55 lines
1.5 KiB
Haskell
55 lines
1.5 KiB
Haskell
module Compiler where
|
|
|
|
import Data.List
|
|
import Interpreter (Code, Datum(..), Id(..), Instr(..), StrTable, strtablize)
|
|
|
|
data PrlgStr
|
|
= CallS String [PrlgStr]
|
|
| LiteralS String
|
|
deriving (Show)
|
|
|
|
data PrlgInt
|
|
= CallI Id [PrlgInt]
|
|
| LiteralI Int --split off vars here later
|
|
deriving (Show)
|
|
|
|
strtablizePrlg :: StrTable -> PrlgStr -> (StrTable, PrlgInt)
|
|
strtablizePrlg = go
|
|
where
|
|
go t (LiteralS str) = LiteralI <$> strtablize t str
|
|
go t (CallS str ps) =
|
|
let (t', i) = strtablize t str
|
|
in CallI (Id i $ length ps) <$> mapAccumL go t' ps
|
|
|
|
compileGoals :: Id -> PrlgInt -> [Code]
|
|
compileGoals andop = go
|
|
where
|
|
go p@(CallI x args)
|
|
| x == andop = concatMap go args
|
|
go x = [compileGoal x]
|
|
|
|
compileGoal :: PrlgInt -> Code
|
|
compileGoal (LiteralI x) = [U (Struct $ Id x 0)]
|
|
compileGoal x = compileArg x
|
|
|
|
compileArg :: PrlgInt -> Code
|
|
compileArg (CallI x args) = U (Struct x) : concatMap compileArg args
|
|
compileArg (LiteralI x) = [U (Atom x)]
|
|
|
|
seqGoals :: [Code] -> Code
|
|
seqGoals [] = [NoGoal]
|
|
seqGoals [[Cut]] = [Cut, NoGoal]
|
|
seqGoals [x] = [Goal] ++ x ++ [LastCall]
|
|
seqGoals [x, [Cut]] = [Goal] ++ x ++ [LastCall, Cut]
|
|
seqGoals (x:xs) = [Goal] ++ x ++ [Call] ++ seqGoals xs
|
|
|
|
compileClause :: Id -> Id -> PrlgInt -> Code
|
|
compileClause proveop andop = go
|
|
where
|
|
go :: PrlgInt -> Code
|
|
go h@(CallI x args)
|
|
| x == proveop
|
|
, [head, goals] <- args =
|
|
compileGoal head ++ seqGoals (compileGoals andop goals)
|
|
| otherwise = compileGoal h ++ seqGoals []
|