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

autoloader for libraries; minor cleanup

Browse source
This commit is contained in:
ESL 2024-07-09 02:42:22 -04:00
parent 9868a37fb3
commit da3255ab71
2 changed files with 163 additions and 74 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

132
src/t.scm
View file

@ -1,13 +1,13 @@
;--------------------------------------------------------------------------------------------- ;--------------------------------------------------------------------------------------------------
; Transformer and Compiler ; Transformer and Compiler
;--------------------------------------------------------------------------------------------- ;--------------------------------------------------------------------------------------------------
(load "s.scm") (load "s.scm")
;--------------------------------------------------------------------------------------------- ;--------------------------------------------------------------------------------------------------
; Utils ; Utils
;--------------------------------------------------------------------------------------------- ;--------------------------------------------------------------------------------------------------
(define (set-member? x s) (define (set-member? x s)
(cond [(null? s) #f] (cond [(null? s) #f]
@ -178,9 +178,9 @@
(print-error-message (string-append "Warning: " msg) args (current-error-port))) (print-error-message (string-append "Warning: " msg) args (current-error-port)))
;--------------------------------------------------------------------------------------------- ;--------------------------------------------------------------------------------------------------
; Syntax of the Scheme Core language ; Syntax of the Scheme Core language
;--------------------------------------------------------------------------------------------- ;--------------------------------------------------------------------------------------------------
; <core> -> (quote <object>) ; <core> -> (quote <object>)
; <core> -> (const <id>) ; immutable variant of ref ; <core> -> (const <id>) ; immutable variant of ref
@ -247,9 +247,9 @@
(fx+ 1 (idslist-req-count (cdr ilist))) (fx+ 1 (idslist-req-count (cdr ilist)))
0))) 0)))
;--------------------------------------------------------------------------------------------- ;--------------------------------------------------------------------------------------------------
; Macro transformer (from Scheme to Scheme Core) derived from Al Petrofsky's EIOD 1.17 ; Macro transformer (from Scheme to Scheme Core) derived from Al Petrofsky's EIOD 1.17
;--------------------------------------------------------------------------------------------- ;--------------------------------------------------------------------------------------------------
; An environment is a procedure that accepts any identifier and access type and returns a ; An environment is a procedure that accepts any identifier and access type and returns a
; denotation. Access type is one of these symbols: ref, set!, define, define-syntax. ; denotation. Access type is one of these symbols: ref, set!, define, define-syntax.
@ -1092,9 +1092,9 @@
(x-error "improper import form" (cons head tail)))) (x-error "improper import form" (cons head tail))))
;--------------------------------------------------------------------------------------------- ;--------------------------------------------------------------------------------------------------
; String representation of S-expressions and code arguments ; String representation of S-expressions and code arguments
;--------------------------------------------------------------------------------------------- ;--------------------------------------------------------------------------------------------------
(define (write-serialized-char x port) (define (write-serialized-char x port)
(cond [(or (char=? x #\%) (char=? x #\") (char=? x #\\) (char<? x #\space) (char>? x #\~)) (cond [(or (char=? x #\%) (char=? x #\") (char=? x #\\) (char<? x #\space) (char>? x #\~))
@ -1173,9 +1173,9 @@
(write-char #\) port)))) (write-char #\) port))))
;--------------------------------------------------------------------------------------------- ;--------------------------------------------------------------------------------------------------
; Compiler producing serialized code ; Compiler producing serialized code
;--------------------------------------------------------------------------------------------- ;--------------------------------------------------------------------------------------------------
(define (c-error msg . args) (define (c-error msg . args)
(error* (string-append "compiler: " msg) args)) (error* (string-append "compiler: " msg) args))
@ -1549,9 +1549,9 @@
(get-output-string p))) (get-output-string p)))
;--------------------------------------------------------------------------------------------- ;--------------------------------------------------------------------------------------------------
; Path and file name resolution ; Path and file name resolution
;--------------------------------------------------------------------------------------------- ;--------------------------------------------------------------------------------------------------
(define (path-directory filename) (define (path-directory filename)
(let loop ([l (reverse (string->list filename))]) (let loop ([l (reverse (string->list filename))])
@ -1589,7 +1589,7 @@
(define (push-current-file! filename) (define (push-current-file! filename)
(when (member filename *current-file-stack* string=?) (when (member filename *current-file-stack* string=?)
(x-error "circularity in include file chain" filename)) (x-error "circularity in nested file chain" filename))
(set! *current-file-stack* (cons filename *current-file-stack*))) (set! *current-file-stack* (cons filename *current-file-stack*)))
(define (pop-current-file!) (define (pop-current-file!)
@ -1609,9 +1609,9 @@
filename)) filename))
;--------------------------------------------------------------------------------------------- ;--------------------------------------------------------------------------------------------------
; Library names and library file lookup ; Library names and library file lookup
;--------------------------------------------------------------------------------------------- ;--------------------------------------------------------------------------------------------------
(define (lnpart? x) (or (id? x) (exact-integer? x))) (define (lnpart? x) (or (id? x) (exact-integer? x)))
(define (listname? x) (and (list1+? x) (andmap lnpart? x))) (define (listname? x) (and (list1+? x) (andmap lnpart? x)))
@ -1691,20 +1691,47 @@
(when ci? (set-port-fold-case! port #t)) (when ci? (set-port-fold-case! port #t))
(read-port-sexps port)))) (read-port-sexps port))))
(define (library-available? lib env) ;=> #f | filepath (external) | (code . eal) (loaded) (define (library-available? lib env) ;=> #f | filepath (external) | <library> (loaded)
(cond [(string? lib) (file-resolve-relative-to-current lib)] (cond [(not (listname? lib)) #f]
[(library-info lib #f)] ; builtin or preloaded FIXME: need to take env into account! [(find-library-in-env lib env)] ; defined below
[else (and (listname? lib) (find-library-path lib))])) [else (find-library-path lib)]))
; name prefixes ; name prefixes
(define (fully-qualified-library-prefixed-name lib id) (define (fully-qualified-library-prefixed-name lib id)
(symbol-append (if (symbol? lib) lib (listname->symbol lib)) '? id)) (symbol-append (if (symbol? lib) lib (listname->symbol lib)) '? id))
; used as autoload action supplying default value for list names
(define (fetch-library listname sld-env) ;=> <library> | #f
; note: any part of the actual fetch/process may fail. In that case,
; fetch-library escapes and environment will still lack binding for
; listname -- so the library can be fixed and reloaded afterwards
(define (fetch filepath)
(unless *quiet*
(let ([p (current-error-port)])
(display "; fetching " p) (write listname p) (display " library from " p)
(display filepath p) (newline p)))
(with-current-file filepath
(lambda ()
(let ([sexps (read-file-sexps filepath #f)])
(if (sexp-match? '((define-library * * ...)) sexps)
; invoke xform-define-library in 'top' context (for lib:// globals)
(let ([core (xform-define-library (caar sexps) (cdar sexps) sld-env #t)])
(if (and (sexp-match? '(define-library * *) core)
(equal? (cadr core) listname) (val-library? (caddr core)))
(caddr core) ;=> <library>
(x-error "library autoloader: internal transformer error"
listname filepath sexps core)))
(x-error "library autoloader: unexpected forms in .sld file"
listname filepath sexps))))))
(define filepath (find-library-path listname))
; return #f if .sld file is not found; otherwise expect it to be in shape
(and filepath (fetch filepath)))
;---------------------------------------------------------------------------------------------
;--------------------------------------------------------------------------------------------------
; Expand-time name registries ; Expand-time name registries
;--------------------------------------------------------------------------------------------- ;--------------------------------------------------------------------------------------------------
; name registries are htables (vectors with one extra slot) of alists ((sym . <location>) ...) ; name registries are htables (vectors with one extra slot) of alists ((sym . <location>) ...)
; last slot is used for list names (library names), the rest for regular symbolic names ; last slot is used for list names (library names), the rest for regular symbolic names
@ -1887,12 +1914,12 @@
)) ))
; private registry for names introduced in repl ; private registry for names introduced in repl
(define *user-name-registry* (make-name-registry 100)) (define *user-name-registry* (make-name-registry 200))
;--------------------------------------------------------------------------------------------- ;--------------------------------------------------------------------------------------------------
; Environments ; Environments
;--------------------------------------------------------------------------------------------- ;--------------------------------------------------------------------------------------------------
; make read-only environment from a registry ; make read-only environment from a registry
(define (make-readonly-environment rr) (define (make-readonly-environment rr)
@ -1903,8 +1930,8 @@
(name-lookup rr name #f)] ; no allocation callback (name-lookup rr name #f)] ; no allocation callback
[else #f]))) [else #f])))
; controlled environments for libraries and programs using import al, global name generator, and env ; makes controlled environments for libraries and programs using import al, global name generator,
; allowing fall-through to env for list names (so libraries can still be fetched by list name) ; and env allowing fall-through for list names (so libraries can still be fetched by list name)
(define (make-controlled-environment ial global use-env) (define (make-controlled-environment ial global use-env)
(define ir (eal->name-registry ial)) ; handmade import registry from ial (define ir (eal->name-registry ial)) ; handmade import registry from ial
(define lr (make-name-registry 100)) ; local registry for new names (define lr (make-name-registry 100)) ; local registry for new names
@ -1938,11 +1965,26 @@
(cond [(name-lookup lr (car p) #f) => (lambda (loc) (cond [(name-lookup lr (car p) #f) => (lambda (loc)
(x-error "imported name shadows local name" (car p) (cdr p) loc))])) (x-error "imported name shadows local name" (car p) (cdr p) loc))]))
(for-each check ial) (for-each check ial)
(eal-name-registry-import! ir ial))] (eal-name-registry-import! ir ial)
#t)] ; don't bother returning counts, they are useful in repl only
[else #f]))) [else #f])))
; mutable environment from two registries; new bindings go to user registry ; makes environments for .sld files, automatically extending root registry with list names
(define (make-repl-environment rr ur gpref) ; prefix for allocated globals (define (make-sld-environment rr)
; note: lookup in sld environment can cause recursive calls to fetch-library
; if upstream dependencies are not yet loaded; loops are detected inside f-l
(define (sld-env id at)
(cond [(not (eq? at 'ref)) #f]
[(procedure? id) (old-den id)]
[(eq? id 'define-library) (make-location 'define-library)]
[(not (listname? id)) #f]
[else (name-lookup rr id
(lambda (n) ; no library? see if we can fetch it recursively
(fetch-library name sld-env)))])) ;=> <library> or #f
sld-env)
; makes mutable environments from two registries; new bindings go to user registry
(define (make-repl-environment rr ur gpref) ; gpref is prefix for allocated globals
(define (global name) (fully-qualified-library-prefixed-name gpref name)) (define (global name) (fully-qualified-library-prefixed-name gpref name))
(lambda (name at) (lambda (name at)
(cond [(new-id? name) ; nonsymbolic ids can't be (re)bound here (cond [(new-id? name) ; nonsymbolic ids can't be (re)bound here
@ -1950,7 +1992,11 @@
[(eq? at 'ref) ; for reference only: try not to alloc [(eq? at 'ref) ; for reference only: try not to alloc
(name-lookup ur name ; return if in user registry (name-lookup ur name ; return if in user registry
(lambda (n) ; ok, not in ur: check rr (lambda (n) ; ok, not in ur: check rr
(or (name-lookup rr name #f) ; if in rr, return it as-is (or (name-lookup rr name ; if in rr, return it as-is
(lambda (n) ; not in rr: see if it is a library to autoload
(and (listname? name) ; special default value: autoload from .sld
(let ([sld-env (make-sld-environment rr)]) ; make env for .sld files
(fetch-library name sld-env))))) ;=> <library> or #f
(and (symbol? name) (list 'ref (global name))))))] ; alloc in repl store (and (symbol? name) (list 'ref (global name))))))] ; alloc in repl store
[(eq? at 'set!) ; for assigning new values to variables [(eq? at 'set!) ; for assigning new values to variables
; works only for symbolic names; auto-allocates but does not shadow ; works only for symbolic names; auto-allocates but does not shadow
@ -1974,7 +2020,7 @@
; special request for repl environment only: mass import ; special request for repl environment only: mass import
(let loop ([eal name] [samc 0] [modc 0] [addc 0]) (let loop ([eal name] [samc 0] [modc 0] [addc 0])
(if (null? eal) (if (null? eal)
(list samc modc addc) (list samc modc addc) ; return counts for verbosity
(let ([id (caar eal)] [loc (cdar eal)] [eal (cdr eal)]) (let ([id (caar eal)] [loc (cdar eal)] [eal (cdr eal)])
(name-remove! ur id) ; user binding isn't changed, but no longer visible (name-remove! ur id) ; user binding isn't changed, but no longer visible
(case (name-install! rr id loc) ; root binding possibly changed (case (name-install! rr id loc) ; root binding possibly changed
@ -1983,17 +2029,23 @@
[(added) (loop eal samc modc (+ addc 1))]))))] [(added) (loop eal samc modc (+ addc 1))]))))]
[else #f]))) [else #f])))
(define (find-library-in-env listname env) ;=> library | #f
(let ([loc (env listname 'ref)])
(and loc (let ([val (location-val loc)]) (and (val-library? val) val)))))
(define root-environment (define root-environment
(make-readonly-environment *root-name-registry*)) (make-readonly-environment *root-name-registry*))
(define repl-environment (define repl-environment
(make-repl-environment *root-name-registry* *user-name-registry* 'repl://)) (make-repl-environment *root-name-registry* *user-name-registry* 'repl://))
;---------------------------------------------------------------------------------------------
;--------------------------------------------------------------------------------------------------
; REPL ; REPL
;--------------------------------------------------------------------------------------------- ;--------------------------------------------------------------------------------------------------
(define *verbose* #f) (define *verbose* #f)
(define *quiet* #f)
(define (repl-compile-and-run-core-expr core) (define (repl-compile-and-run-core-expr core)
(when *verbose* (display "TRANSFORM =>") (newline) (write core) (newline)) (when *verbose* (display "TRANSFORM =>") (newline) (write core) (newline))
@ -2100,14 +2152,23 @@
(display (if (file-exists? (symbol->string (car args))) (display (if (file-exists? (symbol->string (car args)))
"file exists\n" "file does not exist\n") op)] "file exists\n" "file does not exist\n") op)]
[else (display "invalid file name; use double quotes\n" op)])] [else (display "invalid file name; use double quotes\n" op)])]
[(v) (set! *verbose* #t)]
[(verbose on) (set! *verbose* #t)] [(verbose on) (set! *verbose* #t)]
[(verbose off) (set! *verbose* #f)] [(verbose off) (set! *verbose* #f)]
[(q) (set! *quiet* #t)]
[(quiet on) (set! *quiet* #t)]
[(quiet off) (set! *quiet* #f)]
[(help) [(help)
(display "Available commands:\n" op) (display "Available commands:\n" op)
(display " ,say hello -- displays nice greeting\n" op) (display " ,say hello -- displays nice greeting\n" op)
(display " ,peek <fname> -- check if file exists\n" op) (display " ,peek <fname> -- check if file exists\n" op)
(display " ,q -- disable informational messages\n" op)
(display " ,quiet on -- disable informational messages\n" op)
(display " ,quiet off -- enable informational messages\n" op)
(display " ,v -- turn verbosity on\n" op)
(display " ,verbose on -- turn verbosity on\n" op) (display " ,verbose on -- turn verbosity on\n" op)
(display " ,verbose off -- turn verbosity off\n" op) (display " ,verbose off -- turn verbosity off\n" op)
(display " ,verbose off -- turn verbosity off\n" op)
(display " ,ref <name> -- show current denotation for <name>\n" op) (display " ,ref <name> -- show current denotation for <name>\n" op)
(display " ,rnr -- show root name registry\n" op) (display " ,rnr -- show root name registry\n" op)
(display " ,rref <name> -- lookup name in root registry\n" op) (display " ,rref <name> -- lookup name in root registry\n" op)
@ -2163,5 +2224,4 @@
repl-environment repl-environment
"skint]")) "skint]"))
(define run-repl repl)

105
t.c
View file

@ -911,8 +911,8 @@ char *t_code[] = {
"P", "push-current-file!", "P", "push-current-file!",
"%1${@(y8:string=?),@(y20:*current-file-stack*),.4,@(y7:%25member)[03}?" "%1${@(y8:string=?),@(y20:*current-file-stack*),.4,@(y7:%25member)[03}?"
"{${.2,'(s33:circularity in include file chain),@(y7:x-error)[02}}@(y20" "{${.2,'(s32:circularity in nested file chain),@(y7:x-error)[02}}@(y20:"
":*current-file-stack*),.1c@!(y20:*current-file-stack*)]1", "*current-file-stack*),.1c@!(y20:*current-file-stack*)]1",
"P", "pop-current-file!", "P", "pop-current-file!",
"%0@(y20:*current-file-stack*)u~?{@(y20:*current-file-stack*)d@!(y20:*c" "%0@(y20:*current-file-stack*)u~?{@(y20:*current-file-stack*)d@!(y20:*c"
@ -980,14 +980,25 @@ char *t_code[] = {
"-input-file)[22", "-input-file)[22",
"P", "library-available?", "P", "library-available?",
"%2.0S0?{.0,@(y32:file-resolve-relative-to-current)[21}${f,.3,@(y12:lib" "%2${.2,@(y9:listname?)[01}~?{f]2}${.3,.3,@(y19:find-library-in-env)[02"
"rary-info)[02},.0?{.0]3}${.3,@(y9:listname?)[01}?{.1,@(y17:find-librar" "},.0?{.0]3}.1,@(y17:find-library-path)[31",
"y-path)[31}f]3",
"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-"
"append)[23", "append)[23",
"P", "fetch-library",
"%2,,#0#1.3,.3,&2{%1@(y7:*quiet*)~?{Pe,.0,'(s11:; fetching )W4.0,:0W5.0"
",'(s14: library from )W4.0,.2W4.0W6_1}.0,:1,:0,&3{%0${f,:2,@(y15:read-"
"file-sexps)[02},${.2,'(l1:l4:y14:define-library;y1:*;y1:*;y3:...;;),@("
"y11:sexp-match?)[02}?{${t,:1,.4ad,.5aa,@(y20:xform-define-library)[04}"
",${.2,'(l3:y14:define-library;y1:*;y1:*;),@(y11:sexp-match?)[02}?{:0,."
"1dae?{.0ddaV0}{f}}{f}?{.0dda]2}.0,.2,:2,:0,'(s46:library autoloader: i"
"nternal transformer error),@(y7:x-error)[25}.0,:2,:0,'(s49:library aut"
"oloader: unexpected forms in .sld file),@(y7:x-error)[14},.1,@(y17:wit"
"h-current-file)[12}.!0${.4,@(y17:find-library-path)[01}.!1.1^?{.1^,.1^"
"[41}f]4",
"P", "make-name-registry", "P", "make-name-registry",
"%1,,#0#1'(l40:i1;i11;i31;i41;i61;i71;i101;i131;i151;i181;i191;i211;i24" "%1,,#0#1'(l40:i1;i11;i31;i41;i61;i71;i101;i131;i151;i181;i191;i211;i24"
"1;i251;i271;i281;i311;i331;i401;i421;i431;i461;i491;i521;i541;i571;i60" "1;i251;i271;i281;i311;i331;i401;i421;i431;i461;i491;i521;i541;i571;i60"
@ -1220,7 +1231,7 @@ char *t_code[] = {
"03}.1d,.1,:4^[22}.!0.0^_1[52},@(y10:%25for-each1)[02}", "03}.1d,.1,:4^[22}.!0.0^_1[52},@(y10:%25for-each1)[02}",
"C", 0, "C", 0,
"${'(i100),@(y18:make-name-registry)[01}@!(y20:*user-name-registry*)", "${'(i200),@(y18:make-name-registry)[01}@!(y20:*user-name-registry*)",
"P", "make-readonly-environment", "P", "make-readonly-environment",
"%1.0,&1{%2.0K0?{.1,'(l2:y3:ref;y4:set!;),.1A1?{.1,@(y7:old-den)[31}f]3" "%1.0,&1{%2.0K0?{.1,'(l2:y3:ref;y4:set!;),.1A1?{.1,@(y7:old-den)[31}f]3"
@ -1238,24 +1249,34 @@ char *t_code[] = {
":3^,@(y11:name-lookup)[23}'(y6:import),.2q?{${.2,'(l2:py8:<symbol>;zy1" ":3^,@(y11:name-lookup)[23}'(y6:import),.2q?{${.2,'(l2:py8:<symbol>;zy1"
":*;;;y3:...;),@(y11:sexp-match?)[02}}{f}?{.0,,#0:3,&1{%1${f,.3a,:0^,@(" ":*;;;y3:...;),@(y11:sexp-match?)[02}}{f}?{.0,,#0:3,&1{%1${f,.3a,:0^,@("
"y11:name-lookup)[03},.0?{.0,.0,.3d,.4a,'(s32:imported name shadows loc" "y11:name-lookup)[03},.0?{.0,.0,.3d,.4a,'(s32:imported name shadows loc"
"al name),@(y7:x-error)[34}f]2}.!0${.3,.3^,@(y10:%25for-each1)[02}.1,:2" "al name),@(y7:x-error)[34}f]2}.!0${.3,.3^,@(y10:%25for-each1)[02}${.3,"
"^,@(y25:eal-name-registry-import!)[42}f]2}]5", ":2^,@(y25:eal-name-registry-import!)[02}t]4}f]2}]5",
"P", "make-sld-environment",
"%1,#0.0,.2,&2{%2'(y3:ref),.2q~?{f]2}.0K0?{.0,@(y7:old-den)[21}'(y14:de"
"fine-library),.1q?{'(y14:define-library)b]2}${.2,@(y9:listname?)[01}~?"
"{f]2}:1,&1{%1:0^,@(y4:name),@(y13:fetch-library)[12},.1,:0,@(y11:name-"
"lookup)[23}.!0.0^]2",
"P", "make-repl-environment", "P", "make-repl-environment",
"%3,#0.3,&1{%1.0,:0,@(y37:fully-qualified-library-prefixed-name)[12}.!0" "%3,#0.3,&1{%1.0,:0,@(y37:fully-qualified-library-prefixed-name)[12}.!0"
".2,.2,.2,&3{%2.0K0?{.1,'(l2:y3:ref;y4:set!;),.1A1?{.1,@(y7:old-den)[31" ".2,.2,.2,&3{%2.0K0?{.1,'(l2:y3:ref;y4:set!;),.1A1?{.1,@(y7:old-den)[31"
"}f]3}'(y3:ref),.2q?{:1,.1,:0,&3{%1${f,:1,:2,@(y11:name-lookup)[03},.0?" "}f]3}'(y3:ref),.2q?{.0,:1,:0,&3{%1${:2,:1,&2{%1${:1,@(y9:listname?)[01"
"{.0]2}:1Y0?{${:1,:0^[01},'(y3:ref),l2]2}f]2},.1,:2,@(y11:name-lookup)[" "}?{${:0,@(y20:make-sld-environment)[01},.0,:1,@(y13:fetch-library)[22}"
"23}'(y4:set!),.2q?{.0Y0?{.0,:0,:1,&3{%1${f,:2,:0,@(y11:name-lookup)[03" "f]1},:2,:1,@(y11:name-lookup)[03},.0?{.0]2}:2Y0?{${:2,:0^[01},'(y3:ref"
"}~?{${:2,:1^[01},'(y3:ref),l2]1}f]1},.1,:2,@(y11:name-lookup)[23}f]2}'" "),l2]2}f]2},.1,:2,@(y11:name-lookup)[23}'(y4:set!),.2q?{.0Y0?{.0,:0,:1"
"(y6:define),.2q?{.0Y0?{:0,.1,&2{%1${:0,:1^[01},'(y3:ref),l2]1},.1,:2,@" ",&3{%1${f,:2,:0,@(y11:name-lookup)[03}~?{${:2,:1^[01},'(y3:ref),l2]1}f"
"(y11:name-lookup)[23}f]2}'(y13:define-syntax),.2q?{&0{%1Y9]1},.1,:2,@(" "]1},.1,:2,@(y11:name-lookup)[23}f]2}'(y6:define),.2q?{.0Y0?{:0,.1,&2{%"
"y11:name-lookup)[23}'(y6:import),.2q?{${.2,'(l2:py8:<symbol>;zy1:*;;;y" "1${:0,:1^[01},'(y3:ref),l2]1},.1,:2,@(y11:name-lookup)[23}f]2}'(y13:de"
"3:...;),@(y11:sexp-match?)[02}}{f}?{'0,'0,'0,.3,,#0:2,:1,.2,&3{%4.0u?{" "fine-syntax),.2q?{&0{%1Y9]1},.1,:2,@(y11:name-lookup)[23}'(y6:import),"
".3,.3,.3,l3]4}.0d,.1ad,.2aa,${.2,:2,@(y12:name-remove!)[02}${.3,.3,:1," ".2q?{${.2,'(l2:py8:<symbol>;zy1:*;;;y3:...;),@(y11:sexp-match?)[02}}{f"
"@(y13:name-install!)[03},'(y4:same),.1v?{.7,.7,'1,.8+,.6,:0^[84}'(y8:m" "}?{'0,'0,'0,.3,,#0:2,:1,.2,&3{%4.0u?{.3,.3,.3,l3]4}.0d,.1ad,.2aa,${.2,"
"odified),.1v?{.7,'1,.8+,.7,.6,:0^[84}'(y5:added),.1v?{'1,.8+,.7,.7,.6," ":2,@(y12:name-remove!)[02}${.3,.3,:1,@(y13:name-install!)[03},'(y4:sam"
":0^[84}]8}.!0.0^_1[24}f]2}]4", "e),.1v?{.7,.7,'1,.8+,.6,:0^[84}'(y8:modified),.1v?{.7,'1,.8+,.7,.6,:0^"
"[84}'(y5:added),.1v?{'1,.8+,.7,.7,.6,:0^[84}]8}.!0.0^_1[24}f]2}]4",
"P", "find-library-in-env",
"%2${'(y3:ref),.3,.5[02},.0?{.0z,.0V0?{.0]4}f]4}f]3",
"C", 0, "C", 0,
"${@(y20:*root-name-registry*),@(y25:make-readonly-environment)[01}@!(y" "${@(y20:*root-name-registry*),@(y25:make-readonly-environment)[01}@!(y"
@ -1268,6 +1289,9 @@ char *t_code[] = {
"C", 0, "C", 0,
"f@!(y9:*verbose*)", "f@!(y9:*verbose*)",
"C", 0,
"f@!(y7:*quiet*)",
"P", "repl-compile-and-run-core-expr", "P", "repl-compile-and-run-core-expr",
"%1@(y9:*verbose*)?{Po,'(s12:TRANSFORM =>)W4PoW6Po,.1W5PoW6}.0p~?{${.2," "%1@(y9:*verbose*)?{Po,'(s12:TRANSFORM =>)W4PoW6Po,.1W5PoW6}.0p~?{${.2,"
"'(s29:unexpected transformed output),@(y7:x-error)[02}}f,${.3,@(y21:co" "'(s29:unexpected transformed output),@(y7:x-error)[02}}f,${.3,@(y21:co"
@ -1334,21 +1358,29 @@ char *t_code[] = {
"{.4,.1^aF0?{'(s12:file exists%0a)}{'(s20:file does not exist%0a)}W4]5}" "{.4,.1^aF0?{'(s12:file exists%0a)}{'(s20:file does not exist%0a)}W4]5}"
".0^aY0?{.4,.1^aX4F0?{'(s12:file exists%0a)}{'(s20:file does not exist%" ".0^aY0?{.4,.1^aX4F0?{'(s12:file exists%0a)}{'(s20:file does not exist%"
"0a)}W4]5}.4,'(s37:invalid file name; use double quotes%0a)W4]5}${.3^,'" "0a)}W4]5}.4,'(s37:invalid file name; use double quotes%0a)W4]5}${.3^,'"
"(l2:y7:verbose;y2:on;),@(y11:sexp-match?)[02}?{t@!(y9:*verbose*)]5}${." "(l1:y1:v;),@(y11:sexp-match?)[02}?{t@!(y9:*verbose*)]5}${.3^,'(l2:y7:v"
"3^,'(l2:y7:verbose;y3:off;),@(y11:sexp-match?)[02}?{f@!(y9:*verbose*)]" "erbose;y2:on;),@(y11:sexp-match?)[02}?{t@!(y9:*verbose*)]5}${.3^,'(l2:"
"5}${.3^,'(l1:y4:help;),@(y11:sexp-match?)[02}?{.4,'(s20:Available comm" "y7:verbose;y3:off;),@(y11:sexp-match?)[02}?{f@!(y9:*verbose*)]5}${.3^,"
"ands:%0a)W4.4,'(s42: ,say hello -- displays nice greeting%0a)W4.4," "'(l1:y1:q;),@(y11:sexp-match?)[02}?{t@!(y7:*quiet*)]5}${.3^,'(l2:y5:qu"
"'(s40: ,peek <fname> -- check if file exists%0a)W4.4,'(s37: ,verbose " "iet;y2:on;),@(y11:sexp-match?)[02}?{t@!(y7:*quiet*)]5}${.3^,'(l2:y5:qu"
"on -- turn verbosity on%0a)W4.4,'(s38: ,verbose off -- turn verbo" "iet;y3:off;),@(y11:sexp-match?)[02}?{f@!(y7:*quiet*)]5}${.3^,'(l1:y4:h"
"sity off%0a)W4.4,'(s54: ,ref <name> -- show current denotation for " "elp;),@(y11:sexp-match?)[02}?{.4,'(s20:Available commands:%0a)W4.4,'(s"
"<name>%0a)W4.4,'(s43: ,rnr -- show root name registry%0a)W4." "42: ,say hello -- displays nice greeting%0a)W4.4,'(s40: ,peek <fna"
"4,'(s48: ,rref <name> -- lookup name in root registry%0a)W4.4,'(s50:" "me> -- check if file exists%0a)W4.4,'(s50: ,q -- disable "
" ,rrem! <name> -- remove name from root registry%0a)W4.4,'(s43: ,unr " "informational messages%0a)W4.4,'(s50: ,quiet on -- disable inform"
" -- show user name registry%0a)W4.4,'(s48: ,uref <name> -- " "ational messages%0a)W4.4,'(s49: ,quiet off -- enable informational"
"lookup name in user registry%0a)W4.4,'(s50: ,urem! <name> -- remove n" " messages%0a)W4.4,'(s37: ,v -- turn verbosity on%0a)W4.4,'"
"ame from user registry%0a)W4.4,'(s29: ,help -- this help%0a)W" "(s37: ,verbose on -- turn verbosity on%0a)W4.4,'(s38: ,verbose off "
"4]5}.4,'(s29:syntax error in repl command%0a)W4.4,'(s37:type ,help to " " -- turn verbosity off%0a)W4.4,'(s38: ,verbose off -- turn verbosit"
"see available commands%0a)W4]5", "y off%0a)W4.4,'(s54: ,ref <name> -- show current denotation for <na"
"me>%0a)W4.4,'(s43: ,rnr -- show root name registry%0a)W4.4,'"
"(s48: ,rref <name> -- lookup name in root registry%0a)W4.4,'(s50: ,r"
"rem! <name> -- remove name from root registry%0a)W4.4,'(s43: ,unr "
" -- show user name registry%0a)W4.4,'(s48: ,uref <name> -- loo"
"kup name in user registry%0a)W4.4,'(s50: ,urem! <name> -- remove name"
" from user registry%0a)W4.4,'(s29: ,help -- this help%0a)W4]5"
"}.4,'(s29:syntax error in repl command%0a)W4.4,'(s37:type ,help to see"
" available commands%0a)W4]5",
"P", "repl-from-port", "P", "repl-from-port",
"%3,#0${@(y18:current-file-stack)[00}.!0${k0,.0,${.2,.9,.(i11),.(i10),&" "%3,#0${@(y18:current-file-stack)[00}.!0${k0,.0,${.2,.9,.(i11),.(i10),&"
@ -1381,8 +1413,5 @@ char *t_code[] = {
"%0${n,@(y23:set-current-file-stack!)[01}'(s6:skint]),@(y16:repl-enviro" "%0${n,@(y23:set-current-file-stack!)[01}'(s6:skint]),@(y16:repl-enviro"
"nment),Pi,@(y14:repl-from-port)[03", "nment),Pi,@(y14:repl-from-port)[03",
"C", 0,
"@(y4:repl)@!(y8:run-repl)",
0, 0, 0 0, 0, 0
}; };