ref: ee64888896c356a8d3fab62a529e3719b9fdebee
parent: f2849443ec000072b7838bb4b5bbaa44fe71d115
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Tue Dec 31 17:39:16 EST 2024
>: keep the function and define as a macro This reverses the arguments order to be used with <. References: https://todo.sr.ht/~ft/femtolisp/32
--- a/flisp.boot
+++ b/flisp.boot
@@ -18,7 +18,7 @@
(data :size decompressed-bytes)) void? ((x)) length= ((lst
n)) help ((term)) void (rest) *prompt* (nil) lz-pack ((data (level 0))) cons? ((value)) vm-stats (nil) * ((number…)) car ((lst)) cdr ((lst)) + ((number…))) *doc* #table(lz-unpack "Return decompressed data previously compressed using lz-pack.\nEither destination for the decompressed data or the expected size of\nthe decompressed data must be specified. In the latter case a new\narray is allocated." void? "Return #t if x is #<void> and #f otherwise." length= "Bounded length test.\nUse this instead of (= (length lst) n), since it avoids unnecessary\nwork and always terminates." help "Display documentation for the specified term, if available." car "Returns the first element of a list or nil if not available." *builtins* "VM instructions as closures." void "Return the constant #<void> while ignoring any arguments.\n#<void> is mainly used when a function has side effects but does not\nproduce any meaningful value to return, so even though #t or nil could\nbe returned instead, in case of #<void> alone, REPL will not print\nit." arg-counts "VM instructions mapped to their expected arguments count." *prompt* "Function called by REPL to signal the user input is required.\nDefault function prints \"#;> \"." lz-pack "Return data compressed using Lempel-Ziv.\nThe data must be an array, returned value will have the same type.\nThe optional level is between 0 and 10. With level 0 a simple LZSS\nusing hashing will be performed. Levels between 1 and 9 offer a\ntrade-off between time/space and ratio. Level 10 is optimal but very\nslow." Instructions "VM instructions mapped to their encoded byte representation." cons? "Returns #t if the value is a cons cell." vm-stats "Print various VM-related information, such as the number of GC calls\nso far, heap and stack size, etc." * "Return product of the numbers or 1 with no arguments." cdr "Returns the tail of a list or nil if not available." + "Return sum of the numbers or 0 with no arguments." *properties* "All properties of symbols recorded with putprop are recorded in this table."))
*runestring-type* (array rune) *string-type* (array byte)
- *syntax-environment* #table(unwind-protect #fn("A000n220502050218722q1e3e2e1232402286e12587e12686e2e3e3e387e1e3e3:" #(#fn(gensym)+ *syntax-environment* #table(when #fn(";000z1200211POe4:" #(if begin)) unwind-protect #fn("A000n220502050218722q1e3e2e1232402286e12587e12686e2e3e3e387e1e3e3:" #(#fn(gensym) let λ prog1 trycatch begin raise)) help #fn(";000n17002152853W072855147350424250>170026q535247350@B0722728051524735047960:" #(getprop *doc* princ newline #fn(for-each) #fn("7000n17050471A0P61:" #(newline print)) *funvars* "no help for " #fn(string) void)) with-output-to #fn("<000z12021e1220e2e1e12315163:" #(#fn(nconc) with-bindings@@ -42,8 +42,9 @@
#fn("7000n22001e3:" #(set!)) unwind-protect begin #fn("7000n22001e3:" #(set!)))) define-macro #fn("@000z170151863D0710<860=5341=?1@30O422230<e22425e10=e12615153e3:" #(value-get-doc symbol-set-doc set-syntax! quote #fn(nconc) λ #fn(copy-list))) receive #fn("?000z22021q1e32221e10e123825153e3:" #(call-with-values λ #fn(nconc) #fn(copy-list))) dotimes #fn("A000z10<0T20E2187Ke32223e186e1e12415153e4:" #(for -- #fn(nconc) λ #fn(copy-list))) quasiquote #fn("7000n1700E62:" #(bq-process)) throw #fn("9000n220212223e201e4e2:" #(raise- list quote thrown-value)) when #fn(";000z1200211POe4:" #(if begin)))+ #fn(nconc) λ #fn(copy-list))) > #fn("<000z12021e12273151510e163:" #(#fn(nconc) < #fn(copy-list)+ reverse!)) throw #fn("9000n220212223e201e4e2:" #(raise+ list quote thrown-value)) quasiquote #fn("7000n1700E62:" #(bq-process))) 1+ #fn("6000n10KM:" #() 1+) 1- #fn("6000n10K~:" #() 1-) 1arg-lambda? #fn("7000n10B;3E04700<51;3:04710TK62:" #(is-lambda?length=) 1arg-lambda?)
@@ -121,19 +122,19 @@
compile-arglist #fn("8000n3202101>282524228261:" #(#fn(for-each) #fn("9000n170AFO054471AK62:" #(compile-inbcode:stack)) #fn(length)) compile-arglist)
- compile-aset! #fn("=000n3208251r2~87Kl23?07101O2282P64:7387K523d07101O2475828752P5447601778287525378088U5247902262:7:22r362:" #(#fn(length)- compile-app aset! > aref list-head compile-arglist list-tail bcode:stack emit argc-error) compile-aset!)
+ compile-aset! #fn("=000n3208251r2~87Kl23?07101O2282P64:K87L23d07101O2374828752P5447501768287525377088U5247802262:7922r362:" #(#fn(length)+ compile-app aset! aref list-head compile-arglist list-tail bcode:stack emit argc-error) compile-aset!)
compile-begin #fn("9000n483H3?0700182715064:83=H3>070018283<64:7001O83<5447202352474018283=64:" #(compile-invoid emit pop compile-begin) compile-begin)
- compile-builtin-call #fn(">000n7\x8d202186850>3?;514227385O538<3I07483=8<52I=075858<52@30O4858=26CL086El23:07702862:770858663:8=29C708;60:8=2:C708;60:8=2;C]086El23:07702<62:86r2l23:07702=62:770858663:8=2>Cm086El23:07585K62:86Kl23:07702?62:86r2l23:07702@62:770858663:8=2ACL086El23:07702B62:770858663:8=2CCL086El23:07585K62:770858663:8=2DCN086El23<07702E2F63:770858663:8=2GCX086r2L23;07585r262:770823702H@402G8663:8=2ICd086r2l23:07702J62:7K86r2523?07708586r3~63:7585r262:7708562:" #(#0#+ compile-builtin-call #fn(">000n7\x8d202186850>3?;514227385O538<3I07483=8<52I=075858<52@30O4858=26CL086El23:07702862:770858663:8=29C708;60:8=2:C708;60:8=2;C]086El23:07702<62:86r2l23:07702=62:770858663:8=2>Cm086El23:07585K62:86Kl23:07702?62:86r2l23:07702@62:770858663:8=2ACL086El23:07702B62:770858663:8=2CCL086El23:07585K62:770858663:8=2DCN086El23<07702E2F63:770858663:8=2GCX086r2L23;07585r262:770823702H@402G8663:8=2ICb086r2l23:07702J62:r286L23?07708586r3~63:7585r262:7708562:" #(#0# #fn("8000n0AEl239070FK62:7192FA63:" #(argc-error emit) num-compare)#fn(get) arg-counts length= argc-error list emit loadnil < = + load0 add2 - neg sub2 * load1 /
- vector loadv #() apply tapply aref aref2 >) compile-builtin-call)
+ vector loadv #() apply tapply aref aref2) compile-builtin-call)
compile-f #fn("8000n2702101>22262:" #(call-with-values #fn("7000n070AF62:" #(compile-f-)) #fn("5000n20:" #())) compile-f)- compile-f- #fn("O000n270501T711T517215173741T52711518;J7025@408;87H360E@802687518=268:51~73778:528:\x85\xa208?JL07886298>88J708=@508=U54@r07:867;2<7=2<7>8?527?268?5151535152478862@8>268?5188J708=@508=U5547A8608:898>55@30O47B8=2C523I0788688J702D@402E8=53@W088\x85?078862F8=53@E08:J?078862G8=53@30O47H0897I7J1518952537K868@<52486r4268951r4Mp47L868@D7J15154478862M5247N2O7P7Q8651517R86518<537S865162:" #(make-code-emitter+ compile-f- #fn("O000n270501T711T517215173741T52711518;J7025@408;87H360E@802687518=268:51~73778:528:\x85\xa208?JL07886298>88J708=@508=U54@r07:867;2<7=2<7>8?527?268?5151535152478862@8>268?5188J708=@508=U5547A8608:898>55@30O42B8=L23I0788688J702C@402D8=53@W088\x85?078862E8=53@E08:J?078862F8=53@30O47G0897H7I1518952537J868@<52486r4268951r4Mp47K868@D7I15154478862L5247M2N7O7P8651517Q86518<537R865162:" #(make-code-emitterlastcdr lambda:vars filter cons? λ #fn(length) keyword-arg? emit optargs bcode:indexfor
- make-perfect-hash-table #fn(map) cons car iota keyargs emit-optional-arg-inits > 255 largc lvargc
+ make-perfect-hash-table #fn(map) cons car iota keyargs emit-optional-arg-inits 255 largc lvargc
vargc argc extend-env complex-bindings lambda:body box-vars compile-in ret values #fn(function)
encode-byte-code bcode:code const-to-idx-vec bcode:cenv) compile-f-)
compile-if #fn("A000n470051700517005183T718351728351B3;0738351@30O8;DC=07401828<64:8;OC=07401828=64:7401O8;895547502689534770885247401828<544823<07502852@;0750298:534770895247401828=5447708:62:" #(make-label@@ -147,8 +148,8 @@
closure #fn(length))) and compile-and
or compile-or while compile-while cddr return ret set! value-get-doc error "set!: name must be a symbol"
symbol-set-doc is-lambda? lambda:vars compile-set! trycatch 1arg-lambda? caddr "trycatch: second form must be a 1-argument lambda") compile-in)
- compile-let #fn("A000n483<83=7005188T71018953728;737488518;528:537508=524268=1<521=P7708>827488515447808<U524798<E523A082I<07:02;8<63:O:" #(bcode:sp- compile-arglist vars-to-env complex-bindings caddr box-vars #fn(nconc) compile-in bcode:stack >
+ compile-let #fn("A000n483<83=7005188T71018953728;737488518;528:537508=524268=1<521=P7708>827488515447808<U524E8<L23A082I<07902:8<63:O:" #(bcode:sp+ compile-arglist vars-to-env complex-bindings caddr box-vars #fn(nconc) compile-in bcode:stack
emit shift) compile-let)
compile-or #fn("<000n470018283O21O67:" #(compile-short-circuit brt) compile-or) compile-prog1 #fn(":000n37001O82T544718251B3W0720K5247301O71825154474025524720r/62:O:" #(compile-in@@ -183,13 +184,13 @@
#fn(put!))) member
delete-duplicates) delete-duplicates)
diff #fn("8000n20J40q:200<1523:0710=162:0<710=152P:" #(#fn(memq) diff) diff)- disassemble #fn("U000\x871000.///\x881000I60O?14z282JG07001E534715047260:@30O482<2305124051\x8d\x8d252687>1?:5142527187>2?;514r4288851\x8a<\x8d8<<8=L23\x9324292:888<>2O7;537<8<<r4523907150@30O4E87K~2=|48<8<<KM_48>2>8?2?523[08;8>8<<r45348:897@888<<52G5148<8<<r4M_@\x1f12>8?2A523V08;8>8<<K5348:89888<<GG5148<8<<KM_@\xf012>8?2B523e08;8>8<<K5347C2D888<<G8>2EC70r3@30EM515148<8<<KM_@\xb212>8?2F523\\08;8>8<<r45347C2D7@888<<52515148<8<<r4M_@}12>8?2G523\xb808;8>8<<r88>2HC70r4@30EM5347C2D7@888<<52512I5248<8<<r4M_47C2D7@888<<52515148<8<<r4M_48>2HCY07C2I5147C2D7@888<<52512I5248<8<<r4M_@30O@\xec08?2Jc3^08;8>8<<r45347C2D7@888<<52512I5248<8<<r4M_@\xb802>8?2K523e08;8>8<<r25347C2L7M8<<r,7N888<<52g3515248<8<<r2M_@z02>8?2O523e08;8>8<<r45347C2L7M8<<r,7@888<<52g3515248<8<<r4M_@<08;8>8<<E53^1^1@\xc7-:" #(disassemble+ disassemble #fn("U000\x871000.///\x881000I60O?14z282JG07001E534715047260:@30O482<2305124051\x8d\x8d252687>1?:5142527187>2?;514r4288851\x8a<\x8d8<<8=L23\x9124292:888<>2O7;53r48<<L23907150@30O4E87K~2<|48<8<<KM_48>2=8?2>523[08;8>8<<r45348:897?888<<52G5148<8<<r4M_@\x1f12=8?2@523V08;8>8<<K5348:89888<<GG5148<8<<KM_@\xf012=8?2A523e08;8>8<<K5347B2C888<<G8>2DC70r3@30EM515148<8<<KM_@\xb212=8?2E523\\08;8>8<<r45347B2C7?888<<52515148<8<<r4M_@}12=8?2F523\xb808;8>8<<r88>2GC70r4@30EM5347B2C7?888<<52512H5248<8<<r4M_47B2C7?888<<52515148<8<<r4M_48>2GCY07B2H5147B2C7?888<<52512H5248<8<<r4M_@30O@\xec08?2Ic3^08;8>8<<r45347B2C7?888<<52512H5248<8<<r4M_@\xb802=8?2J523e08;8>8<<r25347B2K7L8<<r,7M888<<52g3515248<8<<r2M_@z02=8?2N523e08;8>8<<r45347B2K7L8<<r,7?888<<52g3515248<8<<r4M_@<08;8>8<<E53^1^1@\xc9-:" #(disassemblenewline void #fn(function:code) #fn(function:vals)
#1=#fn("7000z0\x8d:" #() void) #fn("9000n10\\3F00[IA070504710OAKM63:72061:" #(newline disassembleprint) print-val)
#fn(";000n370A3U0FEl23N071A72151523A0A182ML237023@4024751r5~512602765:" #(princ >= 1- " >" " "hex5 ": " " ") print-inst)
- #fn(length) #fn(table-foldl) #fn("7000n382;I?041AF<GQ;34040:" #()) Instructions > #fn("6000n1702161:" #(princ+ #fn(length) #fn(table-foldl) #fn("7000n382;I?041AF<GQ;34040:" #()) Instructions #fn("6000n1702161:" #(princ"\t")) #fn(memq) (loadv.l loadg.l setg.l) ref-int32-LE (loadv loadg setg)
(loada seta loadc call tcall list + - * / < = vector argc vargc loadi8 apply tapply closure box
shift aref) princ #fn(number->string) aref (loada.l seta.l loadc.l largc lvargc call.l tcall.l
@@ -196,12 +197,12 @@
box.l) (optargs keyargs) keyargs " " brbound
(jmp brf brt brne brnn brn) "@" hex5 ref-int16-LE (jmp.l brf.l brt.l brne.l brnn.l brn.l)) disassemble)
div #fn("7000n201k0EL2;3D041EL2;3404K;I504r/;I404EM:" #() div) emit- #fn("Q000z2\x8d2021?75140EG82Jk0122CB088<23C:08824_@R0125CE08788<513;00E88=p@900E188Pp@\x9e126127523A078082<52e1?2@30O42912:52893F07;82<2<523:089T?1@30O^142912=52893F07;82<2<523:089T?1@30O^1412>C\\0822?d3=02@?14q?2@F0822Ad3=02B?14q?2@30O@30O412CC\\0822?d3=02D?14q?2@F0822Ad3=02E?14q?2@30O@30O488<12FQ;3\x9b04892GCM088T2HCE00E82<2I7J8851PPp@x0892GCB00E82<2K88=PPp@a0892LCB00E82<2M88=PPp@J0892HCB00E82<2N88=PPp@30O;I]0412KCI0892HCB00E82<2I88=PPp@?00E7O182P8852p^140:" #(#0#+ #fn("Q000z2\x8d2021?75140EG82Jk0122CB088<23C:08824_@R0125CE08788<513;00E88=p@900E188Pp@\x9a126127523A078082<52e1?2@30O42912:52893D02;82<L23:089T?1@30O^142912<52893D02;82<L23:089T?1@30O^1412=C\\0822>d3=02??14q?2@F0822@d3=02A?14q?2@30O@30O412BC\\0822>d3=02C?14q?2@F0822@d3=02D?14q?2@30O@30O488<12EQ;3\x9b04892FCM088T2GCE00E82<2H7I8851PPp@x0892FCB00E82<2J88=PPp@a0892KCB00E82<2L88=PPp@J0892GCB00E82<2M88=PPp@30O;I]0412JCI0892GCB00E82<2H88=PPp@?00E7N182P8852p^140:" #(#0# #fn("7000n17002162:" #(member (load0 load1 loadt loadf loadnil loadvoid)) load?) car cdr cadr pop#fn(memq) (loadv loadg setg) bcode:indexfor #fn(assq)
- ((loadv loadv.l) (loadg loadg.l) (setg setg.l) (loada loada.l) (seta seta.l) (box box.l)) > 255
- ((loadc loadc.l)) loada (0) loada0 (1) loada1 loadc loadc0 loadc1 brf not null? brn cddr brt eq?
- brne brnn nreconc) emit)
+ ((loadv loadv.l) (loadg loadg.l) (setg setg.l) (loada loada.l) (seta seta.l) (box box.l)) 255 ((loadc
+ loadc.l)) loada (0) loada0 (1) loada1 loadc loadc0 loadc1 brf not null? brn cddr brt eq? brne
+ brnn nreconc) emit)
emit-optional-arg-inits #fn("<000n582B3\x900700517102284534710238953474075176838452q53O7782515447102884534710295247:0895247;0182=8384KM65:O:" #(make-labelemit brbound brt compile-in extend-env list-head cadar seta pop mark-label
emit-optional-arg-inits) emit-optional-arg-inits)
@@ -325,7 +326,7 @@
nreconc #fn("7000n2701062:" #(reverse!-) nreconc) odd? #fn("6000n170051S:" #(even?) odd?) partition #fn(":000n2\x8d2021?65148601qe1qe164:" #(#0# #fn("9000n48283P\x8d1B3Z0401<513?0821<qPN=?2@<0831<qPN=?341=?1@\x05/47088<=88==62:" #(values) partition-)) partition)- positive? #fn("7000n1700E62:" #(>) positive?) princ+ positive? #fn("6000n1E0L2:" #() positive?) princ #fn(";000z070Ow042185>1220>12386>1{86504:" #(*print-readably* #fn("5000n0Aw0:" #(*print-readably*)) #fn("7000n02071A62:" #(#fn(for-each) write)) #fn("6000n1A50420061:" #(#fn(raise)))) princ)@@ -403,8 +404,8 @@
#fn(">000n3\x8d\x8d\x8a7\x8a820872187>1_51420882288>1_5142305124087<01E895488<082895363:" #(#0# #fn("9000n48283L23P02012108252523A0A<017282518364:82:" #(#fn(string-find)#fn(string-char) 1+) trim-start)
- #fn(":000n37082E523R021122073825152523?0A<0173825163:82:" #(> #fn(string-find)- #fn(string-char) 1-) trim-end)
+ #fn(":000n3E82L23R020121072825152523?0A<0172825163:82:" #(#fn(string-find)+ #fn(string-char) 1-) trim-end)
#fn(string-length) #fn(string-sub)) string-trim)
symbol-set-doc #fn("A000z213=070021153@30O482B3H0700222374022q53825263:O:" #(putprop*doc* *funvars* #fn(append) getprop) symbol-set-doc)
binary files a/flisp.boot.builtin b/flisp.boot.builtin differ
--- a/system.lsp
+++ b/system.lsp
@@ -181,6 +181,8 @@
(and (< (car rest) a)
(f (car rest) (cdr rest)))))
(f a rest))
+(define-macro (> a . rest)
+ `(< ,@(reverse! rest) ,a))
(define (<= a b) (not (or (< b a)
(and (nan? a) (nan? b)))))