mirror of
https://github.com/false-schemers/skint.git
synced 2024-12-25 21:58:54 +01:00
top forms scan factored out for reuse
This commit is contained in:
ESL
parent
cf01f4d46e
commit
4f16f52ed6
2 changed files with 98 additions and 77 deletions
113
pre/t.scm
113
pre/t.scm
|
|
@ -1047,6 +1047,66 @@
|
|||
[(eq? (car decl) ld-begin-id)
|
||||
(loop decls code eal esps (append forms (xform-sexp->datum (cdr decl))))]))))))
|
||||
|
||||
; scan forms and return reversed list of core forms, interspersed with (define gs exp)
|
||||
; forms that need further processing (each one will become (set! gs core) form
|
||||
(define (preprocess-top-forms-scan forms cenv env) ;=> code* in reverse order
|
||||
(define (scan body code*) ;=> code* extended, with side-effect on cenv
|
||||
(if (null? body)
|
||||
code*
|
||||
(let ([first (car body)] [rest (cdr body)])
|
||||
(if (pair? first)
|
||||
(let* ([head (car first)] [tail (cdr first)] [hval (xform #t head cenv)])
|
||||
(cond
|
||||
[(eq? hval 'begin)
|
||||
(unless (list? tail) (x-error "improper begin form" first))
|
||||
(scan (append tail rest) code*)] ; splice
|
||||
[(eq? hval 'define)
|
||||
(let ([tail (preprocess-define head tail)])
|
||||
(if (list1? tail) ; tail is either (sexp) or (id sexp)
|
||||
(scan (append tail rest) code*) ; idless, splice
|
||||
(let ([loc (top-defined-id-lookup cenv (car tail) 'define)])
|
||||
(unless (and (location? loc) (sexp-match? '(ref *) (location-val loc)))
|
||||
(x-error "unexpected define for id" (car tail) first))
|
||||
(let ([gs (cadr (location-val loc))] [exp (cadr tail)])
|
||||
; exp expansiom is delayed until all defined ids are ready
|
||||
(scan rest (cons (list 'define gs exp) code*))))))]
|
||||
[(eq? hval 'define-syntax)
|
||||
(let* ([tail (preprocess-define-syntax head tail)]
|
||||
[loc (top-defined-id-lookup cenv (car tail) 'define-syntax)])
|
||||
(unless (location? loc)
|
||||
(x-error "unexpected define-syntax for id" (car tail) first))
|
||||
(location-set-val! loc (xform #t (cadr tail) cenv))
|
||||
(scan rest code*))]
|
||||
[(eq? hval 'define-library)
|
||||
(let* ([core (xform-define-library head tail env #f)]
|
||||
; core is (define-library <listname> <library>)
|
||||
[loc (xenv-lookup env (cadr core) 'define-syntax)])
|
||||
(unless (location? loc)
|
||||
(x-error "unexpected define-library for id" (cadr core) first))
|
||||
(location-set-val! loc (caddr core))
|
||||
(scan rest code*))]
|
||||
[(eq? hval 'import) ; support, in case there is an internal import
|
||||
(let* ([core (xform-import head tail cenv #f)]
|
||||
; core is (import <library>)
|
||||
[l (cadr core)] [code (library-code l)] [eal (library-exports l)])
|
||||
(unless (cenv eal 'import) ; adjoins eal to cenv's imports
|
||||
(x-error "broken import inside library code" first))
|
||||
(scan rest (cons code code*)))] ; adds library init code
|
||||
[(val-transformer? hval) ; apply transformer and loop
|
||||
(scan (cons (hval first cenv) rest) code*)]
|
||||
[else ; form expansion may need to be delayed
|
||||
(scan rest (cons (list 'define '() first) code*))]))
|
||||
; form expansion may need to be delayed
|
||||
(scan rest (cons (list 'define '() first) code*))))))
|
||||
(scan forms '()))
|
||||
|
||||
; scan returns underprocessed defines; this fn fixes that
|
||||
(define (preprocess-forms-fix-define! code cenv) ;=> core
|
||||
(if (and (pair? code) (eq? (car code) 'define) (list3? code))
|
||||
(let* ([gs (cadr code)] [exp (caddr code)] [core (xform #f exp cenv)])
|
||||
(if (null? gs) core (list 'set! gs core)))
|
||||
code))
|
||||
|
||||
(define (preprocess-library sexp env) ;=> (init-core . exports-eal)
|
||||
; generator of globals: use prefix or temporary if no prefix is given
|
||||
(define (make-nid id)
|
||||
|
|
@ -1060,56 +1120,9 @@
|
|||
[icimesfs (preprocess-library-declarations (cons (car sexp) decls) env)])
|
||||
(let* ([code (car icimesfs)] [ial (cadr icimesfs)] [esps (caddr icimesfs)] [forms (cadddr icimesfs)]
|
||||
[cenv (make-controlled-environment ial make-nid env)] [eal '()]) ; m-c-e is defined below
|
||||
(define (scan body code*) ;=> code* extended, with side-effect on cenv
|
||||
(if (null? body)
|
||||
code*
|
||||
(let ([first (car body)] [rest (cdr body)])
|
||||
(if (pair? first)
|
||||
(let* ([head (car first)] [tail (cdr first)] [hval (xform #t head cenv)])
|
||||
(cond
|
||||
[(eq? hval 'begin)
|
||||
(unless (list? tail) (x-error "improper begin form" first))
|
||||
(scan (append tail rest) code*)] ; splice
|
||||
[(eq? hval 'define)
|
||||
(let ([tail (preprocess-define head tail)])
|
||||
(if (list1? tail) ; tail is either (sexp) or (id sexp)
|
||||
(scan (append tail rest) code*) ; idless, splice
|
||||
(let ([loc (top-defined-id-lookup cenv (car tail) 'define)])
|
||||
(unless (and (location? loc) (sexp-match? '(ref *) (location-val loc)))
|
||||
(x-error "unexpected define for id" (car tail) first))
|
||||
(let ([g (cadr (location-val loc))] [core (xform #f (cadr tail) cenv)])
|
||||
(scan rest (cons (list 'set! g core) code*))))))]
|
||||
[(eq? hval 'define-syntax)
|
||||
(let* ([tail (preprocess-define-syntax head tail)]
|
||||
[loc (top-defined-id-lookup cenv (car tail) 'define-syntax)])
|
||||
(unless (location? loc)
|
||||
(x-error "unexpected define-syntax for id" (car tail) first))
|
||||
(location-set-val! loc (xform #t (cadr tail) cenv))
|
||||
(scan rest code*))]
|
||||
[(eq? hval 'define-library)
|
||||
(let* ([core (xform-define-library head tail env #f)]
|
||||
; core is (define-library <listname> <library>)
|
||||
[loc (xenv-lookup env (cadr core) 'define-syntax)])
|
||||
(unless (location? loc)
|
||||
(x-error "unexpected define-library for id" (cadr core) first))
|
||||
(location-set-val! loc (caddr core))
|
||||
(scan rest code*))]
|
||||
[(eq? hval 'import) ; support, in case there is an internal import
|
||||
(let* ([core (xform-import head tail cenv #f)]
|
||||
; core is (import <library>)
|
||||
[l (cadr core)] [code (library-code l)] [eal (library-exports l)])
|
||||
(unless (cenv eal 'import) ; adjoins eal to cenv's imports
|
||||
(x-error "broken import inside library code" first))
|
||||
(scan rest (cons code code*)))] ; adds library init code
|
||||
; TODO: check for built-in (export) and modify eal!
|
||||
[(val-transformer? hval) ; apply transformer and loop
|
||||
(scan (cons (hval first cenv) rest) code*)]
|
||||
[(val-integrable? hval) ; integrable application
|
||||
(scan rest (cons (xform-integrable hval tail cenv) code*))]
|
||||
[else ; other specials and calls (xform does not return libraries)
|
||||
(scan rest (cons (xform #f first cenv) code*))]))
|
||||
(scan rest (cons (xform #f first cenv) code*))))))
|
||||
(let* ([code* (scan forms '())] [forms-code (cons 'begin (reverse! code*))]
|
||||
(let* ([code* (preprocess-top-forms-scan forms cenv env)]
|
||||
[fix! (lambda (code) (preprocess-forms-fix-define! code cenv))]
|
||||
[forms-code (cons 'begin (map fix! (reverse! code*)))]
|
||||
[combined-code (adjoin-code code (if lid (list 'once lid forms-code) forms-code))])
|
||||
; walk through esps, fetching locations from cenv
|
||||
(let loop ([esps esps] [eal eal])
|
||||
|
|
|
|||
60
t.c
60
t.c
|
|
@ -613,6 +613,31 @@ char *t_code[] = {
|
|||
".1aq?{${.2d,@(y17:xform-sexp->datum)[01},.7L6,.6,.6,.6,.5,:0^[75}f]7}."
|
||||
"!0.0^_1[(i17)5",
|
||||
|
||||
"P", "preprocess-top-forms-scan",
|
||||
"%3,#0.2,.4,.2,&3{%2.0u?{.1]2}.0d,.1a,.0p?{.0a,.1d,${:2,.4,t,@(y5:xform"
|
||||
")[03},'(y5:begin),.1q?{.1L0~?{${.5,'(s19:improper begin form),@(y7:x-e"
|
||||
"rror)[02}}.6,.5,.3L6,:0^[72}'(y6:define),.1q?{${.3,.5,@(y17:preprocess"
|
||||
"-define)[02},${.2,@(y6:list1?)[01}?{.7,.6,.2L6,:0^[82}${'(y6:define),."
|
||||
"3a,:2,@(y21:top-defined-id-lookup)[03},.0Y2?{${.2z,'(l2:y3:ref;y1:*;),"
|
||||
"@(y11:sexp-match?)[02}}{f}~?{${.7,.4a,'(s24:unexpected define for id),"
|
||||
"@(y7:x-error)[03}}.1da,.1zda,.(i10),.2,.2,'(y6:define),l3c,.9,:0^[(i11"
|
||||
")2}'(y13:define-syntax),.1q?{${.3,.5,@(y24:preprocess-define-syntax)[0"
|
||||
"2},${'(y13:define-syntax),.3a,:2,@(y21:top-defined-id-lookup)[03},.0Y2"
|
||||
"~?{${.7,.4a,'(s31:unexpected define-syntax for id),@(y7:x-error)[03}}$"
|
||||
"{:2,.4da,t,@(y5:xform)[03},.1sz.8,.7,:0^[92}'(y14:define-library),.1q?"
|
||||
"{${f,:1,.5,.7,@(y20:xform-define-library)[04},${'(y13:define-syntax),."
|
||||
"3da,:1,@(y11:xenv-lookup)[03},.0Y2~?{${.7,.4da,'(s32:unexpected define"
|
||||
"-library for id),@(y7:x-error)[03}}.1dda,.1sz.8,.7,:0^[92}'(y6:import)"
|
||||
",.1q?{${f,:2,.5,.7,@(y12:xform-import)[04},.0da,'0,.1V4,'1,.2V4,${'(y6"
|
||||
":import),.3,:2[02}~?{${.9,'(s33:broken import inside library code),@(y"
|
||||
"7:x-error)[02}}.(i10),.2c,.9,:0^[(i11)2}.0K0?{.6,.5,${:2,.8,.6[02}c,:0"
|
||||
"^[72}.6,.4,n,'(y6:define),l3c,.5,:0^[72}.3,.1,n,'(y6:define),l3c,.2,:0"
|
||||
"^[42}.!0n,.2,.2^[42",
|
||||
|
||||
"P", "preprocess-forms-fix-define!",
|
||||
"%2.0p?{'(y6:define),.1aq?{${.2,@(y6:list3?)[01}}{f}}{f}?{.0da,.1dda,${"
|
||||
".5,.3,f,@(y5:xform)[03},.2u?{.0]5}.0,.3,'(y4:set!),l3]5}.0]2",
|
||||
|
||||
"P", "preprocess-library",
|
||||
"%2,#0.1,&1{%1${:0,@(y7:list2+?)[01}?{${:0da,@(y3:id?)[01}}{f}?{${.2,@("
|
||||
"y7:id->sym)[01},${:0da,@(y7:id->sym)[01},@(y37:fully-qualified-library"
|
||||
|
|
@ -621,32 +646,15 @@ char *t_code[] = {
|
|||
"03}${.3,@(y7:list2+?)[01}?{${.3da,@(y3:id?)[01}}{f}?{${.3da,@(y7:id->s"
|
||||
"ym)[01}}{f},.0?{.2dd}{.2d},${.6,.3,.7ac,@(y31:preprocess-library-decla"
|
||||
"rations)[02},.0a,.1da,.2dda,.3ddda,${.(i11),.(i10)^,.6,@(y27:make-cont"
|
||||
"rolled-environment)[03},n,,#0.(i12),.1,.4,&3{%2.0u?{.1]2}.0d,.1a,.0p?{"
|
||||
".0a,.1d,${:0,.4,t,@(y5:xform)[03},'(y5:begin),.1q?{.1L0~?{${.5,'(s19:i"
|
||||
"mproper begin form),@(y7:x-error)[02}}.6,.5,.3L6,:1^[72}'(y6:define),."
|
||||
"1q?{${.3,.5,@(y17:preprocess-define)[02},${.2,@(y6:list1?)[01}?{.7,.6,"
|
||||
".2L6,:1^[82}${'(y6:define),.3a,:0,@(y21:top-defined-id-lookup)[03},.0Y"
|
||||
"2?{${.2z,'(l2:y3:ref;y1:*;),@(y11:sexp-match?)[02}}{f}~?{${.7,.4a,'(s2"
|
||||
"4:unexpected define for id),@(y7:x-error)[03}}${:0,.4da,f,@(y5:xform)["
|
||||
"03},.1zda,.(i10),.2,.2,'(y4:set!),l3c,.9,:1^[(i11)2}'(y13:define-synta"
|
||||
"x),.1q?{${.3,.5,@(y24:preprocess-define-syntax)[02},${'(y13:define-syn"
|
||||
"tax),.3a,:0,@(y21:top-defined-id-lookup)[03},.0Y2~?{${.7,.4a,'(s31:une"
|
||||
"xpected define-syntax for id),@(y7:x-error)[03}}${:0,.4da,t,@(y5:xform"
|
||||
")[03},.1sz.8,.7,:1^[92}'(y14:define-library),.1q?{${f,:2,.5,.7,@(y20:x"
|
||||
"form-define-library)[04},${'(y13:define-syntax),.3da,:2,@(y11:xenv-loo"
|
||||
"kup)[03},.0Y2~?{${.7,.4da,'(s32:unexpected define-library for id),@(y7"
|
||||
":x-error)[03}}.1dda,.1sz.8,.7,:1^[92}'(y6:import),.1q?{${f,:0,.5,.7,@("
|
||||
"y12:xform-import)[04},.0da,'0,.1V4,'1,.2V4,${'(y6:import),.3,:0[02}~?{"
|
||||
"${.9,'(s33:broken import inside library code),@(y7:x-error)[02}}.(i10)"
|
||||
",.2c,.9,:1^[(i11)2}.0K0?{.6,.5,${:0,.8,.6[02}c,:1^[72}.0U0?{.6,${:0,.5"
|
||||
",.5,@(y16:xform-integrable)[03}c,.5,:1^[72}.6,${:0,.7,f,@(y5:xform)[03"
|
||||
"}c,.5,:1^[72}.3,${:0,.4,f,@(y5:xform)[03}c,.2,:1^[42}.!0${n,.6,.4^[02}"
|
||||
",.0A9,'(y5:begin)c,${.(i13)?{.2,.(i14),'(y4:once),l3}{.2},.(i11),@(y11"
|
||||
":adjoin-code)[02},.4,.8,,#0.8,.1,.5,&3{%2.0u?{.1A9,:0c]2}.0aa,.1ad,${'"
|
||||
"(y3:ref),.4,:2[02},.0~?{.2,'(s16:cannot export id),@(y7:x-error)[52}${"
|
||||
".2,@(y17:location-special?)[01}?{.4,.1,.3cc,.4d,:1^[52}.0z,.0p~,.0?{.0"
|
||||
"}{'(l2:y3:ref;y5:const;),.2aA0}_1?{.5,.2,.4cc,.5d,:1^[62}.0,.4,'(s27:c"
|
||||
"annot export code alias id),@(y7:x-error)[63}.!0.0^_1[(i16)2",
|
||||
"rolled-environment)[03},n,${.(i13),.4,.6,@(y25:preprocess-top-forms-sc"
|
||||
"an)[03},.2,&1{%1:0,.1,@(y28:preprocess-forms-fix-define!)[12},${.3A9,."
|
||||
"3,@(y5:%25map1)[02},'(y5:begin)c,${.(i13)?{.2,.(i14),'(y4:once),l3}{.2"
|
||||
"},.(i11),@(y11:adjoin-code)[02},.4,.8,,#0.8,.1,.5,&3{%2.0u?{.1A9,:0c]2"
|
||||
"}.0aa,.1ad,${'(y3:ref),.4,:2[02},.0~?{.2,'(s16:cannot export id),@(y7:"
|
||||
"x-error)[52}${.2,@(y17:location-special?)[01}?{.4,.1,.3cc,.4d,:1^[52}."
|
||||
"0z,.0p~,.0?{.0}{'(l2:y3:ref;y5:const;),.2aA0}_1?{.5,.2,.4cc,.5d,:1^[62"
|
||||
"}.0,.4,'(s27:cannot export code alias id),@(y7:x-error)[63}.!0.0^_1[(i"
|
||||
"16)2",
|
||||
|
||||
"P", "xform-define-library",
|
||||
"%4${.3,@(y7:list2+?)[01}?{${.3a,@(y9:listname?)[01}}{f}?{${.3a,@(y17:x"
|
||||
|
|
|
|||
Loading…
Reference in a new issue