module Generators.GenFlatCurry (genFlatCurry, genFlatInterface) where
import Curry.FlatCurry.Goodies
import Curry.FlatCurry.Type
import Curry.FlatCurry.Annotated.Goodies
import Curry.FlatCurry.Annotated.Type
genFlatCurry :: AProg TypeExpr -> Prog
genFlatCurry = trAProg
(\name imps types funcs ops ->
Prog name imps types (map genFlatFuncDecl funcs) ops)
genFlatFuncDecl :: AFuncDecl TypeExpr -> FuncDecl
genFlatFuncDecl = trAFunc
(\name arity vis ty rule -> Func name arity vis ty $ genFlatRule rule)
genFlatRule :: ARule TypeExpr -> Rule
genFlatRule = trARule
(\_ args e -> Rule (map fst args) $ genFlatExpr e)
(const External)
genFlatExpr :: AExpr TypeExpr -> Expr
genFlatExpr = trAExpr
(const Var)
(const Lit)
(\_ ct (name, _) args -> Comb ct name args)
(const $ Let . map (\(v, e') -> (fst v, e')))
(const $ Free . map fst)
(const Or)
(const Case)
(Branch . genFlatPattern)
(const Typed)
genFlatPattern :: APattern TypeExpr -> Pattern
genFlatPattern = trAPattern
(\_ (name, _) args -> Pattern name $ map fst args)
(const LPattern)
genFlatInterface :: Prog -> Prog
genFlatInterface =
updProgFuncs $ map $ updFuncRule $ const $ Rule [] $ Var 0