summaryrefslogtreecommitdiff
path: root/app/Code.hs
diff options
context:
space:
mode:
authorMirek Kratochvil <exa.exa@gmail.com>2023-02-26 16:58:56 +0100
committerMirek Kratochvil <exa.exa@gmail.com>2023-02-26 16:58:56 +0100
commitbb40a4f8ca6d837f3ce85ab49e7d892c96ae6b1c (patch)
tree0e478b2301cdcaa35d896629768aa20a0c62d3cd /app/Code.hs
parent27494c044e54f1bfe8fac466f9416b6e17d58b4d (diff)
downloadprlg-bb40a4f8ca6d837f3ce85ab49e7d892c96ae6b1c.tar.gz
prlg-bb40a4f8ca6d837f3ce85ab49e7d892c96ae6b1c.tar.bz2
yolo version
Diffstat (limited to 'app/Code.hs')
-rw-r--r--app/Code.hs58
1 files changed, 1 insertions, 57 deletions
diff --git a/app/Code.hs b/app/Code.hs
index 4473287..684686f 100644
--- a/app/Code.hs
+++ b/app/Code.hs
@@ -23,7 +23,7 @@ data Instr
| Invoke Builtin -- give control to a builtin (invoked from head)
| Done -- all done, can return
| Cut -- remove choicepoints of the current goal
- | Choices [[Code]] -- split off several possibilities (push choicepoints)
+ | Choices [Code] -- split off several possibilities (push choicepoints)
deriving (Show)
type Code = [Instr]
@@ -77,59 +77,3 @@ data Builtin =
instance Show Builtin where
show _ = "Builtin _"
-
-data Dereferenced
- = FreeRef Int
- | BoundRef Int Datum
- | NoRef
- deriving (Show, Eq)
-
--- TRICKY: HeapRefs alone must not form a cycle other than the FreeRef case.
-derefHeap :: Heap -> Int -> Dereferenced
-derefHeap h@(Heap _ hmap) x =
- case hmap M.!? x of
- Just (HeapRef x') ->
- if x == x'
- then FreeRef x'
- else derefHeap h x'
- Just x' -> BoundRef x x'
- _ -> NoRef
-
-writeHeap :: Int -> Datum -> Heap -> Heap
-writeHeap addr x (Heap nxt m) = Heap nxt (M.adjust (const x) addr m)
-
-newHeapVar :: Heap -> (Heap, Int)
-newHeapVar heap = head <$> newHeapVars 1 heap
-
-newHeapVars :: Int -> Heap -> (Heap, [Int])
-newHeapVars n (Heap nxt m) =
- let addrs = [nxt + i - 1 | i <- [1 .. n]]
- in ( Heap (nxt + n) $
- foldr (uncurry M.insert) m [(a, HeapRef a) | a <- addrs]
- , addrs)
-
-withNewHeapStruct :: Int -> Datum -> Heap -> ([Datum] -> Heap -> a) -> a
-withNewHeapStruct addr s@(Struct Id {arity = arity}) heap cont =
- let (Heap nxt' m', addrs) = newHeapVars (arity + 1) heap
- m'' = M.insert addr (HeapRef $ head addrs) . M.insert (head addrs) s $ m'
- in cont (map HeapRef $ tail addrs) (Heap nxt' m'')
-
-heapStruct ::
- Monad m
- => (Datum -> m a)
- -> (Datum -> [a] -> m a)
- -> (Datum -> Int -> m a)
- -> Heap
- -> Int
- -> m a
-heapStruct atom struct rec (Heap _ heap) hr = go [hr] hr
- where
- go visited ref
- | rr@(HeapRef r) <- heap M.! ref =
- if r == ref || r `elem` visited
- then rec rr ref
- else go (r : visited) r
- | s@(Struct (IR.Id _ arity)) <- heap M.! ref =
- sequence [go (ref + i : visited) (ref + i) | i <- [1 .. arity]] >>=
- struct s
- | x <- heap M.! ref = atom x