Created
October 24, 2014 15:04
-
-
Save mrb/bfcbb2bc7f21acdc088c to your computer and use it in GitHub Desktop.
A little straight line program interpreter I implemented from the "modern compiler implementation in ML" book by Appel
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module Main | |
import Control.Monad.Writer | |
Id : Type | |
Id = String | |
data Binop = Plus | Minus | Times | |
mutual | |
data Stm = CompoundStm Stm Stm | |
| AssignStm Id Exp | |
| PrintStm (List Exp) | |
data Exp = IdExp Id | |
| NumExp Int | |
| OpExp Exp Binop Exp | |
| EseqExp Stm Exp | |
instance Show Exp where | |
show (IdExp i) = show i | |
Table : Type | |
Table = List (Id, Int) | |
Log : Type | |
Log = List String | |
Interp : Type | |
Interp = Writer Log Table | |
instance Show Interp where | |
show (WR (Id (table, log))) = show table ++ "\n" ++ show log | |
emptyLog : Log | |
emptyLog = [] | |
emptyTable : Table | |
emptyTable = [] | |
update : Table -> (Id, Int) -> Table | |
update table pair = pair::table | |
lookup : Table -> Id -> Int | |
lookup [] _ = -1 | |
lookup ((id, int)::ts) uid = if id == uid | |
then int | |
else (lookup ts uid) | |
getTable : Interp -> Table | |
getTable (WR (Id (table, _))) = table | |
getLog : Interp -> Log | |
getLog (WR (Id (_, log))) = log | |
newInterp : Table -> Log -> Interp | |
newInterp t l = (WR (Id (t, l))) | |
interp : Stm -> Interp | |
interp stm = (interpStm stm (newInterp emptyTable emptyLog)) where | |
mutual | |
interpStm : Stm -> Interp -> Interp | |
interpStm (CompoundStm s1 s2) i = interpStm s2 (interpStm s1 i) | |
interpStm (AssignStm id exp) i = let (val, newi) = (interpExp exp i) in | |
let newTable = (update (getTable newi) (id, val)) in | |
newInterp newTable (getLog i) | |
interpStm (PrintStm (e::es)) i = do | |
innerInterp <- i | |
tell (show (fst (interpExp e i))::emptyLog) | |
return innerInterp | |
interpStm _ i = i | |
interpExp : Exp -> Interp -> (Int, Interp) | |
interpExp (IdExp id) i = ((lookup (getTable i) id), i) | |
interpExp (NumExp n) i = (n, i) | |
interpExp (OpExp e1 b e2) i = let (val, newI) = (interpExp e1 i) in | |
let (val2, nnewI) = (interpExp e2 newI) in | |
case b of | |
Plus => ((val + val2), nnewI) | |
Minus => ((val - val2), nnewI) | |
Times => ((val * val2), nnewI) | |
interpExp (EseqExp s e) i = (interpExp e (interpStm s i)) | |
interpExp _ i = (0, i) | |
assignprog : Stm | |
assignprog = CompoundStm (AssignStm "Cool" (NumExp 9)) (PrintStm [(IdExp "Cool")]) | |
opprog : Stm | |
opprog = PrintStm [(OpExp (NumExp 1) Plus (NumExp 2))] | |
assignOpProg : Stm | |
assignOpProg = CompoundStm (AssignStm "Cool" (NumExp 9)) (PrintStm [(OpExp (IdExp "Cool") Plus (IdExp "Cool"))]) | |
main : IO () | |
main = do | |
putStrLn (show (interp assignOpProg)) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Which language did you use?
For me, it's new...