Commit ed878fb1 authored by Axel Simon's avatar Axel Simon

add index and println primitive

parent 863fa6ee
......@@ -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);
......
......@@ -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,
......
......@@ -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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment