1 module Compiler(compile) where
    2 
    3 import Machine
    4 import Syntax
    5 import StackMap
    6 import Value
    7 
    8 compile :: Command -> [Instruction]
    9 compile c =
   10   replicate (depth sm) (Push Wrong) ++
   11   compObey sm c ++
   12   [Halt]
   13   where
   14   sm = stackMap c
   15 
   16 compObey :: StackMap -> Command -> [Instruction]
   17 compObey sm Skip = 
   18   []
   19 compObey sm (v := e) =
   20   compEval sm e ++
   21   [Store (location sm v + 1)]
   22 compObey sm (c1 :-> c2) =
   23   compObey sm c1 ++
   24   compObey sm c2
   25 compObey sm (If e c1 c2) =
   26   compEval sm e ++
   27   [JumpUnless (length isc1 + 1)] ++
   28   isc1 ++
   29   [Jump (length isc2)] ++
   30   isc2
   31   where
   32   isc1 = compObey sm c1
   33   isc2 = compObey sm c2
   34 compObey sm (While e c) =
   35   ise ++
   36   [JumpUnless (length isc + 1)] ++
   37   isc ++
   38   [Jump (negate (length isc + 1 + length ise + 1))]
   39   where
   40   ise = compEval sm e
   41   isc = compObey sm c
   42 compObey sm (Print e) =
   43   compEval sm e ++
   44   [Display]
   45 
   46 compEval :: StackMap -> Expr -> [Instruction]
   47 compEval sm (Val v) =
   48   [Push v]
   49 compEval sm (Var v) =
   50   [Fetch (location sm v)]
   51 compEval sm (Uno op1 e) =
   52   compEval sm e ++
   53   [Instr1 op1]
   54 compEval sm (Duo op2 e1 e2) =
   55   compEval sm        e1 ++
   56   compEval (push sm) e2 ++
   57   [Instr2 op2]