Softwaredesign: Beispiel: Programmiersprache mit Interpretierer und Compiler

module Main
where
import           Data.Map (Map)
import qualified Data.Map as M
import           Data.Maybe
-- ------------------------------------------------------------
--
-- the abstract syntax
type Program    = Stmt
type StmtList   = [Stmt]
data Stmt
    = Assign  Ident  Expr
    | Stmts   StmtList 
    | If      Expr  Stmt Stmt
    | While   Expr  Stmt
type Ident      = String
data Expr
    = IntConst  Int
    | BoolConst Bool
    | Var       Ident
    | UnExpr    UnOp  Expr
    | BinExpr   Op    Expr  Expr
data Op = Add | Sub | Mul | Div | Mod | Eq | Neq
        deriving (Eq, Ord)
data UnOp = UPlus | UMinus | Neg
        deriving (Eq, Ord)
-- ------------------------------------------------------------
--
-- example programs
p0, p1, p2 :: Program
p0 = Stmts []           -- the empty program
p1 = Stmts              
     [ Assign i ( IntConst 22 )
     , Assign j ( IntConst 20 )
     , While
       ( BinExpr Neq ( Var i ) ( IntConst 0 ) )
       ( Stmts
         [ Assign i ( BinExpr Sub ( Var i ) ( IntConst 1 ) )
         , Assign j ( BinExpr Add ( Var j ) ( IntConst 1 ) )
         ]
       )
     ]
    where
    i = "i"
    j = "j"
p2 = Stmts              
     [ Assign x (UnExpr UPlus (IntConst 6))
     , Assign y (IntConst 7)
     , Assign p (IntConst 0)
     , While
       ( BinExpr Neq (Var x) (IntConst 0) )
       ( If ( BinExpr Neq ( BinExpr Mod (Var x) (IntConst 2) ) (IntConst 0) )
            ( Stmts
              [ Assign x ( BinExpr Sub (Var x) (IntConst 1) )
              , Assign p ( BinExpr Add (Var p) (Var y) )
              ]
            )
            ( Stmts
              [ Assign x ( BinExpr Div (Var x) (IntConst 2) )
              , Assign y ( BinExpr Mul (Var y) (IntConst 2) )
              ]
            )
       )
     ]
    where
    x = "x"
    y = "y"
    p = "p"
-- ------------------------------------------------------------
--
-- the "interpreter" for generating a text representation
-- more specific:
-- two interpeters: one for statements and one for expressions
--
-- the "show" is the equivaltent to "toString" in Java
instance Show Stmt
    where
    show (Assign lhs rhs)
        = lhs ++ " := " ++ show rhs
    show (If cond thenp elsep)
        = "if " ++ show cond ++ nl ++
          "then" ++ indent (show thenp) ++
          "else" ++ indent (show elsep) ++
          "end if"
    show (While cond body)
        = "while " ++ show cond ++ nl ++
          "do" ++ indent (show body) ++
          "end while"
    show (Stmts [])
        = ""
    show (Stmts (s1:sl))
        = show s1 ++ concatMap (\ s -> ";" ++ nl ++ show s) sl
-- ------------------------------------------------------------
instance Show Expr
    where
    show (IntConst i)
        = show i
    show (BoolConst False)
        = "false"
    show (BoolConst True)
        = "true"
    show (Var id)
        = id
    show (UnExpr op op1)
        = show op ++ " ( " ++ show op1 ++ " )"
    show (BinExpr op op1 op2)
        = "( " ++ show op1 ++ " " ++ show op ++ " " ++ show op2 ++ " )"
instance Show Op
    where
    show Add  = "+"
    show Sub  = "-"
    show Mul  = "*"
    show Div  = "div"
    show Mod  = "mod"
    show Eq   = "=="
    show Neq  = "!="
instance Show UnOp
    where
    show UPlus  = "+"
    show UMinus = "-"
    show Neg    = "!"
-- ------------------------------------------------------------
--
-- auxiliary functions
nl      = "\n"
tab     = "\t"
indent ""
    = nl
indent line
    = concatMap (\ c -> if c == '\n' then nl ++ "  " else [c]) (nl ++ line) ++ nl
-- ------------------------------------------------------------
--
-- 2. example: program execution
--
-- the semantic domains for interpreting a program
--
-- state is an assoc list of variables and values,
-- there are two kinds of values: Ints and Booleans
data State      = State { values :: Map Ident Value }
data Value
    = IntValue  { intValue  :: Int  }
    | BoolValue { boolValue :: Bool }
-- ------------------------------------------------------------
--
-- auxiliary fuction for readable output of program states
instance Show State
    where
    show (State sl) = concat
                      . map ( \ (id,val) -> id ++ "\t:-> " ++ show val ++ "\n")
                      . M.assocs
                      $ sl
instance Show Value
    where
    show (IntValue i)      = show i
    show (BoolValue True)  = "true"
    show (BoolValue False) = "false"
-- ------------------------------------------------------------
--
-- the statement interpreter
run     :: Stmt -> State
run s   = interprete s (State M.empty)
interprete      :: Stmt -> State -> State
interprete (Assign lhs rhs) state@(State s)
    = State ( update lhs v s )
      where
      v = eval rhs state
      update k v s = M.insert k v s
interprete (Stmts []) state
    = state
interprete (Stmts (s:sl)) state
    = interprete (Stmts sl) state'
      where
      state' = interprete s state
interprete (If cond thenp elsep) state
    = interprete (if boolValue (eval cond state)
                  then thenp
                  else elsep) state
interprete w@(While cond body) state
    = if boolValue (eval cond state)
      then let
           state' = interprete body state
           in
           interprete w state'
      else
      state
-- ------------------------------------------------------------
--
-- the expression interpreter
eval    :: Expr -> State -> Value
eval (IntConst i) _state
    = IntValue i
eval (BoolConst b) _state
    = BoolValue b
eval (Var id) (State s)
    = fromJust (M.lookup id s)
eval (UnExpr op op1) state
    = (fromJust (lookup op fl))
         (eval op1 state)
      where
      fl = [ (UPlus,    uplus)
           , (UMinus,   uminus)
           , (Neg,      neg)
           ]
      uplus  (IntValue  i)      = IntValue i
      uminus (IntValue  i)      = IntValue (-i)
      neg    (BoolValue b)      = BoolValue (not b)
eval (BinExpr op op1 op2) state
    = (fromJust (lookup op fl))
         (eval op1 state)
         (eval op2 state)
      where
      fl = [ (Add,  add)
           , (Sub,  sub)
           , (Mul,  mul)
           , (Div,  divide)
           , (Mod,  modulo)
           , (Eq,   eq)
           , (Neq,  neq)
           ]
      add (IntValue i)  (IntValue j)
          = IntValue (i + j)
      sub (IntValue i)  (IntValue j)
          = IntValue (i - j)
      mul (IntValue i)  (IntValue j)
          = IntValue (i * j)
      divide (IntValue i)  (IntValue j)
          = IntValue (i `div` j)
      modulo (IntValue i)  (IntValue j)
          = IntValue (i `mod` j)
      eq  (IntValue i)  (IntValue j)
          = BoolValue (i == j)
      eq  (BoolValue b1) (BoolValue b2)
          = BoolValue (b1 == b2)
      neq v1 v2
          = BoolValue (not res)
            where
            (BoolValue res) = eq v1 v2
-- ------------------------------------------------------------
--
-- the semantic domains for compiling a program
--
-- the compile time state has three components
-- the environment, a map of variables and
-- associated addresses,
-- a counter for generating label names
-- and the code, a list of instructions so far generated
data CState = CState { vars    :: Env
                     , labcnt  :: Label
                     , code    :: Code
                     }
type Env         = Map Ident Address
type Address     = Int
type Label       = Int
type Code        = [Instr]
data Instr
    = Load    Address
    | Lconst  Int
    | Store   Address
    | Compute Opcode
    | Goto    Label
    | Branch  Label
    | Lab     Label
data Opcode
    = OpAdd | OpSub | OpMul | OpDiv | OpMod | OpEq
-- ------------------------------------------------------------
--
-- aux functions for manipulating the compile state
appendCode      :: Code -> CState -> CState
appendCode cl cs
    = cs { code = code cs ++ cl }
getAddr         :: Ident -> CState -> (Address, CState)
getAddr ident state
    = newAdr (M.lookup ident (vars state))
      where
      newAdr (Just adr)
          = (adr, state)
      newAdr Nothing
          = (next, state { vars = M.insert ident next (vars state) })
             where
             next = M.size (vars state)
newLabel        :: CState -> (Label, CState)
newLabel state
    = (labcnt state, state {labcnt = labcnt state + 1})
-- ------------------------------------------------------------
--
-- show assebmler code
--
-- for readable output of assembler instructions
instance Show CState
    where
    show state = showCode (code state)
instance Show Opcode
    where
    show OpAdd = "add"
    show OpSub = "sub"
    show OpMul = "mul"
    show OpDiv = "div"
    show OpMod = "mod"
    show OpEq  = "eq"
instance Show Instr
    where
    show (Load adr)         = tab ++ "load"   ++ tab ++ "m(" ++ show adr ++ ")"
    show (Lconst v)         = tab ++ "lcnst"  ++ tab ++ show v
    show (Store adr)        = tab ++ "store"  ++ tab ++ "m(" ++ show adr ++ ")"
    show (Compute op)       = tab ++ show op
    show (Goto lab)         = tab ++ "jump"   ++ tab ++ "l" ++ show lab
    show (Branch lab)       = tab ++ "branch" ++ tab ++ "l" ++ show lab
    show (Lab lab)          = "l" ++ show lab ++ ":"
showCode        :: Code -> String
showCode
    = concatMap ((++ "\n") . show)
-- ------------------------------------------------------------
--
-- the compile functions
compile :: Program -> CState
compile p
    = cstmt p initialCState
      where
      initialCState = CState M.empty 0 []
-- ------------------------------------------------------------
--
-- compile expressions, no compile state change necessary
cexpr   :: Expr -> Env -> Code
cexpr (IntConst i) _env
    = [Lconst i]
cexpr (BoolConst b) _env
    = [Lconst (fromEnum b)]
cexpr (Var id) env
    = [Load adr]
      where
      adr = fromJust (M.lookup id env)
cexpr (UnExpr UPlus opr1) env
    = cexpr opr1 env
cexpr (UnExpr UMinus opr1) env
    = cexpr (BinExpr Sub (IntConst 0) opr1) env
cexpr (UnExpr Neg opr1) env
    = cexpr (BinExpr Sub (IntConst 1) opr1) env
cexpr (BinExpr Eq opr1 opr2) env 
    = cexpr (UnExpr Neg (BinExpr Neq opr1 opr2)) env
cexpr (BinExpr Neq opr1 opr2) env 
    = cexpr (BinExpr Sub opr1 opr2) env
cexpr (BinExpr op opr1 opr2) env
    = cs1 ++ cs2 ++ [Compute (fromJust (lookup op mol))]
      where
      cs1 = cexpr opr1 env
      cs2 = cexpr opr2 env
      mol = [ (Add,  OpAdd)
            , (Sub,  OpSub)
            , (Mul,  OpMul)
            , (Div,  OpDiv)
            , (Mod,  OpMod)
            ]
-- ------------------------------------------------------------
--
-- compile statements
-- the compile state consists of a variable address assoc list
-- a label count for generating new labels
-- and the so far generated code sequence
cstmt   :: Stmt -> CState -> CState
cstmt (Assign lhs rhs) state
    = appendCode (crhs ++ clhs) state'
      where
      crhs = cexpr rhs (vars state)
      clhs = [Store adr]
      (adr, state') = getAddr lhs state
cstmt (Stmts []) state
    = state
cstmt (Stmts (s:sl)) state
    = cstmt (Stmts sl) state'
      where
      state' = cstmt s state
cstmt (If cond thenp elsep) s0
    = s7
      where
      condCode = cexpr (UnExpr Neg cond) (vars s0)
      (l1, s1) = newLabel s0
      (l2, s2) = newLabel s1
      s3       = appendCode [Branch l1] s2
      s4       = cstmt thenp s3
      s5       = appendCode [ Goto l2
                            , Lab  l1] s4
      s6       = cstmt elsep s5
      s7       = appendCode [Lab l2] s6
cstmt (While cond body) s0
    = s5
      where
      condCode = cexpr cond (vars s0)
      (l1, s1) = newLabel s0
      (l2, s2) = newLabel s1
      s3       = appendCode [ Goto l1
                            , Lab  l2] s2
      s4       = cstmt body s3
      s5       = appendCode ([ Lab l1 ] ++ condCode ++ [Branch l2]) s4
-- ------------------------------------------------------------
--
-- tests
initState       = State M.empty
r0      = run p0
r1      = run p1
r2      = run p2
c0      = compile p0
c1      = compile p1
c2      = compile p2
-- ------------------------------------------------------------
Beispiel: Programmiersprache mit Interpretierer und Compiler

Eine einfache Programmiersprache

Das Programm Interp.hs

Konversion in Textformat: Beispiel 1

Konversion in Textformat: Beispiel 2

Interpretieren: Beispiel 1

Interpretieren: Beispiel 2

Compilieren: Beispiel 1

Compilieren: Beispiel 2
