semicolon colons semi

This commit is contained in:
Mirek Kratochvil 2023-02-26 18:10:10 +01:00
parent 538dc0714a
commit 0d52bcf663
4 changed files with 22 additions and 9 deletions

View file

@ -104,12 +104,13 @@ assertRule addClause =
scope <- use (cur . hvar) scope <- use (cur . hvar)
heap <- use (cur . heap) heap <- use (cur . heap)
comma <- findAtom "," comma <- findAtom ","
semi <- findAtom ";"
cut <- findAtom "!" cut <- findAtom "!"
case Co.squashVars . IR.CallI 0 <$> case Co.squashVars . IR.CallI 0 <$>
traverse (Co.heapStructPrlgInt Nothing heap) args of traverse (Co.heapStructPrlgInt Nothing heap) args of
Just (IR.CallI 0 [hs, gs]) -> Just (IR.CallI 0 [hs, gs]) ->
let (U (Struct s):cs) = let (U (Struct s):cs) =
Co.compileGoal hs ++ Co.seqGoals (Co.compileGoals comma cut gs) Co.compileGoal hs ++ Co.compileGoals comma semi cut gs
in do addClause cs s in do addClause cs s
continue continue
_ -> prlgError "assert clause failure" _ -> prlgError "assert clause failure"
@ -131,10 +132,11 @@ exec' fgol =
case Co.squashVars <$> Co.heapStructPrlgInt Nothing heap arg of case Co.squashVars <$> Co.heapStructPrlgInt Nothing heap arg of
Just gs -> do Just gs -> do
comma <- findAtom "," comma <- findAtom ","
semi <- findAtom ";"
cut <- findAtom "!" cut <- findAtom "!"
zoom cur $ do zoom cur $ do
hvar .= M.empty hvar .= M.empty
hed .= Co.seqGoals (Co.compileGoals comma cut gs) hed .= Co.compileGoals comma semi cut gs
gol %= fgol gol %= fgol
continue continue
_ -> prlgError "bad goal" _ -> prlgError "bad goal"
@ -356,6 +358,7 @@ addPrelude = do
addProc [[U (LocalRef 0), U (LocalRef 0), Done]] "=" 2 addProc [[U (LocalRef 0), U (LocalRef 0), Done]] "=" 2
{- clauses -} {- clauses -}
addOp $ O.xfy "," 1000 addOp $ O.xfy "," 1000
addOp $ O.xfy ";" 1100
addOp $ O.xfx ":-" 1200 addOp $ O.xfx ":-" 1200
addOp $ O.fx ":-" 1200 addOp $ O.fx ":-" 1200
horn1 <- findStruct ":-" 1 horn1 <- findStruct ":-" 1

View file

@ -53,15 +53,25 @@ squashVars x =
[(idx, VarI idx' 0) | ((idx, n), idx') <- zip occurs [1 ..], n > 1] [(idx, VarI idx' 0) | ((idx, n), idx') <- zip occurs [1 ..], n > 1]
in renumVars (m' M.!?) x in renumVars (m' M.!?) x
compileGoals :: Int -> Int -> PrlgInt -> [Code] squashChoices :: [Code] -> Code
compileGoals andop cut = go' 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 where
go' = go . struct2goal go' = go . struct2goal
go p@(CallI x args@[_, _]) go p@(CallI x args@[_, _])
| x == andop = concatMap go' args | x == andop = concatMap go' args
| x == orop = squashChoices $ map go' args
go p@(CallI x []) go p@(CallI x [])
| x == cut = [[Cut]] | x == cut = [Cut]
go x = [compileGoal x] go x = compileGoal x
compileGoal :: PrlgInt -> Code compileGoal :: PrlgInt -> Code
compileGoal = compileArg . struct2goal compileGoal = compileArg . struct2goal

View file

@ -30,8 +30,7 @@ deref :: Int -> PrlgEnv Dereferenced
deref = uses (cur . heap) . flip deref' deref = uses (cur . heap) . flip deref'
writeHeap :: Int -> Datum -> PrlgEnv () writeHeap :: Int -> Datum -> PrlgEnv ()
writeHeap a v = writeHeap a v = cur . heap %= (\(Heap nxt m) -> Heap nxt $ M.insert a v m)
cur . heap %= (\(Heap nxt m) -> Heap nxt $ M.insert a v m)
allocHeap :: Int -> PrlgEnv Int allocHeap :: Int -> PrlgEnv Int
allocHeap n = do allocHeap n = do

View file

@ -39,8 +39,9 @@ intern prlgs = do
compile :: IR.PrlgInt -> PrlgEnv Code compile :: IR.PrlgInt -> PrlgEnv Code
compile prlgv = do compile prlgv = do
comma <- findAtom "," comma <- findAtom ","
semi <- findAtom ";"
cut <- findAtom "!" cut <- findAtom "!"
return $ C.seqGoals (C.compileGoals comma cut prlgv) return $ C.compileGoals comma semi cut prlgv
expansion :: expansion ::
(Int -> IR.PrlgInt -> IR.PrlgInt) (Int -> IR.PrlgInt -> IR.PrlgInt)