allowing multiple expressions in lambda

making cond a macro
increasing size limit for cvalues on the managed heap, and inline
  allocated hashtables

femtolisp/compiler.lsp

@@ -180,19 +180,6 @@
       (closed  (emit g (aref Is 1) (cadr loc) (caddr loc)))
       (else    (emit g (aref Is 2) s)))))
 
-(define (cond->if form)
-  (cond-clauses->if (cdr form)))
-(define (cond-clauses->if lst)
-  (if (atom? lst)
-      #f
-      (let ((clause (car lst)))
-	(if (or (eq? (car clause) 'else)
-		(eq? (car clause) #t))
-	    (cons 'begin (cdr clause))
-	    `(if ,(car clause)
-		 ,(cons 'begin (cdr clause))
-		 ,(cond-clauses->if (cdr lst)))))))
-
 (define (compile-if g env tail? x)
   (let ((elsel (make-label g))
 	(endl  (make-label g)))
@@ -393,7 +380,6 @@
 	(else
 	 (case (car x)
 	   (quote    (emit g :loadv (cadr x)))
-	   (cond     (compile-in g env tail? (cond->if x)))
 	   (if       (compile-if g env tail? x))
 	   (begin    (compile-begin g env tail? (cdr x)))
 	   (prog1    (compile-prog1 g env x))

femtolisp/cps.lsp

@@ -4,16 +4,6 @@
 	((null? (cdr e)) (car e))
 	(#t              (cons 'begin e))))
 
-(define (cond->if form)
-  (cond-clauses->if (cdr form)))
-(define (cond-clauses->if lst)
-  (if (atom? lst)
-      #f
-    (let ((clause (car lst)))
-      `(if ,(car clause)
-           ,(cond-body (cdr clause))
-         ,(cond-clauses->if (cdr lst))))))
-
 (define (begin->cps forms k)
   (cond ((atom? forms)       `(,k ,forms))
         ((null? (cdr forms))  (cps- (car forms) k))
@@ -94,9 +84,6 @@
           ((eq (car form) 'begin)
            (begin->cps (cdr form) k))
 
-          ((eq (car form) 'cond)
-           (cps- (cond->if form) k))
-
           ((eq (car form) 'if)
            (let ((test (cadr form))
                  (then (caddr form))
@@ -255,7 +242,7 @@
         (#t form)))
 
 (define-macro (with-delimited-continuations . code)
-  (cps (f-body code)))
+  (cps `((lambda () ,@code))))
 
 (define-macro (define-generator form . body)
   (let ((ko  (gensym))

femtolisp/flisp.boot

@@ -123,7 +123,7 @@ make-enum-table
 make-code-emitter
 #function("n0_e030`Z3;" [table])
 macroexpand-in
-#function("n2f0?6;0f0;c0e1f0Mf132q42;" [#function("rf06M0e0e1f031g00NQ2e2f03142;c3e4g0031q42;" [macroexpand-in cadr caddr #function("rf06F0e0f0g10NQ2g1142;g10Mc1<6T0g10;g10Mc2<6\x810e3c2e4g1031e0e5g1031g1132e6g103144;g10Mc7<6\xa30c8e4g1031e9e:g103131q43;e;c<mg1042;" [macroexpand-in quote lambda nlist* cadr caddr cdddr let-syntax #function("re0f1e1e2c3mf032g213242;" [macroexpand-in nconc map #function("n1f0Me0e1f031g3132g31L3;" [macroexpand-in cadr])]) f-body cddr map #function("n1e0f0g2142;" [macroexpand-in])]) macrocall?]) assq])
+#function("n2f0?6;0f0;c0e1f0Mf132q42;" [#function("rf06M0e0e1f031g00NQ2e2f03142;c3e4g0031q42;" [macroexpand-in cadr caddr #function("rf06F0e0f0g10NQ2g1142;g10Mc1<6T0g10;g10Mc2<6\x920c3e4g1031F6\x8d0e5g1031F6\x830c6e4g1031K5\x8a0e7g10315\x8e0^q42;g10Mc8<6\xc10c9e:g1031e;c2L1_L1e<e4g10313133L1q43;e=c>mg1042;" [macroexpand-in quote lambda #function("rc0e1f031e2f0g2132q43;" [#function("re0c1e2g3031f0A6G0f15Y0c1f0f1L3e3c4mf032Ke5g303144;" [nlist* lambda cadr map #function("n1^;" []) cdddr]) get-defined-vars macroexpand-in]) cddr cdddr begin caddr let-syntax #function("re0f1e1e2c3mf032g213242;" [macroexpand-in nconc map #function("n1f0Me0e1f031g3132g31L3;" [macroexpand-in cadr])]) cadr nconc copy-list map #function("n1e0f0g2142;" [macroexpand-in])]) macrocall?]) assq])
 macroexpand-1
 #function("n1f0?6;0f0;c0e1f031q42;" [#function("rf06?0f0g00Nt2;g00;" []) macrocall?])
 macroexpand
@@ -184,8 +184,6 @@ fits-i8
 #function("n1f0I16O02e0f0b\xb03216O02e1f0b\xaf42;" [>= <=])
 filter
 #function("n2g00f0f1_43;" [] #0=[#function("n3f1A6;0f2;f0f1M316V0g00f0f1Nf1Mf2K43;g00f0f1Nf243;" [] #0#) ()])
-f-body
-#function("n1c0g00f031q42;" [#function("rc0e1f031q42;" [#function("rf0A6;0g00;c0f0g00L3e1c2mf032K;" [lambda map #function("n1^;" [])]) get-defined-vars])] [#function("n1f0?6:0^;f0N_<6F0f0M;c0f0K;" [begin]) ()])
 expand
 #function("n1e0f041;" [macroexpand])
 every
@@ -218,10 +216,6 @@ copy-list
 #function("n1f0?6;0f0;f0Me0f0N31K;" [copy-list])
 const-to-idx-vec
 #function("n1c0e1f0b2[31q42;" [#function("re0c1mg00a[322f0;" [table.foreach #function("n2g00f1f0\\;" [])]) vector.alloc])
-cond-clauses->if
-#function("n1f0?6:0^;c0f0Mq42;" [#function("rf0Mc0<17A02f0M]<6K0c1f0NK;c2f0Mc1f0NKe3g00N31L4;" [else begin if cond-clauses->if])])
-cond->if
-#function("n1e0f0N41;" [cond-clauses->if])
 compile-while
 #function("n4c0e1f031e1f031q43;" [#function("re0g00g01^^342e1g00f0322e0g00g01^g02342e2g00e3f1332e2g00e4322e0g00g01^g03342e2g00e5f0332e1g00f142;" [compile-in mark-label emit :brf :pop :jmp]) make-label])
 compile-thunk
@@ -237,7 +231,7 @@ compile-or
 compile-let
 #function("n4c0f3Mf3Nq43;" [#function("re0f1e1e2f03131326H0^5T0e3e4c5f032312e6g00e7e8g01f0]33332c9e:g00g01f133q42;" [length= length cadr error string "apply: incorrect number of arguments to " emit :loadv compile-f #function("re0g10e1322e0g10g126K0e25M0e3af0u43;" [emit :copyenv :tcall :call]) compile-arglist])])
 compile-in
-#function("n4f3C6E0e0f0f1f3c144;f3?6\xba0f3`<6[0e2f0e342;f3a<6k0e2f0e442;f3]<6{0e2f0e542;f3^<6\x8b0e2f0e642;f3_<6\x9b0e2f0e742;e8f3316\xaf0e2f0e9f343;e2f0e:f343;c;f3Mq42;" [compile-sym [:loada :loadc :loadg] emit :load0 :load1 :loadt :loadf :loadnil fits-i8 :loadi8 :loadv #function("rf0c0=6J0e1g00e2e3g033143;f0c4=6g0e5g00g01g02e6g033144;f0c7=6\x800e8g00g01g02g0344;f0c9=6\x9a0e:g00g01g02g03N44;f0c;=6\xb00e<g00g01g0343;f0c==6\xd60e1g00e2e>g01g0332332e1g00e?42;f0c@=6\xf00eAg00g01g02g03N44;f0cB=6\x0a0eCg00g01g02g03N44;f0cD=6.0eEg00g01e3g0331c9eFg0331K44;f0cG=6V1eHg00g01e3g0331eIg0331eJg033145;f0cK=6{1e5g00g01]e3g0331342e1g00eL42;f0cM=6\xaa1e5g00g01^eIg0331342eNg00g01e3g0331cO44;f0cP=6\x001e5g00g01^c=_e3g0331L3342eQeIg0331316\xdc1^5\xe21eRcS312e5g00g01^eIg0331342e1g00eT42;eUg00g01g02g0344;" [quote emit :loadv cadr cond compile-in cond->if if compile-if begin compile-begin prog1 compile-prog1 lambda compile-f :closure and compile-and or compile-or while compile-while cddr for compile-for caddr cadddr return :ret set! compile-sym [:seta :setc :setg] trycatch 1arg-lambda? error "trycatch: second form must be a 1-argument lambda" :trycatch compile-app])])
+#function("n4f3C6E0e0f0f1f3c144;f3?6\xba0f3`<6[0e2f0e342;f3a<6k0e2f0e442;f3]<6{0e2f0e542;f3^<6\x8b0e2f0e642;f3_<6\x9b0e2f0e742;e8f3316\xaf0e2f0e9f343;e2f0e:f343;c;f3Mq42;" [compile-sym [:loada :loadc :loadg] emit :load0 :load1 :loadt :loadf :loadnil fits-i8 :loadi8 :loadv #function("rf0c0=6J0e1g00e2e3g033143;f0c4=6c0e5g00g01g02g0344;f0c6=6}0e7g00g01g02g03N44;f0c8=6\x930e9g00g01g0343;f0c:=6\xb90e1g00e2e;g01g0332332e1g00e<42;f0c==6\xd30e>g00g01g02g03N44;f0c?=6\xed0e@g00g01g02g03N44;f0cA=6\x110eBg00g01e3g0331c6eCg0331K44;f0cD=691eEg00g01e3g0331eFg0331eGg033145;f0cH=6^1eIg00g01]e3g0331342e1g00eJ42;f0cK=6\x8d1eIg00g01^eFg0331342eLg00g01e3g0331cM44;f0cN=6\xe31eIg00g01^c:_e3g0331L3342eOeFg0331316\xbf1^5\xc51ePcQ312eIg00g01^eFg0331342e1g00eR42;eSg00g01g02g0344;" [quote emit :loadv cadr if compile-if begin compile-begin prog1 compile-prog1 lambda compile-f :closure and compile-and or compile-or while compile-while cddr for compile-for caddr cadddr return compile-in :ret set! compile-sym [:seta :setc :setg] trycatch 1arg-lambda? error "trycatch: second form must be a 1-argument lambda" :trycatch compile-app])])
 compile-if
 #function("n4c0e1f031e1f031q43;" [#function("re0g00g01^e1g0331342e2g00e3f0332e0g00g01g02e4g0331342g026w0e2g00e5325\x820e2g00e6f1332e7g00f0322e0g00g01g02e8g0331F6\xad0e9g03315\xae0^342e7g00f142;" [compile-in cadr emit :brf caddr :ret :jmp mark-label cdddr cadddr]) make-label])
 compile-for
@@ -337,6 +331,6 @@ Instructions
 *whitespace*
 "\t\n\v\f\r \u0085  ᠎           \u2028\u2029  　"
 *syntax-environment*
-#table(define #function("o1f0C6B0c0f0f1ML3;c0f0Mc1f0Ne2f131L3L3;" [set! lambda f-body])  letrec #function("o1c0e1e2f032e3e4e1c5mf032f13231L3e1c6mf032K;" [lambda map car f-body nconc #function("n1c0f0K;" [set!]) #function("n1^;" [])])  backquote #function("n1e0f041;" [bq-process])  assert #function("n1c0f0]c1c2c3f0L2L2L2L4;" [if raise quote assert-failed])  label #function("n2c0f0L1c1f0f1L3L3^L2;" [lambda set!])  do #function("o2c0e130f1Me2e3f032e2e4f032e2c5mf032q46;" [#function("rc0f0c1f2c2f1e3c4L1e5g01N3132e3c4L1e5g0231e3f0L1e5f43132L133L4L3L2L1e3f0L1e5f33132L3;" [letrec lambda if nconc begin copy-list]) gensym map car cadr #function("n1e0f031F6C0e1f041;f0M;" [cddr caddr])])  when #function("o1c0f0e1f131^L4;" [if f-body])  dotimes #function("o1c0f0Me1f031q43;" [#function("rc0`c1f1aL3c2f0L1e3g0131L3L4;" [for - lambda f-body]) cadr])  unwind-protect #function("n2c0e130e130q43;" [#function("rc0f1c1_g01L3L2L1c2c3g00c1f0L1c4f1L1c5f0L2L3L3L3f1L1L3L3;" [let lambda prog1 trycatch begin raise]) gensym])  define-macro #function("o1c0c1f0ML2c2f0Ne3f131L3L3;" [set-syntax! quote lambda f-body])  unless #function("o1c0f0^e1f131L4;" [if f-body])  let #function("o1c0^q42;" [#function("rg00C6P0g00j02g01Mk002g01Nk015Q0^2c0c1e2c3mg0032e4g0131L3e2c5mg0032q43;" [#function("rg006C0c0g00f0L35E0f0f1K;" [label]) lambda map #function("n1f0F6<0f0M;f0;" []) f-body #function("n1f0F6?0e0f041;^;" [cadr])])])  throw #function("n2c0c1c2c3L2f0f1L4L2;" [raise list quote thrown-value])  time #function("n1c0e130q42;" [#function("rc0f0c1L1L2L1c2g00c3c4c5c1L1f0L3c6L4L3L3;" [let time.now prog1 princ "Elapsed time: " - " seconds\n"]) gensym])  let* #function("o1f0?6?0e0f141;c1e2f031L1e3c4L1f0NL1e5f13133L3e6f031L2;" [f-body lambda caar nconc let* copy-list cadar])  case #function("o1c0^q42;" [#function("rc0mj02c1e230q42;" [#function("n2f1c0<6=0c0;f1A6E0^;f1?6X0c1f0e2f131L3;f1NA6m0c1f0e2f1M31L3;c3f0c4f1L2L3;" [else eqv? quote-value memv quote]) #function("rc0f0g10L2L1e1c2L1e3e4c5mg11323132L3;" [let nconc cond copy-list map #function("n1g10g00f0M32f0NK;" [])]) gensym])])  catch #function("n2c0e130q42;" [#function("rc0g01c1f0L1c2c3c4f0L2c5c6f0L2c7c8L2L3c5c9f0L2g00L3L4c:f0L2c;f0L2L4L3L3;" [trycatch lambda if and pair? eq car quote thrown-value cadr caddr raise]) gensym]))
+#table(define #function("o1f0C6B0c0f0f1ML3;c0f0Mc1f0Nf1KKL3;" [set! lambda])  letrec #function("o1c0e1e2f032e3e1c4mf032f132KKe1c5mf032K;" [lambda map car nconc #function("n1c0f0K;" [set!]) #function("n1^;" [])])  backquote #function("n1e0f041;" [bq-process])  assert #function("n1c0f0]c1c2c3f0L2L2L2L4;" [if raise quote assert-failed])  label #function("n2c0f0L1c1f0f1L3L3^L2;" [lambda set!])  do #function("o2c0e130f1Me2e3f032e2e4f032e2c5mf032q46;" [#function("rc0f0c1f2c2f1e3c4L1e5g01N3132e3c4L1e5g0231e3f0L1e5f43132L133L4L3L2L1e3f0L1e5f33132L3;" [letrec lambda if nconc begin copy-list]) gensym map car cadr #function("n1e0f031F6C0e1f041;f0M;" [cddr caddr])])  when #function("o1c0f0c1f1K^L4;" [if begin])  unwind-protect #function("n2c0e130e130q43;" [#function("rc0f1c1_g01L3L2L1c2c3g00c1f0L1c4f1L1c5f0L2L3L3L3f1L1L3L3;" [let lambda prog1 trycatch begin raise]) gensym])  dotimes #function("o1c0f0Me1f031q43;" [#function("rc0`c1f1aL3e2c3L1f0L1L1e4g013133L4;" [for - nconc lambda copy-list]) cadr])  define-macro #function("o1c0c1f0ML2c2f0Nf1KKL3;" [set-syntax! quote lambda])  unless #function("o1c0f0^c1f1KL4;" [if begin])  let #function("o1c0^q42;" [#function("rg00C6P0g00j02g01Mk002g01Nk015Q0^2c0c1e2c3mg0032g01KKe2c4mg0032q43;" [#function("rg006C0c0g00f0L35E0f0f1K;" [label]) lambda map #function("n1f0F6<0f0M;f0;" []) #function("n1f0F6?0e0f041;^;" [cadr])])])  cond #function("o0c0^q42;" [#function("rc0mj02f0g0041;" [#function("n1f0?6:0^;c0f0Mq42;" [#function("rf0Mc0<17A02f0M]<6K0c1f0NK;c2f0Mc1f0NKg10g00N31L4;" [else begin if])])])])  throw #function("n2c0c1c2c3L2f0f1L4L2;" [raise list quote thrown-value])  time #function("n1c0e130q42;" [#function("rc0f0c1L1L2L1c2g00c3c4c5c1L1f0L3c6L4L3L3;" [let time.now prog1 princ "Elapsed time: " - " seconds\n"]) gensym])  let* #function("o1f0?6L0e0c1L1_L1e2f13133L1;e0c1L1e3f031L1L1e2f0NF6}0e0c4L1f0NL1e2f13133L15\x7F0f13133e5f031L2;" [nconc lambda copy-list caar let* cadar])  case #function("o1c0^q42;" [#function("rc0mj02c1e230q42;" [#function("n2f1c0<6=0c0;f1A6E0^;f1?6X0c1f0e2f131L3;f1NA6m0c1f0e2f1M31L3;c3f0c4f1L2L3;" [else eqv? quote-value memv quote]) #function("rc0f0g10L2L1e1c2L1e3e4c5mg11323132L3;" [let nconc cond copy-list map #function("n1g10g00f0M32f0NK;" [])]) gensym])])  catch #function("n2c0e130q42;" [#function("rc0g01c1f0L1c2c3c4f0L2c5c6f0L2c7c8L2L3c5c9f0L2g00L3L4c:f0L2c;f0L2L4L3L3;" [trycatch lambda if and pair? eq car quote thrown-value cadr caddr raise]) gensym]))
 *banner*
 ";  _\n; |_ _ _ |_ _ |  . _ _\n; | (-||||_(_)|__|_)|_)\n;-------------------|----------------------------------------------------------\n\n"

femtolisp/flisp.h

@@ -216,7 +216,7 @@ typedef struct {
 } function_t;
 
 #define CPRIM_NWORDS 2
-#define MAX_INL_SIZE 96
+#define MAX_INL_SIZE 384
 
 #define CV_OWNED_BIT  0x1
 #define CV_PARENT_BIT 0x2

femtolisp/system.lsp

@@ -8,23 +8,15 @@
 (set! set-syntax!
       (lambda (s v) (put! *syntax-environment* s v)))
 
-; convert a sequence of body statements to a single expression.
-; this allows define, defun, defmacro, let, etc. to contain multiple
-; body expressions.
-(set! f-body (lambda (e)
-               (cond ((atom? e)       #f)
-                     ((eq (cdr e) ()) (car e))
-                     (#t              (cons 'begin e)))))
-
 (set-syntax! 'define-macro
              (lambda (form . body)
                (list 'set-syntax! (list 'quote (car form))
-                     (list 'lambda (cdr form) (f-body body)))))
+                     (cons 'lambda (cons (cdr form) body)))))
 
 (define-macro (define form . body)
   (if (symbol? form)
       (list 'set! form (car body))
-      (list 'set! (car form) (list 'lambda (cdr form) (f-body body)))))
+      (list 'set! (car form) (cons 'lambda (cons (cdr form) body)))))
 
 (define (symbol-syntax s) (get *syntax-environment* s #f))
 
@@ -47,19 +39,32 @@
 		    (list 'label lname thelambda)
 		    thelambda)
 		theargs))
-	(list 'lambda
+	(cons 'lambda
-	      (map (lambda (c) (if (pair? c) (car c) c)) binds)
+	      (cons (map (lambda (c) (if (pair? c) (car c) c)) binds)
-	      (f-body body))
+		    body))
 	(map (lambda (c) (if (pair? c) (cadr c) #f)) binds))))
    #f))
 
 (define-macro (letrec binds . body)
-  (cons (list 'lambda (map car binds)
+  (cons (cons 'lambda (cons (map car binds)
-              (f-body
 			    (nconc (map (lambda (b) (cons 'set! b)) binds)
 				   body)))
 	(map (lambda (x) #f) binds)))
 
+(define-macro (cond . clauses)
+  (define (cond-clauses->if lst)
+    (if (atom? lst)
+	#f
+	(let ((clause (car lst)))
+	  (if (or (eq? (car clause) 'else)
+		  (eq? (car clause) #t))
+	      (cons 'begin (cdr clause))
+	      (list 'if
+		    (car clause)
+		    (cons 'begin (cdr clause))
+		    (cond-clauses->if (cdr lst)))))))
+  (cond-clauses->if clauses))
+
 ; standard procedures ---------------------------------------------------------
 
 (define (append2 l d)
@@ -200,17 +205,18 @@
 		(set-car! lst (f (car lst)))
 		(set! lst (cdr lst)))))
 
+(define mapcar
   (letrec ((mapcar-
 	    (lambda (f lsts)
 	      (cond ((null? lsts) (f))
 		    ((atom? (car lsts)) (car lsts))
 		    (#t (cons (apply   f (map car lsts))
 			      (mapcar- f (map cdr lsts))))))))
-  (set! mapcar
     (lambda (f . lsts) (mapcar- f lsts))))
 
 (define (transpose M) (apply mapcar list M))
 
+(define filter
   (letrec ((filter-
 	    (lambda (pred lst accum)
 	      (cond ((null? lst) accum)
@@ -218,9 +224,9 @@
 		     (filter- pred (cdr lst) (cons (car lst) accum)))
 		    (#t
 		     (filter- pred (cdr lst) accum))))))
-  (set! filter
     (lambda (pred lst) (filter- pred lst ()))))
 
+(define separate
   (letrec ((separate-
 	    (lambda (pred lst yes no)
 	      (cond ((null? lst) (cons yes no))
@@ -228,7 +234,6 @@
 		     (separate- pred (cdr lst) (cons (car lst) yes) no))
 		    (#t
 		     (separate- pred (cdr lst) yes (cons (car lst) no)))))))
-  (set! separate
     (lambda (pred lst) (separate- pred lst () ()))))
 
 (define (nestlist f zero n)
@@ -272,35 +277,6 @@
 	    (cons elt
 		  (delete-duplicates tail))))))
 
-(letrec ((get-defined-vars-
-	  (lambda (expr)
-	    (cond ((atom? expr) ())
-		  ((and (eq? (car expr) 'define)
-			(pair? (cdr expr)))
-		   (or (and (symbol? (cadr expr))
-			    (list (cadr expr)))
-		       (and (pair? (cadr expr))
-			    (symbol? (caadr expr))
-			    (list (caadr expr)))
-		       ()))
-		  ((eq? (car expr) 'begin)
-		   (apply append (map get-defined-vars- (cdr expr))))
-		  (else ())))))
-  (set! get-defined-vars
-	(lambda (expr) (delete-duplicates (get-defined-vars- expr)))))
-
-; redefine f-body to support internal define
-(let ((f-body- f-body))
-  (set! f-body
-	(lambda (e)
-	  ((lambda (B)
-	     ((lambda (V)
-		(if (null? V)
-		    B
-		    (cons (list 'lambda V B) (map (lambda (x) #f) V))))
-	      (get-defined-vars B)))
-	   (f-body- e)))))
-
 ; backquote -------------------------------------------------------------------
 
 (define (revappend l1 l2) (nconc (reverse l1) l2))
@@ -371,9 +347,11 @@
       (list 'quote v)))
 
 (define-macro (let* binds . body)
-  (if (atom? binds) (f-body body)
+  (if (atom? binds) `((lambda () ,@body))
       `((lambda (,(caar binds))
-	  (let* ,(cdr binds) ,@body))
+	  ,@(if (pair? (cdr binds))
+		`((let* ,(cdr binds) ,@body))
+		body))
 	,(cadar binds))))
 
 (define-macro (when   c . body) (list 'if c (cons 'begin body) #f))
@@ -416,7 +394,7 @@
   (let ((v (car var))
         (cnt (cadr var)))
     `(for 0 (- ,cnt 1)
-          (lambda (,v) ,(f-body body)))))
+          (lambda (,v) ,@body))))
 
 (define (map-int f n)
   (if (<= n 0)
@@ -464,9 +442,9 @@
 
 (define-macro (assert expr) `(if ,expr #t (raise '(assert-failed ,expr))))
 
+(define traced?
   (letrec ((sample-traced-lambda (lambda args (begin (println (cons 'x args))
 						     (apply #.apply args)))))
-  (set! traced?
     (lambda (f)
       (equal? (function:code f)
 	      (function:code sample-traced-lambda)))))
@@ -611,6 +589,23 @@
 
 ; toplevel --------------------------------------------------------------------
 
+(define get-defined-vars
+  (letrec ((get-defined-vars-
+	    (lambda (expr)
+	      (cond ((atom? expr) ())
+		    ((and (eq? (car expr) 'define)
+			  (pair? (cdr expr)))
+		     (or (and (symbol? (cadr expr))
+			      (list (cadr expr)))
+			 (and (pair? (cadr expr))
+			      (symbol? (caadr expr))
+			      (list (caadr expr)))
+			 ()))
+		    ((eq? (car expr) 'begin)
+		     (apply append (map get-defined-vars- (cdr expr))))
+		    (else ())))))
+    (lambda (expr) (delete-duplicates (get-defined-vars- expr)))))
+
 (define (macrocall? e) (and (symbol? (car e))
 			    (get *syntax-environment* (car e) #f)))
 
@@ -632,12 +627,23 @@
 		  (macroexpand-in (apply f (cdr e)) env)
 		  (cond ((eq (car e) 'quote) e)
 			((eq (car e) 'lambda)
-			 (nlist* 'lambda (cadr e)
+			 (let ((B (if (pair? (cddr e))
-				 (macroexpand-in (caddr e) env)
+				      (if (pair? (cdddr e))
-				 (cdddr e)))
+					  (cons 'begin (cddr e))
+					  (caddr e))
+				      #f)))
+			   (let ((V  (get-defined-vars B))
+				 (Be (macroexpand-in B env)))
+			     (nlist* 'lambda
+				     (cadr e)
+				     (if (null? V)
+					 Be
+					 (cons (list 'lambda V Be)
+					       (map (lambda (x) #f) V)))
+				     (cdddr e)))))
 			((eq (car e) 'let-syntax)
 			 (let ((binds (cadr e))
-			       (body  (f-body (cddr e))))
+			       (body  `((lambda () ,@(cddr e)))))
 			   (macroexpand-in
 			    body
 			    (nconc

femtolisp/test.lsp

@@ -43,13 +43,14 @@
              (list piv)
              (sort (cdr halves))))))
 
+#|
 (define-macro (dotimes var . body)
   (let ((v   (car var))
         (cnt (cadr var)))
     `(let ((,v 0))
        (while (< ,v ,cnt)
          (prog1
-             ,(f-body body)
+             ,(cons 'begin body)
            (set! ,v (+ ,v 1)))))))
 
 (define (map-int f n)
@@ -63,6 +64,7 @@
 		      (begin (set-cdr! acc (cons (f i) ()))
 			     (map-int- (cdr acc) (+ i 1) n)))))
 	 first 1 n))))
+|#
 
 (define-macro (labl name fn)
   `((lambda (,name) (set! ,name ,fn)) ()))

llt/htable.h

@@ -1,7 +1,7 @@
 #ifndef __HTABLE_H_
 #define __HTABLE_H_
 
-#define HT_N_INLINE 16
+#define HT_N_INLINE 32
 
 typedef struct {
     size_t size;