From 6f123999e01fc1c26742f4c9f575b392693d2847 Mon Sep 17 00:00:00 2001
From: Mirek Kratochvil <exa.exa@gmail.com>
Date: Wed, 16 Nov 2022 15:17:10 +0100
Subject: [PATCH] compile cuts

---
 app/Compiler.hs | 7 +++++--
 app/Frontend.hs | 6 +++---
 2 files changed, 8 insertions(+), 5 deletions(-)

diff --git a/app/Compiler.hs b/app/Compiler.hs
index 1adefc3..ecbd003 100644
--- a/app/Compiler.hs
+++ b/app/Compiler.hs
@@ -36,11 +36,13 @@ variablizePrlg void vs (LiteralI i)
   | Just idx <- elemIndex i vs = VarI idx i
   | otherwise = LiteralI i
 
-compileGoals :: Id -> PrlgInt -> [Code]
-compileGoals andop = go
+compileGoals :: Id -> Int -> PrlgInt -> [Code]
+compileGoals andop cut = go
   where
     go p@(CallI x args)
       | x == andop = concatMap go args
+    go p@(LiteralI x)
+      | x == cut = [[Cut]]
     go x = [compileGoal x]
 
 compileGoal :: PrlgInt -> Code
@@ -58,4 +60,5 @@ seqGoals [] = [NoGoal]
 seqGoals [[Cut]] = [Cut, NoGoal]
 seqGoals [x] = [Goal] ++ x ++ [LastCall]
 seqGoals [x, [Cut]] = [Goal] ++ x ++ [LastCall, Cut]
+seqGoals ([Cut]:xs) = [Cut] ++ seqGoals xs
 seqGoals (x:xs) = [Goal] ++ x ++ [Call] ++ seqGoals xs
diff --git a/app/Frontend.hs b/app/Frontend.hs
index 38ad353..fc57efc 100644
--- a/app/Frontend.hs
+++ b/app/Frontend.hs
@@ -53,8 +53,8 @@ interpret = (>> return True) . lex
       compile prlgv
     compile prlgv = do
       commaId <- findStruct "," 2
-      -- TODO cut
-      let code = C.seqGoals $ C.compileGoals commaId prlgv
+      cut <- findAtom "!"
+      let code = C.seqGoals $ C.compileGoals commaId cut prlgv
       execute code
     execute code = do
       res <- I.prove code
@@ -73,7 +73,7 @@ interpreterStart = do
 
 interpreterLoop :: PrlgEnv ()
 interpreterLoop = do
-  minput <- lift $ getInputLine "π> "
+  minput <- lift $ getInputLine "prlg> "
   case minput of
     Nothing -> return ()
     Just input -> do