diff options
| -rw-r--r-- | Def.dcl | 4 | ||||
| -rw-r--r-- | GraphStore.dcl | 11 | ||||
| -rw-r--r-- | GraphStore.icl | 37 | ||||
| -rw-r--r-- | Machine.dcl | 9 | ||||
| -rw-r--r-- | Nodes.dcl | 26 | ||||
| -rw-r--r-- | Nodes.icl | 77 |
6 files changed, 164 insertions, 0 deletions
@@ -2,4 +2,8 @@ definition module ABC.Def :: NodeId :== Int :: NrArgs :== Int +:: ArgNr :== Int +:: DescId :== Int :: InstrId :== Int + +:: Args :== [NodeId] diff --git a/GraphStore.dcl b/GraphStore.dcl new file mode 100644 index 0000000..5095a78 --- /dev/null +++ b/GraphStore.dcl @@ -0,0 +1,11 @@ +definition module ABC.GraphStore + +from ABC.Def import ::NodeId +from ABC.Nodes import ::Node + +:: GraphStore + +gs_get :: NodeId GraphStore -> Node +gs_init :: GraphStore +gs_newnode :: GraphStore -> (GraphStore, NodeId) +gs_update :: NodeId (Node -> Node) GraphStore -> GraphStore diff --git a/GraphStore.icl b/GraphStore.icl new file mode 100644 index 0000000..e7f0be6 --- /dev/null +++ b/GraphStore.icl @@ -0,0 +1,37 @@ +implementation module ABC.GraphStore + +import StdEnv + +import ABC.Machine + +:: GraphStore = { nodes :: [Node] + , free :: Int + } + +STORE_SIZE :== 1000 + +gs_get :: NodeId GraphStore -> Node +gs_get i {nodes} = get i nodes +where + get :: NodeId [Node] -> Node + get 0 [n:_] = n + get _ [] = abortn "gs_get: index too large" + get i [_:s] = gs_get (i-1) s + +gs_init :: GraphStore +gs_init = {nodes=[], free=STORE_SIZE} + +gs_newnode :: GraphStore -> (GraphStore, NodeId) +gs_newnode {free=:0} = abortn "gs_newnode: graph store is full" +gs_newnode {nodes,free} = ({nodes=[Empty:nodes], free=free-1}, free) + +gs_update :: NodeId (Node -> Node) GraphStore -> GraphStore +gs_update i f gs=:{nodes,free} +| place <= STORE_SIZE-free = {gs & nodes=update place nodes f} +| otherwise = abortn "gs_update: nodeid nonexistant" +where + place = i - free - 1 + + update :: Int [Node] (Node -> Node) -> [Node] + update 0 [n:s] f = [f n:s] + update i [n:s] f = [n:update (i-1) f s] diff --git a/Machine.dcl b/Machine.dcl new file mode 100644 index 0000000..4106009 --- /dev/null +++ b/Machine.dcl @@ -0,0 +1,9 @@ +definition module ABC.Machine + +import + ABC.Def, + ABC.AStack, + ABC.BStack, + ABC.CStack, + ABC.Nodes, + ABC.GraphStore diff --git a/Nodes.dcl b/Nodes.dcl new file mode 100644 index 0000000..c9bf23e --- /dev/null +++ b/Nodes.dcl @@ -0,0 +1,26 @@ +definition module ABC.Nodes + +from ABC.Def import ::ArgNr, ::Arity, ::NodeId, ::InstrId + +:: Node = Node DescId InstrId Args + | Basic DescId InstrId Basic + | Empty + +n_arg :: Node ArgNr Arity -> NodeId +n_args :: Node Arity -> [NodeId] +n_arity :: Node -> Arity +n_B :: Node -> Bool +n_I :: Node -> Int +n_copy :: Node Node -> Node +n_descid :: Node -> DescId +n_entry :: Node -> InstrId +n_eq_arity :: Node Arity -> Bool +n_eq_B :: Node Bool -> Bool +n_eq_descid :: Node DescId -> Bool +n_eq_I :: Node Int -> Bool +n_eq_symbol :: Node Node -> Bool +n_fill :: DescId InstrId Args Node -> Node +n_fillB :: DescId InstrId Bool Node -> Node +n_fillI :: DescId InstrId Int Node -> Node +n_nargs :: Node NrArgs Arity -> [NodeId] +n_setentry :: InstrId Node -> Node diff --git a/Nodes.icl b/Nodes.icl new file mode 100644 index 0000000..4f29d8a --- /dev/null +++ b/Nodes.icl @@ -0,0 +1,77 @@ +implementation module ABC.Nodes + +import StdEnv + +import ABC.Def +import ABC.Misc + +n_arg :: Node ArgNr Arity -> NodeId +n_arg n i a +| a >= i = (n_args n a)!!i +| otherwise = abortn "n_arg: index greater than arity" + +n_args :: Node Arity -> [NodeId] +n_args (Node _ _ args) a +| a = length args = args +| otherwise = abortn "n_args: incorrect arity" +n_args _ _ = abortn "n_args: no arguments in node" + +n_arity :: Node -> Arity +n_arity (Basic _ _ _) = 0 +n_arity (Node _ _ args) = length args +n_arity Empty = abortn "n_arity: arity on Empty not defined" + +n_B :: Node -> Bool +n_B (Basic _ _ (Bool b)) = b +n_B _ = abortn "n_B: no boolean in node" + +n_I :: Node -> Int +n_I (Basic _ _ (Int i)) = i +n_I _ = abortn "n_I: no integer in node" + +n_copy :: Node Node -> Node +n_copy new old = new + +n_descid :: Node -> DescId +n_descid (Node i _ _) = i +n_descid (Basic i _ _) = i +n_descid Empty = abortn "n_descid: no descid in node" + +n_entry :: Node -> InstrId +n_entry (Node _ e _) = e +n_entry (Basic _ e _) = e +n_entry Empty = abortn "n_entry: no entry in node" + +n_eq_arity :: Node Arity -> Bool +n_eq_arity n a = n_arity n == a + +n_eq_B :: Node Bool -> Bool +n_eq_B n b = n_B n == b + +n_eq_descid :: Node DescId -> Bool +n_eq_descid n i = n_descid n == i + +n_eq_I :: Node Int -> Bool +n_eq_I n i = n_I n == i + +n_eq_symbol :: Node Node -> Bool +n_eq_symbol (Node i1 _ _) (Node i2 _ _) = i1 == i2 +n_eq_symbol (Basic i1 _ b1) (Basic i2 _ b2) = i1 == i2 && b1 == b2 +n_eq_symbol _ _ = False + +n_fill :: DescId InstrId Args Node -> Node +n_fill d i a _ = Node d e a + +n_fillB :: DescId InstrId Bool Node -> Node +n_fillB d e b _ = Basic d e (Bool b) + +n_fillI :: DescId InstrId Int Node -> Node +n_fillI d e i _ = Basic d e (Int i) + +n_nargs :: Node NrArgs Arity -> [NodeId] +n_nargs n i a = take i (n_args n a) + +n_setentry :: InstrId Node -> Node +n_setentry e (Node d _ a) = Node d e a +n_setentry e (Basic d _ b) = Bsaic d e b +n_setentry _ Empty = abortn "n_setentry: Empty node" |