ref: cc543231d0958fb8d0b036c3f865d8d864e114e6
parent: 60fc1e71ac62857b59b618ee7c3bcd537b29c4aa
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Fri Dec 20 18:47:14 EST 2024
move *properties* to the top so that props can be set from the beginning
--- a/flisp.boot
+++ b/flisp.boot
@@ -15,7 +15,7 @@
#fn("8000z0700}2:" #(aset!)) 0 0 0 0 0 0 0 0 0 0 0 #fn("9000n3012082>1|:" #(#fn("6000n1A061:" #()))) 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 #fn("8000z0700}2:" #(aref)) 0)*empty-string* "" *properties*
- #table(*funvars* #table(help (term)) *doc* #table(help "Display documentation for the specified term, if available." *properties* "All properties of symbols recorded with putprop are recorded in this table."))
+ #table(*funvars* #table(length= (lst n) help (term)) *doc* #table(length= "Bounded length test.\n\nUse this instead of (= (length lst) n), since it avoids unnecessary\nwork and always terminates." help "Display documentation for the specified term, if available." *properties* "All properties of symbols recorded with putprop are recorded in this table."))
*runestring-type* (array rune) *string-type* (array byte)
*syntax-environment* #table(when #fn(";000z1200211POe4:" #(if begin)) help #fn(";000n170021527002252853\\0738551474504863B07450475086P51@30O474504D:73262705152474504O:" #(getprop *doc* *funvars* princ newline print "no help for " #fn(string))) with-output-to #fn("<000z12021e1220e2e1e12315163:" #(#fn(nconc)@@ -30,7 +30,7 @@
#fn(map) car cadr #fn("6000n170051B38071061:0<:" #(cddr caddr)) letrec λ if #fn(nconc) begin #fn(copy-list))) assert #fn(";000n1200D2122230e2e2e2e4:" #(if raise quote assert-failed)) case #fn("A000z1D\x8a68620_4215022870e2e12324e125268687>215252e3:" #(#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:" #()))) let #fn(">000z1O0R3B00?641<?041=?1@30D42021e12223052e124151532225052863C0268687e2e186e3@408788P:" #(#fn(nconc)+ #fn(gensym) let #fn(nconc) cond #fn(map) #fn("7000n1A<F0<520=P:" #()))) let #fn(">000z1O0R3B00?641<?041=?1@30O42021e12223052e124151532225052863C0268687e2e186e3@408788P:" #(#fn(nconc) λ #fn(map) #fn("5000n10B3500<:0:" #()) #fn(copy-list) #fn("5000n10B3500T:7060:" #(void)) letrec)) with-bindings #fn("G000z12071052207205220230522425e12076888653e12720288687535129242:e12715152242:e127202;8688535152e3e164:" #(#fn(map) car cadr #fn("5000n12060:" #(#fn(gensym))) #fn(nconc) let list #fn(copy-list)@@ -232,7 +232,7 @@
expand-define #fn("?000n10T70051B3:070051@L00TR3;07150e1@=07223740515285R3<0258586<e3:2585<2627e185=e128865185<54e3:" #(cddrvoid error "compile error: invalid syntax " print-to-string set! #fn(nconc) λ #fn(copy-list)) expand-define)
extend-env #fn("8000n370182E530P:" #(vars-to-env) extend-env) filter- #fn("9000n2D200>1?648601qe163:" #(#fn("8000n382D1B3Q04A1<513?0821<qPN=?2@30D41=?1@\x0e/4=:" #() filter-)) filter)+ #fn("9000n2D200>1?648601qe163:" #(#fn("8000n382D1B3Q04A1<513?0821<qPN=?2@30O41=?1@\x0e/4=:" #() filter-)) filter) fits-i8 #fn("7000n10Y;3F04700r\xb052;3:04710r\xaf62:" #(>= <=) fits-i8) foldl #fn("9000n382J401:700082<15282=63:" #(foldl) foldl) foldr #fn(":000n382J401:082<700182=5362:" #(foldr) foldr) get-defined-vars #fn("7000n170A<05161:" #(delete-duplicates) #(#0=(#fn("8000n10H340q:0<20Cj00=B3d00TR;37040Te1;IS040TB;3E0471051R;3:0471051e1;I404q:0<22C?07324A<0=52}2:q:" #(define--- a/system.lsp
+++ b/system.lsp
@@ -3,10 +3,18 @@
; by Jeff Bezanson (C) 2009
; Distributed under the BSD License
+;; This is implemented in a slightly different fashion as expected:
+;;
+;; *properties* : key → { symbol → value }+;;
+;; The assumption here is that keys will most likely be the same across multiple symbols
+;; so it makes more sense to reduce the number of subtables for the *properties* table.
+(define *properties* (table))
+
(define (void) #t) ; the unspecified value
-(if (not (bound? '*syntax-environment*))
- (define *syntax-environment* (table)))
+(unless (bound? '*syntax-environment*)
+ (define *syntax-environment* (table)))
(define (set-syntax! s v) (put! *syntax-environment* s v))
(define (symbol-syntax s) (get *syntax-environment* s #f))
@@ -27,10 +35,10 @@
(define-macro (let binds . body)
(let ((lname #f))
- (if (symbol? binds)
- (begin (set! lname binds)
- (set! binds (car body))
- (set! body (cdr body))))
+ (when (symbol? binds)
+ (set! lname binds)
+ (set! binds (car body))
+ (set! body (cdr body)))
(let ((thelambda
`(λ ,(map (λ (c) (if (cons? c) (car c) c))
binds)
@@ -202,10 +210,11 @@
(define (list-ref lst n)
(car (list-tail lst n)))
-; bounded length test
-; use this instead of (= (length lst) n), since it avoids unnecessary
-; work and always terminates.
(define (length= lst n)
+ "Bounded length test.
+
+Use this instead of (= (length lst) n), since it avoids unnecessary
+work and always terminates."
(cond ((< n 0) #f)
((= n 0) (atom? lst))
((atom? lst) (= n 0))
@@ -235,18 +244,18 @@
(define (map! f lst)
(prog1 lst
(while (cons? lst)
- (set-car! lst (f (car lst)))
- (set! lst (cdr lst)))))
+ (set-car! lst (f (car lst)))
+ (set! lst (cdr lst)))))
(define (filter pred lst)
(define (filter- f lst acc)
(cdr
(prog1 acc
- (while (cons? lst)
- (begin (if (pred (car lst))
- (set! acc
- (cdr (set-cdr! acc (cons (car lst) ())))))
- (set! lst (cdr lst)))))))
+ (while (cons? lst)
+ (when (pred (car lst))
+ (set! acc
+ (cdr (set-cdr! acc (cons (car lst) ())))))
+ (set! lst (cdr lst))))))
(filter- pred lst (list ())))
(define (partition pred lst)
@@ -255,12 +264,10 @@
(prog1
(cons yes no)
(while (cons? lst)
- (begin (if (pred (car lst))
- (set! yes
- (cdr (set-cdr! yes (cons (car lst) ()))))
- (set! no
- (cdr (set-cdr! no (cons (car lst) ())))))
- (set! lst (cdr lst)))))))
+ (if (pred (car lst))
+ (set! yes (cdr (set-cdr! yes (cons (car lst) ()))))
+ (set! no (cdr (set-cdr! no (cons (car lst) ())))))
+ (set! lst (cdr lst))))))
(values (cdr (car vals)) (cdr (cdr vals)))))
(partition- pred lst (list ()) (list ())))
@@ -293,9 +300,9 @@
(define (reverse!- prev l)
(while (cons? l)
- (set! l (prog1 (cdr l)
- (set-cdr! l (prog1 prev
- (set! prev l))))))
+ (set! l (prog1 (cdr l)
+ (set-cdr! l (prog1 prev
+ (set! prev l))))))
prev)
(define (reverse! l) (reverse!- () l))
@@ -699,14 +706,6 @@
(iostream->string b))))
; props -----------------------------------------------------------------------
-
-;; This is implemented in a slightly different fashion as expected:
-;;
-;; *properties* : key → { symbol → value }-;;
-;; The assumption here is that keys will most likely be the same across multiple symbols
-;; so it makes more sense to reduce the number of subtables for the *properties* table.
-(define *properties* (table))
(define (putprop sym key val)
(let ((kt (get *properties* key #f)))