Commit 8585aac7 authored by Finn Teegen's avatar Finn Teegen
Browse files

Merge branch 'generators' into 'master'

Update FlatCurry generation pipeline

Closes #57

See merge request !41
parents 7151e705 86a07531
......@@ -42,8 +42,7 @@ genUntypedAbstractCurry :: CompilerEnv -> CS.Module PredType -> AC.CurryProg
genUntypedAbstractCurry = GAC.genAbstractCurry True
-- |Generate typed FlatCurry
genTypedFlatCurry :: CompilerEnv -> CS.Module Type -> IL.Module
-> TFC.TProg
genTypedFlatCurry :: AFC.AProg FC.TypeExpr -> TFC.TProg
genTypedFlatCurry = GTFC.genTypedFlatCurry
-- |Generate type-annotated FlatCurry
......@@ -52,7 +51,7 @@ genTypeAnnotatedFlatCurry :: CompilerEnv -> CS.Module Type -> IL.Module
genTypeAnnotatedFlatCurry = GTAFC.genTypeAnnotatedFlatCurry
-- |Generate FlatCurry
genFlatCurry :: TFC.TProg -> FC.Prog
genFlatCurry :: AFC.AProg FC.TypeExpr -> FC.Prog
genFlatCurry = GFC.genFlatCurry
-- |Generate a FlatCurry interface
......
......@@ -15,39 +15,39 @@ module Generators.GenFlatCurry (genFlatCurry, genFlatInterface) where
import Curry.FlatCurry.Goodies
import Curry.FlatCurry.Type
import Curry.FlatCurry.Typed.Goodies
import Curry.FlatCurry.Typed.Type
import Curry.FlatCurry.Annotated.Goodies
import Curry.FlatCurry.Annotated.Type
-- transforms annotated FlatCurry code to FlatCurry code
genFlatCurry :: TProg -> Prog
genFlatCurry = trTProg
genFlatCurry :: AProg TypeExpr -> Prog
genFlatCurry = trAProg
(\name imps types funcs ops ->
Prog name imps types (map genFlatFuncDecl funcs) ops)
genFlatFuncDecl :: TFuncDecl -> FuncDecl
genFlatFuncDecl = trTFunc
genFlatFuncDecl :: AFuncDecl TypeExpr -> FuncDecl
genFlatFuncDecl = trAFunc
(\name arity vis ty rule -> Func name arity vis ty $ genFlatRule rule)
genFlatRule :: TRule -> Rule
genFlatRule = trTRule
(\args e -> Rule (map fst args) $ genFlatExpr e)
genFlatRule :: ARule TypeExpr -> Rule
genFlatRule = trARule
(\_ args e -> Rule (map fst args) $ genFlatExpr e)
(const External)
genFlatExpr :: TExpr -> Expr
genFlatExpr = trTExpr
genFlatExpr :: AExpr TypeExpr -> Expr
genFlatExpr = trAExpr
(const Var)
(const Lit)
(\_ ct name args -> Comb ct name args)
(\bs e -> Let (map (\(v, e') -> (fst v, e')) bs) e)
(\vs e -> Free (map fst vs) e)
Or
Case
(\pat e -> Branch (genFlatPattern pat) e)
Typed
genFlatPattern :: TPattern -> Pattern
genFlatPattern = trTPattern
(\_ name args -> Pattern name $ map fst args)
(\_ 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)
-- transforms a FlatCurry module to a FlatCurry interface
......
This diff is collapsed.
......@@ -346,22 +346,22 @@ matchInterface ifn i = do
writeFlat :: Options -> CompilerEnv -> CS.Module Type -> IL.Module -> CYIO ()
writeFlat opts env mdl il = do
(_, tfc) <- dumpWith opts show (pPrint . genFlatCurry) DumpTypedFlatCurry (env, tfcyProg)
when tfcyTarget $ liftIO $ FC.writeFlatCurry (useSubDir tfcyName) tafcyProg
when tafcyTarget $ liftIO $ FC.writeFlatCurry (useSubDir tafcyName) tfc
(_, tafc) <- dumpWith opts show (pPrint . genFlatCurry) DumpTypedFlatCurry (env, tafcyProg)
when tafcyTarget $ liftIO $ FC.writeFlatCurry (useSubDir tafcyName) tafc
when tfcyTarget $ liftIO $ FC.writeFlatCurry (useSubDir tfcyName) tfcyProg
when fcyTarget $ do
(_, fc) <- dumpWith opts show pPrint DumpFlatCurry (env, fcyProg)
liftIO $ FC.writeFlatCurry (useSubDir fcyName) fc
writeFlatIntf opts env fcyProg
where
tfcyName = typedFlatName (filePath env)
tfcyProg = genTypedFlatCurry env mdl il
tfcyTarget = TypedFlatCurry `elem` optTargetTypes opts
tafcyName = typeAnnFlatName (filePath env)
tafcyProg = genTypeAnnotatedFlatCurry env mdl il
tafcyTarget = TypeAnnotatedFlatCurry `elem` optTargetTypes opts
tfcyName = typedFlatName (filePath env)
tfcyProg = genTypedFlatCurry tafcyProg
tfcyTarget = TypedFlatCurry `elem` optTargetTypes opts
fcyName = flatName (filePath env)
fcyProg = genFlatCurry tfcyProg
fcyProg = genFlatCurry tafcyProg
fcyTarget = FlatCurry `elem` optTargetTypes opts
useSubDir = addOutDirModule (optUseOutDir opts) (optOutDir opts) (moduleIdent env)
......
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