hashtable-based xform root environment

src/t.scm

@@ -630,46 +630,58 @@
                (if (eq? (caar env) id)
                    (cdar env) ; location
                    (loop (cdr env)))]
-              [(eq? env #t) 
+              [(vector? env)
-               ; implicitly append integrables and "naked" globals
+               (let* ([n (vector-length env)] [i (immediate-hash id n)]
-               (let ([loc (make-location (or (lookup-integrable id) (list 'ref id)))])
+                      [al (vector-ref env i)] [p (assq id al)])
-                 (set! *root-env* (cons (cons id loc) *root-env*))
+                 (if p (cdr p)
-                 loc)]
+                     ; implicitly append integrables and "naked" globals
+                     (let ([loc (make-location (or (lookup-integrable id) (list 'ref id)))])
+                       (vector-set! env i (cons (cons id loc) al))
+                       loc)))]
               [else ; (future) finite env 
                #f]))))
 
-; make root env from alist of initial transformers
 
-(define *root-env*
+; make root environment from the list of initial transformers
-  (let loop ([l (initial-transformers)] [env #t])
-    (if (null? l) env
-        (let ([p (car l)] [l (cdr l)])
-          (let ([k (car p)] [v (cdr p)])
-            (cond
-              [(or (symbol? v) (number? v)) 
-               (loop l (cons (cons k (make-location v)) env))]
-              [(and (pair? v) (eq? (car v) 'syntax-rules))
-               (body
-                 (define (sr-env id) 
-                   (lookup-in-transformer-env id *root-env*))
-                 (define sr-v
-                   (if (id? (cadr v))
-                       (syntax-rules* sr-env (cadr v) (caddr v) (cdddr v))
-                       (syntax-rules* sr-env #f (cadr v) (cddr v))))
-                 (loop l (cons (cons k (make-location sr-v)) env)))]))))))
 
-(define (root-env id)
+(define *root-environment*
-  (lookup-in-transformer-env id *root-env*))
+  (let* ([n 101] ; use prime number
+         [env (make-vector n '())]) 
+    (define (put! k loc)
+      (let* ([i (immediate-hash k n)] [al (vector-ref env i)] [p (assq k al)])
+        (cond [p (set-cdr! p loc)]
+              [else (vector-set! env i (cons (cons k loc) al))])))
+    (let loop ([l (initial-transformers)])
+      (if (null? l) env
+          (let ([p (car l)] [l (cdr l)])
+            (let ([k (car p)] [v (cdr p)])
+              (cond
+                [(or (symbol? v) (number? v)) 
+                 (put! k (make-location v))
+                 (loop l)]
+                [(and (pair? v) (eq? (car v) 'syntax-rules))
+                 (body
+                   (define (sr-env id) 
+                     (lookup-in-transformer-env id *root-environment*))
+                   (define sr-v
+                     (if (id? (cadr v))
+                         (syntax-rules* sr-env (cadr v) (caddr v) (cdddr v))
+                         (syntax-rules* sr-env #f (cadr v) (cddr v))))
+                   (put! k (make-location sr-v))
+                   (loop l))])))))))
+
+(define (root-environment id)
+  (lookup-in-transformer-env id *root-environment*))
+
+(define (transform! x)
+  (let ([t (xform #t x root-environment)])
+    (when (and (syntax-match? '(define-syntax * *) t) (id? (cadr t))) ; (procedure? (caddr t))
+        (let ([loc (lookup-in-transformer-env (cadr t) *root-environment*)])
+          (when loc (location-set-val! loc (caddr t)))))
+    t)) 
 
 (define (error* msg args)
   (apply error (cons msg args)))
-
-(define (transform! x)
-  (let ([t (xform #t x root-env)])
-    (when (and (syntax-match? '(define-syntax * *) t) (id? (cadr t))) ; (procedure? (caddr t))
-        (let ([loc (lookup-in-transformer-env (cadr t) *root-env*)])
-          (when loc (location-set-val! loc (caddr t)))))
-    t)) 
   
 (define (visit f) 
   (define p (open-input-file f)) 

t.c

@@ -322,29 +322,31 @@ char *t_code[] = {
 
   "P", "lookup-in-transformer-env",
   "%2.0K0?{.0,@(y7:old-den)[21}.1,,#0.2,.1,&2{%1.0p?{:1,.1aaq?{.0ad]1}.0d"
-  ",:0^[11}t,.1q?{:1U5,.0?{.0}{:1,'(y3:ref),l2}_1b,@(y10:*root-env*),.1,:"
+  ",:0^[11}.0V0?{.0V3,.0,:1H2,.0,.3V4,.0,:1A3,.0?{.0d]5}:1U5,.0?{.0}{:1,'"
-  "1cc@!(y10:*root-env*).0]2}f]1}.!0.0^_1[21",
+  "(y3:ref),l2}_1b,.2,.1,:1cc,.4,.7V5.0]6}f]1}.!0.0^_1[21",
 
   "C", 0,
-  "${t,U1,,#0.0,&1{%2.0u?{.1]2}.0d,.1a,.0d,.1a,.1Y0,.0?{.0}{.2N0}_1?{.5,."
+  "'(i101),n,.1V2,,#0.2,.2,&2{%2:1,.1H2,.0,:0V4,.0,.3A3,.0?{.4,.1sd]5}.1,"
-  "2b,.2cc,.4,:0^[62}.1p?{'(y12:syntax-rules),.2aq}{f}?{,,#0#1&0{%1@(y10:"
+  ".5,.5cc,.3,:0V5]5}.!0${U1,,#0.0,.5,.7,&3{%1.0u?{:0]1}.0d,.1a,.0d,.1a,."
-  "*root-env*),.1,@(y25:lookup-in-transformer-env)[12}.!0${.5da,@(y3:id?)"
+  "1Y0,.0?{.0}{.2N0}_1?{${.3b,.3,:1^[02}.3,:2^[51}.1p?{'(y12:syntax-rules"
-  "[01}?{${.5ddd,.6dda,.7da,.5^,@(y13:syntax-rules*)[04}}{${.5dd,.6da,f,."
+  "),.2aq}{f}?{,,#0#1&0{%1@(y18:*root-environment*),.1,@(y25:lookup-in-tr"
-  "5^,@(y13:syntax-rules*)[04}}.!1.7,.2^b,.4cc,.6,:0^[82}f]6}.!0.0^_1[02}"
+  "ansformer-env)[12}.!0${.5da,@(y3:id?)[01}?{${.5ddd,.6dda,.7da,.5^,@(y1"
-  "@!(y10:*root-env*)",
+  "3:syntax-rules*)[04}}{${.5dd,.6da,f,.5^,@(y13:syntax-rules*)[04}}.!1${"
+  ".3^b,.5,:1^[02}.5,:2^[71}f]5}.!0.0^_1[01}_1_1_1@!(y18:*root-environmen"
+  "t*)",
 
-  "P", "root-env",
+  "P", "root-environment",
-  "%1@(y10:*root-env*),.1,@(y25:lookup-in-transformer-env)[12",
+  "%1@(y18:*root-environment*),.1,@(y25:lookup-in-transformer-env)[12",
+
+  "P", "transform!",
+  "%1${@(y16:root-environment),.3,t,@(y5:xform)[03},${.2,'(l3:y13:define-"
+  "syntax;y1:*;y1:*;),@(y13:syntax-match?)[02}?{${.2da,@(y3:id?)[01}}{f}?"
+  "{${@(y18:*root-environment*),.3da,@(y25:lookup-in-transformer-env)[02}"
+  ",.0?{.1dda,.1sz}_1}.0]2",
 
   "P", "error*",
   "%2.1,.1c,@(y5:error),@(y13:apply-to-list)[22",
 
-  "P", "transform!",
-  "%1${@(y8:root-env),.3,t,@(y5:xform)[03},${.2,'(l3:y13:define-syntax;y1"
-  ":*;y1:*;),@(y13:syntax-match?)[02}?{${.2da,@(y3:id?)[01}}{f}?{${@(y10:"
-  "*root-env*),.3da,@(y25:lookup-in-transformer-env)[02},.0?{.1dda,.1sz}_"
-  "1}.0]2",
-
   "P", "visit",
   "%1,#0${.3,@(y15:open-input-file)[01}.!0${${.4^,@(y4:read)[01},,#0.4,.1"
   ",&2{%1.0R8~?{${.2,@(y10:transform!)[01},Po,.1W5PoW6_1${:1^,@(y4:read)["