```-- Author: Danila Fedorin ``` ```import Data.List ``` ``` ``` ```-- Definitions ``` ```type Var = String ``` ```type Macro = String ``` ``` ``` ```data PenMode = Up | Down ``` ``` ``` ```data Expr = Variable Var ``` ``` | Number Int ``` ``` | Sum Expr Expr ``` ``` ``` ```data Cmd = Pen PenMode ``` ``` | Move Expr Expr ``` ``` | Define Macro [Var] Prog ``` ``` | Call Macro [Expr] ``` ``` ``` ```type Prog = [Cmd] ``` ``` ``` ```-- HW Code ``` ```-- define line(x1, y1, x2, y2) { ``` ```-- pen up; move (x1, y1); ``` ```-- pen down; move(x2, y2); ``` ```-- } ``` ```lineMacro = Define "line" [ "x1", "y1", "x2", "y2" ] ``` ``` [ Pen Up ``` ``` , Move (Variable "x1") (Variable "y1") ``` ``` , Pen Down ``` ``` , Move (Variable "x2") (Variable "y2") ``` ``` ] ``` ``` ``` ```-- define nix(x, y, w, h) { ``` ```-- call line(x, y, x + w, y + h); ``` ```-- call line(x + w, y, x, y + h); ``` ```-- } ``` ```nixMacro = Define "nix" [ "x", "y", "w", "h" ] ``` ``` [ Call "line" ``` ``` [ Variable "x" ``` ``` , Variable "y" ``` ``` , Sum (Variable "x") (Variable "w") ``` ``` , Sum (Variable "y") (Variable "h") ``` ``` ] ``` ``` , Call "line" ``` ``` [ Sum (Variable "x") (Variable "w") ``` ``` , Variable "y" ``` ``` , Variable "x" ``` ``` , Sum (Variable "y") (Variable "h") ``` ``` ] ``` ``` ] ``` ``` ``` ```steps :: Int -> Prog ``` ```steps n = base ++ stepList ``` ``` where ``` ``` base = [ Pen Up, Move (Number 0) (Number 0), Pen Down ] ``` ``` stepList = [1..n] >>= (\i -> [ Move (Number (i -1)) (Number i), Move (Number i) (Number i) ]) ``` ``` ``` ```prettyPrintExpr :: Expr -> String ``` ```prettyPrintExpr (Variable v) = v ``` ```prettyPrintExpr (Number i) = show i ``` ```prettyPrintExpr (Sum l r) = prettyPrintExpr l ++ "+" ++ prettyPrintExpr r ``` ``` ``` ```prettyPrintPenMode :: PenMode -> String ``` ```prettyPrintPenMode Up = "up" ``` ```prettyPrintPenMode Down = "down" ``` ``` ``` ```prettyPrintCmd :: Cmd -> [String] ``` ```prettyPrintCmd (Pen m) = [ "pen " ++ prettyPrintPenMode m ++ ";" ] ``` ```prettyPrintCmd (Move l r) = [ "move(" ++ prettyPrintExpr l ++ ", " ++ prettyPrintExpr r ++ ");" ] ``` ```prettyPrintCmd (Define m vs cmds) = ("define " ++ m ++ "(" ++ intercalate ", " vs ++ ") {") : map (" " ++) (cmds >>= prettyPrintCmd) ++ [ "}" ] ``` ```prettyPrintCmd (Call n xs) = [ "call " ++ n ++ "(" ++ intercalate ", " (map prettyPrintExpr xs) ++ ");" ] ``` ``` ``` ```pretty :: Prog -> String ``` ```pretty prog = intercalate "\n" \$ (prog >>= prettyPrintCmd) ++ [ "" ] ``` ``` ``` ```macros :: Prog -> [Macro] ``` ```macros xs = xs >>= macrosC ``` ``` where ``` ``` macrosC (Define n vs cs) = n:(cs >>= macrosC) ``` ``` macrosC _ = [] ``` ``` ``` ```sortWith :: Ord b => (a -> b) -> [a] -> [a] ``` ```sortWith f = sortBy (\l r -> compare (f l) (f r)) ``` ``` ``` ```optE :: Expr -> Expr ``` ```optE expr = mergeAll \$ sortWith exprOrdinal \$ listTerms expr ``` ``` where ``` ``` listTerms (Sum l r) = listTerms l ++ listTerms r ``` ``` listTerms e = [ e ] ``` ``` exprOrdinal (Number _) = 2 ``` ``` exprOrdinal _ = 1 ``` ``` mergeTwo (Number i1) (Number i2) = Number (i1 + i2) ``` ``` mergeTwo l r = Sum l r ``` ``` mergeAll [x] = x ``` ``` mergeAll xs = foldr1 mergeTwo xs ``` ``` ``` ```optP :: Prog -> Prog ``` ```optP = map optC ``` ``` where ``` ``` optC (Move e1 e2) = Move (optE e1) (optE e2) ``` ``` optC (Call n exs) = Call n (map optE exs) ``` ``` optC c = c ```