1 
    2 -- ==========================================================--
    3 -- === Pretty-printer                   prettyprint.m (1) ===--
    4 -- ==========================================================--
    5 
    6 module PrettyPrint where
    7 import BaseDefs
    8 import Utils
    9 import MyUtils
   10 
   11 -- ==========================================================--
   12 --
   13 ppPrintCExpr :: CExpr -> [Char]
   14 
   15 ppPrintCExpr = utiMkStr . ppPrintCExprMain
   16 
   17 
   18 -- ==========================================================--
   19 --
   20 ppPrintCExprMain (EVar v) = utiStr v
   21 ppPrintCExprMain (ENum n) = utiNum n
   22 ppPrintCExprMain (EConstr c) = utiStr c
   23 
   24 ppPrintCExprMain (EAp e1 e2) 
   25    = (ppPrintLAp e1) `utiAppend`
   26      ((utiStr " ") `utiAppend`
   27      (ppPrintRAp e2))
   28  
   29 ppPrintCExprMain (ELet isRec ds e)
   30    = (utiStr "let") `utiAppend` 
   31        (rec `utiAppend`
   32            ((utiIndent
   33                 (utiInterleave (utiStr ";\n")
   34                               [(utiStr n) `utiAppend`
   35                                ((utiStr " = ") `utiAppend`        
   36                                (ppPrintCExprMain e)) | (n,e) <- ds]
   37                 )
   38             ) `utiAppend`
   39                 ((utiStr "\nin ") `utiAppend`  (ppPrintCExprMain e))))
   40 
   41      where rec | isRec      = utiStr "rec\n  "
   42                | otherwise  = utiStr "\n  "
   43 
   44 ppPrintCExprMain (ELam vs e)
   45    = (utiStr "\\") `utiAppend` 
   46         ((utiInterleave (utiStr " ") (map utiStr vs)) `utiAppend`
   47      ((utiStr " -> ") `utiAppend` (utiIndent (ppPrintCExprMain e))))
   48 
   49 ppPrintCExprMain (ECase sw al)
   50    = (utiStr "case ") `utiAppend` ((ppPrintCExprMain sw) 
   51      `utiAppend` ((utiStr " of\n" ) `utiAppend`
   52      ((utiIndent
   53         (utiInterleave (utiStr ";\n")
   54         (map ppPrintAlter al) ) )
   55      `utiAppend` (utiStr "\nend"))))
   56 
   57 
   58 -- ==========================================================--
   59 --
   60 ppPrintAlter (cn, (cal, cexp)) 
   61    = (utiStr "  ") `utiAppend` ((utiStr cn) 
   62       `utiAppend` ((utiStr " ") `utiAppend`
   63       ((utiInterleave (utiStr " ")
   64       [(utiStr ca) | ca <- cal]) `utiAppend`
   65       ((utiStr " -> ") `utiAppend` ((utiIndent (ppPrintCExprMain cexp)))))))
   66 
   67 
   68 
   69 -- ==========================================================--
   70 --
   71 ppPrintRAp    (EVar v)      = utiStr v
   72 ppPrintRAp    (ENum n)      = utiNum n
   73 ppPrintRAp    (EConstr c)   = utiStr c
   74 ppPrintRAp    e             = (utiStr "(") `utiAppend` ((ppPrintCExprMain e) 
   75                                `utiAppend` (utiStr ")"))
   76 
   77 
   78 -- ==========================================================--
   79 --
   80 ppPrintLAp    (EVar v)      = utiStr v
   81 ppPrintLAp    (ENum n)      = utiNum n
   82 ppPrintLAp    (EConstr c)   = utiStr c
   83 ppPrintLAp    (EAp e1 e2)   = (ppPrintLAp e1) `utiAppend`
   84                               ((utiStr " ") `utiAppend`
   85                               (ppPrintRAp e2))
   86 ppPrintLAp    e             = (utiStr "(") `utiAppend` ((ppPrintCExprMain e) 
   87                               `utiAppend` (utiStr ")"))
   88 
   89 
   90 -- ==========================================================--
   91 --
   92 ppPrintTypeDef :: TypeDef -> [Char]
   93 
   94 ppPrintTypeDef = utiMkStr . ppPrintTypeDefMain
   95 
   96 ppPrintTypeDefMain (tn, tal, tcl) 
   97    = (utiStr tn) `utiAppend` 
   98      ((utiStr " ") `utiAppend`
   99      ((utiInterleave (utiStr " ") (map utiStr tal)) `utiAppend`
  100      ((utiStr " ::= ") `utiAppend` 
  101      ((utiIndent
  102          (utiInterleave (utiStr " |\n") 
  103          (map ppPrintConstrAlt tcl) ) )))))
  104 
  105 
  106 -- ==========================================================--
  107 --
  108 ppPrintConstrAlt (cn, ctes) 
  109    = (utiStr cn) `utiAppend` ((utiStr " ") `utiAppend`
  110      ((utiInterleave (utiStr " ") (map ppPrintTDefExpr ctes) )))
  111 
  112 
  113 -- ==========================================================--
  114 --
  115 ppPrintTDefExpr (TDefVar n) = utiStr n
  116 
  117 ppPrintTDefExpr (TDefCons n te) 
  118    = (utiStr "(") `utiAppend` ((utiStr n) `utiAppend` 
  119      ((utiStr " ") `utiAppend`
  120      ((utiInterleave (utiStr " ") (map ppPrintTDefExpr te)) `utiAppend`
  121      ((utiStr ")" )))))
  122 
  123 
  124 -- ==========================================================--
  125 --
  126 ppPrintParsed :: AtomicProgram -> [Char]
  127 
  128 ppPrintParsed (tds, ce) 
  129    = (tdsChars tds) ++ ";;\n\n" ++ (ppPrintCExpr ce)
  130      where
  131         tdsChars [] = ""
  132         tdsChars (t:ts) = "\n" ++ (ppPrintTypeDef t) ++ ";\n\n" 
  133                           ++ (tdsChars ts)
  134 
  135 -- ==========================================================--
  136 -- === End                              prettyprint.m (1) ===--
  137 -- ==========================================================--
  138