103 lines
2.9 KiB
Haskell
103 lines
2.9 KiB
Haskell
-- 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
|