1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
|
{-# LANGUAGE TupleSections #-}
module Code where
import Constant
import Control.Monad.Trans.State.Lazy (StateT)
import qualified Data.Map as M
import IR (StrTable)
import Operators (Ops)
import Parser (PAST)
import System.Console.Haskeline (InputT)
data Id =
Id
{ str :: !Int
, arity :: !Int
}
deriving (Show, Eq, Ord)
data Datum
= C !Constant -- unifies a constant
| Struct !Id -- unifies a structure with arity
| VoidRef -- unifies with anything
| LocalRef !Int -- code-local variable idx (should never occur on heap)
| HeapRef !Int -- something further on the heap
deriving (Show, Eq, Ord)
data Instr
= U !Datum -- unify/resolve something
| 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)
deriving (Show)
type Code = [Instr]
type Defs = M.Map Id [Code]
data Heap =
Heap !Int (M.Map Int Datum)
deriving (Show)
emptyHeap = Heap 1 M.empty
type Scope = M.Map Int Int
emptyScope :: Scope
emptyScope = M.empty
data Cho =
Cho
{ _hed :: Code -- head pointer
, _hvar :: Scope -- variables unified in head (so far)
, _gol :: Code -- goal pointer
, _gvar :: Scope -- variables unified in the goal
, _unis :: Int -- items left to unify
, _retcut :: Bool -- cut after this goal succeeds
, _heap :: Heap -- a snapshot of the heap (there's no trail; we rely on CoW copies in other choicepoints)
, _stk :: [(Code, Scope, [Cho], Bool)] -- remaining goals together with their vars, cuts, and ret-cut flag
, _cut :: [Cho] -- snapshot of choicepoints before entering the goal
, _hcut :: [Cho] -- save of choicepoints just before starting to match head
}
deriving (Show)
data Interp =
Interp
{ _defs :: Defs -- global definitions for lookup
, _cur :: Cho -- the choice that is being evaluated right now
, _cho :: [Cho] -- remaining choice points
, _ops :: Ops -- currently defined operators
, _opstash :: [Ops] -- saved operators
, _macrostash :: [(Maybe [Code], Maybe [Code])] -- saved expansion defs (load, query)
, _strtable :: StrTable -- string table
, _cmdq :: [(Bool, PAST)] -- isQuery, lexemes
}
deriving (Show)
type PrlgEnv = StateT Interp (InputT IO)
type InterpFn = PrlgEnv (Maybe (Either String Bool))
data Builtin =
Builtin InterpFn
instance Show Builtin where
show _ = "Builtin _"
|
