conservatory
/
femtolisp
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

simplifying the whole list* situation, taking better advantage of 

existing builtin functionality
This commit is contained in:
JeffBezanson 2009-05-31 18:58:09 +00:00
parent 7e65db3e74
commit ba32e4b0e9
3 changed files with 25 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
femtolisp/flisp.boot
View File

@ -82,8 +82,6 @@ nreverse
#function("n1c0_q42;" [#function("r^g00F6Q02g00Ng00f0g00j02P2k005202f0;" [])]) #function("n1c0_q42;" [#function("r^g00F6Q02g00Ng00f0g00j02P2k005202f0;" [])])
nreconc nreconc
#function("n2e0e1f031f142;" [nconc nreverse]) #function("n2e0e1f031f142;" [nconc nreverse])
nlist*
#function("o0e0f041;" [apply-nlist*])
newline newline
#function("n0e0e1312];" [princ *linefeed*]) #function("n0e0e1312];" [princ *linefeed*])
nestlist nestlist
@ -119,7 +117,7 @@ make-code-emitter
macroexpand-1 macroexpand-1
#function("n1f0?6;0f0;c0e1f031q42;" [#function("rf06?0f0g00Nt2;g00;" []) macrocall?]) #function("n1f0?6;0f0;c0e1f031q42;" [#function("rf06?0f0g00Nt2;g00;" []) macrocall?])
macroexpand macroexpand
#function("n1c0^^q43;" [#function("rc0mj02c1mj12f1g00_42;" [#function("n2c0e1f031F6]0e2f031F6T0c3e1f031K5Z0e4f0315^0^q42;" [#function("rc0e1f031g11f0g0132q43;" [#function("re0c1e2g1031f0A6G0f15Y0c1f0f1L3e3c4mf032Ke5g103144;" [nlist* lambda cadr map #function("n1^;" []) lastcdr]) get-defined-vars]) cddr cdddr begin caddr]) #function("n2f0?6;0f0;c0e1f0Mf132q42;" [#function("rf06N0g11e0f031g00NQ2e1f03142;c2e3g0031q42;" [cadr caddr #function("rf06G0g21f0g10NQ2g1142;g10Mc0<6U0g10;g10Mc1<6k0g20g10g1142;g10Mc2<6\x9a0c3e4g1031e5c1L1_L1e6e7g10313133L1q43;e8c9mg1042;" [quote lambda let-syntax #function("rg31f1e0e1c2mf032g213242;" [nconc map #function("n1f0Mg41e0f031g3132g31L3;" [cadr])]) cadr nconc copy-list cddr map #function("n1g31f0g2142;" [])]) macrocall?]) assq])])]) #function("n1c0^^q43;" [#function("rc0mj02c1mj12f1g00_42;" [#function("n2c0e1f031F6]0e2f031F6T0c3e1f031K5Z0e4f0315^0^q42;" [#function("rc0e1f031g11f0g0132q43;" [#function("re0c1e2g1031f0A6G0f15Y0c1f0f1L3e3c4mf032Ke5g103144;" [list* lambda cadr map #function("n1^;" []) lastcdr]) get-defined-vars]) cddr cdddr begin caddr]) #function("n2f0?6;0f0;c0e1f0Mf132q42;" [#function("rf06N0g11e0f031g00NQ2e1f03142;c2e3g0031q42;" [cadr caddr #function("rf06G0g21f0g10NQ2g1142;g10Mc0<6U0g10;g10Mc1<6k0g20g10g1142;g10Mc2<6\x9a0c3e4g1031e5c1L1_L1e6e7g10313133L1q43;e8c9mg1042;" [quote lambda let-syntax #function("rg31f1e0e1c2mf032g213242;" [nconc map #function("n1f0Mg41e0f031g3132g31L3;" [cadr])]) cadr nconc copy-list cddr map #function("n1g31f0g2142;" [])]) macrocall?]) assq])])])
macrocall? macrocall?
#function("n1f0MC16E02e0e1f0M^43;" [get *syntax-environment*]) #function("n1f0MC16E02e0e1f0M^43;" [get *syntax-environment*])
lookup-sym lookup-sym
@ -140,8 +138,6 @@ list-head
#function("n2e0f1`326>0_;f0Me1f0Nf1av32K;" [<= list-head]) #function("n2e0f1`326>0_;f0Me1f0Nf1av32K;" [<= list-head])
list->vector list->vector
#function("n1e0f0t2;" [vector]) #function("n1e0f0t2;" [vector])
list*
#function("o0e0e1f03141;" [apply-nlist* copy-list])
length> length>
#function("n2f1`X6<0f0;f1`W6N0f0F16M02f0;f0A6Y0f1`X;e0f0Nf1av42;" [length>]) #function("n2f1`X6<0f0;f1`W6N0f0F16M02f0;f0A6Y0f1`X;e0f0Nf1av42;" [length>])
length= length=
@ -269,7 +265,7 @@ caaar
builtin->instruction builtin->instruction
#function("n1c0e1e2c3f03231q42;" [#function("re0e1f03216@02f0;" [has? Instructions]) intern string #\:]) #function("n1c0e1e2c3f03231q42;" [#function("re0e1f03216@02f0;" [has? Instructions]) intern string #\:])
bq-process bq-process
#function("n1c0^q42;" [#function("rc0mj02e1g00316]0g00H6Y0c2e3e4g003131q42;g00;g00?6l0c5g00L2;g00Mc6<6\x860e3e3e7g00313141;g00Mc8<6\x980e7g0041;e9f0g0032@6\xbb0c:e;g0031e<e=g0032q43;c>g00_q43;" [#function("n1f0F16K02f0Mc0<17K02f0Mc1<17U02f0c2<;" [*comma-at* *comma-dot* *comma*]) self-evaluating? #function("rf0Mc0<6A0e1f0NK;e2e1f0L3;" [list vector apply]) bq-process vector->list quote backquote cadr *comma* any #function("rf0A6=0c0f1K;e1c2f1Ke3f031L142;" [list nconc nlist* bq-process]) lastcdr map bq-bracket1 #function("r^f0F16A02f0Mc0<@6Z02e1f0M31f1Kj12f0Nj05202c2f0F6t0e3f1e4f031L1325\x910f0A6\x830e5f1315\x910e3f1e6f031L132q42;" [*comma* bq-bracket #function("rf0NA6<0f0M;c0f0K;" [nconc]) nreconc cadr nreverse bq-process])])]) #function("n1c0^q42;" [#function("rc0mj02e1g00316]0g00H6Y0c2e3e4g003131q42;g00;g00?6l0c5g00L2;g00Mc6<6\x860e3e3e7g00313141;g00Mc8<6\x980e7g0041;e9f0g0032@6\xbb0c:e;g0031e<e=g0032q43;c>g00_q43;" [#function("n1f0F16K02f0Mc0<17K02f0Mc1<17U02f0c2<;" [*comma-at* *comma-dot* *comma*]) self-evaluating? #function("rf0Mc0<6A0e1f0NK;e2e1f0L3;" [list vector apply]) bq-process vector->list quote backquote cadr *comma* any #function("rf0A6=0c0f1K;e1c2f1Ke3f031L142;" [list nconc list* bq-process]) lastcdr map bq-bracket1 #function("r^f0F16A02f0Mc0<@6Z02e1f0M31f1Kj12f0Nj05202c2f0F6t0e3f1e4f031L1325\x910f0A6\x830e5f1315\x910e3f1e6f031L132q42;" [*comma* bq-bracket #function("rf0NA6<0f0M;c0f0K;" [nconc]) nreconc cadr nreverse bq-process])])])
bq-bracket1 bq-bracket1
#function("n1f0F16@02f0Mc0<6J0e1f041;e2f041;" [*comma* cadr bq-process]) #function("n1f0F16@02f0Mc0<6J0e1f041;e2f041;" [*comma* cadr bq-process])
bq-bracket bq-bracket

30
femtolisp/flisp.c
View File

@ -680,7 +680,9 @@ int isnumber(value_t v)
// eval ----------------------------------------------------------------------- // eval -----------------------------------------------------------------------
static value_t list(value_t *args, uint32_t nargs) #define list(a,n) _list((a),(n),0)
static value_t _list(value_t *args, uint32_t nargs, int star)
{ {
cons_t *c; cons_t *c;
uint32_t i; uint32_t i;
@ -692,13 +694,15 @@ static value_t list(value_t *args, uint32_t nargs)
c->cdr = tagptr(c+1, TAG_CONS); c->cdr = tagptr(c+1, TAG_CONS);
c++; c++;
} }
if (nargs > MAX_ARGS) if (star || nargs > MAX_ARGS)
(c-2)->cdr = (c-1)->car; (c-2)->cdr = (c-1)->car;
else else
(c-1)->cdr = NIL; (c-1)->cdr = NIL;
return v; return v;
} }
#define FL_COPYLIST(l) apply_liststar((l),0)
// perform (apply list* L) // perform (apply list* L)
// like the function list() above, but takes arguments from a list // like the function list() above, but takes arguments from a list
// rather than from an array (the stack) // rather than from an array (the stack)
@ -736,22 +740,18 @@ static value_t apply_liststar(value_t L, int star)
value_t fl_copylist(value_t *args, u_int32_t nargs) value_t fl_copylist(value_t *args, u_int32_t nargs)
{ {
argcount("copy-list", nargs, 1); argcount("copy-list", nargs, 1);
return apply_liststar(args[0], 0); return FL_COPYLIST(args[0]);
} }
value_t fl_apply_nliststar(value_t *args, u_int32_t nargs) value_t fl_liststar(value_t *args, u_int32_t nargs)
{ {
argcount("apply-nlist*", nargs, 1); if (nargs == 1) return args[0];
value_t v = args[0]; else if (nargs == 0) argcount("list*", nargs, 1);
value_t *plastcdr = &args[0]; if (nargs > MAX_ARGS) {
while (iscons(v)) { args[MAX_ARGS] = apply_liststar(args[MAX_ARGS], 1);
if (!iscons(cdr_(v))) return list(args, nargs);
*plastcdr = car_(v);
else
plastcdr = &cdr_(v);
v = cdr_(v);
} }
return args[0]; return _list(args, nargs, 1);
} }
static value_t do_trycatch() static value_t do_trycatch()
@ -1501,7 +1501,7 @@ static builtinspec_t core_builtin_info[] = {
{ "gensym", fl_gensym }, { "gensym", fl_gensym },
{ "hash", fl_hash }, { "hash", fl_hash },
{ "copy-list", fl_copylist }, { "copy-list", fl_copylist },
{ "apply-nlist*", fl_apply_nliststar }, { "list*", fl_liststar },
{ NULL, NULL } { NULL, NULL }
}; };

20
femtolisp/system.lsp
View File

@ -177,10 +177,6 @@
((null? lst) (= n 0)) ((null? lst) (= n 0))
(else (length= (cdr lst) (- n 1))))) (else (length= (cdr lst) (- n 1)))))
(define (list* . l) (apply-nlist* (copy-list l)))
(define (nlist* . l) (apply-nlist* l))
(define (lastcdr l) (define (lastcdr l)
(if (atom? l) l (if (atom? l) l
(lastcdr (cdr l)))) (lastcdr (cdr l))))
@ -301,7 +297,7 @@
(forms (map bq-bracket1 x))) (forms (map bq-bracket1 x)))
(if (null? lc) (if (null? lc)
(cons 'list forms) (cons 'list forms)
(nconc (cons 'nlist* forms) (list (bq-process lc)))))) (nconc (cons 'list* forms) (list (bq-process lc))))))
(#t (let ((p x) (q ())) (#t (let ((p x) (q ()))
(while (and (pair? p) (while (and (pair? p)
(not (eq (car p) '*comma*))) (not (eq (car p) '*comma*)))
@ -613,13 +609,13 @@
#f))) #f)))
(let ((V (get-defined-vars B)) (let ((V (get-defined-vars B))
(Be (macroexpand-in B env))) (Be (macroexpand-in B env)))
(nlist* 'lambda (list* 'lambda
(cadr e) (cadr e)
(if (null? V) (if (null? V)
Be Be
(cons (list 'lambda V Be) (cons (list 'lambda V Be)
(map (lambda (x) #f) V))) (map (lambda (x) #f) V)))
(lastcdr e))))) (lastcdr e)))))
(define (macroexpand-in e env) (define (macroexpand-in e env)
(if (atom? e) e (if (atom? e) e
(let ((f (assq (car e) env))) (let ((f (assq (car e) env)))