Commit 8be8b43b authored by sof's avatar sof
Browse files

[project @ 1997-07-25 23:23:18 by sof]

new function: dsExprToGivenTy; removed: dsExprToAtom
parent 9614b62b
......@@ -13,7 +13,7 @@ module DsUtils (
combineGRHSMatchResults,
combineMatchResults,
dsExprToAtom, SYN_IE(DsCoreArg),
dsExprToAtomGivenTy, SYN_IE(DsCoreArg),
mkCoAlgCaseMatchResult,
mkAppDs, mkConDs, mkPrimDs, mkErrorAppDs,
mkCoLetsMatchResult,
......@@ -275,39 +275,43 @@ combineGRHSMatchResults match_result1 match_result2
%************************************************************************
\begin{code}
dsExprToAtom :: DsCoreArg -- The argument expression
dsArgToAtom :: DsCoreArg -- The argument expression
-> (CoreArg -> DsM CoreExpr) -- Something taking the argument *atom*,
-- and delivering an expression E
-> DsM CoreExpr -- Either E or let x=arg-expr in E
dsExprToAtom (UsageArg u) continue_with = continue_with (UsageArg u)
dsExprToAtom (TyArg t) continue_with = continue_with (TyArg t)
dsExprToAtom (LitArg l) continue_with = continue_with (LitArg l)
dsExprToAtom (VarArg (Var v)) continue_with = continue_with (VarArg v)
dsExprToAtom (VarArg (Lit v)) continue_with = continue_with (LitArg v)
dsExprToAtom (VarArg arg_expr) continue_with
= let
ty = coreExprType arg_expr
in
newSysLocalDs ty `thenDs` \ arg_id ->
dsArgToAtom (UsageArg u) continue_with = continue_with (UsageArg u)
dsArgToAtom (TyArg t) continue_with = continue_with (TyArg t)
dsArgToAtom (LitArg l) continue_with = continue_with (LitArg l)
dsArgToAtom (VarArg arg) continue_with = dsExprToAtomGivenTy arg (coreExprType arg) continue_with
dsExprToAtomGivenTy
:: CoreExpr -- The argument expression
-> Type -- Type of the argument
-> (CoreArg -> DsM CoreExpr) -- Something taking the argument *atom*,
-- and delivering an expression E
-> DsM CoreExpr -- Either E or let x=arg-expr in E
dsExprToAtomGivenTy (Var v) arg_ty continue_with = continue_with (VarArg v)
dsExprToAtomGivenTy (Lit v) arg_ty continue_with = continue_with (LitArg v)
dsExprToAtomGivenTy arg_expr arg_ty continue_with
= newSysLocalDs arg_ty `thenDs` \ arg_id ->
continue_with (VarArg arg_id) `thenDs` \ body ->
returnDs (
if isUnboxedType ty
if isUnboxedType arg_ty
then Case arg_expr (PrimAlts [] (BindDefault arg_id body))
else Let (NonRec arg_id arg_expr) body
)
dsExprsToAtoms :: [DsCoreArg]
dsArgsToAtoms :: [DsCoreArg]
-> ([CoreArg] -> DsM CoreExpr)
-> DsM CoreExpr
dsExprsToAtoms [] continue_with = continue_with []
dsArgsToAtoms [] continue_with = continue_with []
dsExprsToAtoms (arg:args) continue_with
= dsExprToAtom arg $ \ arg_atom ->
dsExprsToAtoms args $ \ arg_atoms ->
dsArgsToAtoms (arg:args) continue_with
= dsArgToAtom arg $ \ arg_atom ->
dsArgsToAtoms args $ \ arg_atoms ->
continue_with (arg_atom:arg_atoms)
\end{code}
......@@ -325,15 +329,15 @@ mkConDs :: Id -> [DsCoreArg] -> DsM CoreExpr
mkPrimDs :: PrimOp -> [DsCoreArg] -> DsM CoreExpr
mkAppDs fun args
= dsExprsToAtoms args $ \ atoms ->
= dsArgsToAtoms args $ \ atoms ->
returnDs (mkGenApp fun atoms)
mkConDs con args
= dsExprsToAtoms args $ \ atoms ->
returnDs (Con con atoms)
= dsArgsToAtoms args $ \ atoms ->
returnDs (Con con atoms)
mkPrimDs op args
= dsExprsToAtoms args $ \ atoms ->
= dsArgsToAtoms args $ \ atoms ->
returnDs (Prim op atoms)
\end{code}
......
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