ref: 6c42012d3d227941cfec46b77768b2d3e5891dea
parent: ee58f398fec62d3096b0e01da51a3969ed37a32d
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Mon Oct 21 19:34:36 EDT 2024
alias λ → lambda
--- a/compiler.lsp
+++ b/compiler.lsp
@@ -150,7 +150,7 @@
(else #f))))))
(table.foreach
- (lambda (addr labl)
+ (λ (addr labl)
(begin (io.seek bcode addr)
(io.write bcode ((if long? int32 int16)
(- (get label-to-loc labl)
@@ -160,7 +160,7 @@
(define (const-to-idx-vec e)
(let ((cvec (vector.alloc (bcode:nconst e))))
- (table.foreach (lambda (val idx) (aset! cvec idx val))
+ (table.foreach (λ (val idx) (aset! cvec idx val))
(bcode:ctable e))
cvec))
@@ -189,7 +189,7 @@
#f)))))
; number of non-nulls
-(define (nnn e) (count (lambda (x) (not (null? x))) e))
+(define (nnn e) (count (λ (x) (not (null? x))) e))
(define (printable? x) (not (or (iostream? x)
(eof-object? x))))
@@ -258,7 +258,7 @@
(define (1arg-lambda? func)
(and (pair? func)
- (eq? (car func) 'lambda)
+ (or (eq? (car func) 'λ) (eq? (car func) 'lambda))
(pair? (cdr func))
(pair? (cadr func))
(length= (cadr func) 1)))
@@ -289,7 +289,7 @@
(compile-short-circuit g env tail? forms #f 'brt))
(define (compile-arglist g env lst)
- (for-each (lambda (a)
+ (for-each (λ (a)
(compile-in g env #f a))
lst)
(length lst))
@@ -314,7 +314,7 @@
+ '+ eqv? 'eqv? compare 'compare aref 'aref
set-car! 'set-car! car 'car
pair? 'pair? = '= vector? 'vector?)))
- (lambda (b)
+ (λ (b)
(get b2i b #f))))
(define (compile-builtin-call g env tail? x head b nargs)
@@ -386,7 +386,7 @@
(if (symbol? form)
`(set! ,form ,(car body))
`(set! ,(car form)
- (lambda ,(cdr form) ,@body . ,(car form))))))
+ (λ ,(cdr form) ,@body . ,(car form))))))
(define (fits-i8 x) (and (fixnum? x) (>= x -128) (<= x 127)))
@@ -412,7 +412,7 @@
(if (compile-if g env tail? x))
(begin (compile-begin g env tail? (cdr x)))
(prog1 (compile-prog1 g env x))
- (lambda (receive (the-f dept) (compile-f- env x)
+ (λ (receive (the-f dept) (compile-f- env x)
(begin (emit g 'loadv the-f)
(bcode:cdepth g dept)
(if (< dept (nnn env))
@@ -429,7 +429,7 @@
(compile-sym g env (cadr x) #(seta setc setg)))
(define (compile-in g env tail?
(expand-define x)))
- (trycatch (compile-in g env #f `(lambda () ,(cadr x)))
+ (trycatch (compile-in g env #f `(λ () ,(cadr x)))
(unless (1arg-lambda? (caddr x))
(error "trycatch: second form must be a 1-argument lambda"))
(compile-in g env #f (caddr x))
@@ -443,7 +443,7 @@
(define get-defined-vars
(letrec ((get-defined-vars-
- (lambda (expr)
+ (λ (expr)
(cond ((atom? expr) ())
((and (eq? (car expr) 'define)
(pair? (cdr expr)))
@@ -456,7 +456,7 @@
((eq? (car expr) 'begin)
(apply nconc (map get-defined-vars- (cdr expr))))
(else ())))))
- (lambda (expr) (delete-duplicates (get-defined-vars- expr)))))
+ (λ (expr) (delete-duplicates (get-defined-vars- expr)))))
(define (keyword-arg? x) (and (pair? x) (keyword? (car x))))
(define (keyword->symbol k)
@@ -466,7 +466,7 @@
k))
(define (lambda-arg-names argl)
- (map! (lambda (s) (if (pair? s) (keyword->symbol (car s)) s))
+ (map! (λ (s) (if (pair? s) (keyword->symbol (car s)) s))
(to-proper argl)))
(define (lambda-vars l)
@@ -514,7 +514,7 @@
#;(define (free-vars e)
(cond ((symbol? e) (list e))
((or (atom? e) (eq? (car e) 'quote)) ())
- ((eq? (car e) 'lambda)
+ ((or (eq? (car e) 'λ) (eq? (car e) 'lambda))
(diff (free-vars (cddr e))
(nconc (get-defined-vars (cons 'begin (cddr e)))
(lambda-arg-names (cadr e)))))
@@ -525,10 +525,10 @@
; to eval a top-level expression we need to avoid internal define
(set-top-level-value!
'compile-thunk
- (lambda (expr)
- (compile `(lambda () ,expr . ,*defines-processed-token*))))
+ (λ (expr)
+ (compile `(λ () ,expr . ,*defines-processed-token*))))
- (lambda (env f)
+ (λ (env f)
; convert lambda to one body expression and process internal defines
(define (lambda-body e)
(let ((B (if (pair? (cddr e))
@@ -539,8 +539,8 @@
(let ((V (get-defined-vars B)))
(if (null? V)
B
- (cons (list* 'lambda V B *defines-processed-token*)
- (map (lambda (x) (void)) V))))))
+ (cons (list* 'λ V B *defines-processed-token*)
+ (map (λ (x) (void)) V))))))
(define (lam:body f)
(if (eq? (lastcdr f) *defines-processed-token*)
(caddr f)
@@ -552,7 +552,7 @@
(vars (lambda-vars (cadr f)))
(opta (filter pair? (cadr f)))
(name (if (eq? (lastcdr f) *defines-processed-token*)
- 'lambda
+ 'λ
(lastcdr f))))
(let* ((nargs (if (atom? args) 0 (length args)))
(nreq (- nargs (length opta)))
@@ -620,7 +620,7 @@
(N (length code)))
(while (< i N)
; find key whose value matches the current byte
- (let ((inst (table.foldl (lambda (k v z)
+ (let ((inst (table.foldl (λ (k v z)
(or z (and (eq? v (aref code i))
k)))
#f Instructions)))
--- a/flisp.boot
+++ b/flisp.boot
@@ -28,23 +28,25 @@
#fn("8000n30182p:" #()) 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 00 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
*interactive* #f *syntax-environment*
- #table(with-bindings #fn(">000|120>21220522123052212405263:" #(#fn("B000n32021e1222382053e1242225015351262027e124F51522027e1242228082535152e3e164:" #(#fn(nconc)- let #fn(map) #.list #fn(copy-list) #fn("8000n22001e3:" #(set!))- unwind-protect begin #fn("8000n22001e3:" #(set!))))- #fn(map) #.car #.cadr #fn("6000n12060:" #(#fn(gensym))))) letrec #fn("?000|1202021e12223052e122240522515154e1222605262:" #(#fn(nconc)+ #table(letrec #fn("?000|1202021e12223052e122240522515154e1222605262:" #(#fn(nconc) lambda #fn(map) #.car #fn("9000n12021e12205162:" #(#fn(nconc) set! #fn(copy-list)))- #fn(copy-list) #fn("6000n17060:" #(void)))) assert #fn("<000n1200D2122230e2e2e2e4:" #(if- raise quote assert-failed)) do #fn("A000|220>21501<22230522224052222505265:" #(#fn("B000n520021822212324e125F=51522324e12590251230e18452e153e4e3e2e1230e18352e3:" #(letrec- lambda if #fn(nconc) begin #fn(copy-list)))
- #fn(gensym) #fn(map) #.car #.cadr #fn("7000n170051B38071061:0<:" #(cddr caddr)))) quasiquote #fn("8000n1700E62:" #(bq-process)) when #fn("<000|1200211POe4:" #(if- begin)) with-input-from #fn("=000|12021e1220e2e1e12315163:" #(#fn(nconc)- with-bindings
- *input-stream*
- #fn(copy-list))) unwind-protect #fn("8000n220>2150215062:" #(#fn("@000n220121qFe3e2e12223A210e1241e1250e2e3e3e31e1e3e3:" #(let+ #fn(copy-list) #fn("6000n17060:" #(void)))) quasiquote #fn("8000n1700E62:" #(bq-process)) when #fn("<000|1200211POe4:" #(if+ begin)) unwind-protect #fn("8000n220>2150215062:" #(#fn("@000n220121qFe3e2e12223A210e1241e1250e2e3e3e31e1e3e3:" #(let lambda prog1 trycatch begin raise)) #fn(gensym))) dotimes #fn(";000|120>0<0T62:" #(#fn("=000n220E211Ke32223e10e1e124F5153e4:" #(for - #fn(nconc) lambda #fn(copy-list))))) define-macro #fn("?000|120210<e22223e10=e12415153e3:" #(set-syntax! quote #fn(nconc) lambda #fn(copy-list))) receive #fn("@000|22021q1e32221e10e123825153e3:" #(call-with-values- lambda #fn(nconc) #fn(copy-list))) unless #fn("=000|1200O211Pe4:" #(if begin)) let #fn(":000|120>O61:" #(#fn("<000n1AR3D0A?04F<z004F=z01@30D420>2122e12324A52e125F51532326A5262:" #(#fn("8000n2A3@020A0e2e1Ae3@3001P:" #(letrec))+ lambda #fn(nconc) #fn(copy-list))) unless #fn("=000|1200O211Pe4:" #(if begin)) let* #fn("A000|10H3E02021e1qe12215153e1:2021e173051e1e1220=B3H02024e10=e12215153e1@301515375051e2:" #(#fn(nconc)+ lambda #fn(copy-list) caar let* cadar)) case #fn(":000|120>D61:" #(#fn("7000n120?0421>225061:" #(#fn("9000n2120C5020:1J40O:1R3=021072151e3:1H3=023072151e3:1=J>0230721<51e3:74251523=0260271e2e3:280271e2e3:" #(else+ eq? quote-value eqv? every #.symbol? memq quote memv) vals->cond)
+ #fn("<000n1200910e2e12122e12324>9115252e3:" #(let #fn(nconc) cond #fn(map)+ #fn("8000n1910A0<520=P:" #())))+ #fn(gensym))))) catch #fn("7000n220>215061:" #(#fn("@000n120F210e12223240e225260e22728e2e325290e2Ae3e42:0e22;0e2e4e3e3:" #(trycatch+ lambda if and pair? eq car quote thrown-value cadr caddr raise))
+ #fn(gensym))) assert #fn("<000n1200D2122230e2e2e2e4:" #(if+ raise quote assert-failed)) do #fn("A000|220>21501<22230522224052222505265:" #(#fn("B000n520021822212324e125F=51522324e12590251230e18452e153e4e3e2e1230e18352e3:" #(letrec+ lambda if #fn(nconc) begin #fn(copy-list)))
+ #fn(gensym) #fn(map) #.car #.cadr #fn("7000n170051B38071061:0<:" #(cddr caddr)))) with-input-from #fn("=000|12021e1220e2e1e12315163:" #(#fn(nconc)+ with-bindings *input-stream* #fn(copy-list))) let #fn(":000|120>O61:" #(#fn("<000n1AR3D0A?04F<z004F=z01@30D420>2122e12324A52e125F51532326A5262:" #(#fn("8000n2A3@020A0e2e1Ae3@3001P:" #(letrec)) #fn(nconc) lambda #fn(map) #fn("6000n10B3500<:0:" #()) #fn(copy-list) #fn("6000n10B3500T:7060:" #(void)))))) cond #fn("9000|020>D61:" #(#fn("7000n120>?040A61:" #(#fn("7000n10H340O:20>0<61:" #(#fn(":000n10<20Q;I7040<DQ3@00=J500<:210=P:0=J@0220<910A=51e3:0T23CW07475051513A026>77750515161:28>295061:2:0<210=P910A=51e4:" #(else begin or => 1arg-lambda? caddr #fn("=000n1200A<e2e1210227374A5151P920910=51e4e3:" #(let@@ -52,19 +54,15 @@
if caddr)) #fn(gensym) if))) cond-clauses->if))))) throw #fn(":000n220212223e201e4e2:" #(raise list quote thrown-value)) time #fn("7000n120>215061:" #(#fn(">000n120021e1e2e122A23242521e10e326e4e3e3:" #(lettime.now prog1 princ "Elapsed time: " - " seconds\n"))
- #fn(gensym))) let* #fn("A000|10H3E02021e1qe12215153e1:2021e173051e1e1220=B3H02024e10=e12215153e1@301515375051e2:" #(#fn(nconc)- lambda #fn(copy-list) caar let* cadar)) case #fn(":000|120>D61:" #(#fn("7000n120?0421>225061:" #(#fn("9000n2120C5020:1J40O:1R3=021072151e3:1H3=023072151e3:1=J>0230721<51e3:74251523=0260271e2e3:280271e2e3:" #(else- eq? quote-value eqv? every #.symbol? memq quote memv) vals->cond)
- #fn("<000n1200910e2e12122e12324>9115252e3:" #(let #fn(nconc) cond #fn(map)- #fn("8000n1910A0<520=P:" #())))- #fn(gensym))))) with-output-to #fn("=000|12021e1220e2e1e12315163:" #(#fn(nconc)- with-bindings *output-stream* #fn(copy-list))) catch #fn("7000n220>215061:" #(#fn("@000n120F210e12223240e225260e22728e2e325290e2Ae3e42:0e22;0e2e4e3e3:" #(trycatch- lambda if and pair? eq car quote thrown-value cadr caddr raise))
- #fn(gensym))))
+ #fn(gensym))) with-output-to #fn("=000|12021e1220e2e1e12315163:" #(#fn(nconc)+ with-bindings *output-stream* #fn(copy-list))) with-bindings #fn(">000|120>21220522123052212405263:" #(#fn("B000n32021e1222382053e1242225015351262027e124F51522027e1242228082535152e3e164:" #(#fn(nconc)+ let #fn(map) #.list #fn(copy-list) #fn("8000n22001e3:" #(set!))+ unwind-protect begin #fn("8000n22001e3:" #(set!))))+ #fn(map) #.car #.cadr #fn("6000n12060:" #(#fn(gensym))))))*whitespace* "\t\n\v\f\r \u0085 \u2028\u2029 " 1+
#fn("7000n10KM:" #() 1+) 1- #fn("7000n10K\x80:" #() 1-) 1arg-lambda?- #fn("8000n10B;3T040<20Q;3J040=B;3B040TB;3:04710TK62:" #(lambda- length=) 1arg-lambda?)
+ #fn("8000n10B;3^040<20Q;I8040<20Q;3J040=B;3B040TB;3:04710TK62:" #(lambda+ length=) 1arg-lambda?)
<= #fn("7000n210L;IB0470051;380470151S:" #(nan?) <=) > #fn("7000n210L:" #() >) >= #fn("7000n201L;IB0470051;380470151S:" #(nan?) >=)Instructions #table(not 35 vargc 76 load1 27 = 60 setc.l 75 sub2 80 brne.l 85 largc 81 brnn 26 loadc.l 70 loadi8 66 < 28 nop 46 set-cdr! 30 loada 8 neg 37 bound? 42 / 58 brn.l 88 lvargc 82 brt 25 trycatch 77 null? 38 load0 21 jmp.l 48 loadv 2 seta 15 keyargs 91 * 57 function? 44 builtin? 43 aref 23 optargs 89 loadt 20 vector? 45 cdr 13 brf 3 loadc00 17 symbol? 34 cadr 36 pop 4 pair? 18 for 78 closure 14 loadf 31 compare 61 loadv.l 67 setg.l 72 brn 87 eqv? 51 aset! 64 atom? 24 eq? 33 boolean? 39 brt.l 50 tapply 79 dummy_nil 94 loada0 0 brbound 90 dup 11 loadc01 22 list 53 loadc 9 apply 54 dummy_t 93 setg 71 loada1 1 tcall.l 84 jmp 16 fixnum? 41 cons 32 loadg.l 68 tcall 6 dummy_eof 95 call 5 - 56 brf.l 49 + 55 dummy_f 92 add2 29 seta.l 73 loadnil 65 brnn.l 86 setc 74 set-car! 47 loadg 7 vector 63 loada.l 69 argc 62 div0 59 ret 10 car 12 number? 40 equal? 52 call.l 83 brne 19)
@@ -165,7 +163,7 @@
largc lvargc vargc argc compile-in ret values #fn(function) encode-byte-code
bcode:code const-to-idx-vec)) filter keyword-arg?))
#fn(length))) #fn(length))) make-code-emitter lastcdr lambda-vars filter #.pair?
- lambda))) #0=#(#:g721 ()))
+ lambda))) #0=#(#:g724 ()))
compile-for #fn(":000n57084513X07101O825447101O835447101O845447202362:742561:" #(1arg-lambda?compile-in emit for error "for: third form must be a 1-argument lambda") compile-for)
compile-if #fn("<000n420>710517105183T728351738351B3;0748351@60755065:" #(#fn(";000n582DC>070AF9028364:82OC>070AF9028464:70AFO8254471A22053470AF902835449023<071A2352@:071A24153475A052470AF9028454475A162:" #(compile-in@@ -264,7 +262,7 @@
#fn(":000n10<7092:0T911525150911e3:" #(compile-thunk))))) expand-let-syntax) #fn("6000n20:" #() local-expansion-env) #fn("7000n20H3400:20>0<61:" #(#fn("9000n120>210F5261:" #(#fn("7000n120>21>61:" #(#fn(":000n1A;3604A=B3M093:AT920=f293970A519215262:A;IA04910RS;I704910Z360060:21>729205161:" #(caddr- #fn("8000n103B094:0930=f293162:92020C60930:92021C>094693093162:92022C>094793093162:92023C>094893093162:A60:" #(quote+ #fn("8000n103B094:0930=f293162:92020C60930:92021C>094693093162:92021C>094693093162:92022C>094793093162:92023C>094893093162:A60:" #(quotelambda define let-syntax)) macrocall?))
#fn("7000n020>D5192061:" #(#fn("6000n120>?040:" #(#fn("9000n10H3400:0<H3700<@<094:0<93152A0=51P:" #())))))))#fn(assq)))) expand-in)))) expand)
--- a/gen.lsp
+++ b/gen.lsp
@@ -12,59 +12,59 @@
OP_LOADC loadc #f 0
OP_RET ret #f 0
OP_DUP dup #f 0
- OP_CAR car 1 (lambda (x) (car x))
- OP_CDR cdr 1 (lambda (x) (cdr x))
+ OP_CAR car 1 (λ (x) (car x))
+ OP_CDR cdr 1 (λ (x) (cdr x))
OP_CLOSURE closure #f 0
OP_SETA seta #f 0
OP_JMP jmp #f 0
OP_LOADC00 loadc00 #f 0
- OP_PAIRP pair? 1 (lambda (x) (pair? x))
+ OP_PAIRP pair? 1 (λ (x) (pair? x))
OP_BRNE brne #f 0
OP_LOADT loadt #f 0
OP_LOAD0 load0 #f 0
OP_LOADC01 loadc01 #f 0
- OP_AREF aref 2 (lambda (x y) (aref x y))
- OP_ATOMP atom? 1 (lambda (x) (atom? x))
+ OP_AREF aref 2 (λ (x y) (aref x y))
+ OP_ATOMP atom? 1 (λ (x) (atom? x))
OP_BRT brt #f 0
OP_BRNN brnn #f 0
OP_LOAD1 load1 #f 0
- OP_LT < 2 (lambda (x y) (< x y))
+ OP_LT < 2 (λ (x y) (< x y))
OP_ADD2 add2 #f 0
- OP_SETCDR set-cdr! 2 (lambda (x y) (set-cdr! x y))
+ OP_SETCDR set-cdr! 2 (λ (x y) (set-cdr! x y))
OP_LOADF loadf #f 0
- OP_CONS cons 2 (lambda (x y) (cons x y))
- OP_EQ eq? 2 (lambda (x y) (eq? x y))
- OP_SYMBOLP symbol? 1 (lambda (x) (symbol? x))
- OP_NOT not 1 (lambda (x) (not x))
- OP_CADR cadr 1 (lambda (x) (cadr x))
+ OP_CONS cons 2 (λ (x y) (cons x y))
+ OP_EQ eq? 2 (λ (x y) (eq? x y))
+ OP_SYMBOLP symbol? 1 (λ (x) (symbol? x))
+ OP_NOT not 1 (λ (x) (not x))
+ OP_CADR cadr 1 (λ (x) (cadr x))
OP_NEG neg #f 0
- OP_NULLP null? 1 (lambda (x) (null? x))
- OP_BOOLEANP boolean? 1 (lambda (x) (boolean? x))
- OP_NUMBERP number? 1 (lambda (x) (number? x))
- OP_FIXNUMP fixnum? 1 (lambda (x) (fixnum? x))
- OP_BOUNDP bound? 1 (lambda (x) (bound? x))
- OP_BUILTINP builtin? 1 (lambda (x) (builtin? x))
- OP_FUNCTIONP function? 1 (lambda (x) (function? x))
- OP_VECTORP vector? 1 (lambda (x) (vector? x))
+ OP_NULLP null? 1 (λ (x) (null? x))
+ OP_BOOLEANP boolean? 1 (λ (x) (boolean? x))
+ OP_NUMBERP number? 1 (λ (x) (number? x))
+ OP_FIXNUMP fixnum? 1 (λ (x) (fixnum? x))
+ OP_BOUNDP bound? 1 (λ (x) (bound? x))
+ OP_BUILTINP builtin? 1 (λ (x) (builtin? x))
+ OP_FUNCTIONP function? 1 (λ (x) (function? x))
+ OP_VECTORP vector? 1 (λ (x) (vector? x))
OP_NOP nop #f 0
- OP_SETCAR set-car! 2 (lambda (x y) (set-car! x y))
+ OP_SETCAR set-car! 2 (λ (x y) (set-car! x y))
OP_JMPL jmp.l #f 0
OP_BRFL brf.l #f 0
OP_BRTL brt.l #f 0
- OP_EQV eqv? 2 (lambda (x y) (eqv? x y))
- OP_EQUAL equal? 2 (lambda (x y) (equal? x y))
- OP_LIST list ANYARGS (lambda rest rest)
- OP_APPLY apply -2 (lambda rest (apply apply rest))
- OP_ADD + ANYARGS (lambda rest (apply + rest))
- OP_SUB - -1 (lambda rest (apply - rest))
- OP_MUL * ANYARGS (lambda rest (apply * rest))
- OP_DIV / -1 (lambda rest (apply / rest))
- OP_IDIV div0 2 (lambda rest (apply div0 rest))
- OP_NUMEQ = 2 (lambda (x y) (= x y))
- OP_COMPARE compare 2 (lambda (x y) (compare x y))
+ OP_EQV eqv? 2 (λ (x y) (eqv? x y))
+ OP_EQUAL equal? 2 (λ (x y) (equal? x y))
+ OP_LIST list ANYARGS (λ rest rest)
+ OP_APPLY apply -2 (λ rest (apply apply rest))
+ OP_ADD + ANYARGS (λ rest (apply + rest))
+ OP_SUB - -1 (λ rest (apply - rest))
+ OP_MUL * ANYARGS (λ rest (apply * rest))
+ OP_DIV / -1 (λ rest (apply / rest))
+ OP_IDIV div0 2 (λ rest (apply div0 rest))
+ OP_NUMEQ = 2 (λ (x y) (= x y))
+ OP_COMPARE compare 2 (λ (x y) (compare x y))
OP_ARGC argc #f 0
- OP_VECTOR vector ANYARGS (lambda rest (apply vector rest))
- OP_ASET aset! 3 (lambda (x y z) (aset! x y z))
+ OP_VECTOR vector ANYARGS (λ rest (apply vector rest))
+ OP_ASET aset! 3 (λ (x y z) (aset! x y z))
OP_LOADNIL loadnil #f 0
OP_LOADI8 loadi8 #f 0
OP_LOADVL loadv.l #f 0
@@ -118,7 +118,7 @@
(begin
(io.write c-header "enum {\n")(for-each-n
- (lambda (cop lop argc f)
+ (λ (cop lop argc f)
(begin
(io.write c-header "\t")
(write cop c-header)
@@ -133,7 +133,7 @@
(io.write c-header "\tN_OPCODES\n};\n\n")
(io.write c-header "static const Builtin builtins[] = {\n")(table.foreach
- (lambda (c la) (begin (io.write c-header "\t[")
+ (λ (c la) (begin (io.write c-header "\t[")
(write c c-header)
(io.write c-header "] = {\"")(write (car la) c-header)
--- a/mkboot0.lsp
+++ b/mkboot0.lsp
@@ -2,18 +2,18 @@
(if (not (bound? 'top-level-value)) (set! top-level-value %eval))
(if (not (bound? 'set-top-level-value!)) (set! set-top-level-value! set))
-(if (not (bound? 'eof-object?)) (set! eof-object? (lambda (x) #f)))
+(if (not (bound? 'eof-object?)) (set! eof-object? (λ (x) #f)))
(define update-compiler
(let ((C ()))
(with-bindings
- ((eval (lambda (x) (set! C (cons (compile-thunk (expand x)) C)))))
+ ((eval (λ (x) (set! C (cons (compile-thunk (expand x)) C)))))
(begin
(load "instructions.lsp")
(load "compiler.lsp")))
- (lambda () (begin
- (for-each (lambda (x) (x)) (reverse! C))
- (set! update-compiler (lambda () ()))))))
+ (λ () (begin
+ (for-each (λ (x) (x)) (reverse! C))
+ (set! update-compiler (λ () ()))))))
(define (compile-file inf)
(update-compiler)
@@ -26,6 +26,6 @@
(next (read in)))))
(io.close in)))
-(for-each (lambda (file)
- (compile-file file))
+(for-each (λ (file)
+ (compile-file file))
(cdr *argv*))
--- a/read.c
+++ b/read.c
@@ -418,7 +418,7 @@
return (toktype = TOK_NUM);
}
toktype = TOK_SYM;
- tokval = symbol(buf);
+ tokval = symbol((uint8_t)buf[0] == 0xce && (uint8_t)buf[1] == 0xbb ? "lambda" : buf);
}
return toktype;
}
--- a/system.lsp
+++ b/system.lsp
@@ -13,7 +13,7 @@
(define-macro (define-macro form . body)
`(set-syntax! ',(car form)
- (lambda ,(cdr form) ,@body)))
+ (λ ,(cdr form) ,@body)))
#;(define (map1 f lst acc)
(cdr
@@ -35,10 +35,10 @@
(mapn f (cons lst lsts))))
(define-macro (letrec binds . body)
- `((lambda ,(map car binds)
- ,.(map (lambda (b) `(set! ,@b)) binds)
+ `((λ ,(map car binds)
+ ,.(map (λ (b) `(set! ,@b)) binds)
,@body)
- ,.(map (lambda (x) (void)) binds)))
+ ,.(map (λ (x) (void)) binds)))
(define-macro (let binds . body)
(let ((lname #f))
@@ -47,11 +47,11 @@
(set! binds (car body))
(set! body (cdr body))))
(let ((thelambda
- `(lambda ,(map (lambda (c) (if (pair? c) (car c) c))
+ `(λ ,(map (λ (c) (if (pair? c) (car c) c))
binds)
,@body))
(theargs
- (map (lambda (c) (if (pair? c) (cadr c) (void))) binds)))
+ (map (λ (c) (if (pair? c) (cadr c) (void))) binds)))
(cons (if lname
`(letrec ((,lname ,thelambda)) ,lname)
thelambda)
@@ -75,7 +75,7 @@
; test => expression
(if (eq? (cadr clause) '=>)
(if (1arg-lambda? (caddr clause))
- ; test => (lambda (x) ...)
+ ; test => (λ (x) ...)
(let ((var (caadr (caddr clause))))
`(let ((,var ,(car clause)))
(if ,var ,(cons 'begin (cddr (caddr clause)))
@@ -140,10 +140,10 @@
(define (abs x) (if (< x 0) (- x) x))
(define (max x0 . xs)
(if (null? xs) x0
- (foldl (lambda (a b) (if (< a b) b a)) x0 xs)))
+ (foldl (λ (a b) (if (< a b) b a)) x0 xs)))
(define (min x0 . xs)
(if (null? xs) x0
- (foldl (lambda (a b) (if (< a b) a b)) x0 xs)))
+ (foldl (λ (a b) (if (< a b) a b)) x0 xs)))
(define (char? x) (eq? (typeof x) 'wchar))
(define (array? x) (or (vector? x)
(let ((t (typeof x)))
@@ -180,12 +180,12 @@
(let ((*values* (list '*values*)))
(set! values
- (lambda vs
+ (λ vs
(if (and (pair? vs) (null? (cdr vs)))
(car vs)
(cons *values* vs))))
(set! call-with-values
- (lambda (producer consumer)
+ (λ (producer consumer)
(let ((res (producer)))
(if (and (pair? res) (eq? *values* (car res)))
(apply consumer (cdr res))
@@ -405,7 +405,7 @@
(list cons ''unquote (bq-process (cdr x) (- d 1)))))
((not (any splice-form? x))
(let ((lc (lastcdr x))
- (forms (map (lambda (x) (bq-bracket1 x d)) x)))
+ (forms (map (λ (x) (bq-bracket1 x d)) x)))
(if (null? lc)
(cons list forms)
(if (null? (cdr forms))
@@ -439,8 +439,8 @@
(list 'quote v)))
(define-macro (let* binds . body)
- (if (atom? binds) `((lambda () ,@body))
- `((lambda (,(caar binds))
+ (if (atom? binds) `((λ () ,@body))
+ `((λ (,(caar binds))
,@(if (pair? (cdr binds))
`((let* ,(cdr binds) ,@body))
body))
@@ -461,7 +461,7 @@
(else `(memv ,key ',v))))
(let ((g (gensym)))
`(let ((,g ,key))
- (cond ,.(map (lambda (clause)
+ (cond ,.(map (λ (clause)
(cons (vals->cond g (car clause))
(cdr clause)))
clauses)))))
@@ -471,12 +471,12 @@
(test-expr (car test-spec))
(vars (map car vars))
(inits (map cadr vars))
- (steps (map (lambda (x)
+ (steps (map (λ (x)
(if (pair? (cddr x))
(caddr x)
(car x)))
vars)))
- `(letrec ((,loop (lambda ,vars
+ `(letrec ((,loop (λ ,vars
(if ,test-expr
(begin
,@(cdr test-spec))
@@ -487,14 +487,14 @@
; SRFI 8
(define-macro (receive formals expr . body)
- `(call-with-values (lambda () ,expr)
- (lambda ,formals ,@body)))
+ `(call-with-values (λ () ,expr)
+ (λ ,formals ,@body)))
(define-macro (dotimes var . body)
(let ((v (car var))
(cnt (cadr var)))
`(for 0 (- ,cnt 1)
- (lambda (,v) ,@body))))
+ (λ (,v) ,@body))))
(define (map-int f n)
(if (<= n 0)
@@ -503,7 +503,7 @@
(acc ()))
(set! acc first)
(for 1 (- n 1)
- (lambda (i)
+ (λ (i)
(begin (set-cdr! acc (cons (f i) ()))
(set! acc (cdr acc)))))
first)))
@@ -525,12 +525,12 @@
(define-macro (with-bindings binds . body)
(let ((vars (map car binds))
(vals (map cadr binds))
- (olds (map (lambda (x) (gensym)) binds)))
+ (olds (map (λ (x) (gensym)) binds)))
`(let ,(map list olds vars)
- ,@(map (lambda (v val) `(set! ,v ,val)) vars vals)
+ ,@(map (λ (v val) `(set! ,v ,val)) vars vals)
(unwind-protect
(begin ,@body)
- (begin ,@(map (lambda (v old) `(set! ,v ,old)) vars olds))))))
+ (begin ,@(map (λ (v old) `(set! ,v ,old)) vars olds))))))
; exceptions ------------------------------------------------------------------
@@ -540,18 +540,18 @@
(define-macro (catch tag expr)
(let ((e (gensym)))
`(trycatch ,expr
- (lambda (,e) (if (and (pair? ,e)
- (eq (car ,e) 'thrown-value)
- (eq (cadr ,e) ,tag))
- (caddr ,e)
- (raise ,e))))))
+ (λ (,e) (if (and (pair? ,e)
+ (eq (car ,e) 'thrown-value)
+ (eq (cadr ,e) ,tag))
+ (caddr ,e)
+ (raise ,e))))))
(define-macro (unwind-protect expr finally)
(let ((e (gensym))
(thk (gensym)))
- `(let ((,thk (lambda () ,finally)))
+ `(let ((,thk (λ () ,finally)))
(prog1 (trycatch ,expr
- (lambda (,e) (begin (,thk) (raise ,e))))
+ (λ (,e) (begin (,thk) (raise ,e))))
(,thk)))))
; debugging utilities ---------------------------------------------------------
@@ -559,10 +559,10 @@
(define-macro (assert expr) `(if ,expr #t (raise '(assert-failed ,expr))))
(define traced?
- (letrec ((sample-traced-lambda (lambda args (begin (write (cons 'x args))
+ (letrec ((sample-traced-lambda (λ args (begin (write (cons 'x args))
(newline)
(apply #.apply args)))))
- (lambda (f)
+ (λ (f)
(and (closure? f)
(equal? (function:code f)
(function:code sample-traced-lambda))))))
@@ -573,7 +573,7 @@
(if (not (traced? func))
(set-top-level-value! sym
(eval
- `(lambda ,args
+ `(λ ,args
(begin (write (cons ',sym ,args))
(newline)
(apply ',func ,args)))))))
@@ -638,7 +638,7 @@
(let ((n (length v))
(l ()))
(for 1 n
- (lambda (i)
+ (λ (i)
(set! l (cons (aref v (- n i)) l))))
l))
@@ -646,7 +646,7 @@
(let* ((n (length v))
(nv (vector.alloc n)))
(for 0 (- n 1)
- (lambda (i)
+ (λ (i)
(aset! nv i (f (aref v i)))))
nv))
@@ -653,26 +653,26 @@
; table functions -------------------------------------------------------------
(define (table.pairs t)
- (table.foldl (lambda (k v z) (cons (cons k v) z))
+ (table.foldl (λ (k v z) (cons (cons k v) z))
() t))
(define (table.keys t)
- (table.foldl (lambda (k v z) (cons k z))
+ (table.foldl (λ (k v z) (cons k z))
() t))
(define (table.values t)
- (table.foldl (lambda (k v z) (cons v z))
+ (table.foldl (λ (k v z) (cons v z))
() t))
(define (table.clone t)
(let ((nt (table)))
- (table.foldl (lambda (k v z) (put! nt k v))
+ (table.foldl (λ (k v z) (put! nt k v))
() t)
nt))
(define (table.invert t)
(let ((nt (table)))
- (table.foldl (lambda (k v z) (put! nt v k))
+ (table.foldl (λ (k v z) (put! nt v k))
() t)
nt))
(define (table.foreach f t)
- (table.foldl (lambda (k v z) (begin (f k v) #t)) () t))
+ (table.foldl (λ (k v z) (begin (f k v) #t)) () t))
; string functions ------------------------------------------------------------
@@ -729,7 +729,7 @@
(if (null? strlist) ""
(let ((b (buffer)))
(io.write b (car strlist))
- (for-each (lambda (s) (begin (io.write b sep)
+ (for-each (λ (s) (begin (io.write b sep)
(io.write b s)))
(cdr strlist))
(io.tostring! b))))
@@ -770,7 +770,7 @@
(dvars (if def? (get-defined-vars body) ()))
(env (nconc (map list dvars) env)))
(if (not def?)
- (map (lambda (x) (expand-in x env)) body)
+ (map (λ (x) (expand-in x env)) body)
(let* ((ex-nondefs ; expand non-definitions
(let loop ((body body))
(cond ((atom? body) body)
@@ -811,7 +811,7 @@
(body (cddr e))
(vars (l-vars (cadr e))))
(let ((env (nconc (map list vars) env)))
- `(lambda ,(expand-lambda-list formals env)
+ `(λ ,(expand-lambda-list formals env)
,.(expand-body body env)
. ,name))))
@@ -833,7 +833,7 @@
(cons 'begin
(expand-body (cddr e)
(nconc
- (map (lambda (bind)
+ (map (λ (bind)
(list (car bind)
((compile-thunk
(expand-in (cadr bind) env)))
@@ -850,7 +850,7 @@
(if (atom? e) e
(let* ((head (car e))
(bnd (assq head env))
- (default (lambda ()
+ (default (λ ()
(let loop ((e e))
(if (atom? e) e
(cons (if (atom? (car e))
@@ -864,9 +864,10 @@
(not (symbol? head))
(bound? head))
(default))
- ((macrocall? e) => (lambda (f)
+ ((macrocall? e) => (λ (f)
(expand-in (apply f (cdr e)) env)))
((eq? head 'quote) e)
+ ((eq? head 'λ) (expand-lambda e env))
((eq? head 'lambda) (expand-lambda e env))
((eq? head 'define) (expand-define e env))
((eq? head 'let-syntax) (expand-let-syntax e env))
@@ -888,7 +889,7 @@
(begin (io.close F)
; evaluate last form in almost-tail position
(load-process E))))
- (lambda (e)
+ (λ (e)
(begin
(io.close F)
(raise `(load-error ,filename ,e)))))))
@@ -905,7 +906,7 @@
(define (prompt)
(princ "> ") (io.flush *output-stream*)
(let ((v (trycatch (read)
- (lambda (e) (begin (io.discardbuffer *input-stream*)
+ (λ (e) (begin (io.discardbuffer *input-stream*)
(raise e))))))
(and (not (io.eof? *input-stream*))
(let ((V (load-process v)))
@@ -914,7 +915,7 @@
#t))))
(define (reploop)
(when (trycatch (and (prompt) (newline))
- (lambda (e)
+ (λ (e)
(top-level-exception-handler e)
#t))
(begin (newline)
@@ -934,25 +935,25 @@
(throw 'ffound path)
(let ((v (function:vals f)))
(for 0 (1- (length v))
- (lambda (i) (if (closure? (aref v i))
+ (λ (i) (if (closure? (aref v i))
(find-in-f (aref v i) tgt path))))))))
(define (fn-name f e)
(let ((p (catch 'ffound
(begin
- (for-each (lambda (topfun)
+ (for-each (λ (topfun)
(find-in-f topfun f ()))
e)
#f))))
(if p
(symbol (string.join (map string (reverse! p)) "/"))
- 'lambda)))
+ 'λ)))
(let ((st (reverse! (list-tail st (if *interactive* 5 4))))
- (e (filter closure? (map (lambda (s) (and (bound? s)
+ (e (filter closure? (map (λ (s) (and (bound? s)
(top-level-value s)))
(environment))))
(n 0))
(for-each
- (lambda (f)
+ (λ (f)
(princ "#" n " ")
(print (cons (fn-name (aref f 0) e)
(cdr (vector->list f))))
@@ -1006,7 +1007,7 @@
(if (or (null? l) (null? (cdr l))) l
(let ((piv (car l)))
(receive (less grtr)
- (separate (lambda (x) (< x piv)) (cdr l))
+ (separate (λ (x) (< x piv)) (cdr l))
(nconc (simple-sort less)
(list piv)
(simple-sort grtr))))))
@@ -1019,7 +1020,7 @@
(with-bindings ((*print-pretty* #t)
(*print-readably* #t))
(let ((syms
- (filter (lambda (s)
+ (filter (λ (s)
(and (bound? s)
(not (constant? s))
(or (not (builtin? (top-level-value s)))
@@ -1042,7 +1043,7 @@
(define (__script fname)
(trycatch (load fname)
- (lambda (e) (begin (top-level-exception-handler e)
+ (λ (e) (begin (top-level-exception-handler e)
(exit 1)))))
(define (__rcscript)