Merge

detail/codegen/c0/runtime.c

@@ -141,6 +141,21 @@ __obj __ipget (__obj s) {
   return (a);
 }
 
+/**
+ * Return the index of a data constructor or zero for any other object.
+ */
+__obj __index (__obj s) {
+  __word val = 0;
+  if (__TAG(s)==__TAGGED) {
+    val = s->tagged.tag;
+  };
+  __LOCAL0(v);
+    __INT_BEGIN(v);
+    __INT_INIT(val);
+    __INT_END(v);
+  return (v);
+}
+
 __obj __concat (__obj A, __obj B) {
   __word a = A->bv.vec;
   __word b = B->bv.vec;
@@ -614,7 +629,7 @@ __obj __print (__obj o) {
       printf("{tag=__LABEL,f=%p}",o->label.f);
       break;
     case __BLOB:
-      printf("{tag=__BLOB,sz=%lu,blob=%p,idx=%lu}",(unsigned long) o->blob.sz, o->blob.blob, o->blob.idx);
+      printf("{tag=__BLOB,sz=%lu,blob=%p,idx=%lu}",(unsigned long) o->blob.sz, o->blob.blob,(unsigned long) o->blob.idx);
       break;
     case __BV:
       printf("{tag=__BV,sz=%lu,vec=%zx}",(unsigned long) o->bv.sz,(unsigned long) o->bv.vec);

detail/cps/from-core.sml

@@ -48,6 +48,8 @@ end = struct
          val not = get "not"
          val raisee = get "raise"
          val ipget = get "ipget"
+         val index = get "index"
+         val println = get "println"
          val return = get "return"
          val add = get "+"
          val eqi = get "==="
@@ -277,6 +279,26 @@ end = struct
                (ipget, [s], body)
             end
 
+         (* val index s = %index(s) *)
+         val index =
+            let
+               val s = fresh "s"
+               val primindex = get "%index"
+               val body = PRI (primindex, [s])
+            in
+               (index, [s], body)
+            end
+
+         (* val println s = %println(s) *)
+         val println =
+            let
+               val s = fresh "s"
+               val primprintln = get "%println"
+               val body = PRI (primprintln, [s])
+            in
+               (println, [s], body)
+            end
+
          (* val slice tok offs sz = return (%slice(tok,offs,sz) *)
          val slice =
             let
@@ -365,7 +387,8 @@ end = struct
           ==,
           concat,
           raisee,
-	  ipget,
+          ipget,
+          index,
           add,
           sx,
           zx,

detail/semantic/primitives.sml

@@ -56,6 +56,8 @@ structure Primitives = struct
    val f = freshVar ()
    val g = freshVar ()
    val g' = newFlow g
+   val h = freshVar ()
+   val i = freshVar ()
    val s1 = freshVar ()
    val s2 = freshVar ()
    val s3 = freshVar ()
@@ -123,12 +125,13 @@ structure Primitives = struct
         flow = noFlow},
        {name="ipget", ty=MONAD (ZENO, stateM, stateM'),
         flow = BD.meetVarImpliesVar (bvar stateM', bvar stateM)},
+       {name="index", ty=func (h, ZENO), flow = noFlow},
+       {name="println", ty=func (i, ZENO), flow = noFlow},
        {name="%raise", ty=UNIT, flow = noFlow},
        {name="%and", ty=UNIT, flow = noFlow},
        {name="%or", ty=UNIT, flow = noFlow},
        {name="%sx", ty=UNIT, flow = noFlow},
        {name="%zx", ty=UNIT, flow = noFlow},
-(*       {name="%ipget", ty=UNIT, flow = noFlow},*)
        {name="%addi", ty=UNIT, flow = noFlow},
        {name="%subi", ty=UNIT, flow = noFlow},
        {name="%eqi", ty=UNIT, flow = noFlow},
@@ -212,8 +215,6 @@ structure Primitives = struct
         flow = BD.meetVarZero (bvar s12)},
        {name="zx", ty=func (VEC s13, ZENO),
         flow = BD.meetVarZero (bvar s13)},
-(*       {name="ipget", ty=FUN([ZENO], ZENO),
-        flow = noFlow},*)
        {name="prefix", ty=func (VEC s14, VEC s15),
         flow = BD.meetVarZero (bvar s14) o
                BD.meetVarZero (bvar s15) o
@@ -240,6 +241,8 @@ structure Primitives = struct
        {name="%slice", ty=MONAD (freshVar (),stateL, stateL'),
         flow = BD.meetVarImpliesVar (bvar stateL', bvar stateL)},
        {name="%ipget", ty=UNIT, flow = noFlow},
+       {name="%index", ty=UNIT, flow = noFlow},
+       {name="%println", ty=UNIT, flow = noFlow},
        {name="vcase", ty=FUN ([VEC inp, content',
          FUN ([content'', VEC out], content''')], content''''),
          flow = BD.meetVarImpliesVar (bvar content'''', bvar content') o