Простой интерпретатор, написанный на Haskell, сохраняет вывод на печать до конца, а не когда сталкивается с оператором печати

Question

Ниже приведена моя попытка создать очень простой интерпретатор, переведенный с версии Java программы, описанной Эндрю Ш в главе 1 «Современная реализация компилятора в Java». Аппель, и действует непосредственно на дерево, которое представляет язык.

По сути, моя проблема в том, что он сохраняет все выходные данные до конца, прежде чем что-либо будет напечатано. Я действительно просто ищу совет о том, как реструктурировать его так, чтобы «печатные» выражения печатались в том виде, в каком они интерпретируются.

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

Answer 1

Использование вами аккумулятора делает вывод неоправданно строгим. Аккумуляторы хороши на строгих языках, потому что они допускают хвостовую рекурсию; в ленивых языках они не нужны (и часто плохие). Я переписал ваш код ниже, чтобы не использовать его.

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). Есть пара монад, которые пишут этот код для вас! Вот пример использования 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

Существует множество других изменений, которые могут быть предложены здесь, но, надеюсь, вы согласитесь, что эта окончательная форма намного, намного приятнее для чтения, чем предыдущая.

Answer 2

Чтобы распечатать вывод на лету, функции интерпретатора interpStm, interpExp и interpExpList должны распечатать вывод вместо его сохранения. Вам нужно будет преобразовать эти функции для запуска в монаде IO, которая включает в себя множество изменений, но процесс прост. Поскольку выходные данные не сохраняются, новые функции не будут иметь параметра или возвращаемого значения Output.

Фактический вызов для печати происходит в interpExpList. Операторы print v; return t говорят, что значение v будет напечатано до того, как любое последующее утверждение прочитает хранилище t. Для разумного определения других функций это создаст требуемый порядок выполнения. Если вы хотите более четко заявить о том, что «v» печатается до выполнения следующего оператора, вы можете преобразовать код в CPS.

interpExpList (LastExpList e) t = do
  (v, t) <- interpExp e t
  print v
  return t
-- Code for PairExpList is similar

Как примечание стороны, ExpList изоморфно [Exp] минус пустой список. Попробуйте использовать [Exp] вместо ExpList.

Answer 3

Этот вопрос был закрыт на некоторое время, но я недавно решил эту проблему и подумал, что люди могут захотеть посмотреть, как я в итоге решил ее.

Делая это таким образом, операторы print фактически выводятся на экран, как только завершается оценка списка выражений, выведенных из него:

module IOInterpreter where

import Data.Char

-------------------------------------------------------------------------------

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

type ExpList =  [Exp]

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 [IdExp "a",
             OpExp (IdExp "a") Minus (NumExp 1)]) (OpExp (NumExp 10) Times
              (IdExp "a")))) (PrintStm [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 = do
    interpStm s []
    return ()

interpStm :: Stm -> Table -> IO Table
interpStm (CompoundStm s1 s2) t = do
    t' <- interpStm s1 t
    interpStm s2 t'
interpStm (AssignStm i e) t = do
    (v, t') <- interpExp e t
    return $ tableUpdate t' i v
interpStm (PrintStm es) t = do
    (s, t') <- interpExpList es t
    putStrLn s
    return t'

interpExp :: Exp -> Table -> IO (Value, Table)
interpExp (NumExp v) t = return (v, t)
interpExp (IdExp i) t = return (tableLookup t i, t)
interpExp (EseqExp s e) t = do
    t' <- interpStm s t
    interpExp e t'
interpExp (OpExp e1 o e2) t = do
    (v1, t') <- interpExp e1 t
    (v2, t'') <- interpExp e2 t'
    return (f o v1 v2, t'')
    where
        f Plus v1 v2 = v1 + v2
        f Minus v1 v2 = v1 - v2
        f Times v1 v2 = v1 * v2
        f Div v1 v2 = v1 `div` v2

interpExpList :: ExpList -> Table -> IO (String, Table)
interpExpList [] t = return ("", t)
interpExpList (e:es) t = do
    (v, t') <- interpExp e t
    (s, t'') <- interpExpList es t'
    return $ (show v ++ " " ++ s, t'')