From 0d52bcf663ead766ae83c8f30f90beaea5790789 Mon Sep 17 00:00:00 2001 From: Mirek Kratochvil Date: Sun, 26 Feb 2023 18:10:10 +0100 Subject: semicolon colons semi --- app/Compiler.hs | 18 ++++++++++++++---- 1 file changed, 14 insertions(+), 4 deletions(-) (limited to 'app/Compiler.hs') diff --git a/app/Compiler.hs b/app/Compiler.hs index afa7e71..f77a969 100644 --- a/app/Compiler.hs +++ b/app/Compiler.hs @@ -53,15 +53,25 @@ squashVars x = [(idx, VarI idx' 0) | ((idx, n), idx') <- zip occurs [1 ..], n > 1] in renumVars (m' M.!?) x -compileGoals :: Int -> Int -> PrlgInt -> [Code] -compileGoals andop cut = go' +squashChoices :: [Code] -> Code +squashChoices = out . concatMap go + where + go [Choices cs] = cs + go x = [x] + out [] = error "choice compilation" + out [x] = x + out xs = [Choices xs] + +compileGoals :: Int -> Int -> Int -> PrlgInt -> Code +compileGoals andop orop cut = (++ [Done]) . go' where go' = go . struct2goal go p@(CallI x args@[_, _]) | x == andop = concatMap go' args + | x == orop = squashChoices $ map go' args go p@(CallI x []) - | x == cut = [[Cut]] - go x = [compileGoal x] + | x == cut = [Cut] + go x = compileGoal x compileGoal :: PrlgInt -> Code compileGoal = compileArg . struct2goal -- cgit v1.2.3