Commit cb8efb73 authored by chak@cse.unsw.edu.au.'s avatar chak@cse.unsw.edu.au.
Browse files

Massive patch for the first months work adding System FC to GHC #8

Broken up massive patch -=chak
Original log message:  
This is (sadly) all done in one patch to avoid Darcs bugs.
It's not complete work... more FC stuff to come.  A compiler
using just this patch will fail dismally.
parent 9f8e195e
......@@ -40,6 +40,7 @@ import IdInfo ( cprInfo, ppCprInfo, strictnessInfo, ppStrictnessInfo )
import DataCon ( dataConTyCon )
import TyCon ( tupleTyConBoxity, isTupleTyCon )
import Type ( pprParendType, pprType, pprParendKind )
import Coercion ( coercionKindTyConApp )
import BasicTypes ( tupleParens, isNoOcc, isAlwaysActive )
import Util ( lengthIs )
import Outputable
......@@ -122,6 +123,14 @@ ppr_expr add_par (Type ty) = add_par (ptext SLIT("TYPE") <+> ppr ty) -- Wierd
ppr_expr add_par (Var name) = ppr name
ppr_expr add_par (Lit lit) = ppr lit
ppr_expr add_par (Cast expr co)
= add_par $
sep [pprParendExpr expr,
ptext SLIT("`cast`") <+> parens (pprCo co)]
where
pprCo co = sep [ppr co, dcolon <+> ppr (coercionKindTyConApp co)]
ppr_expr add_par expr@(Lam _ _)
= let
(bndrs, body) = collectBinders expr
......@@ -214,24 +223,6 @@ ppr_expr add_par (Let bind expr)
ppr_expr add_par (Note (SCC cc) expr)
= add_par (sep [pprCostCentreCore cc, pprCoreExpr expr])
#ifdef DEBUG
ppr_expr add_par (Note (Coerce to_ty from_ty) expr)
= add_par $
getPprStyle $ \ sty ->
if debugStyle sty then
sep [ptext SLIT("__coerce") <+>
sep [pprParendType to_ty, pprParendType from_ty],
pprParendExpr expr]
else
sep [hsep [ptext SLIT("__coerce"), pprParendType to_ty],
pprParendExpr expr]
#else
ppr_expr add_par (Note (Coerce to_ty from_ty) expr)
= add_par $
sep [sep [ptext SLIT("__coerce"), nest 2 (pprParendType to_ty)],
pprParendExpr expr]
#endif
ppr_expr add_par (Note InlineMe expr)
= add_par $ ptext SLIT("__inline_me") <+> pprParendExpr expr
......
......@@ -132,7 +132,7 @@ pexp (Let vd e) = (text "%let" <+> pvdefg vd) $$ (text "%in" <+> pexp e)
pexp (Case e vb ty alts) = sep [text "%case" <+> parens (paty ty) <+> paexp e,
text "%of" <+> pvbind vb]
$$ (indent (braces (vcat (punctuate (char ';') (map palt alts)))))
pexp (Coerce t e) = (text "%coerce" <+> paty t) $$ pexp e
pexp (Cast e co) = (text "%cast" <+> pexp e) $$ paty co
pexp (Note s e) = (text "%note" <+> pstring s) $$ pexp e
pexp (External n t) = (text "%external" <+> pstring n) $$ paty t
pexp e = pfexp e
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment