Tom*_*sby 8 io monads interpreter haskell
下面是我对一个非常简单的解释器的尝试,该解释器是由Andrew w的"Java中的现代编译器实现"的第1章中描述的程序的Java版本翻译而来的.Appel,直接在代表语言的树上运行.
基本上,我的问题是它将所有输出保存到结束之前打印任何东西.我真的只是在寻找有关如何重组它的建议,以便在解释时打印"print"语句.
module Interpreter where
--------------------------------------------------------------------
type Id = [Char]
type Output = [Char]
type Value = Int
type Table = [(Id, Value)]
data Stm = CompoundStm Stm Stm |
AssignStm Id Exp |
PrintStm ExpList deriving Show
data Exp = IdExp Id |
NumExp Value |
OpExp Exp Op Exp |
EseqExp Stm Exp deriving Show
data ExpList = PairExpList Exp ExpList |
LastExpList Exp deriving Show
data Op = Plus | Minus | Times | Div deriving Show
--------------------------------------------------------------------
example :: Stm
example = CompoundStm (AssignStm "a" (OpExp (NumExp 5) Plus (NumExp 3)))
(CompoundStm (AssignStm "b" (EseqExp (PrintStm (PairExpList (IdExp "a")
(LastExpList (OpExp (IdExp "a") Minus (NumExp 1))))) (OpExp (NumExp 10) Times
(IdExp "a")))) (PrintStm (LastExpList (IdExp "b"))))
--------------------------------------------------------------------
tableUpdate :: Table -> Id -> Value -> Table
tableUpdate t i v = (i,v):t
tableLookup :: Table -> Id -> Value
tableLookup ((x,v):t) i | x == i = v
tableLookup ((x,v):t) i | x /= i = tableLookup t i
--------------------------------------------------------------------
execute :: Stm -> IO()
execute s = putStr ((\(o,_)->o) (interpStm s ("",[])))
interpStm :: Stm -> (Output, Table) -> (Output, Table)
interpStm (CompoundStm l r) ot = interpStm r (interpStm l ot)
interpStm (PrintStm el) (o,t) = (interpExpList el o t)
interpStm (AssignStm i e) (o,t) = f i (interpExp e (o,t))
where
f i (v,o,t) = (o, tableUpdate t i v)
interpExp :: Exp -> (Output, Table) -> (Value, Output, Table)
interpExp (IdExp i) (o,t) = (tableLookup t i, o, t)
interpExp (NumExp v) (o,t) = (v, o, t)
interpExp (EseqExp s e) ot = interpExp e (interpStm s ot)
interpExp (OpExp l op r) (o,t) = f (interpExp l (o,t)) op r
where
f (v,o,t) op r = g v op (interpExp r (o,t))
g v1 Plus (v2,o,t) = (v1 + v2, o, t)
g v1 Minus (v2,o,t) = (v1 - v2, o, t)
g v1 Times (v2,o,t) = (v1 * v2, o, t)
g v1 Div (v2,o,t) = (v1 `div` v2, o, t)
interpExpList :: ExpList -> Output -> Table -> (Output, Table)
interpExpList (LastExpList e) o t = f (interpExp e (o,t))
where
f (v, o, t) = (o ++ (show v) ++ "\n", t)
interpExpList (PairExpList e el) o t = f (interpExp e (o,t))
where
f (v, o, t) = interpExpList el (o ++ (show v) ++ " ") t
您使用累加器会使输出不必要地严格.累加器在严格的语言中很好,因为它们允许尾递归; 在懒惰的语言中,它们是不必要的(通常是坏的).我已经重写了下面的代码,不使用它.
module Interpreter where
--------------------------------------------------------------------
type Id = [Char]
type Output = [Char]
type Value = Int
type Table = [(Id, Value)]
data Stm = CompoundStm Stm Stm |
AssignStm Id Exp |
PrintStm ExpList deriving Show
data Exp = IdExp Id |
NumExp Value |
OpExp Exp Op Exp |
EseqExp Stm Exp deriving Show
data ExpList = PairExpList Exp ExpList |
LastExpList Exp deriving Show
data Op = Plus | Minus | Times | Div deriving Show
example :: Stm
example = CompoundStm (AssignStm "a" (OpExp (NumExp 5) Plus (NumExp 3)))
(CompoundStm (AssignStm "b" (EseqExp (PrintStm (PairExpList (IdExp "a")
(LastExpList (OpExp (IdExp "a") Minus (NumExp 1))))) (OpExp (NumExp 10) Times
(IdExp "a")))) (PrintStm (LastExpList (IdExp "b"))))
--------------------------------------------------------------------
tableUpdate :: Table -> Id -> Value -> Table
tableUpdate t i v = (i,v):t
tableLookup :: Table -> Id -> Value
tableLookup ((x,v):t) i | x == i = v
tableLookup ((x,v):t) i | x /= i = tableLookup t i
--------------------------------------------------------------------
execute :: Stm -> IO()
execute s = putStr ((\(o,_)->o) (interpStm s []))
interpStm :: Stm -> Table -> (Output, Table)
interpStm (CompoundStm l r) t = let (o, t') = interpStm l t in
let (o', t'') = interpStm r t' in
(o ++ o', t'')
interpStm (PrintStm el) t = interpExpList el t
interpStm (AssignStm i e) t = let (v, o, t') = interpExp e t in
(o, tableUpdate t' i v)
interpExp :: Exp -> Table -> (Value, Output, Table)
interpExp (IdExp i) t = (tableLookup t i, "", t)
interpExp (NumExp v) t = (v, "", t)
interpExp (EseqExp s e) t = let (o, t') = interpStm s t in
let (v, o', t'') = interpExp e t' in
(v, o ++ o', t'')
interpExp (OpExp l op r) t = let (v, o, t') = interpExp l t in
let (v', o', t'') = interpExp r t' in
(g v op v', o++o', t'')
where
g v1 Plus v2 = v1 + v2
g v1 Minus v2 = v1 - v2
g v1 Times v2 = v1 * v2
g v1 Div v2 = v1 `div` v2
interpExpList :: ExpList -> Table -> (Output, Table)
interpExpList (LastExpList e) t = let (v, o, t') = interpExp e t in
(o ++ show v ++ "\n", t')
interpExpList (PairExpList e el) t = let (v, o, t') = interpExp e t in
let (o', t'') = interpExpList el t' in
(o ++ show v ++ " " ++ o', t')
有了这个改变,输出就会非常懒散.
你会发现,有一个很大的形式重复的代码let (value, newTable) = f oldTable in ...,并且很多形式的重复的代码let (output, value) = exp; (moreOutput, value) = exp2 in (output ++ moreOutput, exp3).有几个monad为你编写这段代码!以下是使用StateT Table(Writer Output)的示例:
module Interpreter where
import Control.Monad.Writer
import Control.Monad.State
import Data.Maybe
--------------------------------------------------------------------
type Id = [Char]
type Output = [Char]
type Value = Int
type Table = [(Id, Value)]
data Stm = CompoundStm Stm Stm |
AssignStm Id Exp |
PrintStm ExpList deriving Show
data Exp = IdExp Id |
NumExp Value |
OpExp Exp Op Exp |
EseqExp Stm Exp deriving Show
data ExpList = PairExpList Exp ExpList |
LastExpList Exp deriving Show
data Op = Plus | Minus | Times | Div deriving Show
type InterpreterM = StateT Table (Writer Output)
example :: Stm
example = CompoundStm (AssignStm "a" (OpExp (NumExp 5) Plus (NumExp 3)))
(CompoundStm (AssignStm "b" (EseqExp (PrintStm (PairExpList (IdExp "a")
(LastExpList (OpExp (IdExp "a") Minus (NumExp 1))))) (OpExp (NumExp 10) Times
(IdExp "a")))) (PrintStm (LastExpList (IdExp "b"))))
--------------------------------------------------------------------
tableUpdate :: Id -> Value -> InterpreterM ()
tableUpdate i v = modify ((i,v):)
tableLookup :: Id -> InterpreterM Value
tableLookup i = gets (fromJust . lookup i)
--------------------------------------------------------------------
execute :: Stm -> IO ()
execute s = putStr . execWriter $ evalStateT (interpStm s) []
interpStm :: Stm -> InterpreterM ()
interpStm (CompoundStm l r) = interpStm l >> interpStm r
interpStm (PrintStm el) = interpExpList el
interpStm (AssignStm i e) = interpExp e >>= tableUpdate i
interpExp :: Exp -> InterpreterM Value
interpExp (IdExp i) = tableLookup i
interpExp (NumExp v) = return v
interpExp (EseqExp s e) = interpStm s >> interpExp e
interpExp (OpExp l op r) = liftM2 (g op) (interpExp l) (interpExp r)
where
g Plus v1 v2 = v1 + v2
g Minus v1 v2 = v1 - v2
g Times v1 v2 = v1 * v2
g Div v1 v2 = v1 `div` v2
interpExpList :: ExpList -> InterpreterM ()
interpExpList (LastExpList e) = interpExp e >>= \v -> tell (show v ++ "\n")
interpExpList (PairExpList e el) = interpExp e >>= \v -> tell (show v ++ " ") >> interpExpList el
从这里可以提出许多其他更改,但希望您同意这个最终形式比前一个更好,更好阅读.