Commit 660589b0 authored by mb0's avatar mb0

Up

parent 997a8e76
......@@ -48,6 +48,7 @@ end = struct
val raisee = get "raise"
val return = get "return"
val add = get "+"
val eqi = get "==="
val muli = get "*"
val lti = get "<"
val lei = get "<="
......@@ -117,6 +118,17 @@ end = struct
(muli, [a, b], body)
end
val eqi =
let
val a = fresh "a"
val b = fresh "b"
val prim = get "%eqi"
val body = PRI (prim, [a, b])
in
(eqi, [a, b], body)
end
val lei =
let
val a = fresh "a"
......@@ -334,6 +346,7 @@ end = struct
muli,
lei,
lti,
eqi,
gei,
gti]
end
......
......@@ -167,6 +167,7 @@ structure Primitives = struct
{name=">", ty=FUN([ZENO,ZENO],VEC (CONST 1)),flow=noFlow},
{name="<=", ty=FUN([ZENO,ZENO],VEC (CONST 1)),flow=noFlow},
{name=">=", ty=FUN([ZENO,ZENO],VEC (CONST 1)),flow=noFlow},
{name="===", ty=FUN([ZENO,ZENO],VEC (CONST 1)),flow=noFlow},
{name="++", ty=vvv s1,
flow = BD.meetVarZero (bvar s1)},
{name="--", ty=vvv s2,
......
# vim:filetype=sml:ts=3:sw=3:expandtab
# This is a modified version of the original implementation for SML.
#
......@@ -17,13 +18,19 @@ export =
bbtree-empty
bbtree-singleton
bbtree-add
bbtree-addWith
bbtree-intersection
bbtree-difference
bbtree-contains?
bbtree-simpleUnion
bbtree-splitLessThan
bbtree-splitGreaterThan
bbtree-union
bbtree-remove
bbtree-removeMin
bbtree-get
bbtree-getOrElse
bbtree-fold
intset-size
intset-empty
......@@ -35,8 +42,23 @@ export =
intset-union
intset-remove
intset-removeMin
intset-fold
fitree-lt?
fitree-size
fitree-empty
fitree-singleton
fitree-add
fitree-intersection
fitree-difference
fitree-contains?
fitree-union
fitree-remove
fitree-removeMin
fitree-fold
#type intset = bbtree [a=int]
#type fitree = bbtree [a={lo:int,hi:int}]
type bbtree =
Lf
......@@ -164,6 +186,17 @@ val bbtree-add lt? bt x =
else mkBr x t.size t.left t.right
end
val bbtree-addWith lt? f bt x =
case bt of
Lf: mkBr x 1 bt bt
| Br t:
if lt? x t.payload
then mkT t.payload (bbtree-addWith lt? f t.left x) t.right
else if lt? t.payload x
then mkT t.payload t.left (bbtree-addWith lt? f t.right x)
else mkBr (f t.payload x) t.size t.left t.right
end
val bbtree-remove lt? bt x =
case bt of
Lf: bt
......@@ -307,6 +340,17 @@ val bbtree-get lt? bt x =
else t.payload
end
val bbtree-getOrElse lt? bt x y =
case bt of
Lf: y
| Br t:
if lt? x t.payload
then bbtree-get lt? t.left x
else if lt? t.payload x
then bbtree-get lt? t.right x
else t.payload
end
val bbtree-intersection lt? btl btr =
case btl of
Lf: btl
......@@ -363,21 +407,50 @@ val bbtree-simpleUnion lt? btl btr =
val bbtree-union lt? btl btr = bbtree-simpleUnion lt? btl btr
## Integer sets
val bbtree-fold f s bt =
case bt of
Lf: s
| Br t: bbtree-fold f (f (bbtree-fold f s t.right) t.payload) t.left
end
val intset-lti? a b = a < b
val intset-add s x = bbtree-add intset-lti? s x
val intset-remove s x = bbtree-remove intset-lti? s x
## Integer Sets
val intset-lt? a b = a < b
val intset-add s x = bbtree-add intset-lt? s x
val intset-remove s x = bbtree-remove intset-lt? s x
val intset-removeMin s = bbtree-removeMin s
val intset-union a b = bbtree-union intset-lti? a b
val intset-intersection a b = bbtree-intersection intset-lti? a b
val intset-difference a b = bbtree-difference intset-lti? a b
val intset-contains? s x = bbtree-contains? intset-lti? s x
val intset-union a b = bbtree-union intset-lt? a b
val intset-intersection a b = bbtree-intersection intset-lt? a b
val intset-difference a b = bbtree-difference intset-lt? a b
val intset-contains? s x = bbtree-contains? intset-lt? s x
val intset-empty x = bbtree-empty x
val intset-singleton x = bbtree-singleton x
val intset-size s = bbtree-size s
val intset-fold f s t = bbtree-fold f s t
## (Finite) Interval Trees
val fitree-lt? a b =
if a.lo < b.lo
then '1'
else if a.lo > b.lo
then '0'
else a.hi < b.hi
val fitree-add s x = bbtree-add fitree-lt? s x
val fitree-remove s x = bbtree-remove fitree-lt? s x
val fitree-removeMin s = bbtree-removeMin s
val fitree-union a b = bbtree-union fitree-lt? a b
val fitree-intersection a b = bbtree-intersection fitree-lt? a b
val fitree-difference a b = bbtree-difference fitree-lt? a b
val fitree-contains? s x = bbtree-contains? fitree-lt? s x
val fitree-empty x = bbtree-empty x
val fitree-singleton x = bbtree-singleton x
val fitree-size s = bbtree-size s
val fitree-fold f s t = bbtree-fold f s t
# TODO: Port the following {hedge union} sml code to GDSL
#
#local
#fun trim (lo,hi,E) = E
#| trim (lo,hi,s as T(v,_,l,r)) =
......
......@@ -67,6 +67,31 @@ type sem_writeback =
SEM_WRITE_VAR of {size: int, id: sem_var}
| SEM_WRITE_MEM of {size: int, address: sem_linear}
val rreil-sizeOf op =
case op of
SEM_LIN x: x.size
| SEM_BSWAP x: x.size
| SEM_MUL x: x.size
| SEM_DIV x: x.size
| SEM_DIVS x: x.size
| SEM_MOD x: x.size
| SEM_SHL x: x.size
| SEM_SHR x: x.size
| SEM_SHRS x: x.size
| SEM_AND x: x.size
| SEM_OR x: x.size
| SEM_XOR x: x.size
| SEM_SX x: x.size
| SEM_ZX x: x.size
| SEM_CMPEQ x: 1
| SEM_CMPNEQ x: 1
| SEM_CMPLES x: 1
| SEM_CMPLEU x: 1
| SEM_CMPLTS x: 1
| SEM_CMPLTU x: 1
| SEM_ARB x: x.size
end
val revSeq stmts =
let
val lp stmt acc =
......
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