diff --git a/app/Load.hs b/app/Load.hs new file mode 100644 index 0000000..b1ad0a5 --- /dev/null +++ b/app/Load.hs @@ -0,0 +1,69 @@ +module Load where + +import Code (Code, Interp(..)) +import qualified Compiler as C +import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.Except (except) +import Control.Monad.Trans.State.Lazy (gets, modify) +import qualified Data.Map as M +import Env (PrlgEnv, findAtom, findStruct, withStrTable) +import qualified IR +import qualified Parser as P +import qualified Text.Megaparsec as MP + +left :: (a -> b) -> Either a c -> Either b c +left f = either (Left . f) Right + +tokenize :: String -> String -> Either String [P.Lexeme] +tokenize fn = left MP.errorBundlePretty . MP.parse P.lexPrlg fn + +parse :: String -> [P.Lexeme] -> Either String [P.PAST] +parse fn = left MP.errorBundlePretty . MP.parse P.parsePrlg fn + +shunt past = do + ops <- lift $ gets ops + except . left (\err -> "operator resolution: " ++ err ++ "\n") $ + P.shuntPrlg ops past + +intern :: IR.PrlgStr -> PrlgEnv IR.PrlgInt +intern prlgs = do + prlgi <- withStrTable $ \st -> IR.internPrlg st prlgs + underscore <- findAtom "_" + list <- findAtom "[]" + withStrTable $ \st -> + ( st + , C.squashVars $ C.variablizePrlg underscore st $ C.desugarPrlg list prlgi) + +compile :: IR.PrlgInt -> PrlgEnv Code +compile prlgv = do + comma <- findAtom "," + cut <- findAtom "!" + return $ C.seqGoals (C.compileGoals comma cut prlgv) + +expansion :: + (Int -> IR.PrlgInt -> IR.PrlgInt) + -> String + -> String + -> IR.PrlgInt + -> PrlgEnv IR.PrlgInt +expansion noexpand expander output x = do + es <- findStruct expander 2 + o <- findAtom output + comma <- findAtom "," + expand <- gets (M.member es . defs) + pure $ + if expand + then IR.CallI + comma + [ IR.CallI (IR.str es) [x, IR.VarI (-1) 0] + , IR.CallI o [IR.VarI (-1) 0] + ] + else noexpand o x + +queryExpansion = expansion (\_ -> id) "query_expansion" "call" + +loadExpansion = expansion (\o x -> IR.CallI o [x]) "load_expansion" "assert" + +processInput fn queryMode input = do + asts <- except $ tokenize fn input >>= parse fn + lift . modify $ \s -> s {cmdq = [(queryMode, ast) | ast <- asts]}