40 lines
1 KiB
Haskell
40 lines
1 KiB
Haskell
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
|