o hello prlg
This commit is contained in:
		
							parent
							
								
									a736c1e7b7
								
							
						
					
					
						commit
						e248226f44
					
				|  | @ -6,6 +6,11 @@ import qualified Data.Map as M | |||
| import Env | ||||
| import qualified Operators as O | ||||
| 
 | ||||
| import Debug.Trace | ||||
| 
 | ||||
| hello :: BuiltinFunc | ||||
| hello = BuiltinFunc $ trace "hllo prlg" | ||||
| 
 | ||||
| addBuiltins :: PrlgEnv () | ||||
| addBuiltins = do | ||||
|   a1 <- findStruct "a" 1 | ||||
|  | @ -13,19 +18,21 @@ addBuiltins = do | |||
|   b <- findAtom "b" | ||||
|   c <- findAtom "c" | ||||
|   b0 <- findStruct "b" 0 | ||||
|   any <- findStruct "any" 1 | ||||
|   eq <- findStruct "=" 2 | ||||
|   any1 <- findStruct "any" 1 | ||||
|   eq2 <- findStruct "=" 2 | ||||
|   hello0 <- findStruct "hello" 0 | ||||
|   modify $ \s -> | ||||
|     s | ||||
|       { defs = | ||||
|           M.fromList | ||||
|             [ (eq, [[U (LocalRef 0 Nothing), U (LocalRef 0 Nothing), NoGoal]]) | ||||
|             [ (eq2, [[U (LocalRef 0 Nothing), U (LocalRef 0 Nothing), NoGoal]]) | ||||
|             , (a1, [[U (Atom a), NoGoal], [U (Atom b), NoGoal]]) | ||||
|             , ( b0 | ||||
|               , [ [Goal, U (Struct a1), U (Atom c), LastCall] | ||||
|                 , [Goal, U (Struct a1), U (Atom b), LastCall] | ||||
|                 ]) | ||||
|             , (any, [[U (VoidRef Nothing), NoGoal]]) | ||||
|             , (any1, [[U (VoidRef Nothing), NoGoal]]) | ||||
|             , (hello0, [[Builtin hello]]) | ||||
|             ] | ||||
|       , ops = [(O.xfy "," 1000), (O.xfx "=" 700)] | ||||
|       } | ||||
|  |  | |||
							
								
								
									
										15
									
								
								app/Code.hs
									
									
									
									
									
								
							
							
						
						
									
										15
									
								
								app/Code.hs
									
									
									
									
									
								
							|  | @ -11,12 +11,19 @@ data Datum | |||
|   | HeapRef Int (Maybe Int) -- heap structure idx | ||||
|   deriving (Show, Eq, Ord) | ||||
| 
 | ||||
| data BuiltinFunc = | ||||
|   BuiltinFunc (Interp -> Interp) | ||||
| 
 | ||||
| instance Show BuiltinFunc where | ||||
|   show _ = "BuiltinFunc _" | ||||
| 
 | ||||
| data Instr | ||||
|   = U Datum -- something unifiable | ||||
|   | NoGoal -- trivial goal | ||||
|   | Goal -- we start a new goal, set up backtracking etc | ||||
|   | Call -- all seems okay, call the goal | ||||
|   | LastCall -- tail call the goal | ||||
|   | NoGoal -- trivial goal (directly after head) | ||||
|   | Builtin BuiltinFunc -- trivial goal (directly after head) | ||||
|   | Goal -- a new goal (set head) | ||||
|   | Call -- all seems okay, call the head's hoal | ||||
|   | LastCall -- tail call the head's goal | ||||
|   | Cut -- remove all alternative clauses of the current goal | ||||
|   deriving (Show) | ||||
| 
 | ||||
|  |  | |||
|  | @ -215,6 +215,10 @@ proveStep c f i = go i | |||
|                                 } | ||||
|                 , cho = chos | ||||
|                 } | ||||
|       {- invoke a built-in (this gets replaced by NoGoal by default but the | ||||
|        - builtin can actually do whatever it wants with the code -} | ||||
|       | [Builtin (BuiltinFunc bf)] <- hed = | ||||
|         c (bf i {cur = cur {hed = [NoGoal]}}) | ||||
|       {- top-level success -} | ||||
|       | [NoGoal] <- hed | ||||
|       , Just nchos <- tailcut gol chos cut | ||||
|  |  | |||
		Loading…
	
		Reference in a new issue