Changeset 38992 in project


Ignore:
Timestamp:
09/01/20 03:35:36 (4 weeks ago)
Author:
Kon Lovett
Message:

type is interface, more specific return type for symbol-table-cursor

Location:
release/5/apropos/trunk
Files:
6 edited

Legend:

Unmodified
Added
Removed
  • release/5/apropos/trunk/apropos-api.scm

    r38628 r38992  
    5353(import symbol-environment-access)
    5454(import symbol-access)
    55 
    56 ;;;
    5755
    5856;;
     
    502500|#
    503501
    504 ;;; Display
    505 
    506 ;;
     502;; Display
    507503
    508504(define apropos-interning (make-parameter #t (lambda (x)
     
    760756    (for-each display-symbol-information ails) ) )
    761757
    762 ;;; API
     758;; API
    763759
    764760(define apropos-default-options (make-parameter '() (lambda (x)
  • release/5/apropos/trunk/apropos-csi.scm

    r38877 r38992  
    2525(import apropos-api)
    2626
    27 ;;; Bug Support
     27;; Bug Support
    2828
    2929(define-syntax apropos-toplevel-command
     
    3232      (chicken.csi#toplevel-command arg0 ...) ) ) )
    3333
    34 ;;; Support
     34;; Support
    3535
    3636;; string extensions
     
    9696)
    9797
    98 ;;;
    99 ;;; REPL Integeration
    100 ;;;
     98;;
     99;; REPL Integeration
     100;;
    101101
    102102(define (interp-split-arg loc arg)
     
    219219        (apply apropos apropos-args) ) ) ) )
    220220
    221 ;;; Main
     221;; Main
    222222
    223223(when (feature? csi:)
  • release/5/apropos/trunk/apropos.egg

    r38877 r38992  
    77 (author "[[kon lovett]]")
    88 (license "BSD")
    9  (dependencies
    10   srfi-1
    11   srfi-13
    12         check-errors
    13         (string-utils "2.1.1")
    14         (symbol-utils "2.0.2"))
     9 (dependencies srfi-1 srfi-13 check-errors string-utils symbol-utils)
    1510 (test-dependencies test)
    1611 (components
  • release/5/apropos/trunk/symbol-access.scm

    r38527 r38992  
    2424(import (only (srfi 13) string-skip string-drop string-take string-index))
    2525
    26 ;;;
     26;;
     27
     28(: toplevel-module-symbol (#!optional symbol -> symbol))
     29(: toplevel-module-string (-> string))
     30(: global-symbol-ref (symbol -> *))
     31(: global-symbol-bound? (symbol -> boolean))
     32(: internal-module-name? (string -> boolean))
     33(: split-prefixed-symbol (symbol -> string string))
    2734
    2835;;
     
    4249  (string-index str #\# (namespace-tag-length str)) )
    4350
    44 ;;;
    45 
    4651;; Toplevel Symbols
    4752
    48 (: toplevel-module-symbol (#!optional symbol -> symbol))
    49 ;
    5053(define toplevel-module-symbol (make-parameter #f (lambda (x)
    5154  (cond
     
    5659      (toplevel-module-symbol))))))
    5760
    58 (: toplevel-module-string (-> string))
    59 ;
    6061;symbol keyed memeoized string
    6162(define toplevel-module-string
    62   (let ((+symbol+ #f) (+string+ #f))
     63  (let ((topsym (string->uninterned-symbol "")) (topstr ""))
    6364    (lambda ()
    64       (if (eq? +symbol+ (toplevel-module-symbol))
    65         +string+
     65      (if (eq? topsym (toplevel-module-symbol))
     66        topstr
    6667        (begin
    67           (set! +symbol+ (toplevel-module-symbol))
    68           (set! +string+ (symbol->string +symbol+))
     68          (set! topsym (toplevel-module-symbol))
     69          (set! topstr (symbol->string topsym))
    6970          (toplevel-module-string) ) ) ) ) )
    7071
    7172;; Raw Access Renames
    7273
    73 (: global-symbol-bound? (symbol -> boolean))
    74 ;
    7574(define (global-symbol-bound? sym) (##sys#symbol-has-toplevel-binding? sym))
    7675
    77 (: global-symbol-ref (symbol -> *))
    78 ;
    7976(define (global-symbol-ref sym) (##sys#slot sym 0))
    8077
    8178;;
    8279
    83 (: internal-module-name? (string -> boolean))
    84 ;
    8580(define (internal-module-name? str)
    8681  (not (zero? (namespace-tag-length str))) )
    8782
    88 (: split-prefixed-symbol (symbol -> string string))
    89 ;
    9083;=> module-name identifier-name
    9184;
  • release/5/apropos/trunk/symbol-environment-access.scm

    r38625 r38992  
    3333(define-type macro-environment *)
    3434
     35(: system-current-environment (-> list))
     36(: system-macro-environment (-> list))
     37(: macro-symbol-in-environment? (symbol macro-environment -> boolean))
     38(: search-list-environment-symbols ((* -> boolean) (list-of (pair symbol *)) #!optional (pair -> *) --> list))
     39(: search-interaction-environment-symbols ((* -> boolean) -> list))
     40(: search-macro-environment-symbols ((* -> boolean) (list-of (pair symbol *)) --> list))
     41(: search-system-environment-symbols ((* -> boolean) (or (list-of (pair symbol *)) boolean) -> list))
     42
    3543;;
    3644
    3745(define-inline (cons-if test? x xs) (if (test? x) (cons x xs) xs))
    3846
    39 ;;;
    40 
    4147;;
    4248
    43 (: system-current-environment ( -> list))
    44 ;
    4549(define system-current-environment ##sys#current-environment)
    46 
    47 (: system-macro-environment ( -> list))
    48 ;
    4950(define system-macro-environment ##sys#macro-environment)
    50 
    51 ;;
    52 
    53 (: macro-symbol-in-environment? (symbol macro-environment -> boolean))
    54 ;
    5551(define macro-symbol-in-environment? ##sys#macro?)
    5652
    5753;;
    5854
    59 (: search-list-environment-symbols ((* -> boolean) (list-of (pair symbol *)) #!optional (pair -> *) --> list))
    60 ;
    6155(define (search-list-environment-symbols test? env #!optional (itemref car))
    6256  (define (cons-if-symbol syms cell) (cons-if test? (itemref cell) syms))
    6357  (foldl cons-if-symbol '() env) )
    6458
    65 (: search-interaction-environment-symbols ((* -> boolean) -> list))
    66 ;
    6759(define (search-interaction-environment-symbols test?)
    6860  (let loop ((cursor (cursor-first)) (syms '()))
     
    7466;;
    7567
    76 (: search-macro-environment-symbols ((* -> boolean) (list-of (pair symbol *)) --> list))
    77 ;
    7868(define (search-macro-environment-symbols test? env)
    7969  (search-list-environment-symbols test? env) )
    8070
    81 (: search-system-environment-symbols ((* -> boolean) (or (list-of (pair symbol *)) boolean) -> list))
    82 ;
    8371(define (search-system-environment-symbols test? #!optional env)
    8472  (if (list? env)
  • release/5/apropos/trunk/symbol-table-access.scm

    r38801 r38992  
    4747(import (chicken syntax))
    4848
     49;;
     50
     51(define-type symbol-table-cursor pair)
     52
     53(: root-symbol-table-size (-> fixnum))
     54(: root-symbol-table-element (fixnum -> pair))
     55(: bucket-symbol (pair -> symbol))
     56(: bucket-link (pair -> list))
     57(: bucket-last? (list --> boolean))
     58(: bucket-symbol-ref (list -> (or false symbol)))
     59(: bucket-link-ref (list -> (or false list)))
     60(: make-symbol-table-cursor (* * -> symbol-table-cursor))
     61(: cursor-active? (* -> boolean))
     62(: symbol-table-cursor? (* -> boolean))
     63(: cursor-index (symbol-table-cursor -> *))
     64(: set-cursor-index! (symbol-table-cursor * -> void))
     65(: cursor-bucket (symbol-table-cursor -> *))
     66(: set-cursor-bucket! (symbol-table-cursor * -> void))
     67(: symbol-table-cursor (-> symbol-table-cursor))
     68(: cursor-next (symbol-table-cursor -> (or false symbol-table-cursor)))
     69(: cursor-first (-> (or false symbol-table-cursor)))
     70(: cursor-current (symbol-table-cursor -> (or false symbol)))
     71
    4972;; Symbol Table
    5073
    51 (: root-symbol-table-size (-> fixnum))
    52 ;
    5374(define root-symbol-table-size
    5475  (foreign-lambda* int ()
    5576    "return( raw_symbol_table_size( use_root_symbol_table() ) );") )
    5677
    57 (: root-symbol-table-element (fixnum -> pair))
    58 ;
    5978(define root-symbol-table-element
    6079  (foreign-lambda* scheme-object ((int i))
    6180    "return( raw_symbol_table_chain( use_root_symbol_table(), i ) );") )
    6281
    63 (: bucket-symbol (pair -> symbol))
    64 ;
    6582(define bucket-symbol
    6683  (foreign-lambda* scheme-object ((scheme-object bucket))
    6784    "return( raw_bucket_symbol( bucket ) );"))
    6885
    69 (: bucket-link (pair -> list))
    70 ;
    7186(define bucket-link
    7287  (foreign-lambda* scheme-object ((scheme-object bucket))
    7388    "return( raw_bucket_link( bucket ) );"))
    7489
    75 (: bucket-last? (list --> boolean))
    76 ;
    7790(define bucket-last? null?)
    7891
    79 (: bucket-symbol-ref (list -> (or boolean symbol)))
    80 ;
    8192(define (bucket-symbol-ref bkt)
    8293  (and
     
    8495    (bucket-symbol bkt) ) )
    8596
    86 (: bucket-link-ref (list -> (or boolean list)))
    87 ;
    8897(define (bucket-link-ref bkt)
    8998  (and
     
    93102;; Symbol Table Cursor
    94103
    95 (define-type symbol-table-cursor pair)
    96104
    97 (: make-symbol-table-cursor (* * -> symbol-table-cursor))
    98 ;
    99105(define make-symbol-table-cursor cons)
    100 
    101 (: cursor-active? (* -> boolean))
    102 ;
    103106(define cursor-active? pair?)
    104 
    105 (: symbol-table-cursor? (* -> boolean))
    106 ;
    107 (define (symbol-table-cursor? obj)
    108   (or
    109     (not obj)
    110     (cursor-active? obj)) )
    111 
    112 (: cursor-index (symbol-table-cursor -> *))
    113 ;
    114107(define cursor-index car)
    115 
    116 (: set-cursor-index! (symbol-table-cursor * -> void))
    117 ;
    118108(define set-cursor-index! set-car!)
    119 
    120 (: cursor-bucket (symbol-table-cursor -> *))
    121 ;
    122109(define cursor-bucket cdr)
    123 
    124 (: set-cursor-bucket! (symbol-table-cursor * -> void))
    125 ;
    126110(define set-cursor-bucket! set-cdr!)
    127111
    128 (: symbol-table-cursor (-> symbol-table-cursor))
    129 ;
    130112(define (symbol-table-cursor) (make-symbol-table-cursor -1 '()))
    131 
    132 ;;;
     113(define (symbol-table-cursor? obj) (or (not obj) (cursor-active? obj)) )
    133114
    134115;;
    135116
    136 (: cursor-next (symbol-table-cursor -> (or boolean symbol-table-cursor)))
    137 ;
    138117(define (cursor-next cursor)
    139118  (and
     
    154133            (loop (root-symbol-table-element idx) idx) ) ) ) ) ) )
    155134
    156 (: cursor-first (-> (or boolean symbol-table-cursor)))
    157 ;
    158135(define (cursor-first)
    159136  (cursor-next (symbol-table-cursor)) )
    160137
    161 (: cursor-current (symbol-table-cursor -> (or boolean symbol)))
    162 ;
    163138(define (cursor-current cursor)
    164139  (and
Note: See TracChangeset for help on using the changeset viewer.