mirror of
https://github.com/false-schemers/skint.git
synced 2025-01-13 20:03:30 +01:00
hashtable-based xform root environment
This commit is contained in:
ESL
parent
e95b05135b
commit
64f34e7d60
2 changed files with 62 additions and 48 deletions
76
src/t.scm
76
src/t.scm
|
|
@ -630,46 +630,58 @@
|
|||
(if (eq? (caar env) id)
|
||||
(cdar env) ; location
|
||||
(loop (cdr env)))]
|
||||
[(eq? env #t)
|
||||
; implicitly append integrables and "naked" globals
|
||||
(let ([loc (make-location (or (lookup-integrable id) (list 'ref id)))])
|
||||
(set! *root-env* (cons (cons id loc) *root-env*))
|
||||
loc)]
|
||||
[(vector? env)
|
||||
(let* ([n (vector-length env)] [i (immediate-hash id n)]
|
||||
[al (vector-ref env i)] [p (assq id al)])
|
||||
(if p (cdr p)
|
||||
; 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*
|
||||
(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)))]))))))
|
||||
; make root environment from the list of initial transformers
|
||||
|
||||
(define (root-env id)
|
||||
(lookup-in-transformer-env id *root-env*))
|
||||
(define *root-environment*
|
||||
(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))
|
||||
|
|
|
|||
34
t.c
34
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,:"
|
||||
"1cc@!(y10:*root-env*).0]2}f]1}.!0.0^_1[21",
|
||||
",:0^[11}.0V0?{.0V3,.0,:1H2,.0,.3V4,.0,:1A3,.0?{.0d]5}:1U5,.0?{.0}{:1,'"
|
||||
"(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,."
|
||||
"2b,.2cc,.4,:0^[62}.1p?{'(y12:syntax-rules),.2aq}{f}?{,,#0#1&0{%1@(y10:"
|
||||
"*root-env*),.1,@(y25:lookup-in-transformer-env)[12}.!0${.5da,@(y3:id?)"
|
||||
"[01}?{${.5ddd,.6dda,.7da,.5^,@(y13:syntax-rules*)[04}}{${.5dd,.6da,f,."
|
||||
"5^,@(y13:syntax-rules*)[04}}.!1.7,.2^b,.4cc,.6,:0^[82}f]6}.!0.0^_1[02}"
|
||||
"@!(y10:*root-env*)",
|
||||
"'(i101),n,.1V2,,#0.2,.2,&2{%2:1,.1H2,.0,:0V4,.0,.3A3,.0?{.4,.1sd]5}.1,"
|
||||
".5,.5cc,.3,:0V5]5}.!0${U1,,#0.0,.5,.7,&3{%1.0u?{:0]1}.0d,.1a,.0d,.1a,."
|
||||
"1Y0,.0?{.0}{.2N0}_1?{${.3b,.3,:1^[02}.3,:2^[51}.1p?{'(y12:syntax-rules"
|
||||
"),.2aq}{f}?{,,#0#1&0{%1@(y18:*root-environment*),.1,@(y25:lookup-in-tr"
|
||||
"ansformer-env)[12}.!0${.5da,@(y3:id?)[01}?{${.5ddd,.6dda,.7da,.5^,@(y1"
|
||||
"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",
|
||||
"%1@(y10:*root-env*),.1,@(y25:lookup-in-transformer-env)[12",
|
||||
"P", "root-environment",
|
||||
"%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)["
|
||||
|
|
|
|||
Loading…
Reference in a new issue