ref: 0864e3a7e23a6e3f6db9049abd3c70fd7e181606
parent: 33cfd0c3a7b0ace96e79dacacb9c69230a633312
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Mon Dec 9 15:05:25 EST 2024
aref: support multiple indices Fixes: https://todo.sr.ht/~ft/femtolisp/19
--- a/compiler.lsp
+++ b/compiler.lsp
@@ -389,6 +389,9 @@
(apply (if (< nargs 2)
(argc-error b 2)
(emit g (if tail? 'tapply 'apply) nargs)))
+ (aref (cond ((= nargs 2) (emit g 'aref0))
+ ((> nargs 2) (emit g b (- nargs 2)))
+ (else (argc-error b 2))))
(else (emit g b)))))
(define (inlineable? form)
@@ -777,7 +780,7 @@
(set! i (+ i 1)))
((loada seta loadc call tcall list + - * / vector
- argc vargc loadi8 apply tapply closure box shift)
+ argc vargc loadi8 apply tapply closure box shift aref)
(print-inst inst i 1)
(princ (number->string (aref code i)))
(set! i (+ i 1)))
--- a/flisp.boot
+++ b/flisp.boot
@@ -1,9 +1,8 @@
(*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 #fn("6000n201G:" #())- #fn("5000n10H:" #()) 0 0 0 #fn("6000n201L:" #()) 0 #fn("6000n201N:" #())- 0 #fn("6000n201P:" #()) #fn("6000n201Q:" #())- #fn("5000n10R:" #()) #fn("5000n10S:" #())- #fn("5000n10T:" #()) 0 #fn("5000n10V:" #())+ #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:" #())+ #fn("6000n201Q:" #()) #fn("5000n10R:" #())+ #fn("5000n10S:" #()) #fn("5000n10T:" #()) 0 #fn("5000n10V:" #()) #fn("5000n10W:" #()) #fn("5000n10X:" #()) #fn("5000n10Y:" #()) #fn("5000n10Z:" #()) #fn("5000n10[:" #()) #fn("5000n10\\:" #())@@ -15,7 +14,8 @@
#fn("8000z0700}2:" #(div0)) #fn("6000n201l:" #()) #fn("6000n201m:" #()) 0 #fn("8000z0700}2:" #(vector)) #fn("7000n30182p:" #()) 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 0 0 0 0)
+ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 #fn("8000z0700}2:" #(aref)) 0 0 0+ 0)
*empty-string* "" *runestring-type* (array rune) *string-type* (array
byte)
*syntax-environment* #table(when #fn(";000z1200211POe4:" #(if begin)) with-output-to #fn("<000z12021e1220e2e1e12315163:" #(#fn(nconc)@@ -49,7 +49,7 @@
length=) 1arg-lambda?)
<= #fn("6000n210L;IB0470051;380470151S:" #(nan?) <=) > #fn("6000n210L:" #() >) >= #fn("6000n201L;IB0470051;380470151S:" #(nan?) >=)- Instructions #table(call.l 81 trycatch 75 largc 79 loadg.l 68 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 pair? 18 sub2 78 add2 29 loadc.l 70 loadc 9 builtin? 43 set-car! 47 brt 25 ret 10 loadi8 66 tapply 77 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 dummy_t 93 bound? 42 brf 3 function? 44 box.l 91 < 28 brnn.l 84 jmp 16 loadv 2 for 76 lvargc 80 dummy_eof 95 + 55 dummy_f 92 brne 19 compare 61 neg 37 loadv.l 67 number? 40 vargc 74 brn 85 brbound 88 vector 63 loadc1 22 setg.l 72 brf.l 49 aref 23 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 dummy_nil 94 tcall 6)
+ Instructions #table(call.l 81 trycatch 75 largc 79 loadg.l 68 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 pair? 18 sub2 78 add2 29 loadc.l 70 loadc 9 builtin? 43 set-car! 47 brt 25 ret 10 loadi8 66 tapply 77 loada1 1 shift 46 aref0 23 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 dummy_t 94 bound? 42 brf 3 function? 44 box.l 91 < 28 brnn.l 84 jmp 16 loadv 2 for 76 lvargc 80 dummy_eof 96 + 55 dummy_f 93 brne 19 compare 61 neg 37 loadv.l 67 number? 40 vargc 74 brn 85 brbound 88 vector 63 loadc1 22 setg.l 72 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 dummy_nil 95 tcall 6)
__init_globals #fn("5000n020w1422w3474w5476w7478w9:" #("/"*directory-separator*
"\n"
@@ -69,7 +69,7 @@
__start #fn("7000n1705040=B3D00=w14Ow24730T51@C00w14Dw24745047550426E61:" #(__init_globals*argv* *interactive* __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 aset! 3 car 1 cons 2 < 2 cadr 1 for 3 vector? 1 fixnum? 1 boolean? 1 atom? 1 cdr 1 div0 2 equal? 2 eqv? 2 pair? 1 compare 2 null? 1 not 1 number? 1 = 2 set-cdr! 2 eq? 2 builtin? 1 set-car! 2 aref 2)+ #fn("7000n21B;3D0401<51;I:047001=62:" #(any) any) arg-counts #table(bound? 1 function? 1 symbol? 1 aset! 3 car 1 cons 2 < 2 cadr 1 for 3 vector? 1 fixnum? 1 boolean? 1 cdr 1 atom? 1 div0 2 equal? 2 eqv? 2 pair? 1 compare 2 null? 1 not 1 number? 1 = 2 set-cdr! 2 eq? 2 builtin? 1 set-car! 2) argc-error #fn(";000n2702102211Kl37023@402465:" #(error "compile error: "" expects " " argument."
" arguments.") argc-error)
@@ -94,7 +94,7 @@
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:" #(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 #.pair? pair? #.aref aref #.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 #.car car #.bound? bound? #.function? function? #.null? null? #.symbol? symbol? #.compare compare #.boolean? boolean? #.fixnum? fixnum? #.atom? atom? #.= = #.number? number? #.* *)))+ builtin->instruction #fn("8000n120A0O63:" #(#fn(get)) #(#table(#.cadr cadr #.aset! aset! #.+ + #.- - #.equal? equal? #.eq? eq? #.builtin? builtin? #.not not #.pair? pair? #.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 #fn("5000n10T<<:" #() caaadr) caaar #fn("5000n10<<<:" #() caaar) caadar #fn("5000n10<T<:" #() caadar) caaddr@@ -131,9 +131,9 @@
bcode:stack)) #fn(length)) compile-arglist)
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@30D4858<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:7508562:" #(#fn(get)+ compile-builtin-call #fn("=000n7207185O538;3I07283=8;52I=073858;52@30D4858<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?07508586r2~63:7385r262:7508562:" #(#fn(get)arg-counts length= argc-error list emit loadnil + load0 add2 - neg sub2 *
- load1 / vector loadv #() apply tapply) compile-builtin-call)
+ load1 / vector loadv #() apply tapply aref aref0 >) 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@30D47B8=2C523I0788688J702D@402E8=53@W088\x85?078862F8=53@E08:J?078862G8=53@30O47H0897I7J1518952537K868@<52486r4268951r4Mp47L868@D7J15154478862M5247N2O7P7Q8651517R86518<537S865162:" #(make-code-emitter@@ -196,7 +196,7 @@
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) princ #fn(number->string)
+ tapply closure box shift aref) princ #fn(number->string)
(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)
--- a/flisp.c
+++ b/flisp.c
@@ -921,6 +921,7 @@
GOTO_OP_OFFSET(OP_LOADT),
GOTO_OP_OFFSET(OP_LOAD0),
GOTO_OP_OFFSET(OP_LOADC1),
+ GOTO_OP_OFFSET(OP_AREF0),
GOTO_OP_OFFSET(OP_AREF),
GOTO_OP_OFFSET(OP_ATOMP),
GOTO_OP_OFFSET(OP_BRT),
@@ -1250,7 +1251,7 @@
PUSH(vector_elt(FL(stack)[bp+nargs], 1));
NEXT_OP;
- OP(OP_AREF)
+ OP(OP_AREF0)
FL(stack)[ipd] = (uintptr_t)ip;
v = FL(stack)[FL(sp)-2];
if(isvector(v)){@@ -1266,6 +1267,27 @@
}
POPN(1);
FL(stack)[FL(sp)-1] = v;
+ NEXT_OP;
+
+ OP(OP_AREF)
+ FL(stack)[ipd] = (uintptr_t)ip;
+ n = 1 + *ip++;
+ v = FL(stack)[FL(sp)-n-1];
+ for(i = n; i > 0; i--){+ if(isvector(v)){+ e = FL(stack)[FL(sp)-i];
+ isz = tosize(e);
+ if(__unlikely(isz >= vector_size(v)))
+ bounds_error(v, e);
+ v = vector_elt(v, isz);
+ }else if(__likely(isarray(v))){+ v = cvalue_array_aref(&FL(stack)[FL(sp)-i]);
+ }else{+ type_error("sequence", v);+ }
+ }
+ POPN(n+1);
+ PUSH(v);
NEXT_OP;
OP(OP_ATOMP)
--- a/gen.lsp
+++ b/gen.lsp
@@ -23,7 +23,7 @@
OP_LOADT loadt #f 0
OP_LOAD0 load0 #f 0
OP_LOADC1 loadc1 #f 0
- OP_AREF aref 2 (λ (x y) (aref x y))
+ OP_AREF0 aref0 #f 0
OP_ATOMP atom? 1 (λ (x) (atom? x))
OP_BRT brt #f 0
OP_BRNN brnn #f 0
@@ -92,6 +92,7 @@
OP_KEYARGS keyargs #f 0
OP_BOX box #f 0
OP_BOXL box.l #f 0
+ OP_AREF aref -2 (λ rest (apply aref rest))
OP_BOOL_CONST_F dummy_f #f 0
OP_BOOL_CONST_T dummy_t #f 0
OP_THE_EMPTY_LIST dummy_nil #f 0
--- a/maxstack.inc
+++ b/maxstack.inc
@@ -30,8 +30,13 @@
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_AREF: case OP_TRYCATCH:
+ case OP_AREF0: case OP_TRYCATCH:
sp--;
+ break;
+
+ case OP_AREF:
+ n = 1 + *ip++;
+ sp -= n;
break;
case OP_ARGC: case OP_SETG: case OP_SETA: case OP_BOX:
--- a/opcodes.h
+++ b/opcodes.h
@@ -22,7 +22,7 @@
OP_LOADT,
OP_LOAD0,
OP_LOADC1,
- OP_AREF,
+ OP_AREF0,
OP_ATOMP,
OP_BRT,
OP_BRNN,
@@ -91,6 +91,7 @@
OP_KEYARGS,
OP_BOX,
OP_BOXL,
+ OP_AREF,
OP_BOOL_CONST_F,
OP_BOOL_CONST_T,
OP_THE_EMPTY_LIST,
@@ -129,8 +130,8 @@
[OP_PAIRP] = {"pair?", 1}, [OP_MUL] = {"*", ANYARGS}, [OP_FOR] = {"for", 3},- [OP_AREF] = {"aref", 2}, [OP_ADD] = {"+", ANYARGS},+ [OP_AREF] = {"aref", -2}, [OP_DIV] = {"/", -1}, [OP_VECTOR] = {"vector", ANYARGS}, [OP_EQUAL] = {"equal?", 2},--- a/test/unittest.lsp
+++ b/test/unittest.lsp
@@ -411,6 +411,15 @@
(assert (equal? (map (λ (x y) (+ x y)) '(1 2) '(3)) '(4)))
(assert (equal? (map (λ (x y z) (+ x y z)) '(1 2) '(3) '(4 5)) '(8)))
+;; aref with multiple indices
+(define a #(#(0 1 2) #(3 #(4 5 6) 7)))
+(assert (equal? 0 (aref a 0 0)))
+(assert (equal? 2 (aref a 0 2)))
+(assert (equal? 3 (aref a 1 0)))
+(assert (equal? 7 (aref a 1 2)))
+(assert (equal? 5 (aref a 1 1 1)))
+(assert-fail (aref a 1 1 3) bounds-error)
+
;; make many initialized tables large enough not to be stored in-line
(for 1 100 (λ (i)
(table eq? 2 eqv? 2