ref: 88782be67311b9018c82d9163dca589bbcb3fd28
parent: 49d1f2e3183cf3b57c800b998601b40463638ed2
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Fri Mar 14 01:57:33 EDT 2025
function → fn
--- a/boot/sl.boot
+++ b/boot/sl.boot
@@ -65,7 +65,7 @@
<= #fn("z1Ib6862086>1_486<^10162:" #(#fn("n21S;JL041<0L2;J5040V340q:A<1<1=62:" #())) <=) > #fn("z1Ib6862086>1_486<^10162:" #(#fn("n21S;JE041<0L2;3;04A<1<1=62:" #())) >) >= #fn("z1Ib6862086>1_486<^10162:" #(#fn("n21S;JL0401<L2;J5040V340q:A<1<1=62:" #())) >=)- Instructions #table(call.l #byte(0x51) trycatch #byte(0x4b) loadg.l #byte(0x44) aref2 #byte(0x17) box #byte(0x32) cadr #byte(0x24) argc #byte(0x3e) setg #byte(0x47) load0 #byte(0x15) nan? #byte(0x26) fixnum? #byte(0x29) loadc0 #byte(0x11) loada0 #byte(0x0) div0 #byte(0x3b) keyargs #byte(0x1f) call #byte(0x5) loada.l #byte(0x45) num? #byte(0x28) sub2 #byte(0x4e) add2 #byte(0x1d) loadc.l #byte(0x46) loadc #byte(0x9) builtin? #byte(0x2b) set-car! #byte(0x2f) vargc.l #byte(0x50) vec #byte(0x3f) ret #byte(0xa) loadi8 #byte(0x42) tapply #byte(0x4d) loadvoid #byte(0x19) loada1 #byte(0x1) shift #byte(0x2e) atom? #byte(0x18) cdr #byte(0xd) brne.l #byte(0x53) / #byte(0x3a) equal? #byte(0x34) apply #byte(0x36) dup #byte(0xb) loadt #byte(0x14) jmp.l #byte(0x30) = #byte(0x3c) not #byte(0x23) set-cdr! #byte(0x1e) eq? #byte(0x21) * #byte(0x39) load1 #byte(0x1b) bound? #byte(0x2a) function? #byte(0x2c) box.l #byte(0x56) < #byte(0x1c) brnn.l #byte(0x54) jmp #byte(0x10) loadv #byte(0x2) for #byte(0x4c) dummy_eof #byte(0x58) + #byte(0x37) brne #byte(0x13) argc.l #byte(0x4f) compare #byte(0x3d) brn #byte(0x3) neg #byte(0x25) loadv.l #byte(0x43) vargc #byte(0x4a) brbound #byte(0x27) loadc1 #byte(0x16) setg.l #byte(0x48) cons? #byte(0x12) aref #byte(0x55) symbol? #byte(0x22) aset! #byte(0x40) car #byte(0xc) cons #byte(0x20) tcall.l #byte(0x52) - #byte(0x38) brn.l #byte(0x31) optargs #byte(0x57) closure #byte(0xe) vec? #byte(0x2d) pop #byte(0x4) eqv? #byte(0x33) list #byte(0x35) seta #byte(0xf) seta.l #byte(0x49) brnn #byte(0x1a) loadnil #byte(0x41) loadg #byte(0x7) loada #byte(0x8) tcall #byte(0x6))
+ Instructions #table(call.l #byte(0x51) trycatch #byte(0x4b) loadg.l #byte(0x44) aref2 #byte(0x17) box #byte(0x32) cadr #byte(0x24) argc #byte(0x3e) setg #byte(0x47) load0 #byte(0x15) nan? #byte(0x26) fixnum? #byte(0x29) loadc0 #byte(0x11) loada0 #byte(0x0) div0 #byte(0x3b) keyargs #byte(0x1f) call #byte(0x5) loada.l #byte(0x45) num? #byte(0x28) sub2 #byte(0x4e) add2 #byte(0x1d) loadc.l #byte(0x46) loadc #byte(0x9) builtin? #byte(0x2b) set-car! #byte(0x2f) vargc.l #byte(0x50) vec #byte(0x3f) ret #byte(0xa) loadi8 #byte(0x42) tapply #byte(0x4d) loadvoid #byte(0x19) loada1 #byte(0x1) shift #byte(0x2e) atom? #byte(0x18) cdr #byte(0xd) brne.l #byte(0x53) / #byte(0x3a) equal? #byte(0x34) apply #byte(0x36) dup #byte(0xb) loadt #byte(0x14) jmp.l #byte(0x30) = #byte(0x3c) not #byte(0x23) set-cdr! #byte(0x1e) fn? #byte(0x2c) eq? #byte(0x21) * #byte(0x39) load1 #byte(0x1b) bound? #byte(0x2a) box.l #byte(0x56) < #byte(0x1c) brnn.l #byte(0x54) jmp #byte(0x10) loadv #byte(0x2) for #byte(0x4c) dummy_eof #byte(0x58) + #byte(0x37) brne #byte(0x13) argc.l #byte(0x4f) compare #byte(0x3d) brn #byte(0x3) neg #byte(0x25) loadv.l #byte(0x43) vargc #byte(0x4a) brbound #byte(0x27) loadc1 #byte(0x16) setg.l #byte(0x48) cons? #byte(0x12) aref #byte(0x55) symbol? #byte(0x22) aset! #byte(0x40) car #byte(0xc) cons #byte(0x20) tcall.l #byte(0x52) - #byte(0x38) brn.l #byte(0x31) optargs #byte(0x57) closure #byte(0xe) vec? #byte(0x2d) pop #byte(0x4) eqv? #byte(0x33) list #byte(0x35) seta #byte(0xf) seta.l #byte(0x49) brnn #byte(0x1a) loadnil #byte(0x41) loadg #byte(0x7) loada #byte(0x8) tcall #byte(0x6))
__finish #fn("n120210>17262:" #(#fn(for-each) #fn("n10A61:" #()) *exit-hooks*) __finish) __init_globals #fn("n07021d37022@402384w4^147025d;350426;J50427w8429w:4qw;47<w=47>w?47@wA:" #(*os-name*@@ -86,7 +86,7 @@
#fn(exit)) __start)
abs #fn("n10EL23500U:0:" #() abs) add-exit-hook #fn("n1070Pw047160:" #(*exit-hooks* void) add-exit-hook) any #fn("n21B;3D0401<51;J:047001=62:" #(any) any)- arg-counts #table(bound? 1 function? 1 symbol? 1 car 1 cons 2 cadr 1 nan? 1 for 3 fixnum? 1 cdr 1 atom? 1 div0 2 vec? 1 equal? 2 eqv? 2 compare 2 not 1 set-cdr! 2 num? 1 eq? 2 builtin? 1 cons? 1 set-car! 2)
+ arg-counts #table(bound? 1 symbol? 1 car 1 cons 2 cadr 1 nan? 1 for 3 fixnum? 1 cdr 1 atom? 1 div0 2 vec? 1 equal? 2 eqv? 2 compare 2 not 1 set-cdr! 2 num? 1 fn? 1 eq? 2 builtin? 1 cons? 1 set-car! 2)
argc-error #fn("n2702102211Kl237023@402465:" #(error "compile error: " " expects " " argument."" arguments.") argc-error)
arr? #fn("n10];JF042005185B;390485<21Q:" #(#fn(typeof) arr) arr?) assoc@@ -107,7 +107,7 @@
splice-form? lastcdr #fn(map) #fn("n1700A62:" #(bq-bracket1)) #fn(nconc) list* #fn("n20J;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("n120A0q63:" #(#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! #.vec vec #.set-cdr! set-cdr! #.< < #.aref aref #.for for #.cons cons #.apply apply #.eqv? eqv? #.vec? vec? #.list list #.car car #.bound? bound? #.nan? nan? #.function? function? #.symbol? symbol? #.compare compare #.fixnum? fixnum? #.atom? atom? #.= = #.num? num? #.* *)))+ builtin->instruction #fn("n120A0q63:" #(#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! #.vec vec #.set-cdr! set-cdr! #.< < #.aref aref #.for for #.cons cons #.apply apply #.eqv? eqv? #.vec? vec? #.list list #.car car #.bound? bound? #.nan? nan? #.fn? fn? #.symbol? symbol? #.compare compare #.fixnum? fixnum? #.atom? atom? #.= = #.num? num? #.* *))) caaaar #fn("n10<<<<:" #() caaaar) caaadr #fn("n10T<<:" #() caaadr) caaar #fn("n10<<<:" #() caaar) caadar #fn("n10<T<:" #() caadar) caaddr #fn("n10=T<:" #() caaddr) caadr@@ -146,7 +146,7 @@
compile-f- #fn("n270501T711T517215173741T52711518;J7025@408;87H360E@802687518=268:51~73778:528:3\xa208?JL07886298>883808=U@408=54@r07:867;2<7=2<7>8?527?268?5151535152478862@8>268?51883808=U@408=5547A8608:898>55@30q42B8=L23I07886883702C@402D8=53@W0883?078862E8=53@E08:J?078862F8=53@30q47G0897H7I1518952537J868@<52486r4268951r4Mp47K868@D7I15154478862L5247M2N7O86EG517P86518<5386r3G62:" #(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 vargc.l argc.l
- vargc argc extend-env complex-bindings lambda:body box-vars compile-in ret values #fn(function)
+ vargc argc extend-env complex-bindings lambda:body box-vars compile-in ret values #fn(fn)
encode-byte-code const-to-idx-vec) compile-f-)
compile-if #fn("n420502050205083T718351728351B3;0738351@30q8;DC=07401828<64:8;J=07401828=64:7401q8;89554750268953475027885347401828<544823<07502852@;0750298:53475027895347401828=544750278:63:" #(#fn(gensym)caddr cdddr cadddr compile-in emit brn label ret jmp) compile-if)
@@ -193,8 +193,8 @@
delete-duplicates) delete-duplicates)
diff #fn("n20J40q:200<1523:0710=162:0<710=152P:" #(#fn(memq) diff) diff) disassemble #fn("\x871000.///W1000J60q?14z282JG07001E534715047260:@30q482<2305124051II252687>1?:5142527187>2?;514E288851b<I8<<8=L23\x8a24292:888<>2q7;53E8<<L23907150@30q4E87K~2<|48<8<<KM_48>2=8?2>523[08;8>8<<r45348:897?888<<52G5148<8<<r4M_@\x1912=8?2@523V08;8>8<<K5348:89888<<GG5148<8<<KM_@\xea12=8?2A523e08;8>8<<K5347B2C888<<G8>2DC70r3@30EM515148<8<<KM_@\xac12=8?2E523\\08;8>8<<r45347B2C7?888<<52515148<8<<r4M_@w12=8?2F523\xb808;8>8<<r88>2GC70r4@30EM5347B2C7?888<<52512H5248<8<<r4M_47B2C7?888<<52515148<8<<r4M_48>2GCY07B2H5147B2C7?888<<52512H5248<8<<r4M_@30q@\xe608?2Ic3^08;8>8<<r45347B2C7?888<<52512H5248<8<<r4M_@\xb202=8?2J523b08;8>8<<r25347B2K7L8<<7M888<<52M515248<8<<r2M_@w02=8?2N523b08;8>8<<r45347B2K7L8<<7?888<<52M515248<8<<r4M_@<08;8>8<<E53^1^1@\xd0-:" #(disassemble- newline void #fn(function:code) #fn(function:vals)
- #1=#fn("z0I:" #() void) #fn("n10\\3F00[JA070504710qAKM63:72061:" #(newline disassemble print) print-val)+ newline void #fn(fn-code) #fn(fn-vals) #1=#fn("z0I:" #() void)+ #fn("n10\\3F00[JA070504710qAKM63:72061:" #(newline disassemble print) print-val) #fn("n370A3U0FEl23N071A72151523A0A182ML237023@4024751K~512602765:" #(princ >= 1- " >" " " hex5": " " ") print-inst)
#fn(length) #fn(table-foldl) #fn("n382;J@041AF<Gl2;34040:" #()) Instructions #fn("n1702161:" #(princ@@ -339,12 +339,11 @@
length= princ "type error: expected " ", got " #fn(typeof) caddr ": " print bounds-error "index "
" out of bounds for " unbound-error "eval: variable " " has no value" error "error: " load-error
print-exception "in file " list? #fn(str?) "*** Unhandled exception: " *linefeed*) print-exception)
- print-stack-trace #fn("n1IIb5b620852185>1_51420862285>1_51473740r3523F075076370r5@40r452@300517778292:2;505252Eb92<2=868889>38762:" #(#0#- #fn("n32005182P2105121151C?022232487e361:25051E76278851512888A187>4|:" #(#fn(function:name)- #fn(function:code)
+ print-stack-trace #fn("n1IIb5b62085218685>2_51420862285>1_51473740r3523F075076370r5@40r452@300517778292:2;505252Eb92<2=868889>38762:" #(#0#+ #fn("n3A<05182P2005120151C?021222387e361:24051E75268851512788F187>4|:" #(#fn(fn-code)#fn(raise) thrown-value
- ffound #fn(function:vals)
- 1- #fn(length)
+ ffound #fn(fn-vals) 1-
+ #fn(length)
#fn("n170A0G513>0F<A0G929363:q:" #(closure?))) find-in-f) #fn("n220A01>321{863E0722374758651522662:27:" #(#fn("n02021AF>292524q:" #(#fn(for-each) #fn("n1A<0Fq63:" #())))@@ -433,11 +432,11 @@
print-stack-trace #fn(stacktrace))) #fn("n1A50420061:" #(#fn(raise)))) top-level-exception-handler) trace #fn("n120051718551Jc02207324252627280e225e3e229e12:2885e225e3e55152@30q^147;60:" #(#fn(top-level-value)traced? #fn(set-top-level-value!) eval λ #:g350 write cons quote newline apply void) trace)
- traced? #fn("n170051;3>042105121A51d:" #(closure? #fn(function:code)) #(#fn("z020210P51472504230}2:" #(#fn(write)+ traced? #fn("n170051;3>042105121A51d:" #(closure? #fn(fn-code)) #(#fn("z020210P51472504230}2:" #(#fn(write)x newline #.apply))))
untrace #fn("n1200517185513C0220238551r3G52@30q^147460:" #(#fn(top-level-value) traced?#fn(set-top-level-value!)
- #fn(function:vals) void) untrace)
+ #fn(fn-vals) void) untrace)
value-get-doc #fn("n10<0=208551;3=0486B;350485:" #(#fn(str?)) value-get-doc) values #fn("z00B3:00=J500<:A0P:" #() #(#3#)) vars-to-env #fn("n32021182>2072230515163:" #(#fn(map) #fn("n2700210A52SS1FM63:" #(vinfo #fn(memq))) iota #fn(length)) vars-to-env)--- a/src/compiler.lsp
+++ b/src/compiler.lsp
@@ -356,7 +356,7 @@
aset! 'aset! - '- not 'not
apply 'apply atom? 'atom? nan? 'nan?
set-cdr! 'set-cdr! / '/
- function? 'function? vec 'vec
+ fn? 'fn? vec 'vec
list 'list bound? 'bound?
< '< * '* cdr 'cdr cadr 'cadr
+ '+ eqv? 'eqv? compare 'compare aref 'aref
@@ -732,8 +732,9 @@
;; compile body and return
(compile-in g newenv t (lambda:body f))
(emit g 'ret)
- (values (function (encode-byte-code (bcode:code g))
- (const-to-idx-vec g) name)
+ (values (fn (encode-byte-code (bcode:code g))
+ (const-to-idx-vec g)
+ name)
(bcode:cenv g))))))
;; disassembler
@@ -757,10 +758,10 @@
(newline)
(return (void)))
(let ((lev (car lev?))
- (code (function:code f))
- (vals (function:vals f)))
+ (code (fn-code f))
+ (vals (fn-vals f)))
(def (print-val v)
- (if (and (function? v) (not (builtin? v)))
+ (if (and (fn? v) (not (builtin? v)))
(begin (newline)
(disassemble v nil (+ lev 1)))
(print v)))
--- a/src/cvalues.c
+++ b/src/cvalues.c
@@ -568,7 +568,7 @@
case TAG_NUM1: case TAG_NUM: return sl_fixnumsym;
case TAG_SYM: return sl_symbolsym;
case TAG_VEC: return sl_vecsym;
- case TAG_FUNCTION:
+ case TAG_FN:
if(args[0] == sl_t)
return sl_booleansym;
if(args[0] == sl_nil)
@@ -579,7 +579,7 @@
return sl_void;
if(isbuiltin(args[0]))
return sl_builtinsym;
- return sl_function;
+ return sl_fnsym;
}
return cv_type(ptr(args[0]));
}
--- a/src/equal.c
+++ b/src/equal.c
@@ -127,8 +127,8 @@
return fixnum(1);
}
break;
- case TAG_FUNCTION:
- if(tagb == TAG_FUNCTION){+ case TAG_FN:
+ if(tagb == TAG_FN){ if(uintval(a) > N_BUILTINS && uintval(b) > N_BUILTINS){sl_fn *fa = ptr(a);
sl_fn *fb = ptr(b);
@@ -194,7 +194,7 @@
for(i = 0; i < m; i++){xa = vec_elt(a, i);
xb = vec_elt(b, i);
- if(!leafp(xa) || tag(xa) == TAG_FUNCTION){+ if(!leafp(xa) || tag(xa) == TAG_FN){d = cyc_compare(xa, xb, table, eq);
if(numval(d) != 0)
return d;
@@ -262,7 +262,7 @@
}
if(isvec(a) && isvec(b))
return cyc_vec_compare(a, b, table, eq);
- if(isfunction(a) && isfunction(b)){+ if(isfn(a) && isfn(b)){sl_fn *fa = ptr(a);
sl_fn *fb = ptr(b);
d = bounded_compare(fa->bcode, fb->bcode, 1, eq);
@@ -336,7 +336,7 @@
case TAG_NUM1:
u.d = (double)numval(a);
return doublehash(u.i64);
- case TAG_FUNCTION:
+ case TAG_FN:
if(uintval(a) > N_BUILTINS)
return bounded_hash(((sl_fn*)ptr(a))->bcode, bound, oob);
return inthash(a);
--- a/src/opcodes.c
+++ b/src/opcodes.c
@@ -5,7 +5,7 @@
[OP_SETCAR] = {"set-car!", 2}, [OP_VECP] = {"vec?", 1}, [OP_CDR] = {"cdr", 1},- [OP_FUNCTIONP] = {"function?", 1},+ [OP_FNP] = {"fn?", 1}, [OP_CADR] = {"cadr", 1}, [OP_SETCDR] = {"set-cdr!", 2}, [OP_EQ] = {"eq?", 2},--- a/src/opcodes.h
+++ b/src/opcodes.h
@@ -43,7 +43,7 @@
OP_FIXNUMP,
OP_BOUNDP,
OP_BUILTINP,
- OP_FUNCTIONP,
+ OP_FNP,
OP_VECP,
OP_SHIFT,
OP_SETCAR,
--- a/src/print.c
+++ b/src/print.c
@@ -103,7 +103,7 @@
print_traverse(vec_elt(v, i));
}else if(iscprim(v)){// don't consider shared references to e.g. chars
- }else if(isfunction(v)){+ }else if(isfn(v)){mark_cons(v);
sl_fn *f = ptr(v);
print_traverse(f->bcode);
@@ -409,7 +409,7 @@
sl_print_child(sl_ios *f, sl_v v)
{const char *name;
- if(sl.print_level >= 0 && sl.p_level >= sl.print_level && (iscons(v) || isvec(v) || isfunction(v))){+ if(sl.print_level >= 0 && sl.p_level >= sl.print_level && (iscons(v) || isvec(v) || isfn(v))){outc(f, '#');
return;
}
@@ -433,7 +433,7 @@
}else
print_symbol_name(f, name);
break;
- case TAG_FUNCTION:
+ case TAG_FN:
if(v == sl_t)
outc(f, 'T');
else if(v == sl_nil)
@@ -447,7 +447,7 @@
outsn(f, "#.", 2);
outs(f, builtins[uintval(v)].name);
}else{- assert(isfunction(v));
+ assert(isfn(v));
if(!sl.print_princ){if(print_circle_prefix(f, v))
break;
@@ -472,7 +472,7 @@
}
outc(f, ')');
}else{- outs(f, "#<function>");
+ outs(f, "#<fn>");
}
}
break;
@@ -904,7 +904,7 @@
if(sl.print_level >= 0 || sl.print_length >= 0)
memset(sl.consflags, 0, 4*bitvector_nwords(slg.heapsize/sizeof(sl_cons)));
- if((iscons(v) || isvec(v) || isfunction(v) || iscvalue(v)) &&
+ if((iscons(v) || isvec(v) || isfn(v) || iscvalue(v)) &&
!sl_isstr(v) && v != sl_t && v != sl_nil && v != sl_void)
htable_reset(&sl.printconses, 32);
}
--- a/src/read.c
+++ b/src/read.c
@@ -666,8 +666,6 @@
if(sym == sl_vu8sym){sym = sl_arrsym;
sl.sp[-1] = mk_cons(sl_u8sym, sl.sp[-1]);
- }else if(sym == sl_fnsym){- sym = sl_function;
}
v = symbol_value(sym);
if(v == UNBOUND)
--- a/src/sl.c
+++ b/src/sl.c
@@ -11,7 +11,7 @@
#include "io.h"
#include "compress.h"
-sl_v sl_builtinssym, sl_quote, sl_lambda, sl_function, sl_comma, sl_commaat;
+sl_v sl_builtinssym, sl_quote, sl_lambda, sl_comma, sl_commaat;
sl_v sl_commadot, sl_trycatch, sl_backquote;
sl_v sl_conssym, sl_symbolsym, sl_fixnumsym, sl_vecsym, sl_builtinsym, sl_vu8sym;
sl_v sl_defsym, sl_defmacrosym, sl_forsym, sl_setqsym;
@@ -52,7 +52,7 @@
isbuiltin(sl_v x)
{int i;
- return tag(x) == TAG_FUNCTION && (i = uintval(x)) < nelem(builtins) && builtins[i].name != nil;
+ return tag(x) == TAG_FN && (i = uintval(x)) < nelem(builtins) && builtins[i].name != nil;
}
static sl_v apply_cl(int nargs) sl_hotfn;
@@ -421,12 +421,12 @@
}
return nc;
}
- if(t == TAG_FUNCTION){+ if(t == TAG_FN){sl_fn *fn = ptr(v);
sl_fn *nfn = alloc_words(sizeof(sl_fn)/sizeof(sl_v));
nfn->vals = fn->vals;
nfn->bcode = fn->bcode;
- nc = tagptr(nfn, TAG_FUNCTION);
+ nc = tagptr(nfn, TAG_FN);
forward(v, nc);
nfn->vals = sl_relocate(nfn->vals);
nfn->bcode = sl_relocate(nfn->bcode);
@@ -573,7 +573,7 @@
sl_v v;
if(iscbuiltin(f))
v = ((csl_v*)ptr(f))->cbuiltin(saveSP-n, n);
- else if(isfunction(f))
+ else if(isfn(f))
v = apply_cl(n);
else if(sl_likely(isbuiltin(f))){sl_v tab = symbol_value(sl_builtinssym);
@@ -582,7 +582,7 @@
saveSP[-n-1] = vec_elt(tab, uintval(f));
v = apply_cl(n);
}else{- type_error("function", f);+ type_error("fn", f);}
sl.sp = saveSP;
return v;
@@ -840,7 +840,7 @@
#endif
/*
- stack on entry: <func> <nargs args...>
+ stack on entry: <fn> <nargs args...>
caller's responsibility:
- put the stack in this state
- provide arg count
@@ -908,12 +908,12 @@
const u8int *ip1 = (void*)top[-1];
int sz = top[-2]+1;
sl_v *bp = top-4-sz;
- sl_v func = bp[0];
- const u8int *ip0 = cvalue_data(fn_bcode(func));
+ sl_v fn = bp[0];
+ const u8int *ip0 = cvalue_data(fn_bcode(fn));
intptr ip = ip1 - ip0 - 1; /* -1: ip1 is *after* the one that was being executed */
sl_v v = alloc_vec(sz+1, 0);
vec_elt(v, 0) = fixnum(ip);
- vec_elt(v, 1) = func;
+ vec_elt(v, 1) = fn;
for(int i = 1; i < sz; i++){sl_v si = bp[i];
// if there's an error evaluating argument defaults some slots
@@ -937,7 +937,7 @@
return sl_void;
}
-BUILTIN("function", function)+BUILTIN("fn", fn) {if(nargs == 1 && issymbol(args[0]))
return fn_builtin_builtin(args, nargs);
@@ -957,7 +957,7 @@
data[i] -= 48;
}
sl_fn *fn = alloc_words(sizeof(sl_fn)/sizeof(sl_v));
- sl_v fv = tagptr(fn, TAG_FUNCTION);
+ sl_v fv = tagptr(fn, TAG_FN);
fn->bcode = args[0];
fn->vals = args[1];
fn->env = sl_nil;
@@ -982,40 +982,40 @@
}
sl_purefn
-BUILTIN("function:code", function_code)+BUILTIN("fn-code", fn_code) {argcount(nargs, 1);
sl_v v = args[0];
- if(sl_unlikely(!isfunction(v)))
- type_error("function", v);+ if(sl_unlikely(!isfn(v)))
+ type_error("fn", v);return fn_bcode(v);
}
sl_purefn
-BUILTIN("function:vals", function_vals)+BUILTIN("fn-vals", fn_vals) {argcount(nargs, 1);
sl_v v = args[0];
- if(sl_unlikely(!isfunction(v)))
- type_error("function", v);+ if(sl_unlikely(!isfn(v)))
+ type_error("fn", v);return fn_vals(v);
}
sl_purefn
-BUILTIN("function:env", function_env)+BUILTIN("fn-env", fn_env) {argcount(nargs, 1);
sl_v v = args[0];
- if(sl_unlikely(!isfunction(v)))
- type_error("function", v);+ if(sl_unlikely(!isfn(v)))
+ type_error("fn", v);return fn_env(v);
}
-BUILTIN("function:name", function_name)+BUILTIN("fn-name", fn_name) {argcount(nargs, 1);
sl_v v = args[0];
- if(isfunction(v))
+ if(isfn(v))
return fn_name(v);
if(isbuiltin(v))
return symbol(builtins[uintval(v)].name, false);
@@ -1025,7 +1025,7 @@
return sl_nil;
return v;
}
- type_error("function", v);+ type_error("fn", v);}
BUILTIN("copy-list", copy_list)@@ -1240,7 +1240,6 @@
comparehash_init();
sl_lambda = csymbol("λ");- sl_function = csymbol("function"); sl_quote = csymbol("quote"); sl_trycatch = csymbol("trycatch"); sl_backquote = csymbol("quasiquote");@@ -1297,7 +1296,7 @@
if(builtins[i].name)
set(symbol(builtins[i].name, false), builtin(i));
}
- setc(csymbol("procedure?"), builtin(OP_FUNCTIONP));+ setc(csymbol("procedure?"), builtin(OP_FNP)); setc(csymbol("top-level-bound?"), builtin(OP_BOUNDP));sl_emptyvec = tagptr(alloc_words(1), TAG_VEC);
@@ -1341,7 +1340,7 @@
sl_v e = sl_read_sexpr(sl.sp[-1]);
if(ios_eof(value2c(sl_ios*, sl.sp[-1])))
break;
- if(isfunction(e)){+ if(isfn(e)){// stage 0 format: series of thunks
PUSH(e);
(void)_applyn(0);
--- a/src/sl.h
+++ b/src/sl.h
@@ -13,7 +13,7 @@
enum {TAG_NUM,
TAG_CPRIM,
- TAG_FUNCTION,
+ TAG_FN,
TAG_VEC,
TAG_NUM1,
TAG_CVALUE,
@@ -105,7 +105,7 @@
#define fixnum(x) ((sl_v)(x)<<2)
#define numval(x) ((sl_fx)(x)>>2)
#define uintval(x) (((unsigned int)(x))>>3)
-#define builtin(n) tagptr(((sl_v)n<<3), TAG_FUNCTION)
+#define builtin(n) tagptr(((sl_v)n<<3), TAG_FN)
#define iscons(x) (tag(x) == TAG_CONS)
#define issymbol(x) (tag(x) == TAG_SYM)
#define isfixnum(x) (((x)&3) == TAG_NUM)
@@ -156,7 +156,7 @@
#define sym_to_numtype(s) (((sl_sym*)ptr(s))->numtype)
#define ismanaged(v) ((((u8int*)ptr(v)) >= slg.fromspace) && (((u8int*)ptr(v)) < slg.fromspace+slg.heapsize))
#define isgensym(x) (issymbol(x) && ismanaged(x))
-#define isfunction(x) (tag(x) == TAG_FUNCTION && (x) > (N_BUILTINS<<3))
+#define isfn(x) (tag(x) == TAG_FN && (x) > (N_BUILTINS<<3))
#define iscbuiltin(x) (iscvalue(x) && cv_class(ptr(x)) == sl_builtintype)
// utility for iterating over all arguments in a builtin
// i=index, i0=start index, arg = var for each arg, args = arg array
@@ -411,7 +411,7 @@
extern Slg slg;
-extern sl_v sl_builtinssym, sl_quote, sl_lambda, sl_function, sl_comma, sl_commaat;
+extern sl_v sl_builtinssym, sl_quote, sl_lambda, sl_comma, sl_commaat;
extern sl_v sl_commadot, sl_trycatch, sl_backquote;
extern sl_v sl_conssym, sl_symbolsym, sl_fixnumsym, sl_vecsym, sl_builtinsym, sl_vu8sym;
extern sl_v sl_defsym, sl_defmacrosym, sl_forsym, sl_setqsym;
--- a/src/system.lsp
+++ b/src/system.lsp
@@ -275,7 +275,7 @@
(and (cons? tx) (eq? (car tx) 'arr)))))
(def (closure? x)
- (and (function? x)
+ (and (fn? x)
(not (builtin? x))))
(def (caar x) (car (car x)))
@@ -698,8 +698,8 @@
(apply #.apply args))))
(λ (f)
(and (closure? f)
- (equal? (function:code f)
- (function:code sample-traced-lambda))))))
+ (equal? (fn-code f)
+ (fn-code sample-traced-lambda))))))
(def (trace sym)
(let ((func (top-level-value sym)))
@@ -716,7 +716,7 @@
(let ((func (top-level-value sym)))
(when (traced? func)
(set-top-level-value! sym
- (aref (function:vals func) 3))))
+ (aref (fn-vals func) 3))))
(void))
(defmacro (time expr)
@@ -1166,10 +1166,10 @@
(def (print-stack-trace st)
(def (find-in-f f tgt path)
- (let ((path (cons (function:name f) path)))
- (if (eq? (function:code f) (function:code tgt))
+ (let ((path (cons (fn-name f) path)))
+ (if (eq? (fn-code f) (fn-code tgt))
(throw 'ffound path)
- (let ((v (function:vals f)))
+ (let ((v (fn-vals f)))
(for 0 (1- (length v))
(λ (i) (when (closure? (aref v i))
(find-in-f (aref v i) tgt path))))))))
--- a/src/vm.h
+++ b/src/vm.h
@@ -29,7 +29,7 @@
LABEL(do_call):
*ipd = (uintptr)ip;
sl_v v = sp[-n-1];
- if(tag(v) == TAG_FUNCTION){+ if(tag(v) == TAG_FN){ if(v > (N_BUILTINS<<3)){nargs = n;
if(tail){@@ -92,7 +92,7 @@
NEXT_OP;
}
sl.sp = sp;
- type_error("function", v);+ type_error("fn", v);}
OP(OP_ARGC) {@@ -283,8 +283,8 @@
#endif
sl_fn *f = (sl_fn*)pv;
sl_v e = sp[-1]; // closure to copy
- sp[-1] = tagptr(f, TAG_FUNCTION);
- assert(isfunction(e));
+ sp[-1] = tagptr(f, TAG_FN);
+ assert(isfn(e));
f->vals = fn_vals(e);
f->bcode = fn_bcode(e);
f->env = sp[0];
@@ -952,10 +952,10 @@
NEXT_OP;
}
-OP(OP_FUNCTIONP) {+OP(OP_FNP) {sl_v v = sp[-1];
sp[-1] =
- ((tag(v) == TAG_FUNCTION &&
+ ((tag(v) == TAG_FN &&
(isbuiltin(v) || v>(N_BUILTINS<<3))) ||
iscbuiltin(v)) ? sl_t : sl_nil;
NEXT_OP;
--- a/tools/disenv.lsp
+++ b/tools/disenv.lsp
@@ -1,7 +1,7 @@
#!/usr/bin/env sl
(for-each (lambda (e)
(let ((v (top-level-value e)))
- (when (and (function? v)
+ (when (and (fn? v)
(not (builtin? v)))
(print e)
(newline)
--- a/tools/gen.lsp
+++ b/tools/gen.lsp
@@ -1,3 +1,4 @@
+
(def opcodes '(
; C opcode, lisp compiler opcode, arg count, builtin lambda, DOC (NEW)
OP_LOADA0 loada0 nil nil nil
@@ -47,7 +48,7 @@
OP_FIXNUMP fixnum? 1 (λ (x) (fixnum? x)) nil
OP_BOUNDP bound? 1 (λ (x) (bound? x)) nil
OP_BUILTINP builtin? 1 (λ (x) (builtin? x)) nil
- OP_FUNCTIONP function? 1 (λ (x) (function? x)) nil
+ OP_FNP fn? 1 (λ (x) (fn? x)) nil
OP_VECP vec? 1 (λ (x) (vec? x)) nil
OP_SHIFT shift nil nil nil
OP_SETCAR set-car! 2 (λ (x y) (set-car! x y)) nil