<br />
<b>Deprecated</b>:  The each() function is deprecated. This message will be suppressed on further calls in <b>/home/zhenxiangba/zhenxiangba.com/public_html/phproxy-improved-master/index.php</b> on line <b>456</b><br />
module Trans where


splitAtLast (x : xs)
  | null xs
    = ([] , x)
  | otherwise
    = let
        (bs , a)
          = splitAtLast xs
      in
      (x : bs , a)


type Var
  = String

type Num
  = Int


type AM
  = [AMAtom]

data AMAtom
  = PushN Num
  | Add
  | Mult
  | Sub
  | PushT Bool
  | Eq
  | Le
  | And
  | Neg
  | Fetch Var
  | Store Var
  | Noop
  | Branch AM AM
  | Loop AM


data AExp
  = AConst Num
  | Var Var
  | AExp :+: AExp
  | AExp :-: AExp
  | AExp :*: AExp

data BExp
  = BConst Bool
  | AExp :=: AExp
  | AExp :<=: AExp
  | Not BExp
  | BExp :&: BExp

data W
  = Assign Var AExp
  | Skip
  | W :. W
  | Cond BExp W W
  | While BExp W


class SX a where
  atomic :: a -> Bool


instance SX AExp where
  atomic e
    = case e of
        AConst _
          -> True
        Var _
          -> True
        _
          -> False

instance SX BExp where
  atomic e
    = case e of
        e1 :&: e2
          -> False
        _
          -> True

instance SX W where
  atomic s
    = case s of
        Assign _ _
          -> True
        Skip
          -> True
        _
          -> False

instance SX AMAtom where
  atomic _
    = True

instance SX a => SX [a] where
  atomic _
    = False

pShowsPrec z w s
  | atomic w
    = showsPrec z w s
  | otherwise
    = '(' : showsPrec z w (')' : s)
        

instance Show AMAtom where
  showsPrec z a s
    = let
        help
          = case a of
              Add
                -> "ADD"
              Mult
                -> "MULT"
              Sub
                -> "SUB"
              Eq
                -> "EQ"
              Le
                -> "LE"
              And
                -> "AND"
              Neg
                -> "NEG"
              Noop
                -> "NOOP"
      in
      case a of
        PushN n
          -> "PUSHN-" ++ showsPrec z n s
        PushT t
          -> "PUSHT-" ++ showsPrec z t s
        Fetch x
          -> "FETCH-" ++ x ++ s
        Store x
          -> "STORE-" ++ x ++ s
        Branch xs ys
          -> "BRANCH " ++ pShowsPrec z xs (' ' : pShowsPrec z ys s)
        Loop xs
          -> "LOOP " ++ pShowsPrec z xs s
        _
          -> help ++ s
  showList as s
    | null as
      = "eps" ++ s
    | otherwise
      = let
          (bs , a)
            = splitAtLast as
        in
        foldr (\a s -> pShowsPrec 0 a (" ; " ++ s)) (pShowsPrec 0 a s) bs

instance Show AExp where
  showsPrec z exp s
    = case exp of
        AConst n
          -> showsPrec z n s
        Var x
          -> showsPrec z x s
        e1 :+: e2
          -> pShowsPrec z e1 (" + " ++ pShowsPrec z e2 s)
        e1 :-: e2
          -> pShowsPrec z e1 (" - " ++ pShowsPrec z e2 s)
        e1 :*: e2
          -> pShowsPrec z e1 (" * " ++ pShowsPrec z e2 s)

instance Show BExp where
  showsPrec z exp s
    = case exp of
        BConst b
          -> showsPrec z b s
        e1 :=: e2
          -> showsPrec z e1 (" = " ++ showsPrec z e2 s)
        e1 :<=: e2
          -> showsPrec z e1 (" <= " ++ showsPrec z e2 s)
        Not e
          -> "not " ++ pShowsPrec z e s
        e1 :&: e2
          -> pShowsPrec z e1 (" and " ++ pShowsPrec z e2 s)

instance Show W where
  showsPrec z stmt s
    = case stmt of
        Assign x e
          -> showsPrec z x (" := " ++ showsPrec z e s)
        Skip
          -> "skip" ++ s
        s1 :. s2
          -> pShowsPrec z s1 (" ; " ++ pShowsPrec z s2 s)
        Cond e s1 s2
          -> "if" ++ 
             showsPrec z e (
               " then " ++ 
               showsPrec z s1 (
                 " else " ++ showsPrec z s2 s
               )
             )
        While e s1
          -> "while " ++ showsPrec z e (" do " ++ showsPrec z s1 s)


class Trans a where
  trans :: a -> AM
  transsPrec :: a -> AM -> AM

  trans
    = flip transsPrec []
  transsPrec x as
    = trans x ++ as


instance Trans AExp where
  transsPrec e as
    = case e of
        AConst n
          -> PushN n : as
        Var x
          -> Fetch x : as
        e1 :+: e2
          -> transsPrec e2 (transsPrec e1 (Add : as))
        e1 :-: e2
          -> transsPrec e2 (transsPrec e1 (Sub : as))
        e1 :*: e2
          -> transsPrec e2 (transsPrec e1 (Mult : as))

instance Trans BExp where
  transsPrec e as
    = case e of
        BConst t
          -> PushT t : as
        e1 :=: e2
          -> transsPrec e2 (transsPrec e1 (Eq : as))
        e1 :<=: e2
          -> transsPrec e2 (transsPrec e1 (Le : as))
        Not e1
          -> transsPrec e1 (Neg : as)
        e1 :&: e2
          -> transsPrec e2 (transsPrec e1 (And : as))

instance Trans W where
  transsPrec s as
    = case s of
        Assign x e
          -> transsPrec e (Store x : as)
        Skip
          -> Noop : as
        s1 :. s2
          -> transsPrec s1 (transsPrec s2 as)
        Cond e s1 s2
          -> transsPrec e (Branch (trans s1) (trans s2) : as)
        While e s1
          -> let
               help
                 = trans e
             in
             help ++ Loop (transsPrec s1 help) : as