CurryInfo: icurry-3.2.0 / FlatCurry.CaseLifting.liftExp

liftExp :: Bool -> Expr -> LiftingState Expr
liftExp _ (Var v) = return (Var v)
liftExp _ (Lit l) = return (Lit l)
liftExp _ (Comb ct qn es) = do
  nes <- mapM (liftExp True) es
  return (Comb ct qn nes)

liftExp nested exp@(Case ct e brs) = do
  opts <- getOpts
  case e of
    Var _ -> liftCaseExp
    _     -> if liftCArg opts then liftCaseArg else liftCaseExp
 where
  liftCaseExp = do
    if nested -- lift case expression by creating new function
      then do
        cfn <- genFuncName "CASE"
        let vs       = unboundVars exp
            noneType = TCons ("Prelude","None") []
            caseFunc = Func cfn (length vs) Private noneType (Rule vs exp)
        casefun <- liftNewFun caseFunc
        modify (addFun2State casefun)
        return $ Comb FuncCall cfn (map Var vs)
      else do
        ne <- liftExp True e
        nbrs <- mapM liftBranch brs
        return $ Case ct ne nbrs

  liftBranch (Branch pat be) = do
    opts <- getOpts
    ne   <- liftExp (liftCase opts) be
    return (Branch pat ne)

  -- lift case with complex (non-variable) case argument:
  liftCaseArg = do
    ne  <- liftExp True e
    cfn <- genFuncName "COMPLEXCASE"
    let casevar    = maximum (0 : allVars exp) + 1
        vs         = unionMap unboundVarsInBranch brs
        noneType   = TCons ("Prelude","None") []
        caseFunc   = Func cfn (length vs + 1) Private noneType
                          (Rule (vs ++ [casevar]) (Case ct (Var casevar) brs))
    casefun <- liftNewFun caseFunc
    modify (addFun2State casefun)
    return $ Comb FuncCall cfn (map Var vs ++ [ne])

liftExp nested exp@(Let bs e)
 | nested -- lift nested let expressions by creating new function
 = do cfn <- genFuncName "LET"
      let vs       = unboundVars exp
          noneType = TCons ("Prelude","None") []
          letFunc  = Func cfn (length vs) Private noneType (Rule vs exp)
      letfun <- liftNewFun letFunc
      modify (addFun2State letfun)
      return $ Comb FuncCall cfn (map Var vs)
 | otherwise
 = do nes <- mapM (liftExp True) (map snd bs)
      ne <- liftExp True e
      return $ Let (zip (map fst bs) nes) ne

liftExp nested exp@(Free vs e)
 | nested -- lift nested free declarations by creating new function
 = do cfn <- genFuncName "FREE"
      let fvs      = unboundVars exp
          noneType = TCons ("Prelude","None") []
          freeFunc = Func cfn (length fvs) Private noneType (Rule fvs exp)
      freefun <- liftNewFun freeFunc
      modify (addFun2State freefun)
      return $ Comb FuncCall cfn (map Var fvs)
 | otherwise
 = do ne <- liftExp True e
      return (Free vs ne)

liftExp _ (Or e1 e2) = do
  ne1 <- liftExp True e1
  ne2 <- liftExp True e2
  return (Or ne1 ne2)

liftExp nested (Typed e te) = do
  ne <- liftExp nested e
  return (Typed ne te)

argument 2

deterministic operation

-- Lift nested cases/lets/free in expressions.
-- If the second argument is `True`, we are inside an expression where
-- lifting is necessary (e.g., in arguments of function calls).

<FAILING>

referentially transparent operation

no fixity defined

{(_,{Var}) |-> _ || (_,{Lit}) |-> _ || (_,{Comb}) |-> _ || (_,{Case}) |-> _ || ({True},{Let}) |-> _ || ({False},{Let}) |-> _ || ({True},{Free}) |-> _ || ({False},{Free}) |-> _ || (_,{Or}) |-> _ || (_,{Typed}) |-> _}

liftExp

no precedence defined

_

Prelude.Bool -> FlatCurry.Types.Expr
-> Control.Monad.Trans.State.StateT LiftState Data.Functor.Identity.Identity FlatCurry.Types.Expr

operation might suspend on free variables

possibly non-terminating

possibly non-reducible on same data term