88 lines
2.4 KiB
Haskell
88 lines
2.4 KiB
Haskell
{-# 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 _"
|