Imperative.hs

module Imperative.Imperative where



import Data.List



type Ident = String

data Expr
    = Lit String           -- Literal
    | Var Ident            -- Variable
    | App String [Expr]    -- Function call
    | Op String Expr Expr  -- Binary operator

type IsPar = Bool  --  Parallel or sequential loop?

data Stmt
    = Nop                        -- No-op
    | Ident := Expr              -- Assignment
    | Cond Expr Prog Prog        -- Conditional
    | For IsPar Expr Ident Prog  -- For loop

type Prog = [Stmt]

data Main = Main
    { mainInp  :: [Ident]
    , mainBody :: Prog
    }

instance Show Main
  where
    show = renderMain



paren :: String -> String
paren = ("(" ++) . (++ ")")

-- | Like 'unlines', but without the final newline
unLines :: [String] -> String
unLines = concat . intersperse "\n"

indent :: Int -> String -> String
indent n = unLines . map move . lines
  where
    move = (replicate n ' ' ++)

renderExpr :: Expr -> String
renderExpr (Lit a)        = a
renderExpr (Var ident)    = ident
renderExpr (App str args) = paren $ unwords (str : map renderExpr args)
renderExpr (Op str a b)   = paren $ unwords [renderExpr a, str, renderExpr b]

mkNop :: Prog -> Prog
mkNop []   = [Nop]
mkNop prog = prog

renderStmt :: Stmt -> String
renderStmt Nop             = "nop"
renderStmt (ident := expr) = ident ++ " := " ++ renderExpr expr
renderStmt (Cond cond tHEN eLSE)
    | isSmall =
        ("if " ++ renderExpr cond ++ " then " ++ tRend ++ " else " ++ eRend)
    | otherwise =
        ("\nif " ++ renderExpr cond ++ " then\n")
          ++
        indent 2 tRend
          ++
        "\nelse\n"
          ++
        indent 2 eRend
  where
    t       = mkNop tHEN
    e       = mkNop eLSE
    tRend   = renderProg t
    eRend   = renderProg e
    isSmall = length (lines tRend) <= 1 && length (lines eRend) <= 1
renderStmt (For isPar len index body) =
    (loop ++ index ++ " in 0 .. (" ++ renderExpr len ++ "-1) do\n")
      ++
    indent 2 (renderProg body)
  where
    loop = if isPar then "\npar " else "\nfor "

renderProg :: Prog -> String
renderProg = unLines . map renderStmt

renderMain :: Main -> String
renderMain (Main params prog) =
    ("main (" ++ concat (intersperse "," params) ++ ")\n")
      ++
    indent 2 (renderProg prog)

printMain :: Main -> IO ()
printMain = putStrLn . (++"\n") . renderMain