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

cleanup & minor fixes for lib mark v

Browse source
This commit is contained in:
ESL 2024-07-04 13:29:02 -04:00
parent d4f6ef3451
commit 43baec6704
2 changed files with 61 additions and 436 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

331
src/t.scm
View file

@ -770,7 +770,7 @@
(cond [(null? (cdr freq)) (alt)] [(null? (cddr freq)) (pp (cadr freq) con alt)] (cond [(null? (cdr freq)) (alt)] [(null? (cddr freq)) (pp (cadr freq) con alt)]
[else (pp (cadr freq) con (lambda () (pp (cons (car freq) (cddr freq)) con alt)))])] [else (pp (cadr freq) con (lambda () (pp (cons (car freq) (cddr freq)) con alt)))])]
[(and (list2? freq) (lit=? (car freq) 'not)) (pp (cadr freq) alt con)] [(and (list2? freq) (lit=? (car freq) 'not)) (pp (cadr freq) alt con)]
[else (x-error freq "invalid cond-expand feature requirement")])) [else (x-error "invalid cond-expand feature requirement" freq)]))
(check-syntax sexp '(<id> (* * ...) ...) "invalid cond-expand syntax") (check-syntax sexp '(<id> (* * ...) ...) "invalid cond-expand syntax")
(let loop ([clauses (cdr sexp)]) (let loop ([clauses (cdr sexp)])
(if (null? clauses) '() (if (null? clauses) '()
@ -1288,7 +1288,7 @@
; Path and file name resolution ; Path and file name resolution
;--------------------------------------------------------------------------------------------- ;---------------------------------------------------------------------------------------------
(define (path-strip-directory filename) #;(define (path-strip-directory filename)
(let loop ([l (reverse (string->list filename))] [r '()]) (let loop ([l (reverse (string->list filename))] [r '()])
(cond [(null? l) (list->string r)] (cond [(null? l) (list->string r)]
[(memv (car l) '(#\\ #\/ #\:)) (list->string r)] [(memv (car l) '(#\\ #\/ #\:)) (list->string r)]
@ -1300,7 +1300,7 @@
[(memv (car l) '(#\\ #\/ #\:)) (list->string (reverse l))] [(memv (car l) '(#\\ #\/ #\:)) (list->string (reverse l))]
[else (loop (cdr l))]))) [else (loop (cdr l))])))
(define (path-strip-extension filename) ;; improved #;(define (path-strip-extension filename) ;; improved
(let loop ([l (reverse (string->list filename))]) (let loop ([l (reverse (string->list filename))])
(cond [(null? l) filename] (cond [(null? l) filename]
[(eqv? (car l) #\.) (list->string (reverse (cdr l)))] [(eqv? (car l) #\.) (list->string (reverse (cdr l)))]
@ -1432,7 +1432,7 @@
(let ([p (listname->path libname (car l) ".sld")]) (let ([p (listname->path libname (car l) ".sld")])
(if (and p (file-exists? p)) p (loop (cdr l))))))) (if (and p (file-exists? p)) p (loop (cdr l)))))))
(define (resolve-input-file/lib-name name) ;=> path (or error is signalled) #;(define (resolve-input-file/lib-name name) ;=> path (or error is signalled)
(define filepath (define filepath
(if (string? name) (if (string? name)
(file-resolve-relative-to-current name) (file-resolve-relative-to-current name)
@ -1455,7 +1455,7 @@
(reverse! sexps) (reverse! sexps)
(loop (cons s sexps)))))))) (loop (cons s sexps))))))))
(define (call-with-input-file/lib name ci? proc) ;=> (proc filepath port), called while name is current-file #;(define (call-with-input-file/lib name ci? proc) ;=> (proc filepath port), called while name is current-file
(let ([filepath (resolve-input-file/lib-name name)]) (let ([filepath (resolve-input-file/lib-name name)])
(with-current-file filepath (with-current-file filepath
(lambda () (lambda ()
@ -1464,7 +1464,7 @@
(when ci? (set-port-fold-case! port #t)) (when ci? (set-port-fold-case! port #t))
(proc filepath port))))))) (proc filepath port)))))))
(define (call-with-file/lib-sexps name ci? proc) ;=> (proc sexps), called while name is current-file #;(define (call-with-file/lib-sexps name ci? proc) ;=> (proc sexps), called while name is current-file
(call-with-input-file/lib name ci? ;=> (call-with-input-file/lib name ci? ;=>
(lambda (filepath port) (lambda (filepath port)
(let loop ([sexps '()]) (let loop ([sexps '()])
@ -1473,13 +1473,19 @@
(proc (reverse! sexps)) (proc (reverse! sexps))
(loop (cons s sexps)))))))) (loop (cons s sexps))))))))
(define (for-each-file/lib-sexp proc name ci?) ; proc called while name is current-file #;(define (for-each-file/lib-sexp proc name ci?) ; proc called while name is current-file
(call-with-input-file/lib name ci? ;=> (call-with-input-file/lib name ci? ;=>
(lambda (filepath port) (lambda (filepath port)
(let loop () (let loop ()
(let ([s (read-code-sexp port)]) (let ([s (read-code-sexp port)])
(unless (eof-object? s) (proc s) (loop))))))) (unless (eof-object? s) (proc s) (loop)))))))
(define (library-available? lib)
(cond [(assoc lib *std-lib->alist-env*) #t] ; FIXME
[(string? lib) (file-resolve-relative-to-current lib)]
[(and (pair? lib) (list? lib)) (find-library-path lib)]
[else #f]))
; name prefixes ; name prefixes
(define (fully-qualified-library-prefixed-name lib id) (define (fully-qualified-library-prefixed-name lib id)
@ -1666,19 +1672,6 @@
(box?) (box) (unbox) (set-box!) (box?) (box) (unbox) (set-box!)
)) ))
(define (std-lib->alist-env lib)
(cond [(assoc lib *std-lib->alist-env*) => cdr]
[else #f]))
(define (std-lib->env lib)
(cond [(std-lib->alist-env lib) =>
(lambda (al)
(lambda (id at)
(and (eq? at 'ref)
(let ([p (assq id al)])
(if p (cdr p) #f)))))]
[else #f]))
; add std libraries to root env as expand time mappings of library's symbolic name ; add std libraries to root env as expand time mappings of library's symbolic name
; to an identifyer-syntax expanding into (quote (<init-code> . <eal>)) form ; to an identifyer-syntax expanding into (quote (<init-code> . <eal>)) form
(for-each (for-each
@ -1691,263 +1684,39 @@
(make-location libid-transformer) #t)))) (make-location libid-transformer) #t))))
*std-lib->alist-env*) *std-lib->alist-env*)
#|
; combine explicit finite env1 with finite or infinite env2 (define (std-lib->alist-env lib)
; env1 here is a proper alist of bindings ((<id> . <location>) ...) (cond [(assoc lib *std-lib->alist-env*) => cdr]
; env2 can be any environment -- explicit or implicit, finite or not
(define (adjoin-env env1 env2) ;=> env12
(if (null? env1) env2
(let ([env2 (adjoin-env (cdr env1) env2)])
(cond [(env-lookup (caar env1) env2 'ref) =>
(lambda (loc) ; ? loc is not auto-mapped even when env2 supports it
(if (eq? (cdar env1) loc)
env2 ; repeat of same id with same binding is allowed
(c-error "multiple identifier bindings on import:"
(caar env1) (cdar env1) loc)))]
[else (cons (car env1) env2)]))))
; this variant is used in repl; it allows shadowing of old bindings with new ones
; todo: remove duplicates by starting ; with the env1 and appending non-duplicate parts of env2
(define (adjoin-env/shadow env1 env2) ;=> env12
(if (null? env1) env2
(let ([env2 (adjoin-env/shadow (cdr env1) env2)])
(cond [(env-lookup (caar env1) env2 'ref) =>
(lambda (loc) ; ? loc is not auto-mapped even when env2 supports it
(if (eq? (cdar env1) a)
env2 ; repeat of same id with same binding is allowed
(begin
(c-warning "old identifier binding shadowed on import:"
(caar env1) 'was: a 'now: (cdar env1))
(cons (car env1) env2))))]
[else (cons (car env1) env2)]))))
; local environment is made for expansion of thislib library's body forms
; it is made of explicit import environment followed by a view to lib-specific
; global locations in root environment, normally prefixed with library name
; NB: import-env is expected to be explicit and limited (just an alist)
(define (make-local-env esps thislib import-env) ;=> env (infinite)
(let loop ([esps esps] [env import-env])
(if (null? esps)
(if (lib-public? thislib)
; all non-exported definitions are public and in global namespace under their own names
(append env #t) ; unprefixed view into global namespace (limited use)
; otherwise they are in global namespace under mangled names
(append env (fully-qualified-library-prefix thislib)))
(loop (cdr esps) ; just for syntax checking
(sexp-case (car esps)
[<symbol> env]
[(rename <symbol> <symbol>) env]
[else (c-error "invalid export spec in export:" (car esps))])))))
; environment for import from thislib library into outside libs or programs
(define (make-export-env esps thislib import-env) ;=> env (finite, alist)
(define (extend-export lid eid env)
(cond [(assq eid env) (c-error "duplicate external id in export:" eid esps)]
[(assq lid import-env) => ; re-exported imported id, keep using imported binding under eid
(lambda (b) (cons (cons eid (cdr b)) env))]
[else (cons (cons eid (fully-qualified-library-location thislib lid)) env)]))
(if (lib-public? thislib)
(if (or esps (pair? import-env))
(c-error "module cannot be imported:" thislib)
'())
(let loop ([esps esps] [env '()])
(if (null? esps)
env
(loop (cdr esps)
(sexp-case (car esps)
[<symbol> (extend-export (car esps) (car esps) env)]
[(rename <symbol> <symbol>) (extend-export (cadr (car esps)) (caddr (car esps)) env)]
[else (c-error "invalid export spec in export:" (car esps))]))))))
;---------------------------------------------------------------------------------------------
; Library processing info cache
;---------------------------------------------------------------------------------------------
; we have to cache loaded libraries, so stores are not hit on repeat loads/visits
; of/to the same library
(define *library-info-cache* '())
;; library info: #(used-libs import-env export-specs beg-forms)
(define (make-library-info) (make-vector 4 #f))
(define (library-available? lib)
(cond [(assoc lib *library-info-cache*) #t]
[(string? lib) (file-resolve-relative-to-current lib)]
[(and (pair? lib) (list? lib)) (find-library-path lib)]
[else #f])) [else #f]))
(define (lookup-library-info lib) ;=> li (possibly non-inited) (define (std-lib->env lib)
(cond [(assoc lib *library-info-cache*) => cdr] (cond [(std-lib->alist-env lib) =>
[(std-lib->alist lib) =>
(lambda (al) (lambda (al)
(define li (make-library-info)) (lambda (id at)
(set! *library-info-cache* (and (eq? at 'ref)
(cons (cons lib li) *library-info-cache*)) (let ([p (assq id al)])
(vector-set! li 0 '()) (if p (cdr p) #f)))))]
(vector-set! li 1 al) [else #f]))
(vector-set! li 2 (map car al)) |#
(vector-set! li 3 '())
li)]
[else ;---------------------------------------------------------------------------------------------
(let ([li (make-library-info)]) ; Library processing
(set! *library-info-cache* ;---------------------------------------------------------------------------------------------
(cons (cons lib li) *library-info-cache*))
li)]))
; main hub for library info -- calls process if library info is not inited
(define (get-library-info lib process return) ;=> (return used-libs import-env export-specs beg-forms)
(define li (lookup-library-info lib))
(define (update-li! used-libs import-env export-specs beg-forms)
(vector-set! li 0 used-libs)
(vector-set! li 1 import-env)
(vector-set! li 2 export-specs)
(vector-set! li 3 beg-forms))
(unless (vector-ref li 0) ; not inited?
(call-with-file/lib-sexps lib #f
(lambda (all-forms) ; need to split off header forms
(process lib all-forms update-li!))))
(return (vector-ref li 0)
(vector-ref li 1)
(vector-ref li 2)
(vector-ref li 3)))
;--------------------------------------------------------------------------------------------- ;---------------------------------------------------------------------------------------------
; Evaluation ; Evaluation
;--------------------------------------------------------------------------------------------- ;---------------------------------------------------------------------------------------------
; transformation of top-level form should process begin, define, and define-syntax
; explicitly, so that they can produce and observe side effects on env
(define (visit-top-form x env)
(if (pair? x)
(let ([hval (xform #t (car x) env)])
(cond
[(eq? hval 'begin)
; splice
(let loop ([x* (cdr x)])
(when (pair? x*)
(visit-top-form (car x*) env)
(loop (cdr x*))))]
[(eq? hval 'define)
; use new protocol for top-level envs
(let* ([core (xform-define (cdr x) env)]
[loc (xenv-lookup env (cadr core) 'define)])
(if (and loc (sexp-match? '(ref *) (location-val loc)))
#t
(x-error "identifier cannot be (re)defined in env:"
(cadr core) env)))]
[(eq? hval 'define-syntax)
; use new protocol for top-level envs
(let* ([core (xform-define-syntax (cdr x) env)]
[loc (xenv-lookup env (cadr core) 'define-syntax)])
(if loc ; location or #f
(location-set-val! loc (caddr core)) ; modifies env!
(x-error "identifier cannot be (re)defined as syntax in env:"
(cadr core) env)))]
[(procedure? hval)
; transformer: apply and loop
(visit-top-form (hval x env) env)]
[(integrable? hval)
; no env effect possible here
#t]
[(symbol? hval)
; other specials: no env effect possible here (?? set! ??)
#t]
[else
; regular call: no env effect possible here
#t]))
; var refs and literals : xform for access check
#t))
(define (eval-top-form x env)
(if (pair? x)
(let ([hval (xform #t (car x) env)])
(cond
[(eq? hval 'begin)
; splice
(let loop ([x* (cdr x)])
(when (pair? x*)
(eval-top-form (car x*) env)
(loop (cdr x*))))]
[(eq? hval 'define)
; use new protocol for top-level envs
(let* ([core (xform-define (cdr x) env)]
[loc (xenv-lookup env (cadr core) 'define)])
(if (and loc (sexp-match? '(ref *) (location-val loc)))
(compile-and-run-core-expr
(list 'set! (cadr (location-val loc)) (caddr core)))
(x-error "identifier cannot be (re)defined in env:"
(cadr core) env)))]
[(eq? hval 'define-syntax)
; use new protocol for top-level envs
(let* ([core (xform-define-syntax (cdr x) env)]
[loc (xenv-lookup env (cadr core) 'define-syntax)])
(if loc ; location or #f
(location-set-val! loc (caddr core))
(x-error "identifier cannot be (re)defined as syntax in env:"
(cadr core) env)))]
[(procedure? hval)
; transformer: apply and loop
(eval-top-form (hval x env) env)]
[(integrable? hval)
; integrable application
(compile-and-run-core-expr
(xform-integrable hval (cdr x) env))]
[(symbol? hval)
; other specials
(compile-and-run-core-expr
(xform #f x env))]
[else
; regular call
(compile-and-run-core-expr
(xform-call hval (cdr x) env))]))
; var refs and literals
(compile-and-run-core-expr
(xform #f x env))))
(define *verbose* #f)
(define (compile-and-run-core-expr core)
(unless (pair? core) (x-error "unexpected transformed output" core))
(when *verbose* (write core) (newline))
(when (eq? (car core) 'define) (set-car! core 'set!))
(let ([code (compile-to-thunk-code core)])
(when *verbose* (write code) (newline))
(let* ([cl (closure (deserialize-code code))] [r (cl)])
(when *verbose* (write r) (newline)))))
(define (visit/v f)
(define p (open-input-file f))
(let loop ([x (read-code-sexp p)])
(unless (eof-object? x)
(when *verbose* (write x) (newline))
(visit-top-form x root-environment)
(when *verbose* (newline))
(loop (read-code-sexp p))))
(close-input-port p))
(define (visit/x f)
(define p (open-input-file f))
(let loop ([x (read-code-sexp p)])
(unless (eof-object? x)
(when *verbose* (write x) (newline))
(eval-top-form x root-environment)
(when *verbose* (newline))
(loop (read-code-sexp p))))
(close-input-port p))
;--------------------------------------------------------------------------------------------- ;---------------------------------------------------------------------------------------------
; REPL ; REPL
;--------------------------------------------------------------------------------------------- ;---------------------------------------------------------------------------------------------
(define *verbose* #f)
(define (repl-environment id at) ; FIXME: need to happen in a "repl." namespace (define (repl-environment id at) ; FIXME: need to happen in a "repl." namespace
(env-lookup id *root-environment* at)) (env-lookup id *root-environment* at))
@ -1969,26 +1738,22 @@
(if (pair? x) (if (pair? x)
(let ([hval (xform #t (car x) env)]) (let ([hval (xform #t (car x) env)])
(cond (cond
[(eq? hval 'begin) [(eq? hval 'begin) ; splice
; splice
(let loop ([x* (cdr x)]) (let loop ([x* (cdr x)])
(when (pair? x*) (when (pair? x*)
(repl-eval-top-form (car x*) env) (repl-eval-top-form (car x*) env)
(loop (cdr x*))))] (loop (cdr x*))))]
[(and (eq? hval 'define) (null? (cadr x))) [(and (eq? hval 'define) (null? (cadr x))) ; special idless define
; special idless define
(repl-eval-top-form (caddr x) env)] (repl-eval-top-form (caddr x) env)]
[(eq? hval 'define) [(eq? hval 'define) ; use new protocol for top-level envs
; use new protocol for top-level envs
(let* ([core (xform-define (cdr x) env)] (let* ([core (xform-define (cdr x) env)]
[loc (xenv-lookup env (cadr core) 'define)]) [loc (xenv-lookup env (cadr core) 'define)])
(if (and loc (sexp-match? '(ref *) (location-val loc))) (if (and loc (sexp-match? '(ref *) (location-val loc)))
(repl-compile-and-run-core-expr (repl-compile-and-run-core-expr
(list 'set! (cadr (location-val loc)) (caddr core))) (list 'set! (cadr (location-val loc)) (caddr core)))
(x-error "identifier cannot be (re)defined in env:" (x-error "identifier cannot be (re)defined as variable in env:"
(cadr core) env)))] (cadr core) env)))]
[(eq? hval 'define-syntax) [(eq? hval 'define-syntax) ; use new protocol for top-level envs
; use new protocol for top-level envs
(let* ([core (xform-define-syntax (cdr x) env)] (let* ([core (xform-define-syntax (cdr x) env)]
[loc (xenv-lookup env (cadr core) 'define-syntax)]) [loc (xenv-lookup env (cadr core) 'define-syntax)])
(if loc ; location or #f (if loc ; location or #f
@ -1996,24 +1761,16 @@
(x-error "identifier cannot be (re)defined as syntax in env:" (x-error "identifier cannot be (re)defined as syntax in env:"
(cadr core) env)) (cadr core) env))
(when *verbose* (display "SYNTAX INSTALLED: ") (write (cadr core)) (newline)))] (when *verbose* (display "SYNTAX INSTALLED: ") (write (cadr core)) (newline)))]
[(procedure? hval) [(procedure? hval) ; transformer: apply and loop
; transformer: apply and loop
(repl-eval-top-form (hval x env) env)] (repl-eval-top-form (hval x env) env)]
[(integrable? hval) [(integrable? hval) ; integrable application
; integrable application (repl-compile-and-run-core-expr (xform-integrable hval (cdr x) env))]
(repl-compile-and-run-core-expr [(symbol? hval) ; other specials
(xform-integrable hval (cdr x) env))] (repl-compile-and-run-core-expr (xform #f x env))]
[(symbol? hval) [else ; regular call
; other specials (repl-compile-and-run-core-expr (xform-call hval (cdr x) env))]))
(repl-compile-and-run-core-expr
(xform #f x env))]
[else
; regular call
(repl-compile-and-run-core-expr
(xform-call hval (cdr x) env))]))
; var refs and literals ; var refs and literals
(repl-compile-and-run-core-expr (repl-compile-and-run-core-expr (xform #f x env))))
(xform #f x env))))
(define (repl-read iport prompt) (define (repl-read iport prompt)
(when prompt (newline) (display prompt) (display " ")) (when prompt (newline) (display prompt) (display " "))

166
t.c
View file

@ -419,8 +419,8 @@ char *t_code[] = {
"a,:1^[33}.2,.3,.3,.3,:1,&4{%0:3,:2,:1dd,:1ac,:0^[03},.2da,:1^[33}${.2," "a,:1^[33}.2,.3,.3,.3,:1,&4{%0:3,:2,:1dd,:1ac,:0^[03},.2da,:1^[33}${.2,"
"@(y7:list1+?)[01}?{${'(y2:or),.3a,:0[02}}{f}?{.0du?{.2[30}.0ddu?{.2,.2" "@(y7:list1+?)[01}?{${'(y2:or),.3a,:0[02}}{f}?{.0du?{.2[30}.0ddu?{.2,.2"
",.2da,:1^[33}.2,.2,.2,:1,&4{%0:3,:2,:1dd,:1ac,:0^[03},.2,.2da,:1^[33}$" ",.2da,:1^[33}.2,.2,.2,:1,&4{%0:3,:2,:1dd,:1ac,:0^[03},.2,.2da,:1^[33}$"
"{.2,@(y6:list2?)[01}?{${'(y3:not),.3a,:0[02}}{f}?{.1,.3,.2da,:1^[33}'(" "{.2,@(y6:list2?)[01}?{${'(y3:not),.3a,:0[02}}{f}?{.1,.3,.2da,:1^[33}.0"
"s39:invalid cond-expand feature requirement),.1,@(y7:x-error)[32}.!0${" ",'(s39:invalid cond-expand feature requirement),@(y7:x-error)[32}.!0${"
"'(s26:invalid cond-expand syntax),'(l3:y4:<id>;l3:y1:*;y1:*;y3:...;;y3" "'(s26:invalid cond-expand syntax),'(l3:y4:<id>;l3:y1:*;y1:*;y3:...;;y3"
":...;),.6,@(y12:check-syntax)[03}.2d,,#0.0,.3,&2{%1.0u?{n]1}.0,:1,&2{%" ":...;),.6,@(y12:check-syntax)[03}.2d,,#0.0,.3,&2{%1.0u?{n]1}.0,:1,&2{%"
"0:1d,:0^[01},.1,&1{%0:0ad]0},.2aa,:0^[13}.!0.0^_1[31", "0:1d,:0^[01},.1,&1{%0:0ad]0},.2aa,:0^[13}.!0.0^_1[31",
@ -676,18 +676,10 @@ char *t_code[] = {
"%1P51,${.2,'0,${n,.8,@(y9:find-free)[02},n,n,n,.9,@(y7:codegen)[07}.0P" "%1P51,${.2,'0,${n,.8,@(y9:find-free)[02},n,n,n,.9,@(y7:codegen)[07}.0P"
"90]2", "90]2",
"P", "path-strip-directory",
"%1n,.1X2A8,,#0.0,&1{%2.0u?{.1X3]2}'(l3:c%5c;c/;c:;),.1aA1?{.1X3]2}.1,."
"1ac,.1d,:0^[22}.!0.0^_1[12",
"P", "path-directory", "P", "path-directory",
"%1.0X2A8,,#0.0,&1{%1.0u?{'(s0:)]1}'(l3:c%5c;c/;c:;),.1aA1?{.0A8X3]1}.0" "%1.0X2A8,,#0.0,&1{%1.0u?{'(s0:)]1}'(l3:c%5c;c/;c:;),.1aA1?{.0A8X3]1}.0"
"d,:0^[11}.!0.0^_1[11", "d,:0^[11}.!0.0^_1[11",
"P", "path-strip-extension",
"%1.0X2A8,,#0.0,.3,&2{%1.0u?{:0]1}'(c.),.1av?{.0dA8X3]1}'(l3:c%5c;c/;c:"
";),.1aA1?{:0]1}.0d,:1^[11}.!0.0^_1[11",
"P", "base-path-separator", "P", "base-path-separator",
"%1.0X2A8,.0u?{f]2}'(l2:c%5c;c/;),.1aA1?{.0a]2}f]2", "%1.0X2A8,.0u?{f]2}'(l2:c%5c;c/;),.1aA1?{.0a]2}f]2",
@ -767,32 +759,15 @@ char *t_code[] = {
"%1@(y19:*library-path-list*),,#0.2,.1,&2{%1.0u?{f]1}${'(s4:.sld),.3a,:" "%1@(y19:*library-path-list*),,#0.2,.1,&2{%1.0u?{f]1}${'(s4:.sld),.3a,:"
"1,@(y14:listname->path)[03},.0?{.0F0}{f}?{.0]2}.1d,:0^[21}.!0.0^_1[11", "1,@(y14:listname->path)[03},.0?{.0F0}{f}?{.0]2}.1d,:0^[21}.!0.0^_1[11",
"P", "resolve-input-file/lib-name",
"%1,#0.1S0?{${.3,@(y32:file-resolve-relative-to-current)[01}}{${.3,@(y1"
"7:find-library-path)[01}}.!0.0^~?{.1S0?{${.3,'(s35:cannot resolve file"
" name to a file:),@(y7:c-error)[02}}{${@(y19:*library-path-list*),'(y2"
":in),.5,'(s38:cannot resolve library name to a file:),@(y7:c-error)[04"
"}}}.0^F0~?{${.2^,'(y2:=>),.5,'(s56:cannot resolve file or library name"
" to an existing file:),@(y7:c-error)[04}}.0^]2",
"P", "read-file-sexps", "P", "read-file-sexps",
"%2.1,&1{%1:0?{t,.1P79}n,,#0.2,.1,&2{%1${:1,@(y14:read-code-sexp)[01},." "%2.1,&1{%1:0?{t,.1P79}n,,#0.2,.1,&2{%1${:1,@(y14:read-code-sexp)[01},."
"0R8?{.1A9]2}.1,.1c,:0^[21}.!0.0^_1[11},.1,@(y20:call-with-input-file)[" "0R8?{.1A9]2}.1,.1c,:0^[21}.!0.0^_1[11},.1,@(y20:call-with-input-file)["
"22", "22",
"P", "call-with-input-file/lib", "P", "library-available?",
"%3${.2,@(y27:resolve-input-file/lib-name)[01},.2,.1,.5,&3{%0:0,:1,:2,&" "%1@(y20:*std-lib->alist-env*),.1A5?{t]1}.0S0?{.0,@(y32:file-resolve-re"
"3{%1:0?{t,.1P79}.0,:1,:2[12},:1,@(y20:call-with-input-file)[02},.1,@(y" "lative-to-current)[11}.0p?{.0L0}{f}?{.0,@(y17:find-library-path)[11}f]"
"17:with-current-file)[42", "1",
"P", "call-with-file/lib-sexps",
"%3.2,&1{%2n,,#0.3,:0,.2,&3{%1${:2,@(y14:read-code-sexp)[01},.0R8?{.1A9"
",:1[21}.1,.1c,:0^[21}.!0.0^_1[21},.2,.2,@(y24:call-with-input-file/lib"
")[33",
"P", "for-each-file/lib-sexp",
"%3.0,&1{%2,#0.2,.1,:0,&3{%0${:2,@(y14:read-code-sexp)[01},.0R8~?{${.2,"
":0[01}:1^[10}]1}.!0.0^_1[20},.3,.3,@(y24:call-with-input-file/lib)[33",
"P", "fully-qualified-library-prefixed-name", "P", "fully-qualified-library-prefixed-name",
"%2.1,'(y1:?),.2Y0?{.2}{${.4,@(y16:listname->symbol)[01}},@(y13:symbol-" "%2.1,'(y1:?),.2Y0?{.2}{${.4,@(y16:listname->symbol)[01}},@(y13:symbol-"
@ -989,122 +964,15 @@ char *t_code[] = {
"environment)[02},.3,${${.9a,:1^[01},:0^[01},:2^[03}.1d,.1,:3^[22}.!0.0" "environment)[02},.3,${${.9a,:1^[01},:0^[01},:2^[03}.1d,.1,:3^[22}.!0.0"
"^_1[42},@(y10:%25for-each1)[02}", "^_1[42},@(y10:%25for-each1)[02}",
"P", "std-lib->alist-env",
"%1@(y20:*std-lib->alist-env*),.1A5,.0?{.0d]2}f]2",
"P", "std-lib->env",
"%1${.2,@(y18:std-lib->alist-env)[01},.0?{.0,.0,&1{%2'(y3:ref),.2q?{:0,"
".1A3,.0?{.0d]3}f]3}f]2}]3}f]2",
"C", 0, "C", 0,
"${@(y20:*std-lib->alist-env*),${f,'(y6:syntax)b,'(y6:syntax),@(y6:new-" "${@(y20:*std-lib->alist-env*),${f,'(y6:syntax)b,'(y6:syntax),@(y6:new-"
"id)[03},.0,&1{%1.0a,.1d,${.3,@(y16:listname->symbol)[01},,#0.2,:0,&2{%" "id)[03},.0,&1{%1.0a,.1d,${.3,@(y16:listname->symbol)[01},,#0.2,:0,&2{%"
"2:1,'(l1:y5:begin;)c,'(y5:quote),l2,:0,l2]2}.!0t,.1^b,.3,@(y27:define-" "2:1,'(l1:y5:begin;)c,'(y5:quote),l2,:0,l2]2}.!0t,.1^b,.3,@(y27:define-"
"in-root-environment!)[53}_1,@(y10:%25for-each1)[02}", "in-root-environment!)[53}_1,@(y10:%25for-each1)[02}",
"P", "adjoin-env",
"%2.0u?{.1]2}${.3,.3d,@(y10:adjoin-env)[02},${'(y3:ref),.3,.5aa,@(y10:e"
"nv-lookup)[03},.0?{.0,.0,.4adq?{.2]5}.0,.4ad,.5aa,'(s39:multiple ident"
"ifier bindings on import:),@(y7:c-error)[54}.1,.3ac]4",
"P", "adjoin-env/shadow",
"%2.0u?{.1]2}${.3,.3d,@(y17:adjoin-env/shadow)[02},${'(y3:ref),.3,.5aa,"
"@(y10:env-lookup)[03},.0?{.0,@(y1:a),.4adq?{.2]5}${.5ad,'(y4:now:),@(y"
"1:a),'(y4:was:),.9aa,'(s42:old identifier binding shadowed on import:)"
",@(y9:c-warning)[06}.2,.4ac]5}.1,.3ac]4",
"P", "make-local-env",
"%3.2,.1,,#0.0,.5,&2{%2.0u?{${:0,@(y11:lib-public?)[01}?{t,.2L6]2}${:0,"
"@(y30:fully-qualified-library-prefix)[01},.2L6]2}.0a,${.2,'(y8:<symbol"
">),@(y11:sexp-match?)[02}?{.2}{${.2,'(l3:y6:rename;y8:<symbol>;y8:<sym"
"bol>;),@(y11:sexp-match?)[02}?{.2}{${.3a,'(s30:invalid export spec in "
"export:),@(y7:c-error)[02}}}_1,.1d,:1^[22}.!0.0^_1[32",
"P", "make-export-env",
"%3,#0.3,.3,.3,&3{%3.2,.2A3?{:0,.2,'(s32:duplicate external id in expor"
"t:),@(y7:c-error)[33}:2,.1A3,.0?{.0,.4,.1d,.5cc]5}.3,${.4,:1,@(y32:ful"
"ly-qualified-library-location)[02},.4cc]4}.!0${.4,@(y11:lib-public?)[0"
"1}?{.1,.0?{.0}{.4p}_1?{.2,'(s26:module cannot be imported:),@(y7:c-err"
"or)[42}n]4}n,.2,,#0.3,.1,&2{%2.0u?{.1]2}.0a,${.2,'(y8:<symbol>),@(y11:"
"sexp-match?)[02}?{${.4,.4a,.5a,:1^[03}}{${.2,'(l3:y6:rename;y8:<symbol"
">;y8:<symbol>;),@(y11:sexp-match?)[02}?{${.4,.4adda,.5ada,:1^[03}}{${."
"3a,'(s30:invalid export spec in export:),@(y7:c-error)[02}}}_1,.1d,:0^"
"[22}.!0.0^_1[42",
"C", 0,
"n@!(y20:*library-info-cache*)",
"P", "make-library-info",
"%0f,'4V2]0",
"P", "library-available?",
"%1@(y20:*library-info-cache*),.1A5?{t]1}.0S0?{.0,@(y32:file-resolve-re"
"lative-to-current)[11}.0p?{.0L0}{f}?{.0,@(y17:find-library-path)[11}f]"
"1",
"P", "lookup-library-info",
"%1@(y20:*library-info-cache*),.1A5,.0?{.0d]2}${.3,@(y14:std-lib->alist"
")[01},.0?{.0,,#0${@(y17:make-library-info)[00}.!0@(y20:*library-info-c"
"ache*),.1^,.6cc@!(y20:*library-info-cache*)n,'0,.2^V5.1,'1,.2^V5${.3,@"
"(y3:car),@(y5:%25map1)[02},'2,.2^V5n,'3,.2^V5.0^]5}${@(y17:make-librar"
"y-info)[00},@(y20:*library-info-cache*),.1,.5cc@!(y20:*library-info-ca"
"che*).0]4",
"P", "get-library-info",
"%3,,#0#1${.4,@(y19:lookup-library-info)[01}.!0.0,&1{%4.0,'0,:0^V5.1,'1"
",:0^V5.2,'2,:0^V5.3,'3,:0^V5]4}.!1'0,.1^V4~?{${.3,.5,.7,&3{%1:2^,.1,:1"
",:0[13},f,.6,@(y24:call-with-file/lib-sexps)[03}}'3,.1^V4,'2,.2^V4,'1,"
".3^V4,'0,.4^V4,.8[54",
"P", "visit-top-form",
"%2.0p?{${.3,.3a,t,@(y5:xform)[03},'(y5:begin),.1q?{.1d,,#0.4,.1,&2{%1."
"0p?{${:1,.3a,@(y14:visit-top-form)[02}.0d,:0^[11}]1}.!0.0^_1[31}'(y6:d"
"efine),.1q?{${.4,.4d,@(y12:xform-define)[02},${'(y6:define),.3da,.7,@("
"y11:xenv-lookup)[03},.0?{${.2z,'(l2:y3:ref;y1:*;),@(y11:sexp-match?)[0"
"2}}{f}?{t]5}.4,.2da,'(s40:identifier cannot be (re)defined in env:),@("
"y7:x-error)[53}'(y13:define-syntax),.1q?{${.4,.4d,@(y19:xform-define-s"
"yntax)[02},${'(y13:define-syntax),.3da,.7,@(y11:xenv-lookup)[03},.0?{."
"1dda,.1sz]5}.4,.2da,'(s50:identifier cannot be (re)defined as syntax i"
"n env:),@(y7:x-error)[53}.0K0?{.2,${.5,.5,.5[02},@(y14:visit-top-form)"
"[32}.0U0?{t]3}.0Y0?{t]3}t]3}t]2",
"P", "eval-top-form",
"%2.0p?{${.3,.3a,t,@(y5:xform)[03},'(y5:begin),.1q?{.1d,,#0.4,.1,&2{%1."
"0p?{${:1,.3a,@(y13:eval-top-form)[02}.0d,:0^[11}]1}.!0.0^_1[31}'(y6:de"
"fine),.1q?{${.4,.4d,@(y12:xform-define)[02},${'(y6:define),.3da,.7,@(y"
"11:xenv-lookup)[03},.0?{${.2z,'(l2:y3:ref;y1:*;),@(y11:sexp-match?)[02"
"}}{f}?{.1dda,.1zda,'(y4:set!),l3,@(y25:compile-and-run-core-expr)[51}."
"4,.2da,'(s40:identifier cannot be (re)defined in env:),@(y7:x-error)[5"
"3}'(y13:define-syntax),.1q?{${.4,.4d,@(y19:xform-define-syntax)[02},${"
"'(y13:define-syntax),.3da,.7,@(y11:xenv-lookup)[03},.0?{.1dda,.1sz]5}."
"4,.2da,'(s50:identifier cannot be (re)defined as syntax in env:),@(y7:"
"x-error)[53}.0K0?{.2,${.5,.5,.5[02},@(y13:eval-top-form)[32}.0U0?{${.4"
",.4d,.4,@(y16:xform-integrable)[03},@(y25:compile-and-run-core-expr)[3"
"1}.0Y0?{${.4,.4,f,@(y5:xform)[03},@(y25:compile-and-run-core-expr)[31}"
"${.4,.4d,.4,@(y10:xform-call)[03},@(y25:compile-and-run-core-expr)[31}"
"${.3,.3,f,@(y5:xform)[03},@(y25:compile-and-run-core-expr)[21",
"C", 0, "C", 0,
"f@!(y9:*verbose*)", "f@!(y9:*verbose*)",
"P", "compile-and-run-core-expr",
"%1.0p~?{${.2,'(s29:unexpected transformed output),@(y7:x-error)[02}}@("
"y9:*verbose*)?{Po,.1W5PoW6}'(y6:define),.1aq?{'(y4:set!),.1sa}${.2,@(y"
"21:compile-to-thunk-code)[01},@(y9:*verbose*)?{Po,.1W5PoW6}.0U4,U91,${"
".2[00},@(y9:*verbose*)?{Po,.1W5PoW6]4}]4",
"P", "visit/v",
"%1,#0${.3,@(y15:open-input-file)[01}.!0${${.4^,@(y14:read-code-sexp)[0"
"1},,#0.4,.1,&2{%1.0R8~?{@(y9:*verbose*)?{Po,.1W5PoW6}${@(y16:root-envi"
"ronment),.3,@(y14:visit-top-form)[02}@(y9:*verbose*)?{PoW6}${:1^,@(y14"
":read-code-sexp)[01},:0^[11}]1}.!0.0^_1[01}.0^P60]2",
"P", "visit/x",
"%1,#0${.3,@(y15:open-input-file)[01}.!0${${.4^,@(y14:read-code-sexp)[0"
"1},,#0.4,.1,&2{%1.0R8~?{@(y9:*verbose*)?{Po,.1W5PoW6}${@(y16:root-envi"
"ronment),.3,@(y13:eval-top-form)[02}@(y9:*verbose*)?{PoW6}${:1^,@(y14:"
"read-code-sexp)[01},:0^[11}]1}.!0.0^_1[01}.0^P60]2",
"P", "repl-environment", "P", "repl-environment",
"%2.1,@(y18:*root-environment*),.2,@(y10:env-lookup)[23", "%2.1,@(y18:*root-environment*),.2,@(y10:env-lookup)[23",
@ -1123,17 +991,17 @@ char *t_code[] = {
"define),.1q?{${.4,.4d,@(y12:xform-define)[02},${'(y6:define),.3da,.7,@" "define),.1q?{${.4,.4d,@(y12:xform-define)[02},${'(y6:define),.3da,.7,@"
"(y11:xenv-lookup)[03},.0?{${.2z,'(l2:y3:ref;y1:*;),@(y11:sexp-match?)[" "(y11:xenv-lookup)[03},.0?{${.2z,'(l2:y3:ref;y1:*;),@(y11:sexp-match?)["
"02}}{f}?{.1dda,.1zda,'(y4:set!),l3,@(y30:repl-compile-and-run-core-exp" "02}}{f}?{.1dda,.1zda,'(y4:set!),l3,@(y30:repl-compile-and-run-core-exp"
"r)[51}.4,.2da,'(s40:identifier cannot be (re)defined in env:),@(y7:x-e" "r)[51}.4,.2da,'(s52:identifier cannot be (re)defined as variable in en"
"rror)[53}'(y13:define-syntax),.1q?{${.4,.4d,@(y19:xform-define-syntax)" "v:),@(y7:x-error)[53}'(y13:define-syntax),.1q?{${.4,.4d,@(y19:xform-de"
"[02},${'(y13:define-syntax),.3da,.7,@(y11:xenv-lookup)[03},.0?{.1dda,." "fine-syntax)[02},${'(y13:define-syntax),.3da,.7,@(y11:xenv-lookup)[03}"
"1sz}{${.6,.4da,'(s50:identifier cannot be (re)defined as syntax in env" ",.0?{.1dda,.1sz}{${.6,.4da,'(s50:identifier cannot be (re)defined as s"
":),@(y7:x-error)[03}}@(y9:*verbose*)?{Po,'(s18:SYNTAX INSTALLED: )W4Po" "yntax in env:),@(y7:x-error)[03}}@(y9:*verbose*)?{Po,'(s18:SYNTAX INST"
",.2daW5PoW6]5}]5}.0K0?{.2,${.5,.5,.5[02},@(y18:repl-eval-top-form)[32}" "ALLED: )W4Po,.2daW5PoW6]5}]5}.0K0?{.2,${.5,.5,.5[02},@(y18:repl-eval-t"
".0U0?{${.4,.4d,.4,@(y16:xform-integrable)[03},@(y30:repl-compile-and-r" "op-form)[32}.0U0?{${.4,.4d,.4,@(y16:xform-integrable)[03},@(y30:repl-c"
"un-core-expr)[31}.0Y0?{${.4,.4,f,@(y5:xform)[03},@(y30:repl-compile-an" "ompile-and-run-core-expr)[31}.0Y0?{${.4,.4,f,@(y5:xform)[03},@(y30:rep"
"d-run-core-expr)[31}${.4,.4d,.4,@(y10:xform-call)[03},@(y30:repl-compi" "l-compile-and-run-core-expr)[31}${.4,.4d,.4,@(y10:xform-call)[03},@(y3"
"le-and-run-core-expr)[31}${.3,.3,f,@(y5:xform)[03},@(y30:repl-compile-" "0:repl-compile-and-run-core-expr)[31}${.3,.3,f,@(y5:xform)[03},@(y30:r"
"and-run-core-expr)[21", "epl-compile-and-run-core-expr)[21",
"P", "repl-read", "P", "repl-read",
"%2.1?{PoW6Po,.2W4Po,'(s1: )W4}.0,@(y14:read-code-sexp)[21", "%2.1?{PoW6Po,.2W4Po,'(s1: )W4}.0,@(y14:read-code-sexp)[21",