started testing bootstrapped compiler

arcall.pir

@@ -75,6 +75,13 @@ too_large:
    .tailcall 'err'("Index too large!")
 .end
 
+.sub arcall1 :multi(ArcNil)
+	 .param pmc the_nil
+	 .param pmc pos
+
+	 .return (the_nil)
+.end
+
 .sub arcall1 :multi(ArcStr)
    .param pmc str
    .param pmc pos

builtins.pir

@@ -439,6 +439,18 @@ end:
    .return ($P1)
 .end
 
+.sub 'ero'
+	 .param pmc what :slurpy
+
+	 $P0 = get_hll_global 'stdout*'
+	 $P1 = get_hll_global 'stderr*'
+	 set_hll_global 'stdout*', $P1
+	 $P1 = 'prn'(what :flat)
+	 set_hll_global 'stdout*', $P0
+
+	 .return ($P1)
+.end
+
 .sub 'eval'
    .param pmc what
 	 .local pmc out
@@ -450,7 +462,7 @@ end:
 	 set_hll_global 'stdout*', $P1
    $P1 = compreg 'PIR'
 	 $P0 = 'inside'(out)
-##	 say $P0
+	 say $P0
    $P0 = $P1($P0)
    $P0()
    $P0 = get_hll_global '***' # !! I don't like this

compiler/boot.arc

@@ -28,7 +28,8 @@
 (def cadr (x) (car:cdr x))
 (def cddr (x) (cdr:cdr x))
 
-(def map1 (f l) 
+(def map1 (f l)
+  ;(ero 'map1 l)
   (if l (cons (f (car l)) (map1 f (cdr l)))))
 
 (set splice 
@@ -73,9 +74,9 @@
 (set coerce-table* (table))
 
 (def coerce (what into)
-  ((coerce-table* into) what))
+  ((coerce-table* (cons (type what) into)) what))
 
-(= (coerce-table* 'string) (fn (s) (str>lst s 0)))
+(= (coerce-table* '(string . cons)) (fn (s) (str>lst s 0)))
 
 (def str>lst (s pos)
   (if (< pos (len s))
@@ -119,6 +120,7 @@
 
 ; from arc.arc (minus string stuff)
 (def map (f . seqs)
+;  (ero 'map seqs)
   (if (no (cdr seqs)) 
        (map1 f (car seqs))
       ((afn (seqs)

compiler/comp.arc

@@ -267,7 +267,7 @@
   (if
     (isa expr 'sym) 
       (list nil nil expr)
-    (or (in (e-type expr) 'int 'num 'char 'string) (aquote expr))
+    (or (in (e-type expr) 'int 'num 'char 'string 't 'nil) (aquote expr))
       (if (consts expr)
         (list nil nil (consts expr))
         (let name (uniq)

lib/Parrot/Test/Arc.pm

@@ -62,8 +62,8 @@ sub get_test_prog {
 
     return
         join( ' ',
-#              "primitivearc",
-							'./test.sh',
+              "primitivearc",
+#							'./test.sh',
 #              'primitivearc.pbc',
               $test_prog_args,
               $lang_fn );

test_serv.arc

@@ -1,12 +1,15 @@
 ; a server to avoid launching a new Arc for each test
 
 ; arc2 def
-
 (set def (annotate 'mac
                (fn (name parms . body)
                  `(do (sref sig ',parms ',name)
                       (safeset ,name (fn ,parms ,@body))))))
 
+; no prints
+(set safeset (annotate 'mac
+                  (fn (var val)
+                    `(do (set ,var ,val)))))
 
 (load "compiler/comp.arc")
 

types.pir

@@ -42,7 +42,14 @@
    $P1 = getstdout
    setattribute $P0, 'stream', $P1
    set_hll_global 'stdout*', $P0
-
+
+   ## default error port
+   $P0 = new 'Outport'
+   $P1 = getstderr
+   setattribute $P0, 'stream', $P1
+   set_hll_global 'stderr*', $P0
+
+
    $P0 = newclass 'Eof'
 
    $P0 = newclass 'Socketport'