Changeset 36254 in project


Ignore:
Timestamp:
08/13/18 05:56:48 (8 days ago)
Author:
kon
Message:

better symbol-table-access api

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

Legend:

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

    r36241 r36254  
    214214;
    215215(define (search-interaction-environment-symbols env optarg?)
    216   (let loop ((cursor (initial-symbol-table-cursor)) (syms '()))
    217     (let ((sym (root-symbol cursor)))
     216  (let loop ((cursor (cursor-first)) (syms '()))
     217    (let ((sym (cursor-current cursor)))
    218218      (if (not sym)
    219219        syms
    220220        (let ((syms (if (optarg? sym) (cons sym syms) syms)))
    221           (loop (next-root-symbol cursor) syms) ) ) ) ) )
     221          (loop (cursor-next cursor) syms) ) ) ) ) )
    222222
    223223(: search-list-environment-symbols (list procedure --> list))
  • release/5/apropos/trunk/apropos.egg

    r36241 r36254  
    33
    44((synopsis "Chicken apropos")
    5  (version "3.2.0")
     5 (version "3.2.1")
    66 (category misc)
    77 (author "[[kon lovett]]")
  • release/5/apropos/trunk/symbol-table-access.scm

    r36241 r36254  
    3737
    3838(;export
    39   initial-symbol-table-cursor
    40   root-symbol
    41   next-root-symbol)
     39  cursor-first
     40  cursor-current
     41  cursor-next)
    4242
    4343(import scheme
     
    7878(define bucket-last? null?)
    7979
    80 ;;
    81 
    82 (define-type symbol-table-cursor pair)
    83 
    84 (: make-symbol-table-cursor (* * --> symbol-table-cursor))
    85 ;
    86 (define make-symbol-table-cursor cons)
    87 
    88 (: symbol-table-cursor-active? (* --> boolean))
    89 ;
    90 (define symbol-table-cursor-active? pair?)
    91 
    92 (: symbol-table-cursor? (* --> boolean))
    93 ;
    94 (define (symbol-table-cursor? obj)
    95   (or
    96     (not obj)
    97     (symbol-table-cursor-active? obj)) )
    98 
    99 (: symbol-table-cursor-index (symbol-table-cursor --> *))
    100 ;
    101 (define symbol-table-cursor-index car)
    102 
    103 (: set-symbol-table-cursor-index! (symbol-table-cursor * -> void))
    104 ;
    105 (define set-symbol-table-cursor-index! set-car!)
    106 
    107 (: symbol-table-cursor-bucket (symbol-table-cursor --> *))
    108 ;
    109 (define symbol-table-cursor-bucket cdr)
    110 
    111 (: set-symbol-table-cursor-bucket! (symbol-table-cursor * -> void))
    112 ;
    113 (define set-symbol-table-cursor-bucket! set-cdr!)
    114 
    115 (: symbol-table-cursor (--> symbol-table-cursor))
    116 ;
    117 (define (symbol-table-cursor)
    118   (make-symbol-table-cursor -1 '()) )
    119 
    12080(: bucket-symbol-ref (list --> (or boolean symbol)))
    12181;
     
    13292    (bucket-link bkt)) )
    13393
     94;; Symbol Table Cursor
     95
     96(define-type symbol-table-cursor pair)
     97
     98(: make-symbol-table-cursor (* * --> symbol-table-cursor))
     99;
     100(define make-symbol-table-cursor cons)
     101
     102(: cursor-active? (* --> boolean))
     103;
     104(define cursor-active? pair?)
     105
     106(: symbol-table-cursor? (* --> boolean))
     107;
     108(define (symbol-table-cursor? obj)
     109  (or
     110    (not obj)
     111    (cursor-active? obj)) )
     112
     113(: cursor-index (symbol-table-cursor --> *))
     114;
     115(define cursor-index car)
     116
     117(: set-cursor-index! (symbol-table-cursor * -> void))
     118;
     119(define set-cursor-index! set-car!)
     120
     121(: cursor-bucket (symbol-table-cursor --> *))
     122;
     123(define cursor-bucket cdr)
     124
     125(: set-cursor-bucket! (symbol-table-cursor * -> void))
     126;
     127(define set-cursor-bucket! set-cdr!)
     128
     129(: symbol-table-cursor (--> symbol-table-cursor))
     130;
     131(define (symbol-table-cursor)
     132  (make-symbol-table-cursor -1 '()) )
     133
    134134;;;
    135135
    136136;;
    137137
    138 (: next-root-symbol (symbol-table-cursor --> (or boolean symbol-table-cursor)))
     138(: cursor-next (symbol-table-cursor --> (or boolean symbol-table-cursor)))
    139139;
    140 (define (next-root-symbol cursor)
     140(define (cursor-next cursor)
    141141  (and
    142     (symbol-table-cursor-active? cursor)
     142    (cursor-active? cursor)
    143143    (let loop (
    144       (bkt (bucket-link-ref (symbol-table-cursor-bucket cursor)))
    145       (idx (symbol-table-cursor-index cursor)))
     144      (bkt (bucket-link-ref (cursor-bucket cursor)))
     145      (idx (cursor-index cursor)))
    146146      ;gotta bucket ?
    147147      (if (and bkt (not (bucket-last? bkt)))
     
    152152          (and
    153153            ;more to go ?
    154             (< idx (root-symbol-table-size))
     154            (fx< idx (root-symbol-table-size))
    155155            ;this slot
    156156            (loop (root-symbol-table-element idx) idx) ) ) ) ) ) )
    157157
    158 (: initial-symbol-table-cursor (--> (or boolean symbol-table-cursor)))
     158(: cursor-first (--> (or boolean symbol-table-cursor)))
    159159;
    160 (define (initial-symbol-table-cursor)
    161   (next-root-symbol (symbol-table-cursor)) )
     160(define (cursor-first)
     161  (cursor-next (symbol-table-cursor)) )
    162162
    163 (: root-symbol (symbol-table-cursor --> (or boolean symbol)))
     163(: cursor-current (symbol-table-cursor --> (or boolean symbol)))
    164164;
    165 (define (root-symbol cursor)
     165(define (cursor-current cursor)
    166166  (and
    167     (symbol-table-cursor-active? cursor)
    168     (bucket-symbol-ref (symbol-table-cursor-bucket cursor)) ) )
     167    (cursor-active? cursor)
     168    (bucket-symbol-ref (cursor-bucket cursor)) ) )
    169169
    170170) ;module symbol-table-access
Note: See TracChangeset for help on using the changeset viewer.