summaryrefslogtreecommitdiff
path: root/app/IR.hs
blob: d7345e5f35e377770bf584bb5d5278924a57a7b7 (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
module IR where

import Constant
import Data.Char (isNumber)
import Data.List (mapAccumL)
import qualified Data.Map as M
import Parser (Lexeme(..), PrlgStr(..))

data PrlgInt
  = CallI Int [PrlgInt]
  | ConstI Constant
  | VarI 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)

internLexeme t (Tok str)
  | all isNumber str = (t, ConstI . Number $ read str)
  | otherwise = ConstI . Atom <$> strtablize t str
internLexeme t (QTok str _) = ConstI . Atom <$> strtablize t str
internLexeme t (DQTok str _) = (t, ConstI $ Str str)

internPrlg :: StrTable -> PrlgStr -> (StrTable, PrlgInt)
internPrlg = go
  where
    go t (LiteralS lex) = internLexeme t lex
    go t (CallS str ps) =
      let (t', i) = strtablize t str
       in CallI i <$> mapAccumL go t' ps