blob: f70511449d451181fc3ee7d14a8bdb3066666265 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
|
module Load where
import Code (Code, PrlgEnv)
import CodeLens
import qualified Compiler as C
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Except (ExceptT, except)
import qualified Data.Map as M
import Env (findAtom, findStruct, withStrTable)
import qualified IR
import Lens.Family2.State
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 :: P.PAST -> ExceptT String PrlgEnv IR.PrlgStr
shunt past = do
ops <- lift $ use 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 ","
semi <- findAtom ";"
cut <- findAtom "!"
return $ C.compileGoals comma semi 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 <- defs `uses` M.member es
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) "expand_query" "call"
loadExpansion = expansion (\o x -> IR.CallI o [x]) "expand_load" "assert"
processInput :: String -> Bool -> String -> ExceptT String PrlgEnv ()
processInput fn queryMode input = do
asts <- except $ tokenize fn input >>= parse fn
lift $ cmdq .= [(queryMode, ast) | ast <- asts]
|
