Created
October 23, 2011 09:44
-
-
Save MohamedIBrahim/1307183 to your computer and use it in GitHub Desktop.
a little interpreter, just for fun
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 where | |
| import AST | |
| import Parser | |
| import Control.Monad.State | |
| import Data.List | |
| import System.IO | |
| import System.Cmd | |
| data Val = VInt Int | |
| | VClo (Env -> Val -> Val) Env | |
| type Env = [(String, Val)] | |
| -- eww | |
| (+.) (VInt l) (VInt r) = VInt (l + r) | |
| (+.) _ _ = error "can not add closures" | |
| (*.) (VInt l) (VInt r) = VInt (l * r) | |
| (*.) _ _ = error "can not multiply closures" | |
| nmlookup :: String -> Env -> Val | |
| nmlookup s env = case lookup s env of | |
| Just a -> a | |
| Nothing -> error $ "could not look up name: " ++ s | |
| interpret :: Env -> Exp -> (Val,Env) | |
| interpret env (EVar v) = ((nmlookup v env), env) | |
| interpret env (Con x) = (VInt x, env) | |
| interpret env (EOp o l r) = let l' = fst $ interpret env l | |
| r' = fst $ interpret env r in | |
| case o of | |
| Add -> ((l' +. r'), env) | |
| Mul -> ((l' *. r'), env) | |
| interpret env (Let v val body) = | |
| let v' = fst $ interpret env val in | |
| interpret ((v,v'):env) body | |
| interpret env (App (EVar v) e) = ((call (nmlookup v env) e'), env) where | |
| (e',_) = interpret env e | |
| interpret env (Lam x exp) = (VClo (lam x exp) env, env) | |
| lam :: String -> Exp -> (Env -> Val -> Val) | |
| lam x exp = \clo val -> fst $ interpret ((x,val):clo) exp | |
| call (VClo f clo) v = f clo v | |
| main = | |
| forever $ | |
| do putStr "> " | |
| hFlush stdout | |
| s <- getLine | |
| go s | |
| go s = | |
| case runwith letORline id s of | |
| Left err -> putStrLn $ show err | |
| Right exp -> let v = interpret [] exp in | |
| do case v of | |
| ((VInt val),_) -> putStrLn $ show val | |
| _ -> putStrLn "returned closure" |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment