Commit dcb182ad authored by simonpj's avatar simonpj

[project @ 2004-09-02 15:21:12 by simonpj]

Preserve ExprWithTySig after type checking
parent 0e2c5824
......@@ -156,7 +156,8 @@ dsLExpr (L loc e) = putSrcSpanDs loc $ dsExpr e
dsExpr :: HsExpr Id -> DsM CoreExpr
dsExpr (HsPar x) = dsLExpr x
dsExpr (HsPar e) = dsLExpr e
dsExpr (ExprWithTySigOut e _) = dsLExpr e
dsExpr (HsVar var) = returnDs (Var var)
dsExpr (HsIPVar ip) = returnDs (Var (ipNameName ip))
dsExpr (HsLit lit) = dsLit lit
......
......@@ -123,9 +123,14 @@ data HsExpr id
-- type of input record)
(HsRecordBinds id)
| ExprWithTySig -- signature binding
| ExprWithTySig -- e :: type
(LHsExpr id)
(LHsType id)
| ExprWithTySigOut -- TRANSLATION
(LHsExpr id)
(LHsType Name) -- Retain the signature for round-tripping purposes
| ArithSeqIn -- arithmetic sequence
(ArithSeqInfo id)
| ArithSeqOut
......@@ -355,6 +360,9 @@ ppr_expr (RecordUpdOut aexp _ _ rbinds)
ppr_expr (ExprWithTySig expr sig)
= hang (nest 2 (ppr_lexpr expr) <+> dcolon)
4 (ppr sig)
ppr_expr (ExprWithTySigOut expr sig)
= hang (nest 2 (ppr_lexpr expr) <+> dcolon)
4 (ppr sig)
ppr_expr (ArithSeqIn info)
= brackets (ppr info)
......
......@@ -166,8 +166,7 @@ tc_expr in_expr@(ExprWithTySig expr poly_ty) res_ty
= addErrCtxt (exprCtxt in_expr) $
tcHsSigType ExprSigCtxt poly_ty `thenM` \ sig_tc_ty ->
tcThingWithSig sig_tc_ty (tcCheckRho expr) res_ty `thenM` \ (co_fn, expr') ->
returnM (co_fn <$> unLoc expr')
-- ToDo: nasty unLoc
returnM (co_fn <$> ExprWithTySigOut expr' poly_ty)
tc_expr (HsType ty) res_ty
= failWithTc (text "Can't handle type argument:" <+> ppr ty)
......
......@@ -482,6 +482,10 @@ zonkExpr env (RecordUpdOut expr in_ty out_ty rbinds)
zonkRbinds env rbinds `thenM` \ new_rbinds ->
returnM (RecordUpdOut new_expr new_in_ty new_out_ty new_rbinds)
zonkExpr env (ExprWithTySigOut e ty)
= do { e' <- zonkLExpr env e
; return (ExprWithTySigOut e' ty) }
zonkExpr env (ExprWithTySig _ _) = panic "zonkExpr env:ExprWithTySig"
zonkExpr env (ArithSeqIn _) = panic "zonkExpr env:ArithSeqIn"
zonkExpr env (PArrSeqIn _) = panic "zonkExpr env:PArrSeqIn"
......
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