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