blob: fef193bc431a7f43133eff5f259954a38fce9685 (
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
|
module IR where
import Data.Char (isNumber)
import Data.List (mapAccumL)
import qualified Data.Map as M
data PrlgStr
= CallS String [PrlgStr]
| LiteralS String
| ListS [PrlgStr] (Maybe PrlgStr)
deriving (Show)
data Id =
Id
{ str :: Int
, arity :: Int
}
deriving (Show, Eq, Ord)
data PrlgInt
= CallI Int [PrlgInt]
| AtomI Int
| NumI Int
| ListI [PrlgInt] (Maybe PrlgInt) -- only exists before desugaring
| VarI Int Int -- VarI localIndex strTableString
| VoidI
deriving (Show)
data StrTable =
StrTable Int (M.Map String Int) (M.Map Int String)
deriving (Show)
emptystrtable = StrTable 1 M.empty M.empty
strtablize t@(StrTable nxt fwd rev) str =
case fwd M.!? str of
Just i -> (t, i)
_ -> (StrTable (nxt + 1) (M.insert str nxt fwd) (M.insert nxt str rev), nxt)
internPrlg :: StrTable -> PrlgStr -> (StrTable, PrlgInt)
internPrlg = go
where
go t (LiteralS str)
| all isNumber str = (t, NumI $ read str)
| otherwise = AtomI <$> strtablize t str
go t (CallS str ps) =
let (t', i) = strtablize t str
in CallI i <$> mapAccumL go t' ps
go t (ListS elems Nothing) = flip ListI Nothing <$> mapAccumL go t elems
go t (ListS elems (Just tail)) =
let (t', tail') = go t tail
in flip ListI (Just tail') <$> mapAccumL go t' elems
|
