semicolon colons semi
This commit is contained in:
		
							parent
							
								
									538dc0714a
								
							
						
					
					
						commit
						0d52bcf663
					
				|  | @ -104,12 +104,13 @@ assertRule addClause = | |||
|     scope <- use (cur . hvar) | ||||
|     heap <- use (cur . heap) | ||||
|     comma <- findAtom "," | ||||
|     semi <- findAtom ";" | ||||
|     cut <- findAtom "!" | ||||
|     case Co.squashVars . IR.CallI 0 <$> | ||||
|          traverse (Co.heapStructPrlgInt Nothing heap) args of | ||||
|       Just (IR.CallI 0 [hs, gs]) -> | ||||
|         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 | ||||
|                continue | ||||
|       _ -> prlgError "assert clause failure" | ||||
|  | @ -131,10 +132,11 @@ exec' fgol = | |||
|     case Co.squashVars <$> Co.heapStructPrlgInt Nothing heap arg of | ||||
|       Just gs -> do | ||||
|         comma <- findAtom "," | ||||
|         semi <- findAtom ";" | ||||
|         cut <- findAtom "!" | ||||
|         zoom cur $ do | ||||
|           hvar .= M.empty | ||||
|           hed .= Co.seqGoals (Co.compileGoals comma cut gs) | ||||
|           hed .= Co.compileGoals comma semi cut gs | ||||
|           gol %= fgol | ||||
|         continue | ||||
|       _ -> prlgError "bad goal" | ||||
|  | @ -356,6 +358,7 @@ addPrelude = do | |||
|   addProc [[U (LocalRef 0), U (LocalRef 0), Done]] "=" 2 | ||||
|   {- clauses -} | ||||
|   addOp $ O.xfy "," 1000 | ||||
|   addOp $ O.xfy ";" 1100 | ||||
|   addOp $ O.xfx ":-" 1200 | ||||
|   addOp $ O.fx ":-" 1200 | ||||
|   horn1 <- findStruct ":-" 1 | ||||
|  |  | |||
|  | @ -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 | ||||
|  |  | |||
|  | @ -30,8 +30,7 @@ deref :: Int -> PrlgEnv Dereferenced | |||
| deref = uses (cur . heap) . flip deref' | ||||
| 
 | ||||
| writeHeap :: Int -> Datum -> PrlgEnv () | ||||
| writeHeap a v = | ||||
|   cur . heap %= (\(Heap nxt m) -> Heap nxt $ M.insert a v m) | ||||
| writeHeap a v = cur . heap %= (\(Heap nxt m) -> Heap nxt $ M.insert a v m) | ||||
| 
 | ||||
| allocHeap :: Int -> PrlgEnv Int | ||||
| allocHeap n = do | ||||
|  |  | |||
|  | @ -39,8 +39,9 @@ intern prlgs = do | |||
| compile :: IR.PrlgInt -> PrlgEnv Code | ||||
| compile prlgv = do | ||||
|   comma <- findAtom "," | ||||
|   semi <- findAtom ";" | ||||
|   cut <- findAtom "!" | ||||
|   return $ C.seqGoals (C.compileGoals comma cut prlgv) | ||||
|   return $ C.compileGoals comma semi cut prlgv | ||||
| 
 | ||||
| expansion :: | ||||
|      (Int -> IR.PrlgInt -> IR.PrlgInt) | ||||
|  |  | |||
		Loading…
	
		Reference in a new issue