blob: efa641c8256b7611f8a5613a376792425631d6a6 (
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
74
75
76
77
78
79
80
81
82
83
84
85
|
module Compiler where
import Data.Char (isUpper)
import Data.Containers.ListUtils (nubOrd)
import qualified Data.Map as M
import Code (Code, Datum(..), Heap, Instr(..), heapStruct)
import IR (Id(..), PrlgInt(..), StrTable(..))
varname :: String -> Bool
varname ('_':_) = True
varname (c:_) = isUpper c
varname _ = False
varIds :: PrlgInt -> [Int]
varIds (CallI _ xs) = nubOrd $ concatMap varIds xs
varIds (VarI idx _) = [idx]
varIds _ = []
variablizePrlg :: Int -> StrTable -> PrlgInt -> PrlgInt
variablizePrlg void (StrTable _ _ itos) = go
where
go (CallI id ps) = CallI id $ map go ps
go (LiteralI i)
| i == void = VoidI
| varname (itos M.! i) = VarI i i
| otherwise = LiteralI i
renumVars :: [(Int, Int)] -> PrlgInt -> PrlgInt
renumVars rename = go
where
go (CallI id ps) = CallI id $ map go ps
go (VarI idx i)
| Just idx' <- lookup idx rename = VarI idx' i
go x = x
squashVars :: PrlgInt -> PrlgInt
squashVars x = renumVars (zip (varIds x) [1 ..]) x
compileGoals :: Id -> Int -> PrlgInt -> [Code]
compileGoals andop cut = go'
where
go' = go . struct2goal
go p@(CallI x args)
| x == andop = concatMap go' args
go p@(CallI (Id x 0) [])
| x == cut = [[Cut]]
go x = [compileGoal x]
compileGoal :: PrlgInt -> Code
compileGoal = compileArg . struct2goal
compileArg :: PrlgInt -> Code
compileArg (CallI s args) = U (Struct s) : concatMap compileArg args
compileArg (LiteralI s) = [U (Atom s)]
compileArg (VarI x s) = [U (LocalRef x s)]
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 ([Cut]:xs) = [Cut] ++ seqGoals xs
seqGoals (x:xs) = [Goal] ++ x ++ [Call] ++ seqGoals xs
heapStructPrlgInt :: Monad m => m PrlgInt -> Heap -> Int -> m PrlgInt
heapStructPrlgInt heaperr heap ref =
squashVars <$> heapStruct atom struct hrec heap ref
where
atom (Atom s) = pure $ LiteralI s
atom VoidRef = pure $ VoidI
struct (Struct s) args = pure $ CallI s args
hrec (HeapRef r) ref
| r == ref = pure $ VarI r 0
| otherwise = heaperr
-- TODO check if this is used
goal2struct :: PrlgInt -> PrlgInt
goal2struct (CallI (Id s 0) []) = LiteralI s
goal2struct x = x
struct2goal :: PrlgInt -> PrlgInt
struct2goal (LiteralI s) = CallI (Id s 0) []
struct2goal x = x
|
