let valargs = get_val_args (Var.varType f) args
genApplication (Left bndr) f (map Left valargs)
- -- A single alt case must be a selector. This means thee scrutinee is a simple
+ -- A single alt case must be a selector. This means the scrutinee is a simple
-- variable, the alternative is a dataalt with a single non-wild binder that
-- is also returned.
mkConcSm (bndr, expr@(CoreSyn.Case (CoreSyn.Var scrut) b ty [alt]))
-- | A function to wrap a builder-like function that expects its arguments to
-- be Literals
genLitArgs ::
- (dst -> func -> [Literal.Literal] -> res)
- -> (dst -> func -> [Either CoreSyn.CoreExpr AST.Expr] -> res)
-genLitArgs wrap dst func args = wrap dst func args'
- where
- args' = map exprToLit litargs
- -- FIXME: Check if we were passed an CoreSyn.App
- litargs = concat (map getLiterals exprargs)
- (exprargs, []) = Either.partitionEithers args
+ (dst -> func -> [Literal.Literal] -> TranslatorSession [AST.ConcSm])
+ -> (dst -> func -> [Either CoreSyn.CoreExpr AST.Expr] -> TranslatorSession [AST.ConcSm])
+genLitArgs wrap dst func args = do
+ hscenv <- MonadState.lift tsType $ getA tsHscEnv
+ let (exprargs, []) = Either.partitionEithers args
+ -- FIXME: Check if we were passed an CoreSyn.App
+ let litargs = concat (map (getLiterals hscenv) exprargs)
+ let args' = map exprToLit litargs
+ concsms <- wrap dst func args'
+ return concsms
-- | A function to wrap a builder-like function that produces an expression
-- and expects it to be assigned to the destination.
, (hwnotId , (1, genOperator1 AST.Not ) )
, (equalityId , (2, genOperator2 (AST.:=:) ) )
, (inEqualityId , (2, genOperator2 (AST.:/=:) ) )
+ , (ltId , (2, genOperator2 (AST.:<:) ) )
+ , (lteqId , (2, genOperator2 (AST.:<=:) ) )
+ , (gtId , (2, genOperator2 (AST.:>:) ) )
+ , (gteqId , (2, genOperator2 (AST.:>=:) ) )
, (boolOrId , (2, genOperator2 AST.Or ) )
, (boolAndId , (2, genOperator2 AST.And ) )
, (plusId , (2, genOperator2 (AST.:+:) ) )