compile cuts
This commit is contained in:
parent
e86aa4faad
commit
6f123999e0
|
@ -36,11 +36,13 @@ variablizePrlg void vs (LiteralI i)
|
||||||
| Just idx <- elemIndex i vs = VarI idx i
|
| Just idx <- elemIndex i vs = VarI idx i
|
||||||
| otherwise = LiteralI i
|
| otherwise = LiteralI i
|
||||||
|
|
||||||
compileGoals :: Id -> PrlgInt -> [Code]
|
compileGoals :: Id -> Int -> PrlgInt -> [Code]
|
||||||
compileGoals andop = go
|
compileGoals andop cut = go
|
||||||
where
|
where
|
||||||
go p@(CallI x args)
|
go p@(CallI x args)
|
||||||
| x == andop = concatMap go args
|
| x == andop = concatMap go args
|
||||||
|
go p@(LiteralI x)
|
||||||
|
| x == cut = [[Cut]]
|
||||||
go x = [compileGoal x]
|
go x = [compileGoal x]
|
||||||
|
|
||||||
compileGoal :: PrlgInt -> Code
|
compileGoal :: PrlgInt -> Code
|
||||||
|
@ -58,4 +60,5 @@ seqGoals [] = [NoGoal]
|
||||||
seqGoals [[Cut]] = [Cut, NoGoal]
|
seqGoals [[Cut]] = [Cut, NoGoal]
|
||||||
seqGoals [x] = [Goal] ++ x ++ [LastCall]
|
seqGoals [x] = [Goal] ++ x ++ [LastCall]
|
||||||
seqGoals [x, [Cut]] = [Goal] ++ x ++ [LastCall, Cut]
|
seqGoals [x, [Cut]] = [Goal] ++ x ++ [LastCall, Cut]
|
||||||
|
seqGoals ([Cut]:xs) = [Cut] ++ seqGoals xs
|
||||||
seqGoals (x:xs) = [Goal] ++ x ++ [Call] ++ seqGoals xs
|
seqGoals (x:xs) = [Goal] ++ x ++ [Call] ++ seqGoals xs
|
||||||
|
|
|
@ -53,8 +53,8 @@ interpret = (>> return True) . lex
|
||||||
compile prlgv
|
compile prlgv
|
||||||
compile prlgv = do
|
compile prlgv = do
|
||||||
commaId <- findStruct "," 2
|
commaId <- findStruct "," 2
|
||||||
-- TODO cut
|
cut <- findAtom "!"
|
||||||
let code = C.seqGoals $ C.compileGoals commaId prlgv
|
let code = C.seqGoals $ C.compileGoals commaId cut prlgv
|
||||||
execute code
|
execute code
|
||||||
execute code = do
|
execute code = do
|
||||||
res <- I.prove code
|
res <- I.prove code
|
||||||
|
@ -73,7 +73,7 @@ interpreterStart = do
|
||||||
|
|
||||||
interpreterLoop :: PrlgEnv ()
|
interpreterLoop :: PrlgEnv ()
|
||||||
interpreterLoop = do
|
interpreterLoop = do
|
||||||
minput <- lift $ getInputLine "π> "
|
minput <- lift $ getInputLine "prlg> "
|
||||||
case minput of
|
case minput of
|
||||||
Nothing -> return ()
|
Nothing -> return ()
|
||||||
Just input -> do
|
Just input -> do
|
||||||
|
|
Loading…
Reference in a new issue