mirror of
https://github.com/false-schemers/skint.git
synced 2024-12-25 21:58:54 +01:00
'import env protocol for repl; minor cleanup
This commit is contained in:
ESL
parent
09f36ab213
commit
a03e3f2d99
2 changed files with 378 additions and 349 deletions
335
src/t.scm
335
src/t.scm
|
|
@ -9,40 +9,34 @@
|
|||
; Utils
|
||||
;---------------------------------------------------------------------------------------------
|
||||
|
||||
(define set-member?
|
||||
(lambda (x s)
|
||||
(cond
|
||||
[(null? s) #f]
|
||||
[(eq? x (car s)) #t]
|
||||
[else (set-member? x (cdr s))])))
|
||||
(define (set-member? x s)
|
||||
(cond [(null? s) #f]
|
||||
[(eq? x (car s)) #t]
|
||||
[else (set-member? x (cdr s))]))
|
||||
|
||||
(define set-cons
|
||||
(lambda (x s)
|
||||
(if (set-member? x s)
|
||||
s
|
||||
(cons x s))))
|
||||
(define (set-cons x s)
|
||||
(if (set-member? x s)
|
||||
s
|
||||
(cons x s)))
|
||||
|
||||
(define set-union
|
||||
(lambda (s1 s2)
|
||||
(if (null? s1)
|
||||
s2
|
||||
(set-union (cdr s1) (set-cons (car s1) s2)))))
|
||||
(define (set-union s1 s2)
|
||||
(if (null? s1)
|
||||
s2
|
||||
(set-union (cdr s1) (set-cons (car s1) s2))))
|
||||
|
||||
(define set-minus
|
||||
(lambda (s1 s2)
|
||||
(if (null? s1)
|
||||
'()
|
||||
(if (set-member? (car s1) s2)
|
||||
(set-minus (cdr s1) s2)
|
||||
(cons (car s1) (set-minus (cdr s1) s2))))))
|
||||
(define (set-minus s1 s2)
|
||||
(if (null? s1)
|
||||
'()
|
||||
(if (set-member? (car s1) s2)
|
||||
(set-minus (cdr s1) s2)
|
||||
(cons (car s1) (set-minus (cdr s1) s2)))))
|
||||
|
||||
(define set-intersect
|
||||
(lambda (s1 s2)
|
||||
(if (null? s1)
|
||||
'()
|
||||
(if (set-member? (car s1) s2)
|
||||
(cons (car s1) (set-intersect (cdr s1) s2))
|
||||
(set-intersect (cdr s1) s2)))))
|
||||
(define (set-intersect s1 s2)
|
||||
(if (null? s1)
|
||||
'()
|
||||
(if (set-member? (car s1) s2)
|
||||
(cons (car s1) (set-intersect (cdr s1) s2))
|
||||
(set-intersect (cdr s1) s2))))
|
||||
|
||||
(define-syntax record-case
|
||||
(syntax-rules (else)
|
||||
|
|
@ -66,7 +60,10 @@
|
|||
(or (eq? pat '*)
|
||||
(and (eq? pat '<id>) (or (symbol? x) (procedure? x)))
|
||||
(and (eq? pat '<symbol>) (symbol? x))
|
||||
(and (eq? pat '<number>) (number? x))
|
||||
(and (eq? pat '<string>) (string? x))
|
||||
(and (eq? pat '<vector>) (vector? x))
|
||||
(and (eq? pat '<box>) (box? x))
|
||||
(eqv? x pat)
|
||||
(and (pair? pat)
|
||||
(cond [(and (eq? (car pat) '...)
|
||||
|
|
@ -108,8 +105,8 @@
|
|||
(begin result1 result2 ...)
|
||||
(sexp-case key clause clauses ...))]))
|
||||
|
||||
(define symbol-append
|
||||
(lambda syms (string->symbol (apply string-append (map symbol->string syms)))))
|
||||
(define (symbol-append . syms)
|
||||
(string->symbol (apply string-append (map symbol->string syms))))
|
||||
|
||||
; unique symbol generator (poor man's version)
|
||||
(define gensym
|
||||
|
|
@ -123,29 +120,32 @@
|
|||
(string-append (symbol->string (car args))
|
||||
(string-append "#" (fixnum->string gsc 10))))))))
|
||||
|
||||
(define posq
|
||||
(lambda (x l)
|
||||
(let loop ([l l] [n 0])
|
||||
(cond [(null? l) #f]
|
||||
[(eq? x (car l)) n]
|
||||
[else (loop (cdr l) (fx+ n 1))]))))
|
||||
(define (posq x l)
|
||||
(let loop ([l l] [n 0])
|
||||
(cond [(null? l) #f]
|
||||
[(eq? x (car l)) n]
|
||||
[else (loop (cdr l) (fx+ n 1))])))
|
||||
|
||||
(define rassq
|
||||
(lambda (x al)
|
||||
(and (pair? al)
|
||||
(let ([a (car al)])
|
||||
(if (eq? x (cdr a)) a (rassq x (cdr al)))))))
|
||||
(define (rassq x al)
|
||||
(and (pair? al)
|
||||
(let ([a (car al)])
|
||||
(if (eq? x (cdr a)) a (rassq x (cdr al))))))
|
||||
|
||||
(define list-diff
|
||||
(lambda (l t)
|
||||
(if (or (null? l) (eq? l t))
|
||||
'()
|
||||
(cons (car l) (list-diff (cdr l) t)))))
|
||||
(define (remove! x l pred?) ; applies (pred? (car l) x)
|
||||
(let loop ([f #f] [l #f] [r l])
|
||||
(cond [(not (pair? r)) (if l (begin (set-cdr! l r) f) r)]
|
||||
[(pred? (car r) x) (loop f l (cdr r))]
|
||||
[l (set-cdr! l r) (loop f r (cdr r))]
|
||||
[else (loop r r (cdr r))])))
|
||||
|
||||
(define (list-diff l t)
|
||||
(if (or (null? l) (eq? l t))
|
||||
'()
|
||||
(cons (car l) (list-diff (cdr l) t))))
|
||||
|
||||
(define (pair* x . more)
|
||||
(let loop ([x x] [rest more])
|
||||
(if (null? rest) x
|
||||
(cons x (loop (car rest) (cdr rest))))))
|
||||
(let loop ([x x] [r more])
|
||||
(if (null? r) x (cons x (loop (car r) (cdr r))))))
|
||||
|
||||
(define (append* lst)
|
||||
(cond [(null? lst) '()]
|
||||
|
|
@ -565,7 +565,7 @@
|
|||
(loop env (cons #f ids) (cons init inits) (cons #f nids) rest))
|
||||
(let ([id (id-rename-as head (caar eal))] [loc (cdar eal)])
|
||||
(scan (cdr eal) ; use handmade env sharing loc, but for ref only!
|
||||
(lambda (i at) (if (and (eq? i id) (eq? at 'ref)) loc (env i at))))))))
|
||||
(lambda (i at) (if (eq? i id) (and (eq? at 'ref) loc) (env i at))))))))
|
||||
(x-error "improper import form" first))]
|
||||
[else
|
||||
(if (val-transformer? hval)
|
||||
|
|
@ -1050,8 +1050,8 @@
|
|||
(cond [(not loc) (x-error "cannot export id" lid)]
|
||||
[(location-special? loc) (loop (cdr esps) (cons (cons eid loc) eal))]
|
||||
[else (let ([val (location-val loc)])
|
||||
(if (memq (car val) '(ref const))
|
||||
(loop (cdr esps) (cons (cons eid (make-location (list 'const (cadr val)))) eal))
|
||||
(if (or (not (val-core? val)) (memq (car val) '(ref const)))
|
||||
(loop (cdr esps) (cons (cons eid loc) eal))
|
||||
(x-error "cannot export code alias id" lid val)))]))))))))
|
||||
|
||||
; Note: define-library semantics does not depend on lexical context, and, as a syntax definition,
|
||||
|
|
@ -1171,107 +1171,61 @@
|
|||
(define (c-warning msg . args)
|
||||
(warning* (string-append "compiler: " msg) args))
|
||||
|
||||
(define find-free*
|
||||
(lambda (x* b)
|
||||
(if (null? x*)
|
||||
'()
|
||||
(set-union
|
||||
(find-free (car x*) b)
|
||||
(find-free* (cdr x*) b)))))
|
||||
(define (find-free* x* b)
|
||||
(if (null? x*)
|
||||
'()
|
||||
(set-union
|
||||
(find-free (car x*) b)
|
||||
(find-free* (cdr x*) b))))
|
||||
|
||||
(define find-free
|
||||
(lambda (x b)
|
||||
(record-case x
|
||||
[quote (obj)
|
||||
'()]
|
||||
[gref (gid)
|
||||
'()]
|
||||
[gset! (gid exp)
|
||||
(find-free exp b)]
|
||||
[(ref const) (id)
|
||||
(if (set-member? id b) '() (list id))]
|
||||
[set! (id exp)
|
||||
(set-union
|
||||
(if (set-member? id b) '() (list id))
|
||||
(find-free exp b))]
|
||||
[set& (id)
|
||||
(if (set-member? id b) '() (list id))]
|
||||
[lambda (idsi exp)
|
||||
(find-free exp (set-union (flatten-idslist idsi) b))]
|
||||
[lambda* clauses
|
||||
(find-free* (map cadr clauses) b)]
|
||||
[letcc (kid exp)
|
||||
(find-free exp (set-union (list kid) b))]
|
||||
[withcc (kexp exp)
|
||||
(set-union (find-free kexp b) (find-free exp b))]
|
||||
[if (test then else)
|
||||
(set-union
|
||||
(find-free test b)
|
||||
(set-union (find-free then b) (find-free else b)))]
|
||||
[begin exps
|
||||
(find-free* exps b)]
|
||||
[integrable (ig . args)
|
||||
(find-free* args b)]
|
||||
[call (exp . args)
|
||||
(set-union (find-free exp b) (find-free* args b))]
|
||||
[asm (cstr)
|
||||
'()]
|
||||
[once (gid exp)
|
||||
(find-free exp b)]
|
||||
[(define define-syntax define-library import) tail
|
||||
(c-error "misplaced definition form" x)]
|
||||
[else (c-error "unexpected <core> form" x)])))
|
||||
(define (find-free x b)
|
||||
(record-case x
|
||||
[quote (obj) '()]
|
||||
[gref (gid) '()]
|
||||
[gset! (gid exp) (find-free exp b)]
|
||||
[(ref const) (id) (if (set-member? id b) '() (list id))]
|
||||
[set! (id exp) (set-union (if (set-member? id b) '() (list id)) (find-free exp b))]
|
||||
[set& (id) (if (set-member? id b) '() (list id))]
|
||||
[lambda (idsi exp) (find-free exp (set-union (flatten-idslist idsi) b))]
|
||||
[lambda* clauses (find-free* (map cadr clauses) b)]
|
||||
[letcc (kid exp) (find-free exp (set-union (list kid) b))]
|
||||
[withcc (kexp exp) (set-union (find-free kexp b) (find-free exp b))]
|
||||
[if (ce te ee) (set-union (find-free ce b) (set-union (find-free te b) (find-free ee b)))]
|
||||
[begin exps (find-free* exps b)]
|
||||
[integrable (i . as) (find-free* as b)]
|
||||
[call (exp . args) (set-union (find-free exp b) (find-free* args b))]
|
||||
[asm (cstr) '()]
|
||||
[once (gid exp) (find-free exp b)]
|
||||
[(define define-syntax define-library import) tail (c-error "misplaced definition form" x)]
|
||||
[else (c-error "unexpected <core> form" x)]))
|
||||
|
||||
(define find-sets*
|
||||
(lambda (x* v)
|
||||
(if (null? x*)
|
||||
'()
|
||||
(set-union
|
||||
(find-sets (car x*) v)
|
||||
(find-sets* (cdr x*) v)))))
|
||||
(define (find-sets* x* v)
|
||||
(if (null? x*)
|
||||
'()
|
||||
(set-union
|
||||
(find-sets (car x*) v)
|
||||
(find-sets* (cdr x*) v))))
|
||||
|
||||
(define find-sets
|
||||
(lambda (x v)
|
||||
(record-case x
|
||||
[quote (obj)
|
||||
'()]
|
||||
[gref (gid)
|
||||
'()]
|
||||
[gset! (gid exp)
|
||||
(find-sets exp v)]
|
||||
[(ref const) (id)
|
||||
'()]
|
||||
[set! (id exp)
|
||||
(set-union
|
||||
(if (set-member? id v) (list id) '())
|
||||
(find-sets exp v))]
|
||||
[set& (id)
|
||||
(if (set-member? id v) (list id) '())]
|
||||
[lambda (idsi exp)
|
||||
(find-sets exp (set-minus v (flatten-idslist idsi)))]
|
||||
[lambda* clauses
|
||||
(find-sets* (map cadr clauses) v)]
|
||||
[letcc (kid exp)
|
||||
(find-sets exp (set-minus v (list kid)))]
|
||||
[withcc (kexp exp)
|
||||
(set-union (find-sets kexp v) (find-sets exp v))]
|
||||
[begin exps
|
||||
(find-sets* exps v)]
|
||||
[if (test then else)
|
||||
(set-union
|
||||
(find-sets test v)
|
||||
(set-union (find-sets then v) (find-sets else v)))]
|
||||
[integrable (ig . args)
|
||||
(find-sets* args v)]
|
||||
[call (exp . args)
|
||||
(set-union (find-sets exp v) (find-sets* args v))]
|
||||
[asm (cstr)
|
||||
'()]
|
||||
[once (gid exp)
|
||||
(find-sets exp v)]
|
||||
[(define define-syntax define-library import) tail
|
||||
(c-error "misplaced definition form" x)]
|
||||
[else (c-error "unexpected <core> form" x)])))
|
||||
(define (find-sets x v)
|
||||
(record-case x
|
||||
[quote (obj) '()]
|
||||
[gref (gid) '()]
|
||||
[gset! (gid exp) (find-sets exp v)]
|
||||
[(ref const) (id) '()]
|
||||
[set! (id exp) (set-union (if (set-member? id v) (list id) '()) (find-sets exp v))]
|
||||
[set& (id) (if (set-member? id v) (list id) '())]
|
||||
[lambda (idsi exp) (find-sets exp (set-minus v (flatten-idslist idsi)))]
|
||||
[lambda* clauses (find-sets* (map cadr clauses) v)]
|
||||
[letcc (kid exp) (find-sets exp (set-minus v (list kid)))]
|
||||
[withcc (kexp exp) (set-union (find-sets kexp v) (find-sets exp v))]
|
||||
[begin exps (find-sets* exps v)]
|
||||
[if (ce te ee) (set-union (find-sets ce v) (set-union (find-sets te v) (find-sets ee v)))]
|
||||
[integrable (i . as) (find-sets* as v)]
|
||||
[call (exp . args) (set-union (find-sets exp v) (find-sets* args v))]
|
||||
[asm (cstr) '()]
|
||||
[once (gid exp) (find-sets exp v)]
|
||||
[(define define-syntax define-library import) tail (c-error "misplaced definition form" x)]
|
||||
[else (c-error "unexpected <core> form" x)]))
|
||||
|
||||
(define codegen
|
||||
; x: <core> expression to compile
|
||||
|
|
@ -1348,19 +1302,19 @@
|
|||
(codegen (car xl) l f s g k port)
|
||||
(loop (cdr xl)))))
|
||||
(when (and k (null? exps)) (write-char #\] port) (write-serialized-arg k port))]
|
||||
[if (test then else)
|
||||
(codegen test l f s g #f port)
|
||||
[if (cexp texp eexp)
|
||||
(codegen cexp l f s g #f port)
|
||||
(write-char #\? port)
|
||||
(write-char #\{ port)
|
||||
(codegen then l f s g k port)
|
||||
(codegen texp l f s g k port)
|
||||
(write-char #\} port)
|
||||
(cond [k ; tail call: 'then' arm exits, so br around is not needed
|
||||
(codegen else l f s g k port)]
|
||||
[(equal? else '(begin)) ; non-tail with void 'else' arm
|
||||
(codegen eexp l f s g k port)]
|
||||
[(equal? eexp '(begin)) ; non-tail with void 'else' arm
|
||||
] ; no code needed -- ac retains #f from failed test
|
||||
[else ; non-tail with 'else' expression; needs br
|
||||
(write-char #\{ port)
|
||||
(codegen else l f s g k port)
|
||||
(codegen eexp l f s g k port)
|
||||
(write-char #\} port)])]
|
||||
[lambda (idsi exp)
|
||||
(let* ([ids (flatten-idslist idsi)]
|
||||
|
|
@ -1765,6 +1719,17 @@
|
|||
loc)]))]
|
||||
[else #f])))
|
||||
|
||||
(define (name-install! nr name loc) ;=> same|modified|added
|
||||
(let* ([n-1 (- (vector-length nr) 1)] [i (if (pair? name) n-1 (immediate-hash name n-1))]
|
||||
[al (vector-ref nr i)] [p (if (pair? name) (assoc name al) (assq name al))])
|
||||
(cond [(and p (eq? (cdr p) loc)) 'same] ; nothing changed
|
||||
[p (set-cdr! p loc) 'modified]
|
||||
[else (vector-set! nr i (cons (cons name loc) al)) 'added])))
|
||||
|
||||
(define (name-remove! nr name)
|
||||
(let* ([n-1 (- (vector-length nr) 1)] [i (if (pair? name) n-1 (immediate-hash name n-1))])
|
||||
(vector-set! nr i (remove! name (vector-ref nr i) (lambda (p name) (equal? (car p) name))))))
|
||||
|
||||
; public registry for all non-hidden skint names
|
||||
(define *root-name-registry* (make-name-registry 300))
|
||||
|
||||
|
|
@ -1894,7 +1859,7 @@
|
|||
(box?) (box) (unbox) (set-box!) (record?) (make-record) (record-length) (record-ref)
|
||||
(record-set!) (fixnum?) (fxpositive?) (fxnegative?) (fxeven?) (fxodd?) (fx+) (fx*) (fx-) (fx/)
|
||||
(fxquotient) (fxremainder) (fxmodquo) (fxmodulo) (fxeucquo) (fxeucrem) (fxneg)
|
||||
(fxabs) (fx<?) (fx<=?) (fx>?) (fx>=?) (fx=?) (fx!=? x y) (fxmin) (fxmax) (fxneg) (fxabs) (fxgcd)
|
||||
(fxabs) (fx<?) (fx<=?) (fx>?) (fx>=?) (fx=?) (fx!=?) (fxmin) (fxmax) (fxneg) (fxabs) (fxgcd)
|
||||
(fxexpt) (fxsqrt) (fxnot) (fxand) (fxior) (fxxor) (fxsll) (fxsrl) (fixnum->flonum) (fixnum->string)
|
||||
(string->fixnum) (flonum?) (flzero?) (flpositive?) (flnegative?) (flinteger?) (flnan?)
|
||||
(flinfinite?) (flfinite?) (fleven?) (flodd?) (fl+) (fl*) (fl-) (fl/) (flneg) (flabs) (flgcd)
|
||||
|
|
@ -1954,8 +1919,8 @@
|
|||
[else #f])))
|
||||
|
||||
; mutable environment from two registries; new bindings go to user registry
|
||||
(define (make-repl-environment rr ur prefix) ; prefix for allocated globals
|
||||
(define (global name) (fully-qualified-library-prefixed-name prefix name))
|
||||
(define (make-repl-environment rr ur gpref) ; prefix for allocated globals
|
||||
(define (global name) (fully-qualified-library-prefixed-name gpref name))
|
||||
(lambda (name at)
|
||||
(cond [(new-id? name) ; nonsymbolic ids can't be (re)bound here
|
||||
(case at [(ref set!) (old-den name)] [else #f])]
|
||||
|
|
@ -1982,6 +1947,17 @@
|
|||
(name-lookup ur name ; return if in user registry
|
||||
(lambda (n) ; ok, not in ur: alloc
|
||||
(void)))]
|
||||
[(and (eq? at 'import) (sexp-match? '((<symbol> . #&*) ...) name))
|
||||
; special request for repl environment only: mass import
|
||||
(let loop ([eal name] [samc 0] [modc 0] [addc 0])
|
||||
(if (null? eal)
|
||||
(list samc modc addc)
|
||||
(let ([id (caar eal)] [loc (cdar eal)] [eal (cdr eal)])
|
||||
(name-remove! ur id) ; user binding isn't changed, but no longer visible
|
||||
(case (name-install! rr id loc) ; root binding possibly changed
|
||||
[(same) (loop eal (+ samc 1) modc addc)]
|
||||
[(modified) (loop eal samc (+ modc 1) addc)]
|
||||
[(added) (loop eal samc modc (+ addc 1))]))))]
|
||||
[else #f])))
|
||||
|
||||
(define root-environment
|
||||
|
|
@ -2048,11 +2024,22 @@
|
|||
[(eq? hval 'import) ; splice as definitions
|
||||
(let* ([core (xform-import (car x) (cdr x) env #t)] ; core is (import <library>)
|
||||
[l (cadr core)] [code (library-code l)] [eal (library-exports l)])
|
||||
(define (define-alias p)
|
||||
(repl-eval-top-form ; FIXME: this is not optimal -- too much fuss
|
||||
(list define-syntax-id (car p) (list syntax-quote-id (location-val (cdr p)))) env))
|
||||
(repl-compile-and-run-core-expr code)
|
||||
(for-each define-alias eal))]
|
||||
; note: we should somehow introduce imported locations as-is for keywords like
|
||||
; 'else' to work correctly -- while protecting imported locations from change
|
||||
; via define or define-syntax; lookup with at=define-syntax returns us new
|
||||
; location from user name registry, offering different locations and no protection!
|
||||
; we need to extend env protocol, e.g. (env id <location>) that either fails,
|
||||
; or inserts <location> under id where it will be returned via (env id 'ref)
|
||||
; and nothing else. We use (env eal 'import) -- with guarantees that env can't
|
||||
; answer any requests but 'ref to imported bindings
|
||||
(let ([counts (env eal 'import)]) ; manually invoke env's extended behavior
|
||||
(if (sexp-match? '(<number> <number> <number>) counts)
|
||||
(when *verbose* (display "IMPORT: ")
|
||||
(write (car counts)) (display " bindings are the same, ")
|
||||
(write (cadr counts)) (display " modified, ")
|
||||
(write (caddr counts)) (display " added\n"))
|
||||
(x-error "failed to import to env, import is not supported:" env eal)))
|
||||
(repl-compile-and-run-core-expr code))]
|
||||
[(val-transformer? hval) ; apply transformer and loop
|
||||
(repl-eval-top-form (hval x env) env)]
|
||||
[(val-integrable? hval) ; integrable application
|
||||
|
|
@ -2078,9 +2065,15 @@
|
|||
[(ref <symbol>) (write (repl-environment (car args) 'ref) op) (newline op)]
|
||||
[(ref (* * ...)) (write (repl-environment (car args) 'ref) op) (newline op)]
|
||||
[(rnr) (write *root-name-registry* op) (newline op)]
|
||||
[(rnr *) (write (name-lookup *root-name-registry* (car args) #f) op) (newline op)]
|
||||
[(rref *) (write (name-lookup *root-name-registry* (car args) #f) op) (newline op)]
|
||||
[(rrem! *) (cond [(name-lookup *root-name-registry* (car args) #f)
|
||||
(name-remove! *root-name-registry* (car args)) (display "done!\n" op)]
|
||||
[else (display "name not found: " op) (write name op) (newline op)])]
|
||||
[(unr) (write *user-name-registry* op) (newline op)]
|
||||
[(unr *) (write (name-lookup *user-name-registry* (car args) #f) op) (newline op)]
|
||||
[(uref *) (write (name-lookup *user-name-registry* (car args) #f) op) (newline op)]
|
||||
[(urem! *) (cond [(name-lookup *user-name-registry* (car args) #f)
|
||||
(name-remove! *user-name-registry* (car args)) (display "done!\n" op)]
|
||||
[else (display "name not found: " op) (write name op) (newline op)])]
|
||||
[(peek *)
|
||||
(cond [(string? (car args))
|
||||
(display (if (file-exists? (car args))
|
||||
|
|
@ -2099,9 +2092,11 @@
|
|||
(display " ,verbose off -- turn verbosity off\n" op)
|
||||
(display " ,ref <name> -- show current denotation for <name>\n" op)
|
||||
(display " ,rnr -- show root name registry\n" op)
|
||||
(display " ,rnr <name> -- lookup name in root registry\n" op)
|
||||
(display " ,rref <name> -- lookup name in root registry\n" op)
|
||||
(display " ,rrem! <name> -- remove name from root registry\n" op)
|
||||
(display " ,unr -- show user name registry\n" op)
|
||||
(display " ,unr <name> -- lookup name in user registry\n" op)
|
||||
(display " ,uref <name> -- lookup name in user registry\n" op)
|
||||
(display " ,urem! <name> -- remove name from user registry\n" op)
|
||||
(display " ,help -- this help\n" op)]
|
||||
[else
|
||||
(display "syntax error in repl command\n" op)
|
||||
|
|
|
|||
392
t.c
392
t.c
|
|
@ -35,14 +35,17 @@ char *t_code[] = {
|
|||
|
||||
"P", "sexp-match?",
|
||||
"%2'(y1:*),.1q,.0?{.0]3}'(y4:<id>),.2q?{.2Y0,.0?{.0}{.3K0}_1}{f},.0?{.0"
|
||||
"]4}'(y8:<symbol>),.3q?{.3Y0}{f},.0?{.0]5}'(y8:<string>),.4q?{.4S0}{f},"
|
||||
".0?{.0]6}.4,.6v,.0?{.0]7}.5p?{'(y3:...),.6aq?{.5dp?{.5ddu}{f}}{f}?{.5d"
|
||||
"a,.7v}{.5dp?{'(y3:...),.6daq?{.5ddu}{f}}{f}?{.5a,'(y1:*),.1q?{.7L0}{${"
|
||||
".9,,#0.0,.5,&2{%1.0u,.0?{.0]2}.1p?{${.3a,:0,@(y11:sexp-match?)[02}?{.1"
|
||||
"d,:1^[21}f]2}f]2}.!0.0^_1[01}}_1}{.6p?{${.8a,.8a,@(y11:sexp-match?)[02"
|
||||
"}?{${.8d,.8d,@(y11:sexp-match?)[02}}{f}}{f}}}}{f},.0?{.0]8}.6V0?{.7V0?"
|
||||
"{${.9X0,.9X0,@(y11:sexp-match?)[02}}{f}}{f},.0?{.0]9}.7Y2?{.8Y2?{.8z,."
|
||||
"8z,@(y11:sexp-match?)[92}f]9}f]9",
|
||||
"]4}'(y8:<symbol>),.3q?{.3Y0}{f},.0?{.0]5}'(y8:<number>),.4q?{.4N0}{f},"
|
||||
".0?{.0]6}'(y8:<string>),.5q?{.5S0}{f},.0?{.0]7}'(y8:<vector>),.6q?{.6V"
|
||||
"0}{f},.0?{.0]8}'(y5:<box>),.7q?{.7Y2}{f},.0?{.0]9}.7,.9v,.0?{.0](i10)}"
|
||||
".8p?{'(y3:...),.9aq?{.8dp?{.8ddu}{f}}{f}?{.8da,.(i10)v}{.8dp?{'(y3:..."
|
||||
"),.9daq?{.8ddu}{f}}{f}?{.8a,'(y1:*),.1q?{.(i10)L0}{${.(i12),,#0.0,.5,&"
|
||||
"2{%1.0u,.0?{.0]2}.1p?{${.3a,:0,@(y11:sexp-match?)[02}?{.1d,:1^[21}f]2}"
|
||||
"f]2}.!0.0^_1[01}}_1}{.9p?{${.(i11)a,.(i11)a,@(y11:sexp-match?)[02}?{${"
|
||||
".(i11)d,.(i11)d,@(y11:sexp-match?)[02}}{f}}{f}}}}{f},.0?{.0](i11)}.9V0"
|
||||
"?{.(i10)V0?{${.(i12)X0,.(i12)X0,@(y11:sexp-match?)[02}}{f}}{f},.0?{.0]"
|
||||
"(i12)}.(i10)Y2?{.(i11)Y2?{.(i11)z,.(i11)z,@(y11:sexp-match?)[(i12)2}f]"
|
||||
"(i12)}f](i12)",
|
||||
|
||||
"S", "sexp-case",
|
||||
"l6:y12:syntax-rules;l1:y4:else;;l2:l4:y1:_;l2:y3:key;y3:...;;y7:clause"
|
||||
|
|
@ -71,6 +74,11 @@ char *t_code[] = {
|
|||
"P", "rassq",
|
||||
"%2.1p?{.1a,.0d,.2q?{.0]3}.2d,.2,@(y5:rassq)[32}f]2",
|
||||
|
||||
"P", "remove!",
|
||||
"%3.1,f,f,,#0.0,.7,.6,&3{%3.2p~?{.1?{.2,.2sd.0]3}.2]3}${:0,.5a,:1[02}?{"
|
||||
".2d,.2,.2,:2^[33}.1?{.2,.2sd.2d,.3,.2,:2^[33}.2d,.3,.4,:2^[33}.!0.0^_1"
|
||||
"[33",
|
||||
|
||||
"P", "list-diff",
|
||||
"%2.0u,.0?{.0}{.2,.2q}_1?{n]2}${.3,.3d,@(y9:list-diff)[02},.1ac]2",
|
||||
|
||||
|
|
@ -358,7 +366,7 @@ char *t_code[] = {
|
|||
",.0da,'0,.1V4,'1,.2V4,.(i10),.1,,#0.(i10),.1,.(i14),.(i19),.(i19),.(i1"
|
||||
"9),:0,.(i11),&8{%2.0u?{:0,@(y15:syntax-quote-id),l2,:5,:4,fc,:3,.3c,:2"
|
||||
",fc,.6,:1^[35}.0ad,${.3aa,:7,@(y12:id-rename-as)[02},.3,.2,.2,&3{%2:0,"
|
||||
".1q?{'(y3:ref),.2q}{f}?{:1]2}.1,.1,:2[22},.3d,:6^[42}.!0.0^_1[(i15)2}."
|
||||
".1q?{'(y3:ref),.2q?{:1]2}f]2}.1,.1,:2[22},.3d,:6^[42}.!0.0^_1[(i15)2}."
|
||||
"4,'(s20:improper import form),@(y7:x-error)[(i11)2}.1K0?{.5,${.9,.8,.6"
|
||||
"[02}c,.(i10),.(i10),.(i10),.(i10),:0^[(i11)5}:1,.7,.(i12),.(i12)A8,.(i"
|
||||
"12)A8,.(i12)A8,@(y12:xform-labels)[(i11)6}:1,.1,.6,.6A8,.6A8,.6A8,@(y1"
|
||||
|
|
@ -609,9 +617,9 @@ char *t_code[] = {
|
|||
",'(y5:begin)c,${.(i13)?{.2,.(i14),'(y4:once),l3}{.2},.(i11),@(y11:adjo"
|
||||
"in-code)[02},.4,.8,,#0.8,.1,.5,&3{%2.0u?{.1A9,:0c]2}.0aa,.1ad,${'(y3:r"
|
||||
"ef),.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,'(l2:y3:ref;y5:c"
|
||||
"onst;),.1aA0?{.5,.1da,'(y5:const),l2b,.4cc,.5d,:1^[62}.0,.4,'(s27:cann"
|
||||
"ot export code alias id),@(y7:x-error)[63}.!0.0^_1[(i16)2",
|
||||
"y17:location-special?)[01}?{.4,.1,.3cc,.4d,:1^[52}.0z,.0p~,.0?{.0}{'(l"
|
||||
"2: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[(i16)2",
|
||||
|
||||
"P", "xform-define-library",
|
||||
"%4${.3,@(y7:list2+?)[01}?{${.3a,@(y9:listname?)[01}}{f}?{${.3a,@(y17:x"
|
||||
|
|
@ -763,104 +771,104 @@ char *t_code[] = {
|
|||
",.1aq?{.0d,.6,.8,.4,.6,.8,.(i10),&6{%!0${.2,,#0.0,:3,:2,:1,:0,:4,:5,&7"
|
||||
"{%1.0p?{.0dp?{f}{:0},${:1,.3,:2,:3,:4,:5,.9a,@(y7:codegen)[07}.1d,:6^["
|
||||
"21}]1}.!0.0^_1[01}:5?{.0u}{f}?{:4,'(c])W0:4,:5,@(y20:write-serialized-"
|
||||
"arg)[12}]1},@(y13:apply-to-list)[72}'(y2:if),.1aq?{.0d,.6,.6,.6,.6,.6,"
|
||||
".(i12),&6{%3${:0,f,:4,:3,:2,:1,.8,@(y7:codegen)[07}:0,'(c?)W0:0,'(c{)W"
|
||||
"0${:0,:5,:4,:3,:2,:1,.9,@(y7:codegen)[07}:0,'(c})W0:5?{:0,:5,:4,:3,:2,"
|
||||
":1,.8,@(y7:codegen)[37}'(l1:y5:begin;),.3e,.0?{.0]4}.3?{:0,'(c{)W0${:0"
|
||||
",:5,:4,:3,:2,:1,.(i11),@(y7:codegen)[07}:0,'(c})W0]4}f]4},@(y13:apply-"
|
||||
"to-list)[72}'(y6:lambda),.1aq?{.0d,.6,.8,.7,.7,.7,.7,&6{%2${.2,@(y15:f"
|
||||
"latten-idslist)[01},${:3,${.5,.8,@(y9:find-free)[02},@(y9:set-minus)[0"
|
||||
"2},${.3,.6,@(y9:find-sets)[02},${:0,.4A8,,#0.0,:4,:1,:3,&4{%2.0u?{]2}$"
|
||||
"{:2,f,:0,n,:1,.8,.8a,'(y3:ref),l2,@(y7:codegen)[07}:2,'(c,)W0.1,fc,.1d"
|
||||
",:3^[22}.!0.0^_1[02}:4,'(c&)W0${:4,.4g,@(y20:write-serialized-arg)[02}"
|
||||
":4,'(c{)W0.3L0?{:4,'(c%25)W0${:4,.6g,@(y20:write-serialized-arg)[02}}{"
|
||||
":4,'(c%25)W0:4,'(c!)W0${:4,${.8,@(y17:idslist-req-count)[01},@(y20:wri"
|
||||
"te-serialized-arg)[02}}${'0,.5,,#0.0,.6,:4,&3{%2.0u?{]2}${:1,.3a,@(y11"
|
||||
":set-member?)[02}?{:0,'(c#)W0${:0,.4,@(y20:write-serialized-arg)[02}}'"
|
||||
"1,.2I+,.1d,:2^[22}.!0.0^_1[02}${:4,.5g,:3,${${.(i10),:2,@(y13:set-inte"
|
||||
"rsect)[02},.8,@(y9:set-union)[02},.7,.9,.(i12),@(y7:codegen)[07}:4,'(c"
|
||||
"})W0_1_1_1:5?{:4,'(c])W0:4,:5,@(y20:write-serialized-arg)[22}]2},@(y13"
|
||||
":apply-to-list)[72}'(y7:lambda*),.1aq?{.0d,.6,.8,.5,.7,.9,.7,&6{%!0${:"
|
||||
"0,.3A8,,#0.0,:4,:3,:2,:1,&5{%2.0u?{]2}${:3,f,:0,:1,:2,.8,.8ada,@(y7:co"
|
||||
"degen)[07}:3,'(c%25)W0:3,'(cx)W0:3,'(c,)W0.1,fc,.1d,:4^[22}.!0.0^_1[02"
|
||||
"}:4,'(c&)W0${:4,.3g,@(y20:write-serialized-arg)[02}:4,'(c{)W0${'0,.3,,"
|
||||
"#0.0,:4,&2{%2.0u?{]2}.0aa,.0a,.1da,:0,'(c|)W0.0?{:0,'(c!)W0}${:0,.4,@("
|
||||
"y20:write-serialized-arg)[02}${:0,.7,@(y20:write-serialized-arg)[02}_1"
|
||||
"_1_1'1,.2I+,.1d,:1^[22}.!0.0^_1[02}:4,'(c%25)W0:4,'(c%25)W0:4,'(c})W0:"
|
||||
"5?{:4,'(c])W0:4,:5,@(y20:write-serialized-arg)[12}]1},@(y13:apply-to-l"
|
||||
"ist)[72}'(y5:letcc),.1aq?{.0d,.4,.7,.7,.6,.6,.(i12),&6{%2.0,l1,${.2,.5"
|
||||
",@(y9:find-sets)[02},${.2,${.6,:5,@(y9:set-minus)[02},@(y9:set-union)["
|
||||
"02},:4?{:0,'(ck)W0${:0,:4,@(y20:write-serialized-arg)[02}:0,'(c,)W0${."
|
||||
"3,.6,@(y11:set-member?)[02}?{:0,'(c#)W0:0,'(c0)W0}:0,'1,:4I+,:3,.3,:2,"
|
||||
":1,.9c,.(i10),@(y7:codegen)[57}:0,'(c$)W0:0,'(c{)W0:0,'(ck)W0:0,'(c0)W"
|
||||
"0:0,'(c,)W0${.3,.6,@(y11:set-member?)[02}?{:0,'(c#)W0:0,'(c0)W0}${:0,f"
|
||||
",:3,.5,:2,:1,fc,fc,.(i11)c,.(i12),@(y7:codegen)[07}:0,'(c_)W0${:0,'3,@"
|
||||
"(y20:write-serialized-arg)[02}:0,'(c})W0]5},@(y13:apply-to-list)[72}'("
|
||||
"y6:withcc),.1aq?{.0d,.7,.3,.5,.7,.9,&5{%2'(l3:y5:quote;y3:ref;y6:lambd"
|
||||
"a;),.2aA0?{${:4,f,:0,:1,:2,:3,.9,@(y7:codegen)[07}:4,'(c,)W0${:4,f,:0,"
|
||||
":1,:2,:3,fc,.8,@(y7:codegen)[07}:4,'(cw)W0:4,'(c!)W0]2}${:4,f,:0,:1,:2"
|
||||
",:3,.9,n,'(y6:lambda),l3,@(y7:codegen)[07}:4,'(c,)W0${:4,f,:0,:1,:2,:3"
|
||||
",fc,.8,@(y7:codegen)[07}:4,'(cw)W0]2},@(y13:apply-to-list)[72}'(y10:in"
|
||||
"tegrable),.1aq?{.0d,.6,.8,.5,.7,.9,.7,&6{%!1'0,.2U8,.2U6,.0,'(l4:c0;c1"
|
||||
";c2;c3;),.1A1?{${:0,.6A8,,#0.0,:4,:3,:2,:1,&5{%2.0u?{]2}${:3,f,:0,:1,:"
|
||||
"2,.8,.8a,@(y7:codegen)[07}.0du~?{:3,'(c,)W0}.1,fc,.1d,:4^[22}.!0.0^_1["
|
||||
"02}${:4,.5,@(y12:write-string)[02}}{'(cp),.1v?{.3u?{'1,.5U8,${:4,.3,@("
|
||||
"y12:write-string)[02}_1}{'1,.4gI-,${:0,.7A8,,#0.0,:4,:3,:2,:1,&5{%2.0u"
|
||||
"?{]2}${:3,f,:0,:1,:2,.8,.8a,@(y7:codegen)[07}.0du~?{:3,'(c,)W0}.1,fc,."
|
||||
"1d,:4^[22}.!0.0^_1[02}${'0,,#0.0,.8,:4,.7,&4{%1:0,.1I<!?{]1}${:1,:2,@("
|
||||
"y12:write-string)[02}'1,.1I+,:3^[11}.!0.0^_1[01}_1}}{'(cm),.1v?{.3du?{"
|
||||
"'1,.5U8,${:4,f,:1,:2,:3,:0,.(i12)a,@(y7:codegen)[07}${:4,.3,@(y12:writ"
|
||||
"arg)[12}]1},@(y13:apply-to-list)[72}'(y2:if),.1aq?{.0d,.7,.3,.5,.7,.9,"
|
||||
".(i11),&6{%3${:5,f,:1,:2,:3,:4,.8,@(y7:codegen)[07}:5,'(c?)W0:5,'(c{)W"
|
||||
"0${:5,:0,:1,:2,:3,:4,.9,@(y7:codegen)[07}:5,'(c})W0:0?{:5,:0,:1,:2,:3,"
|
||||
":4,.8,@(y7:codegen)[37}'(l1:y5:begin;),.3e,.0?{.0]4}:5,'(c{)W0${:5,:0,"
|
||||
":1,:2,:3,:4,.(i11),@(y7:codegen)[07}:5,'(c})W0]4},@(y13:apply-to-list)"
|
||||
"[72}'(y6:lambda),.1aq?{.0d,.6,.8,.7,.7,.7,.7,&6{%2${.2,@(y15:flatten-i"
|
||||
"dslist)[01},${:3,${.5,.8,@(y9:find-free)[02},@(y9:set-minus)[02},${.3,"
|
||||
".6,@(y9:find-sets)[02},${:0,.4A8,,#0.0,:4,:1,:3,&4{%2.0u?{]2}${:2,f,:0"
|
||||
",n,:1,.8,.8a,'(y3:ref),l2,@(y7:codegen)[07}:2,'(c,)W0.1,fc,.1d,:3^[22}"
|
||||
".!0.0^_1[02}:4,'(c&)W0${:4,.4g,@(y20:write-serialized-arg)[02}:4,'(c{)"
|
||||
"W0.3L0?{:4,'(c%25)W0${:4,.6g,@(y20:write-serialized-arg)[02}}{:4,'(c%2"
|
||||
"5)W0:4,'(c!)W0${:4,${.8,@(y17:idslist-req-count)[01},@(y20:write-seria"
|
||||
"lized-arg)[02}}${'0,.5,,#0.0,.6,:4,&3{%2.0u?{]2}${:1,.3a,@(y11:set-mem"
|
||||
"ber?)[02}?{:0,'(c#)W0${:0,.4,@(y20:write-serialized-arg)[02}}'1,.2I+,."
|
||||
"1d,:2^[22}.!0.0^_1[02}${:4,.5g,:3,${${.(i10),:2,@(y13:set-intersect)[0"
|
||||
"2},.8,@(y9:set-union)[02},.7,.9,.(i12),@(y7:codegen)[07}:4,'(c})W0_1_1"
|
||||
"_1:5?{:4,'(c])W0:4,:5,@(y20:write-serialized-arg)[22}]2},@(y13:apply-t"
|
||||
"o-list)[72}'(y7:lambda*),.1aq?{.0d,.6,.8,.5,.7,.9,.7,&6{%!0${:0,.3A8,,"
|
||||
"#0.0,:4,:3,:2,:1,&5{%2.0u?{]2}${:3,f,:0,:1,:2,.8,.8ada,@(y7:codegen)[0"
|
||||
"7}:3,'(c%25)W0:3,'(cx)W0:3,'(c,)W0.1,fc,.1d,:4^[22}.!0.0^_1[02}:4,'(c&"
|
||||
")W0${:4,.3g,@(y20:write-serialized-arg)[02}:4,'(c{)W0${'0,.3,,#0.0,:4,"
|
||||
"&2{%2.0u?{]2}.0aa,.0a,.1da,:0,'(c|)W0.0?{:0,'(c!)W0}${:0,.4,@(y20:writ"
|
||||
"e-serialized-arg)[02}${:0,.7,@(y20:write-serialized-arg)[02}_1_1_1'1,."
|
||||
"2I+,.1d,:1^[22}.!0.0^_1[02}:4,'(c%25)W0:4,'(c%25)W0:4,'(c})W0:5?{:4,'("
|
||||
"c])W0:4,:5,@(y20:write-serialized-arg)[12}]1},@(y13:apply-to-list)[72}"
|
||||
"'(y5:letcc),.1aq?{.0d,.4,.7,.7,.6,.6,.(i12),&6{%2.0,l1,${.2,.5,@(y9:fi"
|
||||
"nd-sets)[02},${.2,${.6,:5,@(y9:set-minus)[02},@(y9:set-union)[02},:4?{"
|
||||
":0,'(ck)W0${:0,:4,@(y20:write-serialized-arg)[02}:0,'(c,)W0${.3,.6,@(y"
|
||||
"11:set-member?)[02}?{:0,'(c#)W0:0,'(c0)W0}:0,'1,:4I+,:3,.3,:2,:1,.9c,."
|
||||
"(i10),@(y7:codegen)[57}:0,'(c$)W0:0,'(c{)W0:0,'(ck)W0:0,'(c0)W0:0,'(c,"
|
||||
")W0${.3,.6,@(y11:set-member?)[02}?{:0,'(c#)W0:0,'(c0)W0}${:0,f,:3,.5,:"
|
||||
"2,:1,fc,fc,.(i11)c,.(i12),@(y7:codegen)[07}:0,'(c_)W0${:0,'3,@(y20:wri"
|
||||
"te-serialized-arg)[02}:0,'(c})W0]5},@(y13:apply-to-list)[72}'(y6:withc"
|
||||
"c),.1aq?{.0d,.7,.3,.5,.7,.9,&5{%2'(l3:y5:quote;y3:ref;y6:lambda;),.2aA"
|
||||
"0?{${:4,f,:0,:1,:2,:3,.9,@(y7:codegen)[07}:4,'(c,)W0${:4,f,:0,:1,:2,:3"
|
||||
",fc,.8,@(y7:codegen)[07}:4,'(cw)W0:4,'(c!)W0]2}${:4,f,:0,:1,:2,:3,.9,n"
|
||||
",'(y6:lambda),l3,@(y7:codegen)[07}:4,'(c,)W0${:4,f,:0,:1,:2,:3,fc,.8,@"
|
||||
"(y7:codegen)[07}:4,'(cw)W0]2},@(y13:apply-to-list)[72}'(y10:integrable"
|
||||
"),.1aq?{.0d,.6,.8,.5,.7,.9,.7,&6{%!1'0,.2U8,.2U6,.0,'(l4:c0;c1;c2;c3;)"
|
||||
",.1A1?{${:0,.6A8,,#0.0,:4,:3,:2,:1,&5{%2.0u?{]2}${:3,f,:0,:1,:2,.8,.8a"
|
||||
",@(y7:codegen)[07}.0du~?{:3,'(c,)W0}.1,fc,.1d,:4^[22}.!0.0^_1[02}${:4,"
|
||||
".5,@(y12:write-string)[02}}{'(cp),.1v?{.3u?{'1,.5U8,${:4,.3,@(y12:writ"
|
||||
"e-string)[02}_1}{'1,.4gI-,${:0,.7A8,,#0.0,:4,:3,:2,:1,&5{%2.0u?{]2}${:"
|
||||
"3,f,:0,:1,:2,.8,.8a,@(y7:codegen)[07}.0du~?{:3,'(c,)W0}.1,fc,.1d,:4^[2"
|
||||
"2}.!0.0^_1[02}${'0,,#0.0,.8,:4,.7,&4{%1:0,.1I<!?{]1}${:1,:2,@(y12:writ"
|
||||
"e-string)[02}'1,.1I+,:3^[11}.!0.0^_1[01}_1}}{'(cc),.1v?{.3A8,'1,.5gI-,"
|
||||
"${:4,f,:1,:2,:3,:0,.9a,@(y7:codegen)[07}:4,'(c,)W0${:0,fc,.4d,,#0.0,:4"
|
||||
",:3,:2,:1,&5{%2.0u?{]2}${:3,f,:0,:1,:2,.8,.8a,@(y7:codegen)[07}.0du~?{"
|
||||
":3,'(c,)W0:3,'(c,)W0}.1,fc,fc,.1d,:4^[22}.!0.0^_1[02}${'0,,#0.0,.9,:4,"
|
||||
".7,&4{%1:0,.1I<!?{]1}.0I=0~?{:1,'(c;)W0}${:1,:2,@(y12:write-string)[02"
|
||||
"}'1,.1I+,:3^[11}.!0.0^_1[01}_2}{'(cx),.1v?{'1,.4gI-,${:0,.7A8,,#0.0,:4"
|
||||
",:3,:2,:1,&5{%2.0u?{]2}${:3,f,:0,:1,:2,.8,.8a,@(y7:codegen)[07}.0du~?{"
|
||||
":3,'(c,)W0}.1,fc,.1d,:4^[22}.!0.0^_1[02}${'0,,#0.0,.8,:4,.7,&4{%1:0,.1"
|
||||
"I<!?{]1}${:1,:2,@(y12:write-string)[02}'1,.1I+,:3^[11}.!0.0^_1[01}_1}{"
|
||||
"'(cu),.1v?{.3u?{${:4,'1,.8U8,@(y12:write-string)[02}}{${:4,f,:1,:2,:3,"
|
||||
":0,.(i11)a,@(y7:codegen)[07}}${:4,.5,@(y12:write-string)[02}}{'(cb),.1"
|
||||
"v?{.3du?{${:4,'1,.8U8,@(y12:write-string)[02}}{${:4,f,:1,:2,:3,:0,.(i1"
|
||||
"1)da,@(y7:codegen)[07}}:4,'(c,)W0${:4,f,:1,:2,:3,:0,fc,.(i11)a,@(y7:co"
|
||||
"degen)[07}${:4,.5,@(y12:write-string)[02}}{'(ct),.1v?{.3ddu?{${:4,'1,."
|
||||
"8U8,@(y12:write-string)[02}}{${:4,f,:1,:2,:3,:0,.(i11)dda,@(y7:codegen"
|
||||
")[07}}:4,'(c,)W0${:4,f,:1,:2,:3,:0,fc,.(i11)da,@(y7:codegen)[07}:4,'(c"
|
||||
",)W0${:4,f,:1,:2,:3,:0,fc,fc,.(i11)a,@(y7:codegen)[07}${:4,.5,@(y12:wr"
|
||||
"ite-string)[02}}{'(c#),.1v?{${:0,.6A8,,#0.0,:4,:3,:2,:1,&5{%2.0u?{]2}$"
|
||||
"{:3,f,:0,:1,:2,.8,.8a,@(y7:codegen)[07}:3,'(c,)W0.1,fc,.1d,:4^[22}.!0."
|
||||
"0^_1[02}${:4,.5,@(y12:write-string)[02}${:4,.6g,@(y20:write-serialized"
|
||||
"-arg)[02}}{${.3,'(s27:unsupported integrable type),@(y7:c-error)[02}}}"
|
||||
"}}}}}}}_1_2:5?{:4,'(c])W0:4,:5,@(y20:write-serialized-arg)[22}]2},@(y1"
|
||||
"3:apply-to-list)[72}'(y4:call),.1aq?{.0d,.7,.4,.6,.8,.6,.(i11),&6{%!1'"
|
||||
"(y6:lambda),.2aq?{.1daL0?{.1dag,.1gI=}{f}}{f}?{${:1,.3A8,,#0.0,:5,:4,:"
|
||||
"3,:2,&5{%2.0u?{]2}${:3,f,:0,:1,:2,.8,.8a,@(y7:codegen)[07}:3,'(c,)W0.1"
|
||||
",fc,.1d,:4^[22}.!0.0^_1[02}.1da,.2dda,${.3,.3,@(y9:find-sets)[02},${.2"
|
||||
",${.7,:3,@(y9:set-minus)[02},@(y9:set-union)[02},:1,.4L6,${'0,.7,,#0.0"
|
||||
",.8,:5,&3{%2.0u?{]2}${:1,.3a,@(y11:set-member?)[02}?{:0,'(c#)W0${:0,.4"
|
||||
",@(y20:write-serialized-arg)[02}}'1,.2I+,.1d,:2^[22}.!0.0^_1[02}:0?{:5"
|
||||
",.6g,:0I+,:2,.4,:4,.5,.9,@(y7:codegen)[77}${:5,f,:2,.6,:4,.7,.(i11),@("
|
||||
"y7:codegen)[07}:5,'(c_)W0:5,.6g,@(y20:write-serialized-arg)[72}:0?{${:"
|
||||
"1,.3A8,,#0.0,:5,:4,:3,:2,.(i11),&6{%2.0u?{:4,f,:1,:2,:3,.6,:0,@(y7:cod"
|
||||
"egen)[27}${:4,f,:1,:2,:3,.8,.8a,@(y7:codegen)[07}:4,'(c,)W0.1,fc,.1d,:"
|
||||
"5^[22}.!0.0^_1[02}:5,'(c[)W0${:5,:0,@(y20:write-serialized-arg)[02}:5,"
|
||||
".1g,@(y20:write-serialized-arg)[22}:5,'(c$)W0:5,'(c{)W0${:1,fc,fc,.3A8"
|
||||
",,#0.0,:5,:4,:3,:2,.(i11),&6{%2.0u?{:4,f,:1,:2,:3,.6,:0,@(y7:codegen)["
|
||||
"27}${:4,f,:1,:2,:3,.8,.8a,@(y7:codegen)[07}:4,'(c,)W0.1,fc,.1d,:5^[22}"
|
||||
".!0.0^_1[02}:5,'(c[)W0${:5,'0,@(y20:write-serialized-arg)[02}${:5,.3g,"
|
||||
"@(y20:write-serialized-arg)[02}:5,'(c})W0]2},@(y13:apply-to-list)[72}'"
|
||||
"(y3:asm),.1aq?{.0d,.6,.8,&2{%1${:0,.3,@(y12:write-string)[02}:1?{:0,'("
|
||||
"c])W0:0,:1,@(y20:write-serialized-arg)[12}]1},@(y13:apply-to-list)[72}"
|
||||
"'(y4:once),.1aq?{.0d,.7,.7,.7,.7,.7,.7,&6{%2:5,:4,:3,:2,:1,:0,n,n,.9c,"
|
||||
"n,n,tc,'(y5:quote)cc,.9c,'(y5:gset!)cc,'(y5:begin)cc,n,'(y5:begin)cc,n"
|
||||
",n,tc,'(y5:quote)cc,n,.9c,'(y4:gref)cc,'(y3:eq?)U5c,'(y10:integrable)c"
|
||||
"c,'(y2:if)c,@(y7:codegen)[27},@(y13:apply-to-list)[72}'(l4:y6:define;y"
|
||||
"13:define-syntax;y14:define-library;y6:import;),.1aA0?{.0d,.1,&1{%!0:0"
|
||||
",'(s25:misplaced definition form),@(y7:c-error)[12},@(y13:apply-to-lis"
|
||||
"t)[72}.0,'(s22:unexpected <core> form),@(y7:c-error)[72",
|
||||
"e-string)[02}'1,.1I+,:3^[11}.!0.0^_1[01}_1}}{'(cm),.1v?{.3du?{'1,.5U8,"
|
||||
"${:4,f,:1,:2,:3,:0,.(i12)a,@(y7:codegen)[07}${:4,.3,@(y12:write-string"
|
||||
")[02}_1}{'1,.4gI-,${:0,.7A8,,#0.0,:4,:3,:2,:1,&5{%2.0u?{]2}${:3,f,:0,:"
|
||||
"1,:2,.8,.8a,@(y7:codegen)[07}.0du~?{:3,'(c,)W0}.1,fc,.1d,:4^[22}.!0.0^"
|
||||
"_1[02}${'0,,#0.0,.8,:4,.7,&4{%1:0,.1I<!?{]1}${:1,:2,@(y12:write-string"
|
||||
")[02}'1,.1I+,:3^[11}.!0.0^_1[01}_1}}{'(cc),.1v?{.3A8,'1,.5gI-,${:4,f,:"
|
||||
"1,:2,:3,:0,.9a,@(y7:codegen)[07}:4,'(c,)W0${:0,fc,.4d,,#0.0,:4,:3,:2,:"
|
||||
"1,&5{%2.0u?{]2}${:3,f,:0,:1,:2,.8,.8a,@(y7:codegen)[07}.0du~?{:3,'(c,)"
|
||||
"W0:3,'(c,)W0}.1,fc,fc,.1d,:4^[22}.!0.0^_1[02}${'0,,#0.0,.9,:4,.7,&4{%1"
|
||||
":0,.1I<!?{]1}.0I=0~?{:1,'(c;)W0}${:1,:2,@(y12:write-string)[02}'1,.1I+"
|
||||
",:3^[11}.!0.0^_1[01}_2}{'(cx),.1v?{'1,.4gI-,${:0,.7A8,,#0.0,:4,:3,:2,:"
|
||||
"1,&5{%2.0u?{]2}${:3,f,:0,:1,:2,.8,.8a,@(y7:codegen)[07}.0du~?{:3,'(c,)"
|
||||
"W0}.1,fc,.1d,:4^[22}.!0.0^_1[02}${'0,,#0.0,.8,:4,.7,&4{%1:0,.1I<!?{]1}"
|
||||
"${:1,:2,@(y12:write-string)[02}'1,.1I+,:3^[11}.!0.0^_1[01}_1}{'(cu),.1"
|
||||
"v?{.3u?{${:4,'1,.8U8,@(y12:write-string)[02}}{${:4,f,:1,:2,:3,:0,.(i11"
|
||||
")a,@(y7:codegen)[07}}${:4,.5,@(y12:write-string)[02}}{'(cb),.1v?{.3du?"
|
||||
"{${:4,'1,.8U8,@(y12:write-string)[02}}{${:4,f,:1,:2,:3,:0,.(i11)da,@(y"
|
||||
"7:codegen)[07}}:4,'(c,)W0${:4,f,:1,:2,:3,:0,fc,.(i11)a,@(y7:codegen)[0"
|
||||
"7}${:4,.5,@(y12:write-string)[02}}{'(ct),.1v?{.3ddu?{${:4,'1,.8U8,@(y1"
|
||||
"2:write-string)[02}}{${:4,f,:1,:2,:3,:0,.(i11)dda,@(y7:codegen)[07}}:4"
|
||||
",'(c,)W0${:4,f,:1,:2,:3,:0,fc,.(i11)da,@(y7:codegen)[07}:4,'(c,)W0${:4"
|
||||
",f,:1,:2,:3,:0,fc,fc,.(i11)a,@(y7:codegen)[07}${:4,.5,@(y12:write-stri"
|
||||
"ng)[02}}{'(c#),.1v?{${:0,.6A8,,#0.0,:4,:3,:2,:1,&5{%2.0u?{]2}${:3,f,:0"
|
||||
",:1,:2,.8,.8a,@(y7:codegen)[07}:3,'(c,)W0.1,fc,.1d,:4^[22}.!0.0^_1[02}"
|
||||
"${:4,.5,@(y12:write-string)[02}${:4,.6g,@(y20:write-serialized-arg)[02"
|
||||
"}}{${.3,'(s27:unsupported integrable type),@(y7:c-error)[02}}}}}}}}}}_"
|
||||
"1_2:5?{:4,'(c])W0:4,:5,@(y20:write-serialized-arg)[22}]2},@(y13:apply-"
|
||||
"to-list)[72}'(y4:call),.1aq?{.0d,.7,.4,.6,.8,.6,.(i11),&6{%!1'(y6:lamb"
|
||||
"da),.2aq?{.1daL0?{.1dag,.1gI=}{f}}{f}?{${:1,.3A8,,#0.0,:5,:4,:3,:2,&5{"
|
||||
"%2.0u?{]2}${:3,f,:0,:1,:2,.8,.8a,@(y7:codegen)[07}:3,'(c,)W0.1,fc,.1d,"
|
||||
":4^[22}.!0.0^_1[02}.1da,.2dda,${.3,.3,@(y9:find-sets)[02},${.2,${.7,:3"
|
||||
",@(y9:set-minus)[02},@(y9:set-union)[02},:1,.4L6,${'0,.7,,#0.0,.8,:5,&"
|
||||
"3{%2.0u?{]2}${:1,.3a,@(y11:set-member?)[02}?{:0,'(c#)W0${:0,.4,@(y20:w"
|
||||
"rite-serialized-arg)[02}}'1,.2I+,.1d,:2^[22}.!0.0^_1[02}:0?{:5,.6g,:0I"
|
||||
"+,:2,.4,:4,.5,.9,@(y7:codegen)[77}${:5,f,:2,.6,:4,.7,.(i11),@(y7:codeg"
|
||||
"en)[07}:5,'(c_)W0:5,.6g,@(y20:write-serialized-arg)[72}:0?{${:1,.3A8,,"
|
||||
"#0.0,:5,:4,:3,:2,.(i11),&6{%2.0u?{:4,f,:1,:2,:3,.6,:0,@(y7:codegen)[27"
|
||||
"}${:4,f,:1,:2,:3,.8,.8a,@(y7:codegen)[07}:4,'(c,)W0.1,fc,.1d,:5^[22}.!"
|
||||
"0.0^_1[02}:5,'(c[)W0${:5,:0,@(y20:write-serialized-arg)[02}:5,.1g,@(y2"
|
||||
"0:write-serialized-arg)[22}:5,'(c$)W0:5,'(c{)W0${:1,fc,fc,.3A8,,#0.0,:"
|
||||
"5,:4,:3,:2,.(i11),&6{%2.0u?{:4,f,:1,:2,:3,.6,:0,@(y7:codegen)[27}${:4,"
|
||||
"f,:1,:2,:3,.8,.8a,@(y7:codegen)[07}:4,'(c,)W0.1,fc,.1d,:5^[22}.!0.0^_1"
|
||||
"[02}:5,'(c[)W0${:5,'0,@(y20:write-serialized-arg)[02}${:5,.3g,@(y20:wr"
|
||||
"ite-serialized-arg)[02}:5,'(c})W0]2},@(y13:apply-to-list)[72}'(y3:asm)"
|
||||
",.1aq?{.0d,.6,.8,&2{%1${:0,.3,@(y12:write-string)[02}:1?{:0,'(c])W0:0,"
|
||||
":1,@(y20:write-serialized-arg)[12}]1},@(y13:apply-to-list)[72}'(y4:onc"
|
||||
"e),.1aq?{.0d,.7,.7,.7,.7,.7,.7,&6{%2:5,:4,:3,:2,:1,:0,n,n,.9c,n,n,tc,'"
|
||||
"(y5:quote)cc,.9c,'(y5:gset!)cc,'(y5:begin)cc,n,'(y5:begin)cc,n,n,tc,'("
|
||||
"y5:quote)cc,n,.9c,'(y4:gref)cc,'(y3:eq?)U5c,'(y10:integrable)cc,'(y2:i"
|
||||
"f)c,@(y7:codegen)[27},@(y13:apply-to-list)[72}'(l4:y6:define;y13:defin"
|
||||
"e-syntax;y14:define-library;y6:import;),.1aA0?{.0d,.1,&1{%!0:0,'(s25:m"
|
||||
"isplaced definition form),@(y7:c-error)[12},@(y13:apply-to-list)[72}.0"
|
||||
",'(s22:unexpected <core> form),@(y7:c-error)[72",
|
||||
|
||||
"P", "compile-to-string",
|
||||
"%1P51,${.2,f,${n,.8,@(y9:find-free)[02},n,n,n,.9,@(y7:codegen)[07}.0P9"
|
||||
|
|
@ -990,6 +998,15 @@ char *t_code[] = {
|
|||
"%3'1,.1V3-,.2p?{.0}{.0,.3H2},.0,.3V4,.4p?{.0,.5A5}{.0,.5A3},.0?{.0d]7}"
|
||||
".6?{${.7,.9[01},.0~?{f]8}.0Y2?{.0]8}.0b,.3,.1,.9cc,.5,.8V5.0]9}f]7",
|
||||
|
||||
"P", "name-install!",
|
||||
"%3'1,.1V3-,.2p?{.0}{.0,.3H2},.0,.3V4,.4p?{.0,.5A5}{.0,.5A3},.0?{.6,.1d"
|
||||
"q}{f}?{'(y4:same)]7}.0?{.6,.1sd'(y8:modified)]7}.1,.7,.7cc,.3,.6V5'(y5"
|
||||
":added)]7",
|
||||
|
||||
"P", "name-remove!",
|
||||
"%2'1,.1V3-,.2p?{.0}{.0,.3H2},${&0{%2.1,.1ae]2},.3,.6V4,.7,@(y7:remove!"
|
||||
")[03},.1,.4V5]4",
|
||||
|
||||
"C", 0,
|
||||
"${'(i300),@(y18:make-name-registry)[01}@!(y20:*root-name-registry*)",
|
||||
|
||||
|
|
@ -1158,42 +1175,42 @@ char *t_code[] = {
|
|||
";l1:y7:fxeven?;;l1:y6:fxodd?;;l1:y3:fx+;;l1:y3:fx*;;l1:y3:fx-;;l1:y3:f"
|
||||
"x/;;l1:y10:fxquotient;;l1:y11:fxremainder;;l1:y8:fxmodquo;;l1:y8:fxmod"
|
||||
"ulo;;l1:y8:fxeucquo;;l1:y8:fxeucrem;;l1:y5:fxneg;;l1:y5:fxabs;;l1:y4:f"
|
||||
"x<?;;l1:y5:fx<=?;;l1:y4:fx>?;;l1:y5:fx>=?;;l1:y4:fx=?;;l3:y5:fx!=?;y1:"
|
||||
"x;y1:y;;l1:y5:fxmin;;l1:y5:fxmax;;l1:y5:fxneg;;l1:y5:fxabs;;l1:y5:fxgc"
|
||||
"d;;l1:y6:fxexpt;;l1:y6:fxsqrt;;l1:y5:fxnot;;l1:y5:fxand;;l1:y5:fxior;;"
|
||||
"l1:y5:fxxor;;l1:y5:fxsll;;l1:y5:fxsrl;;l1:y14:fixnum->flonum;;l1:y14:f"
|
||||
"ixnum->string;;l1:y14:string->fixnum;;l1:y7:flonum?;;l1:y7:flzero?;;l1"
|
||||
":y11:flpositive?;;l1:y11:flnegative?;;l1:y10:flinteger?;;l1:y6:flnan?;"
|
||||
";l1:y11:flinfinite?;;l1:y9:flfinite?;;l1:y7:fleven?;;l1:y6:flodd?;;l1:"
|
||||
"y3:fl+;;l1:y3:fl*;;l1:y3:fl-;;l1:y3:fl/;;l1:y5:flneg;;l1:y5:flabs;;l1:"
|
||||
"y5:flgcd;;l1:y6:flexpt;;l1:y6:flsqrt;;l1:y7:flfloor;;l1:y9:flceiling;;"
|
||||
"l1:y10:fltruncate;;l1:y7:flround;;l1:y5:flexp;;l1:y5:fllog;;l1:y5:flsi"
|
||||
"n;;l1:y5:flcos;;l1:y5:fltan;;l1:y6:flasin;;l1:y6:flacos;;l2:y6:flatan;"
|
||||
"l1:y1:y;;;l1:y4:fl<?;;l1:y5:fl<=?;;l1:y4:fl>?;;l1:y5:fl>=?;;l1:y4:fl=?"
|
||||
";;l1:y5:fl!=?;;l1:y5:flmin;;l1:y5:flmax;;l1:y14:flonum->fixnum;;l1:y14"
|
||||
":flonum->string;;l1:y14:string->flonum;;l1:y8:list-cat;;l1:y4:meme;;l1"
|
||||
":y4:asse;;l1:y8:reverse!;;l1:y9:circular?;;l1:y8:char-cmp;;l1:y11:char"
|
||||
"-ci-cmp;;l1:y10:string-cat;;l1:y15:string-position;;l1:y10:string-cmp;"
|
||||
";l1:y13:string-ci-cmp;;l1:y10:vector-cat;;l1:y16:bytevector->list;;l1:"
|
||||
"y16:list->bytevector;;l1:y13:subbytevector;;l1:y19:standard-input-port"
|
||||
";;l1:y20:standard-output-port;;l1:y19:standard-error-port;;l1:y11:rena"
|
||||
"me-file;;),&0{%1,,,,#0#1#2#3&0{%1.0,'(y1:w),.1v?{'(l2:y6:scheme;y5:wri"
|
||||
"te;)]2}'(y1:t),.1v?{'(l2:y6:scheme;y4:time;)]2}'(y1:p),.1v?{'(l2:y6:sc"
|
||||
"heme;y4:repl;)]2}'(y1:r),.1v?{'(l2:y6:scheme;y4:read;)]2}'(y1:v),.1v?{"
|
||||
"'(l2:y6:scheme;y4:r5rs;)]2}'(y1:u),.1v?{'(l2:y6:scheme;y9:r5rs-null;)]"
|
||||
"2}'(y1:d),.1v?{'(l2:y6:scheme;y4:load;)]2}'(y1:z),.1v?{'(l2:y6:scheme;"
|
||||
"y4:lazy;)]2}'(y1:s),.1v?{'(l2:y6:scheme;y15:process-context;)]2}'(y1:i"
|
||||
"),.1v?{'(l2:y6:scheme;y7:inexact;)]2}'(y1:f),.1v?{'(l2:y6:scheme;y4:fi"
|
||||
"le;)]2}'(y1:e),.1v?{'(l2:y6:scheme;y4:eval;)]2}'(y1:o),.1v?{'(l2:y6:sc"
|
||||
"heme;y7:complex;)]2}'(y1:h),.1v?{'(l2:y6:scheme;y4:char;)]2}'(y1:l),.1"
|
||||
"v?{'(l2:y6:scheme;y11:case-lambda;)]2}'(y1:x),.1v?{'(l2:y6:scheme;y3:c"
|
||||
"xr;)]2}'(y1:b),.1v?{'(l2:y6:scheme;y4:base;)]2}]2}.!0&0{%1${&0{%1n,'(l"
|
||||
"1:y5:begin;),V12]1},.3,@(y20:*root-name-registry*),@(y11:name-lookup)["
|
||||
"03}z]1}.!1&0{%3'1,.1V4,.0,.3A3,.0?{.4,.1sd]5}.1,.5,.5cc,'1,.4V5]5}.!2&"
|
||||
"0{%1&0{%1.0,'(y5:const),l2]1},.1,@(y20:*root-name-registry*),@(y11:nam"
|
||||
"e-lookup)[13}.!3.4d,.5a,,#0.0,.6,.5,.7,.(i10),&5{%2.1u?{${.2,:0^[01},."
|
||||
"1,${'(l1:y4:repl;),:1^[01},:3^[23}${${.4,:0^[01},.3,${${.9a,:2^[01},:1"
|
||||
"^[01},:3^[03}.1d,.1,:4^[22}.!0.0^_1[52},@(y10:%25for-each1)[02}",
|
||||
"x<?;;l1:y5:fx<=?;;l1:y4:fx>?;;l1:y5:fx>=?;;l1:y4:fx=?;;l1:y5:fx!=?;;l1"
|
||||
":y5:fxmin;;l1:y5:fxmax;;l1:y5:fxneg;;l1:y5:fxabs;;l1:y5:fxgcd;;l1:y6:f"
|
||||
"xexpt;;l1:y6:fxsqrt;;l1:y5:fxnot;;l1:y5:fxand;;l1:y5:fxior;;l1:y5:fxxo"
|
||||
"r;;l1:y5:fxsll;;l1:y5:fxsrl;;l1:y14:fixnum->flonum;;l1:y14:fixnum->str"
|
||||
"ing;;l1:y14:string->fixnum;;l1:y7:flonum?;;l1:y7:flzero?;;l1:y11:flpos"
|
||||
"itive?;;l1:y11:flnegative?;;l1:y10:flinteger?;;l1:y6:flnan?;;l1:y11:fl"
|
||||
"infinite?;;l1:y9:flfinite?;;l1:y7:fleven?;;l1:y6:flodd?;;l1:y3:fl+;;l1"
|
||||
":y3:fl*;;l1:y3:fl-;;l1:y3:fl/;;l1:y5:flneg;;l1:y5:flabs;;l1:y5:flgcd;;"
|
||||
"l1:y6:flexpt;;l1:y6:flsqrt;;l1:y7:flfloor;;l1:y9:flceiling;;l1:y10:flt"
|
||||
"runcate;;l1:y7:flround;;l1:y5:flexp;;l1:y5:fllog;;l1:y5:flsin;;l1:y5:f"
|
||||
"lcos;;l1:y5:fltan;;l1:y6:flasin;;l1:y6:flacos;;l2:y6:flatan;l1:y1:y;;;"
|
||||
"l1:y4:fl<?;;l1:y5:fl<=?;;l1:y4:fl>?;;l1:y5:fl>=?;;l1:y4:fl=?;;l1:y5:fl"
|
||||
"!=?;;l1:y5:flmin;;l1:y5:flmax;;l1:y14:flonum->fixnum;;l1:y14:flonum->s"
|
||||
"tring;;l1:y14:string->flonum;;l1:y8:list-cat;;l1:y4:meme;;l1:y4:asse;;"
|
||||
"l1:y8:reverse!;;l1:y9:circular?;;l1:y8:char-cmp;;l1:y11:char-ci-cmp;;l"
|
||||
"1:y10:string-cat;;l1:y15:string-position;;l1:y10:string-cmp;;l1:y13:st"
|
||||
"ring-ci-cmp;;l1:y10:vector-cat;;l1:y16:bytevector->list;;l1:y16:list->"
|
||||
"bytevector;;l1:y13:subbytevector;;l1:y19:standard-input-port;;l1:y20:s"
|
||||
"tandard-output-port;;l1:y19:standard-error-port;;l1:y11:rename-file;;)"
|
||||
",&0{%1,,,,#0#1#2#3&0{%1.0,'(y1:w),.1v?{'(l2:y6:scheme;y5:write;)]2}'(y"
|
||||
"1:t),.1v?{'(l2:y6:scheme;y4:time;)]2}'(y1:p),.1v?{'(l2:y6:scheme;y4:re"
|
||||
"pl;)]2}'(y1:r),.1v?{'(l2:y6:scheme;y4:read;)]2}'(y1:v),.1v?{'(l2:y6:sc"
|
||||
"heme;y4:r5rs;)]2}'(y1:u),.1v?{'(l2:y6:scheme;y9:r5rs-null;)]2}'(y1:d),"
|
||||
".1v?{'(l2:y6:scheme;y4:load;)]2}'(y1:z),.1v?{'(l2:y6:scheme;y4:lazy;)]"
|
||||
"2}'(y1:s),.1v?{'(l2:y6:scheme;y15:process-context;)]2}'(y1:i),.1v?{'(l"
|
||||
"2:y6:scheme;y7:inexact;)]2}'(y1:f),.1v?{'(l2:y6:scheme;y4:file;)]2}'(y"
|
||||
"1:e),.1v?{'(l2:y6:scheme;y4:eval;)]2}'(y1:o),.1v?{'(l2:y6:scheme;y7:co"
|
||||
"mplex;)]2}'(y1:h),.1v?{'(l2:y6:scheme;y4:char;)]2}'(y1:l),.1v?{'(l2:y6"
|
||||
":scheme;y11:case-lambda;)]2}'(y1:x),.1v?{'(l2:y6:scheme;y3:cxr;)]2}'(y"
|
||||
"1:b),.1v?{'(l2:y6:scheme;y4:base;)]2}]2}.!0&0{%1${&0{%1n,'(l1:y5:begin"
|
||||
";),V12]1},.3,@(y20:*root-name-registry*),@(y11:name-lookup)[03}z]1}.!1"
|
||||
"&0{%3'1,.1V4,.0,.3A3,.0?{.4,.1sd]5}.1,.5,.5cc,'1,.4V5]5}.!2&0{%1&0{%1."
|
||||
"0,'(y5:const),l2]1},.1,@(y20:*root-name-registry*),@(y11:name-lookup)["
|
||||
"13}.!3.4d,.5a,,#0.0,.6,.5,.7,.(i10),&5{%2.1u?{${.2,:0^[01},.1,${'(l1:y"
|
||||
"4:repl;),:1^[01},:3^[23}${${.4,:0^[01},.3,${${.9a,:2^[01},:1^[01},:3^["
|
||||
"03}.1d,.1,:4^[22}.!0.0^_1[52},@(y10:%25for-each1)[02}",
|
||||
|
||||
"C", 0,
|
||||
"${'(i100),@(y18:make-name-registry)[01}@!(y20:*user-name-registry*)",
|
||||
|
|
@ -1215,14 +1232,19 @@ char *t_code[] = {
|
|||
|
||||
"P", "make-repl-environment",
|
||||
"%3,#0.3,&1{%1.0,:0,@(y37:fully-qualified-library-prefixed-name)[12}.!0"
|
||||
".2,.1,.3,&3{%2.0K0?{.1,'(l2:y3:ref;y4:set!;),.1A1?{.1,@(y7:old-den)[31"
|
||||
"}f]3}'(y3:ref),.2q?{:0,.1,:1,&3{%1${f,:1,:2,@(y11:name-lookup)[03},.0?"
|
||||
".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?"
|
||||
"{.0]2}:1Y0?{${:1,:0^[01},'(y3:ref),l2]2}f]2},.1,:2,@(y11:name-lookup)["
|
||||
"23}'(y4:set!),.2q?{.0Y0?{.0,:1,:0,&3{%1${f,:2,:0,@(y11:name-lookup)[03"
|
||||
"23}'(y4:set!),.2q?{.0Y0?{.0,:0,:1,&3{%1${f,:2,:0,@(y11:name-lookup)[03"
|
||||
"}~?{${:2,:1^[01},'(y3:ref),l2]1}f]1},.1,:2,@(y11:name-lookup)[23}f]2}'"
|
||||
"(y6:define),.2q?{.0Y0?{:1,.1,&2{%1${:0,:1^[01},'(y3:ref),l2]1},.1,:2,@"
|
||||
"(y6:define),.2q?{.0Y0?{:0,.1,&2{%1${:0,:1^[01},'(y3:ref),l2]1},.1,:2,@"
|
||||
"(y11:name-lookup)[23}f]2}'(y13:define-syntax),.2q?{&0{%1Y9]1},.1,:2,@("
|
||||
"y11:name-lookup)[23}f]2}]4",
|
||||
"y11:name-lookup)[23}'(y6:import),.2q?{${.2,'(l2:py8:<symbol>;zy1:*;;;y"
|
||||
"3:...;),@(y11:sexp-match?)[02}}{f}?{'0,'0,'0,.3,,#0:2,:1,.2,&3{%4.0u?{"
|
||||
".3,.3,.3,l3]4}.0d,.1ad,.2aa,${.2,:2,@(y12:name-remove!)[02}${.3,.3,:1,"
|
||||
"@(y13:name-install!)[03},'(y4:same),.1v?{.7,.7,'1,.8+,.6,:0^[84}'(y8:m"
|
||||
"odified),.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",
|
||||
|
||||
"C", 0,
|
||||
"${@(y20:*root-name-registry*),@(y25:make-readonly-environment)[01}@!(y"
|
||||
|
|
@ -1260,15 +1282,18 @@ char *t_code[] = {
|
|||
"xenv-lookup)[03},.0?{.1dda,.0,.2sz_1}{${.6,.4da,'(s50:identifier canno"
|
||||
"t be (re)defined as syntax in env:),@(y7:x-error)[03}}@(y9:*verbose*)?"
|
||||
"{Po,'(s19:LIBRARY INSTALLED: )W4Po,.2daW5PoW6]5}]5}'(y6:import),.1q?{$"
|
||||
"{t,.5,.5d,.6a,@(y12:xform-import)[04},.0da,'0,.1V4,'1,.2V4,,#0.7,&1{%1"
|
||||
":0,.1dz,@(y15:syntax-quote-id),l2,.2a,@(y16:define-syntax-id),l3,@(y18"
|
||||
":repl-eval-top-form)[12}.!0${.4,@(y30:repl-compile-and-run-core-expr)["
|
||||
"01}.1,.1^,@(y10:%25for-each1)[82}.0K0?{.2,${.5,.5,.5[02},@(y18:repl-ev"
|
||||
"al-top-form)[32}.0U0?{${.4,.4d,.4,@(y16:xform-integrable)[03},@(y30:re"
|
||||
"pl-compile-and-run-core-expr)[31}.0Y0?{${.4,.4,f,@(y5:xform)[03},@(y30"
|
||||
":repl-compile-and-run-core-expr)[31}${.4,.4d,.4,@(y10:xform-call)[03},"
|
||||
"@(y30:repl-compile-and-run-core-expr)[31}${.3,.3,f,@(y5:xform)[03},@(y"
|
||||
"30:repl-compile-and-run-core-expr)[21",
|
||||
"{t,.5,.5d,.6a,@(y12:xform-import)[04},.0da,'0,.1V4,'1,.2V4,${'(y6:impo"
|
||||
"rt),.3,.(i10)[02},${.2,'(l3:y8:<number>;y8:<number>;y8:<number>;),@(y1"
|
||||
"1:sexp-match?)[02}?{@(y9:*verbose*)?{Po,'(s8:IMPORT: )W4Po,.1aW5Po,'(s"
|
||||
"24: bindings are the same, )W4Po,.1daW5Po,'(s11: modified, )W4Po,.1dda"
|
||||
"W5Po,'(s7: added%0a)W4}}{${.3,.(i10),'(s49:failed to import to env, im"
|
||||
"port is not supported:),@(y7:x-error)[03}}_1.1,@(y30:repl-compile-and-"
|
||||
"run-core-expr)[71}.0K0?{.2,${.5,.5,.5[02},@(y18:repl-eval-top-form)[32"
|
||||
"}.0U0?{${.4,.4d,.4,@(y16:xform-integrable)[03},@(y30:repl-compile-and-"
|
||||
"run-core-expr)[31}.0Y0?{${.4,.4,f,@(y5:xform)[03},@(y30:repl-compile-a"
|
||||
"nd-run-core-expr)[31}${.4,.4d,.4,@(y10:xform-call)[03},@(y30:repl-comp"
|
||||
"ile-and-run-core-expr)[31}${.3,.3,f,@(y5:xform)[03},@(y30:repl-compile"
|
||||
"-and-run-core-expr)[21",
|
||||
|
||||
"P", "repl-read",
|
||||
"%2.1?{PoW6Po,.2W4Po,'(s1: )W4}.0,@(y14:read-code-sexp)[21",
|
||||
|
|
@ -1283,28 +1308,37 @@ char *t_code[] = {
|
|||
"(y3:ref),.4^a,@(y16:repl-environment)[02}W5.4W6]5}${.3^,'(l2:y3:ref;l3"
|
||||
":y1:*;y1:*;y3:...;;),@(y11:sexp-match?)[02}?{.4,${'(y3:ref),.4^a,@(y16"
|
||||
":repl-environment)[02}W5.4W6]5}${.3^,'(l1:y3:rnr;),@(y11:sexp-match?)["
|
||||
"02}?{.4,@(y20:*root-name-registry*)W5.4W6]5}${.3^,'(l2:y3:rnr;y1:*;),@"
|
||||
"(y11:sexp-match?)[02}?{.4,${f,.4^a,@(y20:*root-name-registry*),@(y11:n"
|
||||
"ame-lookup)[03}W5.4W6]5}${.3^,'(l1:y3:unr;),@(y11:sexp-match?)[02}?{.4"
|
||||
",@(y20:*user-name-registry*)W5.4W6]5}${.3^,'(l2:y3:unr;y1:*;),@(y11:se"
|
||||
"xp-match?)[02}?{.4,${f,.4^a,@(y20:*user-name-registry*),@(y11:name-loo"
|
||||
"kup)[03}W5.4W6]5}${.3^,'(l2:y4:peek;y1:*;),@(y11:sexp-match?)[02}?{.0^"
|
||||
"aS0?{.4,.1^aF0?{'(s12:file exists%0a)}{'(s20:file does not exist%0a)}W"
|
||||
"4]5}.0^aY0?{.4,.1^aX4F0?{'(s12:file exists%0a)}{'(s20:file does not ex"
|
||||
"ist%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"
|
||||
"}${.3^,'(l2:y7:verbose;y3:off;),@(y11:sexp-match?)[02}?{f@!(y9:*verbos"
|
||||
"e*)]5}${.3^,'(l1:y4:help;),@(y11:sexp-match?)[02}?{.4,'(s20:Available "
|
||||
"commands:%0a)W4.4,'(s42: ,say hello -- displays nice greeting%0a)W"
|
||||
"4.4,'(s40: ,peek <fname> -- check if file exists%0a)W4.4,'(s37: ,verb"
|
||||
"ose on -- turn verbosity on%0a)W4.4,'(s38: ,verbose off -- turn v"
|
||||
"erbosity off%0a)W4.4,'(s54: ,ref <name> -- show current denotation "
|
||||
"for <name>%0a)W4.4,'(s43: ,rnr -- show root name registry%0a"
|
||||
")W4.4,'(s48: ,rnr <name> -- lookup name in root registry%0a)W4.4,'("
|
||||
"s43: ,unr -- show user name registry%0a)W4.4,'(s48: ,unr <na"
|
||||
"me> -- lookup name in user registry%0a)W4.4,'(s29: ,help -"
|
||||
"- this help%0a)W4]5}.4,'(s29:syntax error in repl command%0a)W4.4,'(s3"
|
||||
"7:type ,help to see available commands%0a)W4]5",
|
||||
"02}?{.4,@(y20:*root-name-registry*)W5.4W6]5}${.3^,'(l2:y4:rref;y1:*;),"
|
||||
"@(y11:sexp-match?)[02}?{.4,${f,.4^a,@(y20:*root-name-registry*),@(y11:"
|
||||
"name-lookup)[03}W5.4W6]5}${.3^,'(l2:y5:rrem!;y1:*;),@(y11:sexp-match?)"
|
||||
"[02}?{${f,.3^a,@(y20:*root-name-registry*),@(y11:name-lookup)[03}?{${."
|
||||
"2^a,@(y20:*root-name-registry*),@(y12:name-remove!)[02}.4,'(s6:done!%0"
|
||||
"a)W4]5}.4,'(s16:name not found: )W4.4,@(y4:name)W5.4W6]5}${.3^,'(l1:y3"
|
||||
":unr;),@(y11:sexp-match?)[02}?{.4,@(y20:*user-name-registry*)W5.4W6]5}"
|
||||
"${.3^,'(l2:y4:uref;y1:*;),@(y11:sexp-match?)[02}?{.4,${f,.4^a,@(y20:*u"
|
||||
"ser-name-registry*),@(y11:name-lookup)[03}W5.4W6]5}${.3^,'(l2:y5:urem!"
|
||||
";y1:*;),@(y11:sexp-match?)[02}?{${f,.3^a,@(y20:*user-name-registry*),@"
|
||||
"(y11:name-lookup)[03}?{${.2^a,@(y20:*user-name-registry*),@(y12:name-r"
|
||||
"emove!)[02}.4,'(s6:done!%0a)W4]5}.4,'(s16:name not found: )W4.4,@(y4:n"
|
||||
"ame)W5.4W6]5}${.3^,'(l2:y4:peek;y1:*;),@(y11:sexp-match?)[02}?{.0^aS0?"
|
||||
"{.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%"
|
||||
"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}${."
|
||||
"3^,'(l2:y7:verbose;y3:off;),@(y11:sexp-match?)[02}?{f@!(y9:*verbose*)]"
|
||||
"5}${.3^,'(l1:y4:help;),@(y11:sexp-match?)[02}?{.4,'(s20:Available comm"
|
||||
"ands:%0a)W4.4,'(s42: ,say hello -- displays nice greeting%0a)W4.4,"
|
||||
"'(s40: ,peek <fname> -- check if file exists%0a)W4.4,'(s37: ,verbose "
|
||||
"on -- turn verbosity on%0a)W4.4,'(s38: ,verbose off -- turn verbo"
|
||||
"sity off%0a)W4.4,'(s54: ,ref <name> -- show current denotation for "
|
||||
"<name>%0a)W4.4,'(s43: ,rnr -- show root name registry%0a)W4."
|
||||
"4,'(s48: ,rref <name> -- lookup name in root registry%0a)W4.4,'(s50:"
|
||||
" ,rrem! <name> -- remove name from root registry%0a)W4.4,'(s43: ,unr "
|
||||
" -- show user name registry%0a)W4.4,'(s48: ,uref <name> -- "
|
||||
"lookup name in user registry%0a)W4.4,'(s50: ,urem! <name> -- remove n"
|
||||
"ame from user registry%0a)W4.4,'(s29: ,help -- this help%0a)W"
|
||||
"4]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",
|
||||
"%3,#0${@(y18:current-file-stack)[00}.!0${k0,.0,${.2,.9,.(i11),.(i10),&"
|
||||
|
|
|
|||
Loading…
Reference in a new issue