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 a -> Prog
genFlatCurry = trAProg
(\name imps types funcs ops ->
Prog name imps types (map genFlatFuncDecl funcs) ops)
genFlatFuncDecl :: AFuncDecl a -> FuncDecl
genFlatFuncDecl = trAFunc
(\name arity vis ty rule -> Func name arity vis ty $ genFlatRule rule)
genFlatRule :: ARule a -> Rule
genFlatRule = trARule
(\_ args e -> Rule (map fst args) $ genFlatExpr e)
(const External)
genFlatExpr :: AExpr a -> Expr
genFlatExpr = trAExpr
(const Var)
(const Lit)
(\_ ct name args -> Comb ct (fst name) args)
(\_ bs e -> Let (map (\(v, e') -> (fst v, e')) bs) e)
(\_ vs e -> Free (map fst vs) e)
(\_ e1 e2 -> Or e1 e2)
(\_ ct e bs -> Case ct e bs)
(\pat e -> Branch (genFlatPattern pat) e)
(\_ e ty -> Typed e ty)
genFlatPattern :: APattern a -> Pattern
genFlatPattern = trAPattern
(\_ name args -> Pattern (fst name) $ map fst args)
(const LPattern)
genFlatInterface :: Prog -> Prog
genFlatInterface =
updProgFuncs $ map $ updFuncRule $ const $ Rule [] $ Var 0