homeSoftwaredesign Softwaredesign: Beispiel: Programmiersprache mit Interpretierer und Compiler Prof. Dr. Uwe Schmidt FH Wedel

Beispiel: Programmiersprache mit Interpretierer und Compiler

weiter

weiter

Eine einfache Programmiersprache

Beispiel
für ein Kompositum mit mehreren Interpretierern zur Verarbeitung
weiter
Haskell
als Spezifikations- und Programmiersprache.
Dadurch wird die Spezifikation kurz aber gleichzeitig sogar auch ausführbar.
Abstrakte Syntax
in Haskell-Notation für den Programmbaum
weiter
einfacher Interpretierer
für die formatierte Ausgabe eines Programmbaums
weiter
Interpretierer
zum Ausführen eines Programms
weiter
2. Interpretierer
zum Übersetzen eines Programms in Code für eine einfache Kellermaschine
weiter
Ausprobieren
mit Hugs oder ghc. Interp.hs laden und p0, p1, p2 für die formatierte Ausgabe aufrufen, r0, r1, r2 fürs Interpretieren und c0, c1, c2 fürs Compilieren.
weiter
Download
weiter

weiter

Das Programm Interp.hs

   1module Main
   2where
   3
   4import           Data.Map (Map)
   5import qualified Data.Map as M
   6import           Data.Maybe
   7
   8-- ------------------------------------------------------------
   9--
  10-- the abstract syntax
  11
  12type Program    = Stmt
  13
  14type StmtList   = [Stmt]
  15
  16data Stmt
  17    = Assign  Ident  Expr
  18    | Stmts   StmtList 
  19    | If      Expr  Stmt Stmt
  20    | While   Expr  Stmt
  21
  22type Ident      = String
  23
  24data Expr
  25    = IntConst  Int
  26    | BoolConst Bool
  27    | Var       Ident
  28    | UnExpr    UnOp  Expr
  29    | BinExpr   Op    Expr  Expr
  30
  31data Op = Add | Sub | Mul | Div | Mod | Eq | Neq
  32        deriving (Eq, Ord)
  33
  34data UnOp = UPlus | UMinus | Neg
  35        deriving (Eq, Ord)
  36
  37-- ------------------------------------------------------------
  38--
  39-- example programs
  40
  41p0, p1, p2 :: Program
  42
  43p0 = Stmts []           -- the empty program
  44
  45p1 = Stmts              
  46     [ Assign i ( IntConst 22 )
  47     , Assign j ( IntConst 20 )
  48     , While
  49       ( BinExpr Neq ( Var i ) ( IntConst 0 ) )
  50       ( Stmts
  51         [ Assign i ( BinExpr Sub ( Var i ) ( IntConst 1 ) )
  52         , Assign j ( BinExpr Add ( Var j ) ( IntConst 1 ) )
  53         ]
  54       )
  55     ]
  56    where
  57    i = "i"
  58    j = "j"
  59
  60p2 = Stmts              
  61     [ Assign x (UnExpr UPlus (IntConst 6))
  62     , Assign y (IntConst 7)
  63     , Assign p (IntConst 0)
  64     , While
  65       ( BinExpr Neq (Var x) (IntConst 0) )
  66       ( If ( BinExpr Neq ( BinExpr Mod (Var x) (IntConst 2) ) (IntConst 0) )
  67            ( Stmts
  68              [ Assign x ( BinExpr Sub (Var x) (IntConst 1) )
  69              , Assign p ( BinExpr Add (Var p) (Var y) )
  70              ]
  71            )
  72            ( Stmts
  73              [ Assign x ( BinExpr Div (Var x) (IntConst 2) )
  74              , Assign y ( BinExpr Mul (Var y) (IntConst 2) )
  75              ]
  76            )
  77       )
  78     ]
  79    where
  80    x = "x"
  81    y = "y"
  82    p = "p"
  83
  84-- ------------------------------------------------------------
  85--
  86-- the "interpreter" for generating a text representation
  87-- more specific:
  88-- two interpeters: one for statements and one for expressions
  89--
  90-- the "show" is the equivaltent to "toString" in Java
  91
  92instance Show Stmt
  93    where
  94    show (Assign lhs rhs)
  95        = lhs ++ " := " ++ show rhs
  96
  97    show (If cond thenp elsep)
  98        = "if " ++ show cond ++ nl ++
  99          "then" ++ indent (show thenp) ++
 100          "else" ++ indent (show elsep) ++
 101          "end if"
 102
 103    show (While cond body)
 104        = "while " ++ show cond ++ nl ++
 105          "do" ++ indent (show body) ++
 106          "end while"
 107    show (Stmts [])
 108        = ""
 109    show (Stmts (s1:sl))
 110        = show s1 ++ concatMap (\ s -> ";" ++ nl ++ show s) sl
 111
 112-- ------------------------------------------------------------
 113
 114instance Show Expr
 115    where
 116    show (IntConst i)
 117        = show i
 118    show (BoolConst False)
 119        = "false"
 120    show (BoolConst True)
 121        = "true"
 122    show (Var id)
 123        = id
 124    show (UnExpr op op1)
 125        = show op ++ " ( " ++ show op1 ++ " )"
 126    show (BinExpr op op1 op2)
 127        = "( " ++ show op1 ++ " " ++ show op ++ " " ++ show op2 ++ " )"
 128
 129instance Show Op
 130    where
 131    show Add  = "+"
 132    show Sub  = "-"
 133    show Mul  = "*"
 134    show Div  = "div"
 135    show Mod  = "mod"
 136    show Eq   = "=="
 137    show Neq  = "!="
 138
 139instance Show UnOp
 140    where
 141    show UPlus  = "+"
 142    show UMinus = "-"
 143    show Neg    = "!"
 144
 145-- ------------------------------------------------------------
 146--
 147-- auxiliary functions
 148
 149nl      = "\n"
 150tab     = "\t"
 151
 152indent ""
 153    = nl
 154indent line
 155    = concatMap (\ c -> if c == '\n' then nl ++ "  " else [c]) (nl ++ line) ++ nl
 156
 157-- ------------------------------------------------------------
 158--
 159-- 2. example: program execution
 160--
 161-- the semantic domains for interpreting a program
 162--
 163-- state is an assoc list of variables and values,
 164-- there are two kinds of values: Ints and Booleans
 165
 166data State      = State { values :: Map Ident Value }
 167
 168data Value
 169    = IntValue  { intValue  :: Int  }
 170    | BoolValue { boolValue :: Bool }
 171
 172-- ------------------------------------------------------------
 173--
 174-- auxiliary fuction for readable output of program states
 175
 176instance Show State
 177    where
 178    show (State sl) = concat
 179                      . map ( \ (id,val) -> id ++ "\t:-> " ++ show val ++ "\n")
 180                      . M.assocs
 181                      $ sl
 182
 183instance Show Value
 184    where
 185    show (IntValue i)      = show i
 186    show (BoolValue True)  = "true"
 187    show (BoolValue False) = "false"
 188
 189-- ------------------------------------------------------------
 190--
 191-- the statement interpreter
 192
 193run     :: Stmt -> State
 194run s   = interprete s (State M.empty)
 195
 196interprete      :: Stmt -> State -> State
 197interprete (Assign lhs rhs) state@(State s)
 198    = State ( update lhs v s )
 199      where
 200      v = eval rhs state
 201      update k v s = M.insert k v s
 202
 203interprete (Stmts []) state
 204    = state
 205
 206interprete (Stmts (s:sl)) state
 207    = interprete (Stmts sl) state'
 208      where
 209      state' = interprete s state
 210
 211interprete (If cond thenp elsep) state
 212    = interprete (if boolValue (eval cond state)
 213                  then thenp
 214                  else elsep) state
 215
 216interprete w@(While cond body) state
 217    = if boolValue (eval cond state)
 218      then let
 219           state' = interprete body state
 220           in
 221           interprete w state'
 222      else
 223      state
 224
 225-- ------------------------------------------------------------
 226--
 227-- the expression interpreter
 228
 229eval    :: Expr -> State -> Value
 230
 231eval (IntConst i) _state
 232    = IntValue i
 233
 234eval (BoolConst b) _state
 235    = BoolValue b
 236
 237eval (Var id) (State s)
 238    = fromJust (M.lookup id s)
 239
 240eval (UnExpr op op1) state
 241    = (fromJust (lookup op fl))
 242         (eval op1 state)
 243      where
 244      fl = [ (UPlus,    uplus)
 245           , (UMinus,   uminus)
 246           , (Neg,      neg)
 247           ]
 248      uplus  (IntValue  i)      = IntValue i
 249      uminus (IntValue  i)      = IntValue (-i)
 250      neg    (BoolValue b)      = BoolValue (not b)
 251
 252
 253eval (BinExpr op op1 op2) state
 254    = (fromJust (lookup op fl))
 255         (eval op1 state)
 256         (eval op2 state)
 257      where
 258      fl = [ (Add,  add)
 259           , (Sub,  sub)
 260           , (Mul,  mul)
 261           , (Div,  divide)
 262           , (Mod,  modulo)
 263           , (Eq,   eq)
 264           , (Neq,  neq)
 265           ]
 266      add (IntValue i)  (IntValue j)
 267          = IntValue (i + j)
 268
 269      sub (IntValue i)  (IntValue j)
 270          = IntValue (i - j)
 271
 272      mul (IntValue i)  (IntValue j)
 273          = IntValue (i * j)
 274
 275      divide (IntValue i)  (IntValue j)
 276          = IntValue (i `div` j)
 277
 278      modulo (IntValue i)  (IntValue j)
 279          = IntValue (i `mod` j)
 280
 281      eq  (IntValue i)  (IntValue j)
 282          = BoolValue (i == j)
 283
 284      eq  (BoolValue b1) (BoolValue b2)
 285          = BoolValue (b1 == b2)
 286
 287      neq v1 v2
 288          = BoolValue (not res)
 289            where
 290            (BoolValue res) = eq v1 v2
 291
 292-- ------------------------------------------------------------
 293--
 294-- the semantic domains for compiling a program
 295--
 296-- the compile time state has three components
 297-- the environment, a map of variables and
 298-- associated addresses,
 299-- a counter for generating label names
 300-- and the code, a list of instructions so far generated
 301
 302data CState = CState { vars    :: Env
 303                     , labcnt  :: Label
 304                     , code    :: Code
 305                     }
 306
 307type Env         = Map Ident Address
 308type Address     = Int
 309type Label       = Int
 310type Code        = [Instr]
 311
 312data Instr
 313    = Load    Address
 314    | Lconst  Int
 315    | Store   Address
 316    | Compute Opcode
 317    | Goto    Label
 318    | Branch  Label
 319    | Lab     Label
 320
 321data Opcode
 322    = OpAdd | OpSub | OpMul | OpDiv | OpMod | OpEq
 323
 324
 325-- ------------------------------------------------------------
 326--
 327-- aux functions for manipulating the compile state
 328
 329appendCode      :: Code -> CState -> CState
 330appendCode cl cs
 331    = cs { code = code cs ++ cl }
 332
 333getAddr         :: Ident -> CState -> (Address, CState)
 334getAddr ident state
 335    = newAdr (M.lookup ident (vars state))
 336      where
 337      newAdr (Just adr)
 338          = (adr, state)
 339      newAdr Nothing
 340          = (next, state { vars = M.insert ident next (vars state) })
 341             where
 342             next = M.size (vars state)
 343
 344newLabel        :: CState -> (Label, CState)
 345newLabel state
 346    = (labcnt state, state {labcnt = labcnt state + 1})
 347
 348-- ------------------------------------------------------------
 349--
 350-- show assebmler code
 351--
 352-- for readable output of assembler instructions
 353
 354instance Show CState
 355    where
 356    show state = showCode (code state)
 357
 358instance Show Opcode
 359    where
 360    show OpAdd = "add"
 361    show OpSub = "sub"
 362    show OpMul = "mul"
 363    show OpDiv = "div"
 364    show OpMod = "mod"
 365    show OpEq  = "eq"
 366
 367instance Show Instr
 368    where
 369    show (Load adr)         = tab ++ "load"   ++ tab ++ "m(" ++ show adr ++ ")"
 370    show (Lconst v)         = tab ++ "lcnst"  ++ tab ++ show v
 371    show (Store adr)        = tab ++ "store"  ++ tab ++ "m(" ++ show adr ++ ")"
 372    show (Compute op)       = tab ++ show op
 373    show (Goto lab)         = tab ++ "jump"   ++ tab ++ "l" ++ show lab
 374    show (Branch lab)       = tab ++ "branch" ++ tab ++ "l" ++ show lab
 375    show (Lab lab)          = "l" ++ show lab ++ ":"
 376
 377showCode        :: Code -> String
 378showCode
 379    = concatMap ((++ "\n") . show)
 380
 381-- ------------------------------------------------------------
 382--
 383-- the compile functions
 384
 385compile :: Program -> CState
 386compile p
 387    = cstmt p initialCState
 388      where
 389      initialCState = CState M.empty 0 []
 390
 391-- ------------------------------------------------------------
 392--
 393-- compile expressions, no compile state change necessary
 394
 395cexpr   :: Expr -> Env -> Code
 396cexpr (IntConst i) _env
 397    = [Lconst i]
 398
 399cexpr (BoolConst b) _env
 400    = [Lconst (fromEnum b)]
 401
 402cexpr (Var id) env
 403    = [Load adr]
 404      where
 405      adr = fromJust (M.lookup id env)
 406
 407cexpr (UnExpr UPlus opr1) env
 408    = cexpr opr1 env
 409
 410cexpr (UnExpr UMinus opr1) env
 411    = cexpr (BinExpr Sub (IntConst 0) opr1) env
 412
 413cexpr (UnExpr Neg opr1) env
 414    = cexpr (BinExpr Sub (IntConst 1) opr1) env
 415
 416cexpr (BinExpr Eq opr1 opr2) env 
 417    = cexpr (UnExpr Neg (BinExpr Neq opr1 opr2)) env
 418
 419cexpr (BinExpr Neq opr1 opr2) env 
 420    = cexpr (BinExpr Sub opr1 opr2) env
 421
 422cexpr (BinExpr op opr1 opr2) env
 423    = cs1 ++ cs2 ++ [Compute (fromJust (lookup op mol))]
 424      where
 425      cs1 = cexpr opr1 env
 426      cs2 = cexpr opr2 env
 427      mol = [ (Add,  OpAdd)
 428            , (Sub,  OpSub)
 429            , (Mul,  OpMul)
 430            , (Div,  OpDiv)
 431            , (Mod,  OpMod)
 432            ]
 433
 434-- ------------------------------------------------------------
 435--
 436-- compile statements
 437-- the compile state consists of a variable address assoc list
 438-- a label count for generating new labels
 439-- and the so far generated code sequence
 440
 441cstmt   :: Stmt -> CState -> CState
 442cstmt (Assign lhs rhs) state
 443    = appendCode (crhs ++ clhs) state'
 444      where
 445      crhs = cexpr rhs (vars state)
 446      clhs = [Store adr]
 447      (adr, state') = getAddr lhs state
 448
 449cstmt (Stmts []) state
 450    = state
 451
 452cstmt (Stmts (s:sl)) state
 453    = cstmt (Stmts sl) state'
 454      where
 455      state' = cstmt s state
 456
 457cstmt (If cond thenp elsep) s0
 458    = s7
 459      where
 460      condCode = cexpr (UnExpr Neg cond) (vars s0)
 461      (l1, s1) = newLabel s0
 462      (l2, s2) = newLabel s1
 463      s3       = appendCode [Branch l1] s2
 464      s4       = cstmt thenp s3
 465      s5       = appendCode [ Goto l2
 466                            , Lab  l1] s4
 467      s6       = cstmt elsep s5
 468      s7       = appendCode [Lab l2] s6
 469
 470cstmt (While cond body) s0
 471    = s5
 472      where
 473      condCode = cexpr cond (vars s0)
 474      (l1, s1) = newLabel s0
 475      (l2, s2) = newLabel s1
 476      s3       = appendCode [ Goto l1
 477                            , Lab  l2] s2
 478      s4       = cstmt body s3
 479      s5       = appendCode ([ Lab l1 ] ++ condCode ++ [Branch l2]) s4
 480
 481-- ------------------------------------------------------------
 482--
 483-- tests
 484
 485initState       = State M.empty
 486
 487r0      = run p0
 488r1      = run p1
 489r2      = run p2
 490
 491
 492c0      = compile p0
 493c1      = compile p1
 494c2      = compile p2
 495
 496-- ------------------------------------------------------------
weiter

weiter

Konversion in Textformat: Beispiel 1

ghc -e p1 Interp
weiter

weiter

Konversion in Textformat: Beispiel 2

ghc -e p2 Interp
weiter

weiter

Interpretieren: Beispiel 1

ghc -e r1 Interp
weiter

weiter

Interpretieren: Beispiel 2

ghc -e r2 Interp
weiter

weiter

Compilieren: Beispiel 1

ghc -e c1 Interp
weiter

weiter

Compilieren: Beispiel 2

ghc -e c2 Interp
weiter

Letzte Änderung: 11.07.2012
© Prof. Dr. Uwe Schmidt
Prof. Dr. Uwe Schmidt FH Wedel