Miroirs/skint
1
0
Fork 0
mirror of https://github.com/false-schemers/skint.git synced 2024-12-25 21:58:54 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

top forms scan factored out for reuse

Browse source
This commit is contained in:
ESL 2024-07-24 01:47:28 -04:00
parent cf01f4d46e
commit 4f16f52ed6
2 changed files with 98 additions and 77 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

115
pre/t.scm
View file

@ -1046,7 +1046,67 @@
(loop decls code eal esps `(,@forms (,include-ci-id . ,(cdr decl))))] (loop decls code eal esps `(,@forms (,include-ci-id . ,(cdr decl))))]
[(eq? (car decl) ld-begin-id) [(eq? (car decl) ld-begin-id)
(loop decls code eal esps (append forms (xform-sexp->datum (cdr decl))))])))))) (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) (define (preprocess-library sexp env) ;=> (init-core . exports-eal)
; generator of globals: use prefix or temporary if no prefix is given ; generator of globals: use prefix or temporary if no prefix is given
(define (make-nid id) (define (make-nid id)
@ -1060,56 +1120,9 @@
[icimesfs (preprocess-library-declarations (cons (car sexp) decls) env)]) [icimesfs (preprocess-library-declarations (cons (car sexp) decls) env)])
(let* ([code (car icimesfs)] [ial (cadr icimesfs)] [esps (caddr icimesfs)] [forms (cadddr icimesfs)] (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 [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 (let* ([code* (preprocess-top-forms-scan forms cenv env)]
(if (null? body) [fix! (lambda (code) (preprocess-forms-fix-define! code cenv))]
code* [forms-code (cons 'begin (map fix! (reverse! 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*))]
[combined-code (adjoin-code code (if lid (list 'once lid forms-code) forms-code))]) [combined-code (adjoin-code code (if lid (list 'once lid forms-code) forms-code))])
; walk through esps, fetching locations from cenv ; walk through esps, fetching locations from cenv
(let loop ([esps esps] [eal eal]) (let loop ([esps esps] [eal eal])

60
t.c
View file

@ -613,6 +613,31 @@ char *t_code[] = {
".1aq?{${.2d,@(y17:xform-sexp->datum)[01},.7L6,.6,.6,.6,.5,:0^[75}f]7}." ".1aq?{${.2d,@(y17:xform-sexp->datum)[01},.7L6,.6,.6,.6,.5,:0^[75}f]7}."
"!0.0^_1[(i17)5", "!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", "P", "preprocess-library",
"%2,#0.1,&1{%1${:0,@(y7:list2+?)[01}?{${:0da,@(y3:id?)[01}}{f}?{${.2,@(" "%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" "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" "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" "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" "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?{" "rolled-environment)[03},n,${.(i13),.4,.6,@(y25:preprocess-top-forms-sc"
".0a,.1d,${:0,.4,t,@(y5:xform)[03},'(y5:begin),.1q?{.1L0~?{${.5,'(s19:i" "an)[03},.2,&1{%1:0,.1,@(y28:preprocess-forms-fix-define!)[12},${.3A9,."
"mproper begin form),@(y7:x-error)[02}}.6,.5,.3L6,:1^[72}'(y6:define),." "3,@(y5:%25map1)[02},'(y5:begin)c,${.(i13)?{.2,.(i14),'(y4:once),l3}{.2"
"1q?{${.3,.5,@(y17:preprocess-define)[02},${.2,@(y6:list1?)[01}?{.7,.6," "},.(i11),@(y11:adjoin-code)[02},.4,.8,,#0.8,.1,.5,&3{%2.0u?{.1A9,:0c]2"
".2L6,:1^[82}${'(y6:define),.3a,:0,@(y21:top-defined-id-lookup)[03},.0Y" "}.0aa,.1ad,${'(y3:ref),.4,:2[02},.0~?{.2,'(s16:cannot export id),@(y7:"
"2?{${.2z,'(l2:y3:ref;y1:*;),@(y11:sexp-match?)[02}}{f}~?{${.7,.4a,'(s2" "x-error)[52}${.2,@(y17:location-special?)[01}?{.4,.1,.3cc,.4d,:1^[52}."
"4:unexpected define for id),@(y7:x-error)[03}}${:0,.4da,f,@(y5:xform)[" "0z,.0p~,.0?{.0}{'(l2:y3:ref;y5:const;),.2aA0}_1?{.5,.2,.4cc,.5d,:1^[62"
"03},.1zda,.(i10),.2,.2,'(y4:set!),l3c,.9,:1^[(i11)2}'(y13:define-synta" "}.0,.4,'(s27:cannot export code alias id),@(y7:x-error)[63}.!0.0^_1[(i"
"x),.1q?{${.3,.5,@(y24:preprocess-define-syntax)[02},${'(y13:define-syn" "16)2",
"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",
"P", "xform-define-library", "P", "xform-define-library",
"%4${.3,@(y7:list2+?)[01}?{${.3a,@(y9:listname?)[01}}{f}?{${.3a,@(y17:x" "%4${.3,@(y7:list2+?)[01}?{${.3a,@(y9:listname?)[01}}{f}?{${.3a,@(y17:x"