ref: 8dc30ea0d32f49247e0347fb4527ebc4e64eb992
parent: bc241ef58075410b4d06af49eb42b07174f5f0a5
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Mon Dec 30 19:20:16 EST 2024
< and =: allow single and more than two arguments >, <= and >= need a bit of thinking. References: https://todo.sr.ht/~ft/femtolisp/32
--- a/compiler.lsp
+++ b/compiler.lsp
@@ -382,6 +382,10 @@
(get b2i b #f))))
(define (compile-builtin-call g env tail? x head b nargs)
+ (define (num-compare)
+ (if (= nargs 0)
+ (argc-error b 1)
+ (emit g b nargs)))
(let ((count (get arg-counts b #f)))
(if (and count
(not (length= (cdr x) count)))
@@ -388,6 +392,8 @@
(argc-error b count))
(case b ; handle special cases of vararg builtins
(list (if (= nargs 0) (emit g 'loadnil) (emit g b nargs)))
+ (< (num-compare))
+ (= (num-compare))
(+ (cond ((= nargs 0) (emit g 'load0))
((= nargs 2) (emit g 'add2))
(else (emit g b nargs))))
@@ -395,7 +401,8 @@
((= nargs 1) (emit g 'neg))
((= nargs 2) (emit g 'sub2))
(else (emit g b nargs))))
- (* (if (= nargs 0) (emit g 'load1)
+ (* (if (= nargs 0)
+ (emit g 'load1)
(emit g b nargs)))
(/ (if (= nargs 0)
(argc-error b 1)
--- a/flisp.boot
+++ b/flisp.boot
@@ -1,6 +1,6 @@
(*builtins* #(0 0 0 0 0 0 0 0 0 0 0 0 #fn("5000n10<:" #()) #fn("5000n10=:" #()) 0 0 0 0 #fn("5000n10B:" #()) 0 0 0 0 0 #fn("5000n10H:" #()) 0 0- 0 #fn("6000n201L:" #()) 0 #fn("6000n201N:" #()) 0 #fn("6000n201P:" #())+ 0 #fn("8000z0700}2:" #(<)) 0 #fn("6000n201N:" #()) 0 #fn("6000n201P:" #()) #fn("6000n201Q:" #()) #fn("5000n10R:" #()) #fn("5000n10S:" #()) #fn("5000n10T:" #()) 0 #fn("5000n10V:" #()) #fn("5000n10W:" #()) #fn("5000n10X:" #())@@ -11,7 +11,7 @@
#fn("8000z0700}2:" #(apply)) #fn("8000z0700}2:" #(+)) #fn("8000z0700}2:" #(-)) #fn("8000z0700}2:" #(*)) #fn("8000z0700}2:" #(/)) #fn("8000z0700}2:" #(div0))- #fn("6000n201l:" #()) #fn("6000n201m:" #()) 0 #fn("8000z0700}2:" #(vector))+ #fn("8000z0700}2:" #(=)) #fn("6000n201m:" #()) 0 #fn("8000z0700}2:" #(vector)) #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 0)*properties* #table(*funvars* #table(lz-unpack ((data :to destination)
@@ -47,8 +47,8 @@
1+ #fn("6000n10KM:" #() 1+) 1- #fn("6000n10K~:" #() 1-) 1arg-lambda? #fn("7000n10B;3E04700<51;3:04710TK62:" #(is-lambda?length=) 1arg-lambda?)
- <= #fn("6000n210L;IB0470051;380470151S:" #(nan?) <=) >- #fn("6000n210L:" #() >) >= #fn("6000n201L;IB0470051;380470151S:" #(nan?) >=)+ <= #fn("6000n210L2;IB0470051;380470151S:" #(nan?) <=) >+ #fn("6000n210L2:" #() >) >= #fn("6000n201L2;IB0470051;380470151S:" #(nan?) >=)Instructions #table(call.l 81 trycatch 75 largc 79 loadg.l 68 aref2 23 box 90 cadr 36 argc 62 setg 71 load0 21 vector? 45 fixnum? 41 loadc0 17 loada0 0 div0 59 keyargs 89 call 5 loada.l 69 brt.l 50 sub2 78 add2 29 loadc.l 70 loadc 9 builtin? 43 set-car! 47 brt 25 ret 10 loadi8 66 tapply 77 loadvoid 93 loada1 1 shift 46 boolean? 39 atom? 24 cdr 13 brne.l 83 / 58 loadf 31 equal? 52 apply 54 dup 11 loadt 20 jmp.l 48 null? 38 not 35 = 60 set-cdr! 30 eq? 33 * 57 load1 27 bound? 42 brf 3 function? 44 box.l 91 < 28 brnn.l 84 jmp 16 loadv 2 for 76 lvargc 80 dummy_eof 94 + 55 brne 19 compare 61 neg 37 loadv.l 67 number? 40 vargc 74 brn 85 brbound 88 vector 63 loadc1 22 setg.l 72 cons? 18 brf.l 49 aref 92 symbol? 34 aset! 64 car 12 cons 32 tcall.l 82 - 56 brn.l 86 optargs 87 closure 14 pop 4 eqv? 51 list 53 seta 15 seta.l 73 brnn 26 loadnil 65 loadg 7 loada 8 tcall 6)
__init_globals #fn("5000n020w1422w3424w5476w7478w947:w;:" #(#fn("6000n0702161:" #(princ"#;> ")) *prompt* "/" *directory-separator* "\n" *linefeed* *stdout* *output-stream* *stdin*
@@ -66,10 +66,10 @@
__script
__rcscript
repl #fn(exit)) __start)
- abs #fn("6000n10EL3500U:0:" #() abs) any- #fn("7000n21B;3D0401<51;I:047001=62:" #(any) any) arg-counts #table(bound? 1 function? 1 symbol? 1 car 1 cons 2 < 2 cadr 1 for 3 boolean? 1 fixnum? 1 vector? 1 cdr 1 atom? 1 div0 2 equal? 2 eqv? 2 compare 2 null? 1 not 1 number? 1 = 2 set-cdr! 2 eq? 2 builtin? 1 cons? 1 set-car! 2)- argc-error #fn(";000n2702102211Kl37023@402465:" #(error "compile error: " " expects "- " argument." " arguments.") argc-error)
+ abs #fn("6000n10EL23500U:0:" #() abs) any+ #fn("7000n21B;3D0401<51;I:047001=62:" #(any) any) arg-counts #table(bound? 1 function? 1 symbol? 1 car 1 cons 2 cadr 1 for 3 boolean? 1 fixnum? 1 vector? 1 cdr 1 atom? 1 div0 2 equal? 2 eqv? 2 compare 2 null? 1 not 1 number? 1 set-cdr! 2 builtin? 1 eq? 2 cons? 1 set-car! 2)+ argc-error #fn(";000n2702102211Kl237023@402465:" #(error "compile error: " " expects "+ " argument." " arguments.") argc-error)
array? #fn("7000n10];IF042005185B;390485<21Q:" #(#fn(typeof) array) array?) assoc #fn("7000n21J40O:701510d3501<:7101=62:" #(caar assoc) assoc) assv #fn("7000n21J40O:701510c3501<:7101=62:" #(caarassv) assv)
@@ -81,15 +81,15 @@
#fn("6000n10r4G:" #() bcode:sp) bcode:stack #fn("8000n20r40r4G1Mp:" #() bcode:stack) box-vars #fn("9000n2\x8d\x8a68620086>2_486<^1161:" #(#fn("9000n10B3Q00<T3B070A21720<5153@30O4F<0=61:O:" #(emitbox caddr))) box-vars)
- bq-bracket #fn(";000n20H3=070710152e2:0<22CR01El380700=P:707324710=1K~52e3e2:0<25CS01El390260Te2:707027710T1K~52e3e2:0<28CO01El3500T:707029710T1K~52e3e2:70710152e2:" #(list+ bq-bracket #fn(";000n20H3=070710152e2:0<22CS01El2380700=P:707324710=1K~52e3e2:0<25CT01El2390260Te2:707027710T1K~52e3e2:0<28CP01El23500T:707029710T1K~52e3e2:70710152e2:" #(listbq-process unquote cons 'unquote unquote-splicing copy-list 'unquote-splicing unquote-nsplicing
'unquote-nsplicing) bq-bracket)
- bq-bracket1 #fn(":000n20B3R00<20CK01El3500T:7122730=1K~52e3:730162:" #(unquote cons 'unquote- bq-process) bq-bracket1)
- bq-process #fn("<000n20R380200e2:0]3T0717205115286<73C907486=P:757486e3:0H3400:0<26CB07327710T1KM52e3:0<28CU01El3?0790r2523500T:7:2;710=1K~52e3:7<7=052It07>0512?2@1>105286J807387P:87=JA07:87<7186152e3:2A7B87P7186152e162:\x8d\x8a6862C186>2_486<^10q62:" #(quote+ bq-bracket1 #fn(":000n20B3S00<20CL01El23500T:7122730=1K~52e3:730162:" #(unquote cons 'unquote+ bq-process) bq-bracket1)
+ bq-process #fn("<000n20R380200e2:0]3T0717205115286<73C907486=P:757486e3:0H3400:0<26CB07327710T1KM52e3:0<28CV01El23?0790r2523500T:7:2;710=1K~52e3:7<7=052It07>0512?2@1>105286J807387P:87=JA07:87<7186152e3:2A7B87P7186152e162:\x8d\x8a6862C186>2_486<^10q62:" #(quotebq-process vector->list list vector apply quasiquote 'quasiquote unquote length= cons 'unquote
any splice-form? lastcdr #fn(map) #fn("7000n1700A62:" #(bq-bracket1))- #fn(nconc) list* #fn("=000n20J;02071151P:0B3n00<22CW020731AEl3700=@C07425e2760=AK~52e252P:F<0=770<A521P62:2071760A521P51P:" #(nconc+ #fn(nconc) list* #fn("=000n20J;02071151P:0B3o00<22CX020731AEl23700=@C07425e2760=AK~52e252P:F<0=770<A521P62:2071760A521P51P:" #(nconcreverse! unquote nreconc list 'unquote bq-process bq-bracket))) bq-process)
builtin->instruction #fn("8000n120A0O63:" #(#fn(get)) #(#table(#.cadr cadr #.aset! aset! #.+ + #.- - #.equal? equal? #.eq? eq? #.builtin? builtin? #.not not #.cons? cons? #.cdr cdr #./ / #.div0 div0 #.set-car! set-car! #.vector vector #.set-cdr! set-cdr! #.< < #.for for #.cons cons #.apply apply #.eqv? eqv? #.vector? vector? #.list list #.aref aref #.car car #.bound? bound? #.function? function? #.null? null? #.symbol? symbol? #.compare compare #.boolean? boolean? #.fixnum? fixnum? #.atom? atom? #.= = #.number? number? #.* *))) caaaar #fn("5000n10<<<<:" #() caaaar) caaadr@@ -119,13 +119,14 @@
compile-arglist #fn("8000n3202101>282524228261:" #(#fn(for-each) #fn("9000n170AFO054471AK62:" #(compile-inbcode:stack)) #fn(length)) compile-arglist)
- compile-aset! #fn("=000n3208251r2~87Kl3?07101O2282P64:7387K523d07101O2475828752P5447601778287525378088U5247902262:7:22r362:" #(#fn(length)+ 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-begin #fn("9000n483H3?0700182715064:83=H3>070018283<64:7001O83<5447202352474018283=64:" #(compile-invoid emit pop compile-begin) compile-begin)
- compile-builtin-call #fn("=000n7207185O538;3I07283=8;52I=073858;52@30O4858<24CK086El3:07502662:750858663:8<27C[086El3:07502862:86r2l3:07502962:750858663:8<2:Cj086El3:07385K62:86Kl3:07502;62:86r2l3:07502<62:750858663:8<2=CK086El3:07502>62:750858663:8<2?CK086El3:07385K62:750858663:8<2@CM086El3<07502A2B63:750858663:8<2CCW086r2L3;07385r262:750823702D@402C8663:8<2ECc086r2l3:07502F62:7G86r2523?07508586r3~63:7385r262:7508562:" #(#fn(get)- arg-counts length= argc-error list emit loadnil + load0 add2 - neg sub2 * load1 / vector loadv #()
- apply tapply aref aref2 >) compile-builtin-call)
+ 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#+ #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)
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@@ -150,12 +151,12 @@
compile-or #fn("<000n470018283O21O67:" #(compile-short-circuit brt) compile-or) compile-prog1 #fn(":000n37001O82T544718251B3W0720K5247301O71825154474025524720r/62:O:" #(compile-incddr bcode:stack compile-begin emit pop) compile-prog1)
- compile-set! #fn("?000n470821E538821CF07201O83544730248263:88<El88=T893<07588=51@9076082528:3g07308937027@40288;534790K5247201O83544790r/5247302:62:7201O8354489IA07;2<2=825251@30O47302>8;63:" #(lookup-sym+ compile-set! #fn("?000n470821E538821CF07201O83544730248263:88<El288=T893<07588=51@9076082528:3g07308937027@40288;534790K5247201O83544790r/5247302:62:7201O8354489IA07;2<2=825251@30O47302>8;63:" #(lookup-symglobal compile-in emit setg vinfo:index capture-var! loada loadc bcode:stack set-car! error #fn(string)
"internal error: misallocated var " seta) compile-set!)
compile-short-circuit #fn("?000n783H3?0700182848665:83=H3@070018283<8665:86;I804710517001O83<86554720K52486360O@9073024524730858;534720r/52486360O@907302552476018283=84858657486340O:7708;62:" #(compile-inmake-label bcode:stack emit dup pop compile-short-circuit mark-label) compile-short-circuit)
- compile-sym #fn(";000n470821E538821C`02282513M073248251513@07502624825163:750278263:88<El3W0750287988=51534833A088=T3:07502:62:O:7502;7<08252534833A088=T3:07502:62:O:" #(lookup-sym+ compile-sym #fn(";000n470821E538821C`02282513M073248251513@07502624825163:750278263:88<El23W0750287988=51534833A088=T3:07502:62:O:7502;7<08252534833A088=T3:07502:62:O:" #(lookup-symglobal #fn(constant?) printable? #fn(top-level-value) emit loadv loadg loada vinfo:index car
loadc capture-var!) compile-sym)
compile-thunk #fn(":000n170q21q72051e362:" #(compile-f λ lower-define) compile-thunk)@@ -180,12 +181,12 @@
#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=L3\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@\xc8-:" #(disassemble+ 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-:" #(disassemblenewline void #fn(function:code) #fn(function:vals)
#1=#fn("7000z0\x8d:" #() void) #fn("9000n10\\3F00[IA070504710OAKM63:72061:" #(newline disassembleprint) print-val)
- #fn(";000n370A3S0FEl3M071A72151523@0A182ML37023@4024751r5~512602765:" #(princ >= 1- " >" " "- hex5 ": " " ") print-inst)
+ #fn(";000n370A3U0FEl23N071A72151523A0A182ML237023@4024751r5~512602765:" #(princ >= 1- " >" " "+ hex5 ": " " ") print-inst)
#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
@@ -192,7 +193,7 @@
aref) princ #fn(number->string) aref (loada.l seta.l loadc.l largc lvargc call.l tcall.l 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("7000n201k0EL;3C041EL;3404K;I504r/;I404EM:" #() div) emit+ 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("7000n17002162:" #(member (load0 load1 loadt loadf loadnil loadvoid)) load?) car cdr cadr pop#fn(memq) (loadv loadg setg) bcode:indexfor #fn(assq)
@@ -202,7 +203,7 @@
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)
- encode-byte-code #fn("S000n17005171855172238651r3238651r2ki2M2452238651E255025502650OO278<28524\x8d8988L3\xd9148689G?=48=29CP02:8:8689KMG2;8<5153489r2M?9@\xa81278<2<2=7>873\x8308=8D2?C702@@p08D2AC702B@d08D2CC702D@X08D2EC702F@L08D2GC702H@@08D2IC702J@408=^1@408=525152489KM?948988L3:08689G@30O?>42K8=2L523`02:8;2;8<518>534278<873707M@407NE5152489KM?9@\xeb08=2OCH0278<2P8>5152489KM?9@\xce08>X3\xc708=2K8?2Q523H0278<2P8>5152489KM?9@\x9f02K8?2R523\x810278<2P8>5152489KM?94278<2P8689G5152489KM?948=2SCK0278<2P8689G5152489KM?9@30O@E0278<2T8>5152489KM?9^1@30O@\x83.42U2V8<878:>38;5242W8<61:" #(reverse!+ encode-byte-code #fn("S000n17005171855172238651r3238651r2ki2M2452238651E255025502650OO278<28524\x8d8988L23\xda148689G?=48=29CP02:8:8689KMG2;8<5153489r2M?9@\xa91278<2<2=7>873\x8308=8D2?C702@@p08D2AC702B@d08D2CC702D@X08D2EC702F@L08D2GC702H@@08D2IC702J@408=^1@408=525152489KM?948988L23:08689G@30O?>42K8=2L523`02:8;2;8<518>534278<873707M@407NE5152489KM?9@\xeb08=2OCH0278<2P8>5152489KM?9@\xce08>X3\xc708=2K8?2Q523H0278<2P8>5152489KM?9@\x9f02K8?2R523\x810278<2P8>5152489KM?94278<2P8689G5152489KM?948=2SCK0278<2P8689G5152489KM?9@30O@E0278<2T8>5152489KM?9^1@30O@\x81.42U2V8<878:>38;5242W8<61:" #(reverse!list->vector >= #fn(length) 65536 #fn(table) #fn(buffer)
#fn(io-write) #int32(0) label #fn(put!) #fn(sizeof)
#fn(byte) #fn(get) Instructions jmp jmp.l brt brt.l brf brf.l brne brne.l brnn brnn.l brn brn.l
@@ -214,7 +215,7 @@
int32 int16 #fn(get)))
#fn(iostream->string)) encode-byte-code)
error #fn("9000z020210P61:" #(#fn(raise) error) error) eval- #fn("7000n170710515160:" #(compile-thunk expand) eval) even? #fn("7000n1200K52El:" #(#fn(logand)) even?)+ #fn("7000n170710515160:" #(compile-thunk expand) eval) even? #fn("7000n1200K52El2:" #(#fn(logand)) even?) every #fn("7000n21H;ID0401<51;3:047001=62:" #(every) every) expand #fn("G000n1\x8d\x8d\x8d\x8d\x8d\x8d\x8d\x8d\x8d\x8d\x8d\x8a5\x8a6\x8a7\x8a8\x8a9\x8a:\x8a;\x8a<\x8a=\x8a>\x8a?208521_51420862286>1_514208723e1_51420882485868?87>4_5142089258?89>2_514208:268:>1_514208;278:8988>3_514208<288?8:8988>4_514208=29888?>2_514208>2:_514208?2;8?8>8;8<8=>5_5148?<0q62:" #(#0# #fn("7000n20Z;I904200152S:" #(#fn(assq)) top?) #fn("8000n10H3400:020d3400:0<B3P07105122CF023A<7405151A<0=5162:0<A<0=51P:" #(((begin))@@ -274,7 +275,7 @@
lambda:body #fn("6000n170061:" #(caddr) lambda:body) lambda:vars #fn("6000n1700T61:" #(lambda-vars) lambda:vars) last-pair #fn("6000n10=H3400:700=61:" #(last-pair) last-pair) lastcdr #fn("6000n10H3400:70051=:" #(last-pair) lastcdr) length=- #fn("8000n21EL340O:1El3500H:0H3601El:700=1K~62:" #(length=) length=) length> #fn("8000n21EL3400:1El3;00B;34040:0H3601EL:700=1K~62:" #(length>) length>)+ #fn("8000n21EL2340O:1El23500H:0H3701El2:700=1K~62:" #(length=) length=) length> #fn("8000n21EL23400:1El23;00B;34040:0H3701EL2:700=1K~62:" #(length>) length>) list->vector #fn("6000n1700}2:" #(vector) list->vector) list-head #fn("9000n2701E52340q:0<710=1K~52P:" #(<= list-head) list-head) list-ref #fn("7000n2700152<:" #(list-tail) list-ref) list-tail #fn("8000n2701E523400:710=1K~62:" #(<= list-tail) list-tail) list?@@ -311,11 +312,11 @@
map! #fn("8000n21\x8d1B3B04101<51_41=?1@\x1d/4:" #() map!) map-int #fn(";000n2701E52340q:0E51qPq\x8a78786_4K7115122870>2|486:" #(<= 1- #fn("7000n1A<F051qPN4AA<=_:" #())) map-int) mark-label #fn("8000n270021163:" #(emit label) mark-label) max- #fn(";000z11J400:70210163:" #(foldl #fn("6000n201L3401:0:" #())) max) member #fn("7000n21J40O:1<0d3401:7001=62:" #(member) member)+ #fn(";000z11J400:70210163:" #(foldl #fn("6000n201L23401:0:" #())) max) member #fn("7000n21J40O:1<0d3401:7001=62:" #(member) member) memv #fn("7000n21J40O:1<0c3401:7001=62:" #(memv) memv) min- #fn(";000z11J400:70210163:" #(foldl #fn("6000n201L3400:1:" #())) min) mod #fn("8000n207001521i2~:" #(div) mod)+ #fn(";000z11J400:70210163:" #(foldl #fn("6000n201L23400:1:" #())) min) mod #fn("8000n207001521i2~:" #(div) mod) mod0 #fn("7000n2001k1i2~:" #() mod0) nan?- #fn("6000n1020d;I704021d:" #(+nan.0 -nan.0) nan?) negative? #fn("6000n10EL:" #() negative?)+ #fn("6000n1020d;I704021d:" #(+nan.0 -nan.0) nan?) negative? #fn("6000n10EL2:" #() negative?) nestlist #fn(":000n37082E52340q:1710015182K~53P:" #(<= nestlist) nestlist) newline #fn("8000\x8700001000\x880000I7070?04210725247360:" #(*output-stream* #fn(io-write)*linefeed* void) newline)
@@ -345,7 +346,7 @@
ffound caddr #fn(raise))) #fn(symbol) string-join #fn(map) string reverse! "/" λ) fn-name)
reverse! length> list-tail *interactive* filter closure? #fn(map)
#fn("6000n10Z;380420061:" #(#fn(top-level-value)))- #fn(environment) #fn(for-each) #fn("8000n170A<0KGF5271051==P5147250492<El3?0730KG0EG52@30O49292<KM_:" #(print+ #fn(environment) #fn(for-each) #fn("8000n170A<0KGF5271051==P5147250492<El23?0730KG0EG52@30O49292<KM_:" #(printvector->list newline disassemble))) print-stack-trace)
print-to-string #fn("8000n1205021085524228561:" #(#fn(buffer)#fn(write)
@@ -382,7 +383,7 @@
set-syntax! #fn("8000n220710163:" #(#fn(put!)*syntax-environment*) set-syntax!)
simple-sort #fn("9000n10V;I6040=V3400:0<7021850>22285>162:" #(call-with-values #fn("7000n07021A>1F=62:" #(partition- #fn("6000n10AL:" #()))) #fn("9000n22071051Ae17115163:" #(#fn(nconc) simple-sort))) simple-sort)+ #fn("6000n10AL2:" #()))) #fn("9000n22071051Ae17115163:" #(#fn(nconc) simple-sort))) simple-sort) splice-form? #fn("7000n10B;3X040<20Q;IN040<21Q;ID040<22Q;3:04730r252;I704022Q:" #(unquote-splicingunquote-nsplicing unquote length>) splice-form?)
string-join #fn("9000n20J5020:215022860<5242324861>20=524258661:" #("" #fn(buffer)@@ -391,15 +392,15 @@
#fn("7000n120AF52420A062:" #(#fn(io-write)))#fn(iostream->string)) string-join)
string-lpad #fn(":000n3207182122051~52062:" #(#fn(string) string-rep #fn(string-length)) string-lpad)- string-map #fn("=000n2205021151E\x8d8887L3O0422860231885251524748851?8@\x0d/^14258661:" #(#fn(buffer)+ string-map #fn("=000n2205021151E\x8d8887L23O0422860231885251524748851?8@\x0c/^14258661:" #(#fn(buffer)#fn(string-length) #fn(io-putc) #fn(string-char) 1+ #fn(iostream->string)) string-map)
- string-rep #fn(":000n21r4L3`0701E5235021:1Kl38022061:1r2l390220062:2200063:731513@02207401K~5262:742200521r2j262:" #(<=+ string-rep #fn(":000n21r4L23b0701E5235021:1Kl238022061:1r2l2390220062:2200063:731513@02207401K~5262:742200521r2j262:" #(<="" #fn(string) odd? string-rep) string-rep)
string-rpad #fn(";000n32007182122051~5262:" #(#fn(string) string-rep #fn(string-length)) string-rpad) string-tail #fn("7000n2200162:" #(#fn(string-sub)) string-tail) string-trim #fn(">000n3\x8d\x8d\x8a7\x8a820872187>1_51420882288>1_5142305124087<01E895488<082895363:" #(#0#- #fn("9000n48283L3P02012108252523A0A<017282518364:82:" #(#fn(string-find)- #fn(string-char) 1+) trim-start)
+ #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(string-length) #fn(string-sub)) string-trim)
@@ -446,4 +447,4 @@
vinfo #fn("7000n30182e3:" #() vinfo) vinfo:heap? #.cadr vinfo:index#4# vinfo:sym #.car void
#1# void? #fn("6000n10\x8dQ:" #() void?) zero?- #fn("6000n10El:" #() zero?))+ #fn("6000n10El2:" #() zero?))binary files a/flisp.boot.builtin b/flisp.boot.builtin differ
--- a/gen.lsp
+++ b/gen.lsp
@@ -31,7 +31,7 @@
OP_BRT brt #f 0 ()
OP_BRNN brnn #f 0 ()
OP_LOAD1 load1 #f 0 ()
- OP_LT < 2 (λ (x y) (< x y)) ()
+ OP_LT < -1 (λ rest (apply < rest)) ()
OP_ADD2 add2 #f 0 ()
OP_SETCDR set-cdr! 2 (λ (x y) (set-cdr! x y)) ()
OP_LOADF loadf #f 0 ()
@@ -65,7 +65,7 @@
((number…) "Return product of the numbers or 1 with no arguments."))
OP_DIV / -1 (λ rest (apply / rest)) ()
OP_IDIV div0 2 (λ rest (apply div0 rest)) ()
- OP_NUMEQ = 2 (λ (x y) (= x y)) ()
+ OP_NUMEQ = -1 (λ rest (apply = rest)) ()
OP_COMPARE compare 2 (λ (x y) (compare x y)) ()
OP_ARGC argc #f 0 ()
OP_VECTOR vector ANYARGS (λ rest (apply vector rest)) ()
--- a/maxstack.inc
+++ b/maxstack.inc
@@ -28,7 +28,7 @@
case OP_POP: case OP_RET:
case OP_CONS: case OP_SETCAR: case OP_SETCDR:
case OP_EQ: case OP_EQV: case OP_EQUAL: case OP_ADD2: case OP_SUB2:
- case OP_IDIV: case OP_NUMEQ: case OP_LT: case OP_COMPARE:
+ case OP_IDIV: case OP_COMPARE:
case OP_AREF2: case OP_TRYCATCH:
sp--;
break;
@@ -127,7 +127,7 @@
ip += 4; // fallthrough
case OP_TAPPLY: case OP_APPLY:
case OP_LIST: case OP_ADD: case OP_SUB: case OP_MUL: case OP_DIV:
- case OP_VECTOR:
+ case OP_VECTOR: case OP_LT: case OP_NUMEQ:
n = *ip++;
sp -= n-1;
break;
--- a/opcodes.c
+++ b/opcodes.c
@@ -18,13 +18,13 @@
[OP_CONS] = {"cons", 2}, [OP_NUMBERP] = {"number?", 1}, [OP_BOUNDP] = {"bound?", 1},- [OP_LT] = {"<", 2},+ [OP_LT] = {"<", -1}, [OP_VECTORP] = {"vector?", 1}, [OP_CAR] = {"car", 1}, [OP_EQV] = {"eqv?", 2}, [OP_IDIV] = {"div0", 2}, [OP_FIXNUMP] = {"fixnum?", 1},- [OP_NUMEQ] = {"=", 2},+ [OP_NUMEQ] = {"=", -1}, [OP_SYMBOLP] = {"symbol?", 1}, [OP_BUILTINP] = {"builtin?", 1}, [OP_SUB] = {"-", -1},--- a/test/unittest.lsp
+++ b/test/unittest.lsp
@@ -136,11 +136,17 @@
; comparing strings
(assert (< "a" "b"))
+(assert (< "a" "b" "c"))
(assert (> "b" "a"))
+;(assert (> "c" "b" "a")) ; FIXME
(assert (not (< "a" "a")))
+(assert (not (< "a" "a" "a")))
(assert (<= "a" "a"))
+;(assert (<= "a" "a" "a")) ; FIXME
(assert (>= "a" "a"))
+;(assert (>= "a" "a" "a")) ; FIXME
(assert (>= "ab" "aa"))
+;(assert (>= "ab" "aa" "aa")) ; FIXME
; comparing numbers and runes
(assert (< 9 #\newline))
--- a/vm.inc
+++ b/vm.inc
@@ -72,6 +72,8 @@
case OP_DIV: goto LABEL(apply_div);
case OP_AREF: goto LABEL(apply_aref);
case OP_ASET: goto LABEL(apply_aset);
+ case OP_LT: goto LABEL(apply_lt);
+ case OP_NUMEQ: goto LABEL(apply_numeq);
default:
#if defined(COMPUTED_GOTO)
goto *ops[i];
@@ -310,17 +312,31 @@
NEXT_OP;
OP(OP_LT)
+ n = *ip++;
+LABEL(apply_lt):
{- value_t a = FL(stack)[FL(sp)-2], b = FL(stack)[FL(sp)-1];
- POPN(1);
- if(bothfixnums(a, b)){- FL(stack)[FL(sp)-1] = (fixnum_t)a < (fixnum_t)b ? FL_t : FL_f;
- }else{- x = numeric_compare(a, b, false, false, false);
- if(x > 1)
- x = numval(fl_compare(a, b));
- FL(stack)[FL(sp)-1] = x < 0 ? FL_t : FL_f;
+ i = n;
+ value_t a = FL(stack)[FL(sp)-i], b;
+ for(v = FL_t; i > 1; a = b){+ i--;
+ b = FL(stack)[FL(sp)-i];
+ if(bothfixnums(a, b)){+ if((fixnum_t)a >= (fixnum_t)b){+ v = FL_f;
+ break;
+ }
+ }else{+ x = numeric_compare(a, b, false, false, false);
+ if(x > 1)
+ x = numval(fl_compare(a, b));
+ if(x >= 0){+ v = FL_f;
+ break;
+ }
+ }
}
+ POPN(n);
+ PUSH(v);
}
NEXT_OP;
@@ -624,17 +640,31 @@
NEXT_OP;
OP(OP_NUMEQ)
+ n = *ip++;
+LABEL(apply_numeq):
{- value_t a = FL(stack)[FL(sp)-2];
- value_t b = FL(stack)[FL(sp)-1];
- if(bothfixnums(a, b))
- v = a == b ? FL_t : FL_f;
- else{- FL(stack)[ipd] = (uintptr_t)ip;
- v = numeric_compare(a, b, true, false, true) == 0 ? FL_t : FL_f;
+ i = n;
+ value_t a = FL(stack)[FL(sp)-i], b;
+ for(v = FL_t; i > 1; a = b){+ i--;
+ b = FL(stack)[FL(sp)-i];
+ if(bothfixnums(a, b)){+ if((fixnum_t)a != (fixnum_t)b){+ v = FL_f;
+ break;
+ }
+ }else{+ x = numeric_compare(a, b, false, false, false);
+ if(x > 1)
+ x = numval(fl_compare(a, b));
+ if(x != 0){+ v = FL_f;
+ break;
+ }
+ }
}
- POPN(1);
- FL(stack)[FL(sp)-1] = v;
+ POPN(n);
+ PUSH(v);
}
NEXT_OP;