load-and-dump

arc.pir

@@ -22,7 +22,8 @@
 		load_bytecode 'ac/boot.pbc'
 		load_bytecode 'ac/comp.pbc'
 		load_bytecode 'ac/qq.pbc'
-
+		load_bytecode 'aa.pbc'
+
     ## register the sub _compile as the compilation function for Arc
     $P0 = get_hll_global '_compile_and_eval'
     compreg 'Arc', $P0

builtins.pir

@@ -486,6 +486,8 @@ end:
 
 .sub 'eval'
    .param pmc what
+	 .param pmc send_pir_to_stdout :optional
+
 	 .local pmc out
 	 out = 'outstring'()
 	 $P1 = get_hll_global 'stdout*'
@@ -495,7 +497,9 @@ end:
 	 set_hll_global 'stdout*', $P1
    $P1 = compreg 'PIR'
 	 $P0 = 'inside'(out)
-#	 say $P0
+	 if_null send_pir_to_stdout, execute
+	 'prn'($P0)
+execute:				
    $P0 = $P1($P0)
    $P0()
    $P0 = get_hll_global '***' # !! I don't like this
@@ -768,14 +772,15 @@ do:
 
 .sub 'load'
    .param pmc file
+	 .param pmc save_pir :optional
 
    $P0 = 'infile'(file)
    $P2 = get_hll_global 'nil'
 loop:
    $P1 = 'read'($P0)
    $S0 = typeof $P1
    if $S0 == 'eof' goto end
-   $P2 = 'eval'($P1)
+   $P2 = 'eval'($P1, save_pir)
    goto loop
 end:
    .return ($P2)
@@ -859,7 +864,7 @@ loop:
    unless iter goto end
    $P0 = shift iter
    $P1 = table[$P0]
-   arcall2(fn, $P0, $P1)
+	 arcall2(fn, $P0, $P1)
    goto loop
 end:
    .return (table)

compiler/boot.arc

@@ -126,3 +126,8 @@
 (assign join +)
 
 (def exact (x) (isa x 'int))
+
+(def load-and-dump (file-in file-out)
+  (let o (outfile file-out)
+    (call-w/stdout o (fn () (load file-in t)))
+    (close o)))

compiler/comp.arc

@@ -147,6 +147,11 @@
       (prn " :flat)")
       (prn ")"))))
 
+;(def compile-const-ref (cs e out-reg)
+;  (let name (uniq)
+;    (prn ".const 'Sub' " name " = '" (cadr e) "'")
+;    (prn out-reg " = " name)))
+
 (def compile-const (cs const)
   (let emit-const (afn (e)
                     (if 
@@ -161,13 +166,18 @@
                                  (prn (c-push cs) " = 'cons'(" b "," a ")")))
                         ; else
                         (compile-expr cs e nil))))
+    ;(prn ".sub '" const!name "' :subid('" const!name "') :immediate")
     (emit-const const!expr)
+    ;(prn ".return (" (c-pop cs) ")")
+    ;(prn ".end")))
     (prn "set_hll_global '" const!name "', " (c-pop cs))))
 
 (def emit-fn-head (cs name dbg-name outer)
-  (pr ".sub '" (or dbg-name name) "' :nsentry('" name "')")
-  (if dbg-name
-    (pr " :subid('" name "')"))
+  ;(pr ".sub '" (or dbg-name name) "' :nsentry('" name "')")
+  ;(if dbg-name
+  ;  (pr " :subid('" name "')"))
+  (pr ".sub '" (or dbg-name name) "'")
+  (pr " :subid('" name "')")
   (if (no (iso outer ""))
     (pr " :outer('" outer "')"))
   (prn))
@@ -191,6 +201,7 @@
 ; takes a fn-info object
 ; ($fn name (arg1 ... . rest-arg) ...)
 (def compile-fn (cs f)
+  ;(ero "compiling: " (or f!dbg-name (cadr f!expr)))
   (withs (e f!expr
           name e.1
           args (collect-args e.2)
@@ -211,8 +222,11 @@
 ; compile closure creation form
 ; ($closure code-name)
 (def compile-closure (cs expr out-reg)
-  (prn out-reg " = get_hll_global '" expr.1 "'")
-  (prn out-reg " = newclosure " out-reg))
+;  (prn out-reg " = get_hll_global '" expr.1 "'")
+;  (prn out-reg " = newclosure " out-reg))
+  (let name (uniq)
+    (prn ".const 'Sub' " name " = '" expr.1 "'")
+    (prn out-reg " = newclosure " name)))
 
 ; compile function creation form
 ; ($function code-name)
@@ -292,6 +306,7 @@
         (let name (uniq)
           (= (consts expr) name)
           ;(ero (string "    name: " name " -> " expr))
+          ; TODO: optimize simple constants (int, num, char, string)
           (list nil (list (mk-const name expr)) name)))
     (a-fn-assign expr)
       (let (f c e) (collect-fns-and-consts (caddr expr) lex outer 

src/pmc/arcfn.pmc

@@ -7,7 +7,7 @@ pmclass ArcFn
   maps Sub {
 
 	VTABLE STRING* name() {
-		return Parrot_str_new_constant(INTERP, "function");
+		return Parrot_str_new_constant(INTERP, "fn");
 	}
 
 	METHOD pr_repr() {

symtable.pir

@@ -39,6 +39,10 @@ end:
    $S0 = $P0
    $S1 = "gs"
    $S1 .= $S0
+	 $S1 .= "_"
+	 $I0 = time
+	 $S0 = $I0
+	 $S1 .= $S0
    $P0 += 1
    set_hll_global 'gensym-count', $P0
    $P1 = new 'ArcSym'

t/04-functions.t

@@ -10,7 +10,7 @@ use Test::More tests => 25;
 use Parrot::Test;
 
 language_output_is('Arc', '(fn ())', "#<function>\n", "simple fn");
-language_output_is('Arc', '(type (fn ()))', "function\n", "type fn");
+language_output_is('Arc', '(type (fn ()))', "fn\n", "type fn");
 language_output_is('Arc', '((fn (x) x) 9)', "9\n", "id fn");
 language_output_is('Arc', '((fn (x y) y) 1 2)', "2\n", "2 args fn");
 language_output_is('Arc', '((fn r r) 1 2 3)', "(1 2 3)\n", "rest arg fn");

test_serv.arc

@@ -23,6 +23,6 @@
       (prn "Serving: " ip)
       (let it `((fn () ,@(ss-expand (upto-eof i))))
         (w/stdout o
-          (errsafe (tl-compile it))))
+          (tl-compile it)))
       (close i)
       (close o))))