0
@@ -69,3 +69,32 @@
0
       (__if cell
0
         (setcdr cell fn)
0
         (set macros* (cons (cons name fn) macros*))))))
0
+
0
+(set list-ref 
0
+  (__fn (l n)
0
+    (__if (is n 0) (car l) (list-ref (cdr l) (fx- n 1)))))
0
+
0
+; split the argument list of a (fn (args) ...) form into two lists:
0
+; the first contains the first atomic symbols, the second the rest of 
0
+; the argument list
0
+(set split-arglist
0
+  (__fn (l acc)
0
+    (__if (symbolp l) ; arg list with rest parameter
0
+      (list (rev (cons l acc)) nil)
0
+      (__let ((arg (car l)))
0
+        (__if (__if (not l) t (consp arg))
0
+          (list (rev acc) l)
0
+          (split-arglist (cdr l) (cons arg acc)))))))
0
+
0
+; tells if l is a list ending with nil
0
+(set proper-list
0
+  (__fn (l)
0
+    (__if (not l) t (__if (consp l) (proper-list (cdr l)) nil))))
0
+
0
+; set the value of the last cdr in a list
0
+(set set-last-cdr!
0
+  (__fn (l val)
0
+    (__if l
0
+      (__if (consp (cdr l))
0
+        (set-last-cdr! (cdr l) val)
0
+        (setcdr l val)))))

0
@@ -41,8 +41,8 @@
0
 (mac withs (bnds . body)
0
   (list '__let* (group-n bnds 2) (cons 'do body)))
0
 
0
-(mac fn (args . body)
0
-  (list '__fn args (cons 'do body)))
0
+;(mac fn (args . body)
0
+;  (list '__fn args (cons 'do body)))
0
 
0
 (mac def args
0
   (if (fx>= (len args) 3) (list 'set-symbol-value (list 'quote (car args)) 
0
@@ -50,3 +50,31 @@
0
       (is (len args) 2) (list 'set-symbol-value (list 'quote (car args))
0
                                (cadr args))
0
       (err "Wrong number of arguments passed to def")))
0
+
0
+(mac fn (args . body)
0
+  (__let ((build-value-expr 
0
+            ; build expression to set the value of an optional argument
0
+            (__fn (o-arg rest-arg-name)
0
+              (__let ((default (caddr o-arg)))
0
+                `(__if ,rest-arg-name 
0
+                   (__let ((val (car ,rest-arg-name)))
0
+                     (do
0
+                       (set ,rest-arg-name (cdr ,rest-arg-name))
0
+                       val))
0
+                   ,default))))
0
+          (args (__if (proper-list args)
0
+                  (split-arglist args nil)
0
+                  (list args nil)))
0
+          (rest-arg-name (uniq)))
0
+    (__let ((fun-args (car args))
0
+            (o-args (cadr args)))
0
+      (__if o-args 
0
+        (do  
0
+          (set-last-cdr! fun-args rest-arg-name)
0
+          `(__fn ,fun-args 
0
+             (__let ,(map (__fn (x) 
0
+                            `(,(cadr x) ,(build-value-expr x rest-arg-name)))
0
+                          o-args)
0
+               (do
0
+                 ,@body))))
0
+        `(__fn ,fun-args (do ,@body))))))

0
@@ -530,11 +530,10 @@
0
    cont-label (unique-label))
0
     (cmp (imm unbound-val) eax)
0
     (jne cont-label)
0
-    (movl (imm 0) (deref si esp))
0
+    (movl (imm frame-sentinel) (deref si esp))
0
     (movl (imm 0) (deref (next-si si) esp))
0
     (movl ecx (deref (next-si-n si 2) esp))
0
     (movl (imm 1) eax)
0
-    (movl (imm frame-sentinel) (deref si esp))
0
     (addl (imm si) esp)
0
     (movl '__unbound_error_fun ecx)
0
     (call (unref-call (deref 2 ecx)))
0
@@ -1795,8 +1794,11 @@
0
 (def emit-funcall-a (si env args)
0
   (if args
0
     (do
0
-      (emit-expr si env (car args))
0
-      (emit-save si eax)
0
+      (if (immediatep (car args)) ; optimization if arg is an immediate
0
+        (emit-save si (imm (imm-rep (car args))))
0
+        (do
0
+          (emit-expr si env (car args))
0
+          (emit-save si eax)))
0
       (emit-funcall-a (next-si si) env (cdr args)))))
0
 
0
 (def emit-funcall (si env expr tail apply-p)
0
@@ -1813,7 +1815,7 @@
0
   ; emit code for calling function in si(%esp) and use args-generator
0
   ; to emit code to pass the arguments
0
   ; clear space reserved for frame-sentinel and ret. adress
0
-  (emit-save (next-si si) (imm 0))
0
+  (emit-save (next-si si) (imm frame-sentinel));0))
0
   (emit-save (next-si-n si 2) (imm 0))
0
   ; leave space for previous closure pointer, 
0
   ; for frame-sentinel and for return adress
0
@@ -1838,7 +1840,7 @@
0
     (emit-load si edi)
0
     (emit-save si ebx)
0
     ; put frame sentinel
0
-	  (emit-save (next-si si) (imm frame-sentinel))
0
+	  ;(emit-save (next-si si) (imm frame-sentinel))
0
     (if apply-p
0
             (do
0
               (emit-unrolled-arg last-si env)

0
@@ -10,6 +10,8 @@
0
                   (err "+: Wrong types"))
0
       (err "+: Wrong types")))
0
 
0
+; Warning: the current implementation of '-' is _very_ slow, because
0
+; it needs to cons its arguments
0
 (def - args
0
   (let l (len args)
0
     (if (is l 0) 0
0
@@ -311,3 +313,14 @@
0
 
0
 (def ccc (f)
0
   (__ccc (fn (cc) (f [__restore-continuation cc _]))))
0
+
0
+; compile and load a file
0
+(def load (file-name)
0
+  (withs (out-name (make-string "tmp/to-load-" (uniq) ".s")
0
+          so-name (make-string out-name ".so")
0
+          in-file (open-file file-name 'in)
0
+          out-file (open-file out-name 'out))
0
+    (compile in-file out-file nil transform-expr)
0
+    (if (is (system (make-string "gcc --shared -o " so-name " " out-name " 2>err")) 0)
0
+      (__load so-name)
0
+      (err "Compilation error: see file err"))))

0
@@ -14,7 +14,7 @@
0
     (ccc [set __error_continuation
0
              (fn (s)
0
                (print (make-string "Error: " s))
0
-               ;(__print_backtrace)
0
+               (__print_backtrace)
0
                (_ nil))])
0
     (write-string "arc> " out)
0
     (print (eval (read/tbl in read-table)))