Changeset 12638 in project for chicken


Ignore:
Timestamp:
11/28/08 13:52:00 (11 years ago)
Author:
felix winkelmann
Message:

desperate attempts to tune

Location:
chicken/branches/lazy-gensyms
Files:
6 edited

Legend:

Unmodified
Added
Removed
  • chicken/branches/lazy-gensyms/c-platform.scm

    r12629 r12638  
    7878    (bound-to-procedure
    7979     ##sys#for-each ##sys#map ##sys#print ##sys#setter
    80      ##sys#setslot ##sys#dynamic-wind ##sys#call-with-values
     80     ##sys#setslot ##sys#dynamic-wind ##sys#call-with-values ##sys#get ##sys#put!
    8181     ##sys#start-timer ##sys#stop-timer ##sys#gcd ##sys#lcm ##sys#make-promise ##sys#structure? ##sys#slot
    8282     ##sys#allocate-vector ##sys#list->vector ##sys#block-ref ##sys#block-set!
     83     ##sys#get ##sys#put! ##sys#symbol-name
    8384     ##sys#list ##sys#cons ##sys#append ##sys#vector ##sys#foreign-char-argument ##sys#foreign-fixnum-argument
    8485     ##sys#foreign-flonum-argument ##sys#error ##sys#peek-c-string ##sys#peek-nonnull-c-string
     
    170171    block-ref block-set! number-of-slots substring-index substring-index-ci
    171172    hash-table-ref any? read-string substring=? substring-ci=?
    172     first second third fourth make-record-instance
     173    first second third fourth make-record-instance gensym
    173174    u8vector-length s8vector-length u16vector-length s16vector-length u32vector-length s32vector-length
    174175    f32vector-length f64vector-length setter
     
    189190    ##sys#make-structure ##sys#apply ##sys#apply-values ##sys#continuation-graft
    190191    ##sys#bytevector? ##sys#make-vector ##sys#setter ##sys#car ##sys#cdr ##sys#pair?
    191     ##sys#eq? ##sys#list? ##sys#vector? ##sys#eqv? ##sys#gensym
     192    ##sys#eq? ##sys#list? ##sys#vector? ##sys#eqv? ##sys#gensym ##sys#get ##sys#put!
    192193    ##sys#foreign-char-argument ##sys#foreign-fixnum-argument ##sys#foreign-flonum-argument
    193     ##sys#foreign-block-argument ##sys#foreign-number-vector-argument
     194    ##sys#foreign-block-argument ##sys#foreign-number-vector-argument ##sys#symbol-name
    194195    ##sys#foreign-string-argument ##sys#foreign-pointer-argument ##sys#void
    195196    ##sys#foreign-integer-argument ##sys#foreign-unsigned-integer-argument ##sys#double->number
     
    217218    u8vector->blob/shared s8vector->blob/shared u16vector->blob/shared s16vector->blob/shared u32vector->blob/shared
    218219    f32vector->blob/shared f64vector->blob/shared
    219     s32vector->blob/shared read-string read-string!
     220    s32vector->blob/shared read-string read-string! gensym ##sys#gensym
    220221    ##sys#make-structure print* ##sys#make-vector ##sys#apply ##sys#setislot ##sys#block-ref
    221     ##sys#byte ##sys#setbyte
     222    ##sys#byte ##sys#setbyte ##sys#get ##sys#put! ##sys#symbol-name
    222223    u8vector-length s8vector-length u16vector-length s16vector-length u32vector-length s32vector-length
    223224    f32vector-length f64vector-length ##sys#apply-values ##sys#setter setter
  • chicken/branches/lazy-gensyms/compiler.scm

    r12629 r12638  
    8383;   ##compiler#visibility -> #f | 'hidden | 'exported
    8484;   ##compiler#constant -> BOOL
    85 ;   ##compiler#intrinsic -> #f | 'standard | 'extended
     85;   ##compiler#intrinsic -> #f | 'standard | 'extended | 'internal
    8686;   ##compiler#inline -> 'no | 'yes
    8787;   ##compiler#inline-global -> 'yes | 'no | <node>
     
    18191819                  (compiler-warning 'redef "redefinition of standard binding `~S'" var) )
    18201820                 ((extended)
    1821                   (compiler-warning 'redef "redefinition of extended binding `~S'" var) ) )
     1821                  (compiler-warning 'redef "redefinition of extended binding `~S'" var) )
     1822                 ((internal)
     1823                  (compiler-warning 'redef "redefinition of internal binding `~S'" var) ) )
    18221824               (put! db var 'potential-value val) )
    18231825             (when (and (not (memq var localenv))
  • chicken/branches/lazy-gensyms/eval.scm

    r12629 r12638  
    159159            (set! cache-s s)
    160160            (set! cache-h
    161               (let ((sn (##sys#symbol-name s)))
    162                 (##core#inline "C_hash_string" sn)))
     161              (let ((sn (##sys#slot s 1)))
     162                (##core#inline
     163                 "C_hash_string"
     164                 (if (fixnum? sn)       ; can't use counter directly, as replacement
     165                     (##sys#symbol-name s) ; will change hash
     166                     sn))))
    163167            (##core#inline "C_fixnum_modulo" cache-h n))))))
    164168
  • chicken/branches/lazy-gensyms/expand.scm

    r12629 r12638  
    3434        lookup check-for-redef) )
    3535
    36 
    3736(set! ##sys#features
    3837  (append '(#:hygienic-macros #:syntax-rules) ##sys#features))
     
    4948(cond-expand
    5049 ((not debugbuild)
     50  (declare
     51    (no-bound-checks)
     52    (no-procedure-checks))
    5153  (cond-expand
    5254   (hygienic-macros
     
    6062    (define-macro (dm . _) '(void)))))
    6163 (else))
     64
     65(define-inline (symname sym)
     66  (let ((sn (##sys#slot sym 1)))
     67    (if (fixnum? sn)
     68        (##sys#symbol-name sym)
     69        sn)))
    6270
    6371
     
    254262    (##sys#slot prefix 1)               ;*** must be symbol with name, not uninst. gensym!
    255263    "#"
    256     (##sys#symbol-name sym) ) ) )
     264    (symname sym) ) ) )
    257265
    258266(define (##sys#alias-global-hook sym assign)
     
    318326    (lambda (llist0 body errh se)
    319327      (define (err msg) (errh msg llist0))
    320       (define (->keyword s) (string->keyword (##sys#symbol-name s)))
     328      (define (->keyword s) (string->keyword (symname s)))
    321329      (let ([rvar #f]
    322330            [hasrest #f]
     
    15131521                          (let ((palias
    15141522                                 (##sys#string->symbol
    1515                                   (##sys#string-append "#%" (##sys#symbol-name ve)))))
     1523                                  (##sys#string-append "#%" (symname ve)))))
    15161524                            (##sys#put! palias '##core#primitive ve)
    15171525                            (cons ve palias))
  • chicken/branches/lazy-gensyms/library.scm

    r12629 r12638  
    11071107  (##sys#intern-symbol str) )
    11081108
     1109(define-inline (symname sym)
     1110  (let ((sn (##sys#slot sym 1)))
     1111    (if (fixnum? sn)
     1112        (##sys#symbol-name sym)
     1113        sn)))
     1114
    11091115(define (##sys#symbol-name sym)
    11101116  (let ((n (##sys#slot sym 1)))
     
    11321138  (set! ##sys#symbol->string
    11331139    (lambda (s)
    1134       (let* ([str (##sys#symbol-name s)]
     1140      (let* ([str (symname s)]
    11351141             [len (##sys#size str)]
    11361142             [i (split str len)] )
     
    11391145  (set! ##sys#symbol->qualified-string
    11401146    (lambda (s)
    1141       (let* ([str (##sys#symbol-name s)]
     1147      (let* ([str (symname s)]
    11421148             [len (##sys#size str)]
    11431149             [i (split str len)] )
     
    11481154  (set! ##sys#qualified-symbol-prefix
    11491155    (lambda (s)
    1150       (let* ([str (##sys#symbol-name s)]
     1156      (let* ([str (symname s)]
    11511157             [len (##sys#size str)]
    11521158             [i (split str len)] )
     
    11541160
    11551161(define (##sys#qualified-symbol? s)
    1156   (let ((str (##sys#symbol-name s)))
     1162  (let ((str (symname s)))
    11571163    (and (fx> (##sys#size str) 0)
    11581164         (fx<= (##sys#byte str 0) namespace-max-id-len))))
  • chicken/branches/lazy-gensyms/support.scm

    r12629 r12638  
    340340         (when (memq s foldable-extended-bindings) (put! db s 'foldable #t)) )
    341341       extended-bindings)
     342      (when initial
     343        (for-each
     344         (lambda (s)
     345           (mark-variable s '##compiler#intrinsic 'internal))
     346         internal-bindings))
    342347      (set! initial #f))))
    343348
Note: See TracChangeset for help on using the changeset viewer.