blob: 1adefc3cce3e6878dae74b2c44a4df3ad7594053 (
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
|
module Compiler where
import Data.Char (isUpper)
import Data.Containers.ListUtils (nubOrd)
import Data.List
import qualified Data.Map as M
import Code (Code, Datum(..), Instr(..))
import IR (Id(..), PrlgInt(..), PrlgStr(..), StrTable(..), strtablize)
internPrlg :: StrTable -> PrlgStr -> (StrTable, PrlgInt)
internPrlg = go
where
go t (LiteralS str) = LiteralI <$> strtablize t str
go t (CallS str ps) =
let (t', i) = strtablize t str
in CallI (Id i $ length ps) <$> mapAccumL go t' ps
varname :: String -> Bool
varname ('_':_) = True
varname (c:_) = isUpper c
varname _ = False
varIds :: StrTable -> PrlgInt -> [Int]
varIds st (CallI _ xs) = nubOrd $ concatMap (varIds st) xs
varIds (StrTable _ _ st) (LiteralI x)
| Just s <- st M.!? x
, varname s = [x]
| otherwise = []
variablizePrlg :: Int -> [Int] -> PrlgInt -> PrlgInt
variablizePrlg void vs (CallI id ps) =
CallI id $ map (variablizePrlg void vs) ps
variablizePrlg void vs (LiteralI i)
| i == void = VoidI
| Just idx <- elemIndex i vs = VarI idx i
| otherwise = LiteralI i
compileGoals :: Id -> PrlgInt -> [Code]
compileGoals andop = go
where
go p@(CallI x args)
| x == andop = concatMap go args
go x = [compileGoal x]
compileGoal :: PrlgInt -> Code
compileGoal (LiteralI x) = [U (Struct $ Id x 0)]
compileGoal x = compileArg x
compileArg :: PrlgInt -> Code
compileArg (CallI x args) = U (Struct x) : concatMap compileArg args
compileArg (LiteralI x) = [U (Atom x)]
compileArg (VarI x i) = [U (LocalRef x i)]
compileArg (VoidI) = [U VoidRef]
seqGoals :: [Code] -> Code
seqGoals [] = [NoGoal]
seqGoals [[Cut]] = [Cut, NoGoal]
seqGoals [x] = [Goal] ++ x ++ [LastCall]
seqGoals [x, [Cut]] = [Goal] ++ x ++ [LastCall, Cut]
seqGoals (x:xs) = [Goal] ++ x ++ [Call] ++ seqGoals xs
|
