shithub: femtolisp

--- a/flisp.boot

+++ b/flisp.boot

@@ -14,8 +14,8 @@

 	      #fn("8000z0700}2:" #(*)) #fn("8000z0700}2:" #(/))

 	      #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 0 0 0 0 0 0 0 0 0

-	      0 0 0 0 0 0 0 0 0 0 0)

+	      #fn("7000n30182p:" #()) 0 0 0 0 0 0 0 0 0 0 0 #fn("9000n320012182>163:" #(#.for

+  #fn("6000n1A061:" #()))) 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 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)

@@ -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  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  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)

 	    argc-error #fn(";000n2702102211Kl37023@402465:" #(error "compile error: "

 							      " expects " " argument."

 							      " arguments.") argc-error)

@@ -187,7 +187,7 @@

   #fn(has?) #fn(put!))) member delete-duplicates) delete-duplicates)

 	    diff #fn("8000n20J40q:200<1523:0710=162:0<710=152P:" #(#fn(memq)

 								   diff) diff)

-	    disassemble #fn("T000\x871000.///\x881000I60O?14z282JD07001E53471504D:@30D482<2205123051DD2487>1?:425187>2?;4r4268851\x8a<D8<<8=L3\x85242728888<>2O79537:8<<r4523907150@30D4E87K~2;|48<8<<KM_48>2<8?2=523[08;8>8<<r45348:897>888<<52G5148<8<<r4M_@\x1112<8?2?523V08;8>8<<K5348:89888<<GG5148<8<<KM_@\xe212<8?2@523W08;8>8<<K5347A2B888<<G515148<8<<KM_@\xb212<8?2C523\\08;8>8<<r45347A2B7>888<<52515148<8<<r4M_@}12<8?2D523\xb808;8>8<<r88>2EC70r4@30EM5347A2B7>888<<52512F5248<8<<r4M_47A2B7>888<<52515148<8<<r4M_48>2ECY07A2F5147A2B7>888<<52512F5248<8<<r4M_@30D@\xec08?2Gc3^08;8>8<<r45347A2B7>888<<52512F5248<8<<r4M_@\xb802<8?2H523e08;8>8<<r25347A2I7J8<<r,7K888<<52g3515248<8<<r2M_@z02<8?2L523e08;8>8<<r45347A2I7J8<<r,7>888<<52g3515248<8<<r4M_@<08;8>8<<E53^1^1@\xd6-:" #(disassemble

+	    disassemble #fn("T000\x871000.///\x881000I60O?14z282JD07001E53471504D:@30D482<2205123051DD2487>1?:425187>2?;4r4268851\x8a<D8<<8=L3\x88242728888<>2O79537:8<<r4523907150@30D42;E87K~2<5348<8<<KM_48>2=8?2>523[08;8>8<<r45348:897?888<<52G5148<8<<r4M_@\x1112=8?2@523V08;8>8<<K5348:89888<<GG5148<8<<KM_@\xe212=8?2A523W08;8>8<<K5347B2C888<<G515148<8<<KM_@\xb212=8?2D523\\08;8>8<<r45347B2C7?888<<52515148<8<<r4M_@}12=8?2E523\xb808;8>8<<r88>2FC70r4@30EM5347B2C7?888<<52512G5248<8<<r4M_47B2C7?888<<52515148<8<<r4M_48>2FCY07B2G5147B2C7?888<<52512G5248<8<<r4M_@30D@\xec08?2Hc3^08;8>8<<r45347B2C7?888<<52512G5248<8<<r4M_@\xb802=8?2I523e08;8>8<<r25347B2J7K8<<r,7L888<<52g3515248<8<<r2M_@z02=8?2M523e08;8>8<<r45347B2J7K8<<r,7?888<<52g3515248<8<<r4M_@<08;8>8<<E53^1^1@\xd3-:" #(disassemble

   newline #fn(function:code) #fn(function:vals)

   #fn("9000n10\\;36040[S3C07021514720OAKM63:73061:" #(princ "\n" disassemble

 						      print) print-val)

@@ -194,7 +194,7 @@

   #fn(";000n370A;3P04FEl;3H0471A7215152;3904A182ML37023@4024751r5~512602765:" #(princ

   >= 1- " >" "  " hex5 ":  " " ") print-inst)

   #fn(length) #fn(table-foldl) #fn("7000n382;I?041AF<GQ;34040:" #())

-  Instructions > #fn("6000n1702161:" #(princ "\t"))

+  Instructions > #.for #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)

@@ -318,7 +318,8 @@

   #fn(write) nconc #fn(map) list top-level-value #fn(io-write) *linefeed* #fn(io-close)))

   #fn("6000n1A50420061:" #(#fn(raise)))) make-system-image)

 	    map! #fn("8000n21D1B3B04101<51_41=?1@\x1d/4:" #() map!) map-int

-	    #fn(";000n2701E52340q:0E51qPq\x8a78786_4K1K~21870>2|486:" #(<= #fn("7000n1A<F051qPN4AA<=_:" #())) map-int)

+	    #fn("<000n2701E52340q:0E51qPq\x8a78786_421K1K~22870>253486:" #(<=

+  #.for #fn("7000n1A<F051qPN4AA<=_:" #())) map-int)

 	    mark-label #fn("8000n270021163:" #(emit label) mark-label) max

 	    #fn(";000z11J400:70210163:" #(foldl #fn("6000n201L3401:0:" #())) max)

 	    member #fn("7000n21H340O:1<0d3401:7001=62:" #(member) member) memv

@@ -343,9 +344,9 @@

   " out of bounds for " unbound-error "eval: variable " " has no value" error

   "error: " load-error print-exception "in file " list? ": " #fn(string?)

   "*** Unhandled exception: " *linefeed*) print-exception)

-	    print-stack-trace #fn("@000n1DD\x8a5\x8a6852085>1_4862185>1_472730r3523F074075370r5@40r452@30051767728292:505252E\x8a97;2<868889>38762:" #(#fn("=000n32005182P2105121151C?022232487e361:25051E76278851512888A187>4|:" #(#fn(function:name)

-  #fn(function:code) #fn(raise) thrown-value ffound #fn(function:vals) 1- #fn(length)

-  #fn("8000n170A0G513>0F<A0G929363:D:" #(closure?))) find-in-f)

+	    print-stack-trace #fn("@000n1DD\x8a5\x8a6852085>1_4862185>1_472730r3523F074075370r5@40r452@30051767728292:505252E\x8a97;2<868889>38762:" #(#fn(">000n32005182P2105121151C?022232487e361:2505126E77288851512988A187>463:" #(#fn(function:name)

+  #fn(function:code) #fn(raise) thrown-value ffound #fn(function:vals) #.for 1-

+  #fn(length) #fn("8000n170A0G513>0F<A0G929363:D:" #(closure?))) find-in-f)

   #fn(";000n220A01>321{863I02273247576865152275261:28:" #(#fn("8000n07021AF>292524O:" #(for-each

   #fn("8000n1A<0Fq63:" #()))) #fn("6000n10B;3B040<20Q;38040T21Q38072061:23061:" #(thrown-value

   ffound caddr #fn(raise))) #fn(symbol) string-join #fn(map) string reverse! "/"

@@ -442,11 +443,10 @@

 	    #fn(":000n32021182>2072230515163:" #(#fn(map)

 						 #fn("9000n2700210A52SS1FM63:" #(vinfo

   #fn(memq))) iota #fn(length)) vars-to-env)

-	    vector->list #fn("<000n120051q\x8a6K852186085>3|486<:" #(#fn(length)

-  #fn("8000n1AF920~GA<P_:" #())) vector->list)

-	    vector-map #fn("<000n220151218651E86K~228701>3|487:" #(#fn(length)

-								   #fn(vector-alloc)

-								   #fn("9000n1A0F920G51p:" #())) vector-map)

+	    vector->list #fn("=000n120051q\x8a621K852286085>353486<:" #(#fn(length)

+  #.for #fn("8000n1AF920~GA<P_:" #())) vector->list)

+	    vector-map #fn("=000n22015121865122E86K~238701>353487:" #(#fn(length)

+  #fn(vector-alloc) #.for #fn("9000n1A0F920G51p:" #())) vector-map)

 	    vinfo #fn("7000n30182e3:" #() vinfo) vinfo:heap? #.cadr vinfo:index

 	    #2# vinfo:sym #.car void

 	    #fn("5000n0D:" #() void) zero? #fn("6000n10El:" #() zero?))

--- a/gen.lsp

+++ b/gen.lsp

@@ -76,7 +76,7 @@

     OP_SETAL          seta.l    #f      0

     OP_VARGC          vargc     #f      0

     OP_TRYCATCH       trycatch  #f      0

-    OP_FOR            for       #f      0

+    OP_FOR            for       3       (λ (a b f) (for a b (λ (x) (f x))))

     OP_TAPPLY         tapply    #f      0

     OP_SUB2           sub2      #f      0

     OP_LARGC          largc     #f      0

--- a/opcodes.h

+++ b/opcodes.h

@@ -128,6 +128,7 @@

 	[OP_COMPARE] = {"compare", 2},

 	[OP_PAIRP] = {"pair?", 1},

 	[OP_MUL] = {"*", ANYARGS},

+	[OP_FOR] = {"for", 3},

 	[OP_AREF] = {"aref", 2},

 	[OP_ADD] = {"+", ANYARGS},

 	[OP_DIV] = {"/", -1},