ref: 1532ee600d35a23b8ec968871ad349fdc7f7c5cf
parent: 26a557739a36368bc0fc570830a7cee782d8028f
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Tue Feb 4 19:40:58 EST 2025
automatic gensyms Fixes: https://todo.sr.ht/~ft/femtolisp/41
--- a/README.md
+++ b/README.md
@@ -26,6 +26,7 @@
* seamless bignums
* `[` and `]`, `{` and `}` are synonyms to `(` and `)`* `λ` as a shorthand for `lambda`
+ * automatic gensyms for macros (`blah#`) at read time
* some of the previously available (but not merged) patches from the community and [Julia](https://github.com/JuliaLang/julia) are applied
* `c***r` of empty list returns empty list
* "boot" image is built into the executable
--- a/boot/flisp.boot
+++ b/boot/flisp.boot
@@ -21,11 +21,11 @@
*runestring-type* (array rune) *string-type* (array byte)
*syntax-environment* #table(bcode:nconst #fn("7000n1200r2e3:" #(aref)) doc-for #fn("@000\x8710002000\x881000I60O?140B;35040<;I40402086510B;35040=88II087\\3?07122862353@30O@F087\\360O@<071228624534252686e2261e22688e2e4:" #(#fn(top-level-value) error "docs: " ": no funvars specified" ": funvars set but isn't a function" symbol-set-doc quote)) with-input-from #fn("<000z12021e1220e2e1e12315163:" #(#fn(nconc)- with-bindings *input-stream* #fn(copy-list))) unless #fn("<000z1200O211Pe4:" #(if begin)) time #fn(">000n12050218522e1e2e123024252622e185e32728e5e3e3:" #(#fn(gensym)- let time-now prog1 princ "Elapsed time: " - " seconds" *linefeed*)) cond #fn(";000z0\x8d\x8a520852185>1_51485<061:" #(#0=#fn("7000z0\x8d:" #() void)- #fn(">000n10H340O:0<85<20Q;I80485<DQ3C085=J6085<:2185=P:85=J@02285<A<0=51e3:85T23C\x98074758551513c07675855151278685<e2e12886217975855151PA<0=51e4e3:2:50278685<e2e1288675855186e2A<0=51e4e3:2885<2185=PA<0=51e4:" #(else- begin or => 1arg-lambda? caddr caadr let if cddr #fn(gensym)) cond-clauses->if))) do #fn("J000z220501<2172052217305221240522587268927882829e12:1=51522829e12:82512887e18;52e153e4e3e2e12887e18:52e3:" #(#fn(gensym)- #fn(map) car cadr #fn("6000n170051B38071061:0<:" #(cddr caddr)) letrec λ if #fn(nconc) begin #fn(copy-list))) mark-label #fn("8000n22002122e21e4:" #(emit+ with-bindings *input-stream* #fn(copy-list))) unless #fn("<000z1200O211Pe4:" #(if begin)) time #fn("=000n1202122e1e2e123024252622e121e32728e5e3e3:" #(let+ #:g357 time-now prog1 princ "Elapsed time: " - " seconds" *linefeed*)) cond #fn(";000z0\x8d\x8a520852185>1_51485<061:" #(#0=#fn("7000z0\x8d:" #() void)+ #fn(">000n10H340O:0<85<20Q;I80485<DQ3C085=J6085<:2185=P:85=J@02285<A<0=51e3:85T23C\x94074758551513c07675855151278685<e2e12886217975855151PA<0=51e4e3:272:85<e2e1282:7585512:e2A<0=51e4e3:2885<2185=PA<0=51e4:" #(else+ begin or => 1arg-lambda? caddr caadr let if cddr #:g26) cond-clauses->if))) do #fn("I000z21<2071052207205220230522425268827872829e12:1=51522829e12:82512825e18:52e153e4e3e2e12825e18952e3:" #(#fn(map)+ car cadr #fn("6000n170051B38071061:0<:" #(cddr caddr)) letrec #:g327 λ if #fn(nconc) begin #fn(copy-list))) mark-label #fn("8000n22002122e21e4:" #(emit quote label)) with-bindings #fn("G000z12071052207205220230522425e12076888653e12720288687535129242:e12715152242:e127202;8688535152e3e164:" #(#fn(map) car cadr #fn("5000n12060:" #(#fn(gensym))) #fn(nconc) let list #fn(copy-list) #fn("7000n22001e3:" #(set!)) unwind-protect begin #fn("7000n22001e3:" #(set!)))) let #fn(">000z1O0R3B00?641<?041=?1@30O42021e12223052e124151532225052863C0268687e2e186e3@408788P:" #(#fn(nconc)@@ -36,8 +36,8 @@
begin)) help #fn(";000n17002152853W072855147350424250>170026q535247350@B0722728051524735047960:" #(getprop *doc* princ newline #fn(for-each) #fn("7000n17050471A0P61:" #(newline print)) *funvars* "no help for " #fn(string) void)) bcode:ctable #fn("7000n1200Ke3:" #(aref)) with-output-to #fn("<000z12021e1220e2e1e12315163:" #(#fn(nconc)- with-bindings *output-stream* #fn(copy-list))) catch #fn("@000n220502112286e123242586e2262786e22829e2e3262:86e20e3e42;86e22<86e2e4e3e3:" #(#fn(gensym)- trycatch λ if and cons? eq? car quote thrown-value cadr caddr raise)) let* #fn("@000z10H3E02021e1qe12215153e1:2021e173051e1e1220=B3H02024e10=e12215153e1@301515375051e2:" #(#fn(nconc)+ with-bindings *output-stream* #fn(copy-list))) catch #fn("?000n22012122e123242522e2262722e22829e2e3262:22e20e3e42;22e22<22e2e4e3e3:" #(trycatch+ λ #:g352 if and cons? eq? car quote thrown-value cadr caddr raise)) let* #fn("@000z10H3E02021e1qe12215153e1:2021e173051e1e1220=B3H02024e10=e12215153e1@301515375051e2:" #(#fn(nconc) λ #fn(copy-list) caar let* cadar)) letrec #fn(">000z1202021e12273052e122240522515154e1227605262:" #(#fn(nconc) λ #fn(map) car #fn("8000n12021e12205162:" #(#fn(nconc) set! #fn(copy-list))) #fn(copy-list) void)) /= #fn("=000z1202122e10e12315153e2:" #(not #fn(nconc) = #fn(copy-list))) bcode:sp #fn("7000n1200r4e3:" #(aref)) bcode:stack #fn(":000n2200r421220e21e3e4:" #(aset!@@ -45,8 +45,8 @@
#fn("8000n2120C5020:1J40O:1R3=021072151e3:1H3=023072151e3:1=J>0230721<51e3:74751523=0260271e2e3:280271e2e3:" #(elseeq? quote-value eqv? every symbol? memq quote memv) vals->cond)
#fn(gensym) let #fn(nconc) cond #fn(map) #fn("7000n1A<F0<520=P:" #()))) receive #fn("?000z22021q1e32221e10e123825153e3:" #(call-with-values- λ #fn(nconc) #fn(copy-list))) unwind-protect #fn("A000n220502050218722q1e3e2e1232402286e12587e12686e2e3e3e387e1e3e3:" #(#fn(gensym)- let λ prog1 trycatch begin raise)) dotimes #fn("A000z10<0T20E2187Ke32223e186e1e12415153e4:" #(for+ λ #fn(nconc) #fn(copy-list))) unwind-protect #fn("?000n2202122q1e3e2e1232402225e12621e12725e2e3e3e321e1e3e3:" #(let+ #:g353 λ prog1 trycatch #:g354 begin raise)) dotimes #fn("A000z10<0T20E2187Ke32223e186e1e12415153e4:" #(for - #fn(nconc) λ #fn(copy-list))) throw #fn("9000n220212223e201e4e2:" #(raise list quotethrown-value)))
1+ #fn("6000n10KM:" #() 1+) 1-@@ -425,8 +425,8 @@
print-stack-trace
#fn(stacktrace)))
#fn("6000n1A50420061:" #(#fn(raise)))) top-level-exception-handler)- trace #fn("A000n1200512150728551Ig0230742586262728290e286e3e22:e12;2985e286e3e4e35152@30O^1^147<60:" #(#fn(top-level-value)- #fn(gensym) traced? #fn(set-top-level-value!) eval λ begin write cons quote newline apply void) trace)
+ trace #fn("@000n120051718551Ig0220732425262728290e225e3e22:e12;2985e225e3e4e35152@30O^147<60:" #(#fn(top-level-value)+ traced? #fn(set-top-level-value!) eval λ #:g355 begin write cons quote newline apply void) trace)
traced? #fn("7000n170051;3?042105121A<51d:" #(closure? #fn(function:code)) #((#fn("9000z020210P51472504230}2:" #(#fn(write)x newline #.apply)))))
untrace #fn("9000n1200517185513C0220238551r3G52@30O^147460:" #(#fn(top-level-value)binary files a/boot/flisp.boot.builtin b/boot/flisp.boot.builtin differ
--- a/src/read.c
+++ b/src/read.c
@@ -372,6 +372,8 @@
ctx->toktype = TOK_SYM;
const char *name = (strcmp(ctx->buf, "lambda") == 0 || strcmp(ctx->buf, "λ") == 0) ? "λ" : ctx->buf;
ctx->tokval = strcasecmp(name, "nil") == 0 ? FL_nil : symbol(name, name == ctx->buf);
+ if(name[strlen(name)-1] == '#')
+ ctx->toktype = TOK_GENSYM;
}
return ctx->toktype;
}
--- a/src/system.lsp
+++ b/src/system.lsp
@@ -80,11 +80,10 @@
(if ,var ,(cons 'begin (cddr (caddr clause)))
,(cond-clauses->if (cdr lst)))))
; test => proc
- (let ((b (gensym)))
- `(let ((,b ,(car clause)))
- (if ,b
- (,(caddr clause) ,b)
- ,(cond-clauses->if (cdr lst))))))
+ `(let ((b# ,(car clause)))
+ (if b#
+ (,(caddr clause) b#)
+ ,(cond-clauses->if (cdr lst)))))
(list 'if
(car clause)
(cons 'begin (cdr clause))
@@ -552,8 +551,7 @@
clauses)))))
(define-macro (do vars test-spec . commands)
- (let ((loop (gensym))
- (test-expr (car test-spec))
+ (let ((test-expr (car test-spec))
(vars (map car vars))
(inits (map cadr vars))
(steps (map (λ (x)
@@ -561,14 +559,14 @@
(caddr x)
(car x)))
vars)))
- `(letrec ((,loop (λ ,vars
+ `(letrec ((loop# (λ ,vars
(if ,test-expr
(begin
,@(cdr test-spec))
(begin
,@commands
- (,loop ,.steps))))))
- (,loop ,.inits))))
+ (loop# ,.steps))))))
+ (loop# ,.inits))))
; SRFI 8
(define-macro (receive formals expr . body)
@@ -610,21 +608,18 @@
(define-macro (throw tag value) `(raise (list 'thrown-value ,tag ,value)))
(define-macro (catch tag expr)
- (let ((e (gensym)))
- `(trycatch ,expr
- (λ (,e) (if (and (cons? ,e)
- (eq? (car ,e) 'thrown-value)
- (eq? (cadr ,e) ,tag))
- (caddr ,e)
- (raise ,e))))))
+ `(trycatch ,expr
+ (λ (e#) (if (and (cons? 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 (λ () ,finally)))
- (prog1 (trycatch ,expr
- (λ (,e) (begin (,thk) (raise ,e))))
- (,thk)))))
+ `(let ((thk# (λ () ,finally)))
+ (prog1 (trycatch ,expr
+ (λ (e#) (begin (thk#) (raise e#))))
+ (thk#))))
;;; debugging utilities
@@ -640,15 +635,14 @@
(function:code sample-traced-lambda))))))
(define (trace sym)
- (let* ((func (top-level-value sym))
- (args (gensym)))
+ (let* ((func (top-level-value sym)))
(when (not (traced? func))
(set-top-level-value! sym
(eval
- `(λ ,args
- (begin (write (cons ',sym ,args))
+ `(λ args#
+ (begin (write (cons ',sym args#))
(newline)
- (apply ',func ,args)))))))
+ (apply ',func args#)))))))
(void))
(define (untrace sym)
@@ -659,11 +653,10 @@
(void))
(define-macro (time expr)
- (let ((t0 (gensym)))
- `(let ((,t0 (time-now)))
- (prog1
- ,expr
- (princ "Elapsed time: " (- (time-now) ,t0) " seconds" *linefeed*)))))
+ `(let ((t0# (time-now)))
+ (prog1
+ ,expr
+ (princ "Elapsed time: " (- (time-now) t0#) " seconds" *linefeed*))))
;;; text I/O
--- a/test/test.lsp
+++ b/test/test.lsp
@@ -167,25 +167,23 @@
;(tt)
(define-macro (accumulate-while cnd what . body)
- (let ((acc (gensym)))
- `(let ((,acc (list ())))
- (cdr
- (prog1 ,acc
- (while ,cnd
- (begin (set! ,acc
- (cdr (set-cdr! ,acc (cons ,what ()))))
- ,@body)))))))
+ `(let ((acc# (list ())))
+ (cdr
+ (prog1 acc#
+ (while ,cnd
+ (begin (set! acc#
+ (cdr (set-cdr! acc# (cons ,what ()))))
+ ,@body))))))
(define-macro (accumulate-for var lo hi what . body)
- (let ((acc (gensym)))
- `(let ((,acc (list ())))
- (cdr
- (prog1 ,acc
- (for ,lo ,hi
- (λ (,var)
- (begin (set! ,acc
- (cdr (set-cdr! ,acc (cons ,what ()))))
- ,@body))))))))
+ `(let ((acc# (list ())))
+ (cdr
+ (prog1 acc#
+ (for ,lo ,hi
+ (λ (,var)
+ (begin (set! acc#
+ (cdr (set-cdr! acc# (cons ,what ()))))
+ ,@body)))))))
(define (map-indexed f lst)
(if (atom? lst) lst
--- a/test/unittest.lsp
+++ b/test/unittest.lsp
@@ -765,5 +765,15 @@
(assert (< 50 (length rdouble)))
(assert (< 50 (length rfloat))))
+;; auto gensym
+
+(define-macro (f x)
+ `(let ((a# 1)) (list a# ,x)))
+
+(define-macro (g x)
+ `(let ((a# 2)) (list a# ,x)))
+
+(assert (equal? '(1 (2 3)) (f (g 3))))
+
(princ "all tests pass")
(newline)