Skip to content

GitLab

Commit 79782290 authored by Kai-Oliver Prott's avatar Kai-Oliver Prott Committed by Finn Teegen
Browse files

Change TypedFlatCurry while keeping the old one as TypeAnnotatedFlat...

parent 242037ad
Expand all Hide whitespace changes
Inline Side-by-side
curry-frontend.cabal
View file @ 79782290
......@@ -108,6 +108,7 @@ Library
, Generators.GenAbstractCurry
, Generators.GenFlatCurry
, Generators.GenTypedFlatCurry
, Generators.GenTypeAnnotatedFlatCurry
, Html.CurryHtml
, Html.SyntaxColoring
, IL
......
src/CompilerOpts.hs
View file @ 79782290
......@@ -174,13 +174,14 @@ verbosities = [ ( VerbQuiet , "0", "quiet" )
-- |Type of the target file
data TargetType
= Tokens -- ^ Source code tokens
| Parsed -- ^ Parsed source code
| FlatCurry -- ^ FlatCurry
| TypedFlatCurry -- ^ Typed FlatCurry
| AbstractCurry -- ^ AbstractCurry
| UntypedAbstractCurry -- ^ Untyped AbstractCurry
| Html -- ^ HTML documentation
= Tokens -- ^ Source code tokens
| Parsed -- ^ Parsed source code
| FlatCurry -- ^ FlatCurry
| TypedFlatCurry -- ^ Typed FlatCurry
| TypeAnnotatedFlatCurry -- ^ Type-annotated FlatCurry
| AbstractCurry -- ^ AbstractCurry
| UntypedAbstractCurry -- ^ Untyped AbstractCurry
| Html -- ^ HTML documentation
deriving (Eq, Show)
-- |Warnings flags
......@@ -421,19 +422,21 @@ options =
addFlag WarnOverlapping (wnWarnFlags opts) }))
"do not print warnings for overlapping rules"
-- target types
, targetOption Tokens "tokens"
, targetOption Tokens "tokens"
"generate token stream"
, targetOption Parsed "parse-only"
, targetOption Parsed "parse-only"
"generate source representation"
, targetOption FlatCurry "flat"
, targetOption FlatCurry "flat"
"generate FlatCurry code"
, targetOption TypedFlatCurry "typed-flat"
, targetOption TypedFlatCurry "typed-flat"
"generate typed FlatCurry code"
, targetOption AbstractCurry "acy"
, targetOption TypeAnnotatedFlatCurry "typed-flat"
"generate type-annotated FlatCurry code"
, targetOption AbstractCurry "acy"
"generate typed AbstractCurry"
, targetOption UntypedAbstractCurry "uacy"
, targetOption UntypedAbstractCurry "uacy"
"generate untyped AbstractCurry"
, targetOption Html "html"
, targetOption Html "html"
"generate html documentation"
, Option "F" []
(NoArg (onPrepOpts $ \ opts -> opts { ppPreprocess = True }))
......
src/CurryBuilder.hs
View file @ 79782290
......@@ -165,13 +165,14 @@ process opts idx m fn deps
destFiles = [ gen fn | (t, gen) <- nameGens, t `elem` optTargetTypes opts]
nameGens =
[ (Tokens , tgtDir . tokensName )
, (Parsed , tgtDir . sourceRepName)
, (FlatCurry , tgtDir . flatName )
, (TypedFlatCurry , tgtDir . typedFlatName)
, (AbstractCurry , tgtDir . acyName )
, (UntypedAbstractCurry, tgtDir . uacyName )
, (Html , const (fromMaybe "." (optHtmlDir opts) </> htmlName m))
[ (Tokens , tgtDir . tokensName )
, (Parsed , tgtDir . sourceRepName )
, (FlatCurry , tgtDir . flatName )
, (TypedFlatCurry , tgtDir . typedFlatName )
, (TypeAnnotatedFlatCurry, tgtDir . typeAnnFlatName)
, (AbstractCurry , tgtDir . acyName )
, (UntypedAbstractCurry , tgtDir . uacyName )
, (Html , const (fromMaybe "." (optHtmlDir opts) </> htmlName m))
]
-- |Create a status message like
......
src/Generators.hs
View file @ 79782290
......@@ -13,16 +13,19 @@
-}
module Generators where
import qualified Curry.AbstractCurry as AC (CurryProg)
import qualified Curry.FlatCurry.Type as FC (Prog)
import qualified Curry.FlatCurry.Annotated.Type as AFC (AProg, TypeExpr)
import qualified Curry.Syntax as CS (Module)
import qualified Generators.GenAbstractCurry as GAC (genAbstractCurry)
import qualified Generators.GenFlatCurry as GFC ( genFlatCurry
, genFlatInterface
)
import qualified Generators.GenTypedFlatCurry as GTFC (genTypedFlatCurry)
import qualified Curry.AbstractCurry as AC (CurryProg)
import qualified Curry.FlatCurry.Type as FC (Prog, TypeExpr)
import qualified Curry.FlatCurry.Annotated.Type as AFC (AProg)
import qualified Curry.FlatCurry.Typed.Type as TFC (TProg)
import qualified Curry.Syntax as CS (Module)
import qualified Generators.GenAbstractCurry as GAC (genAbstractCurry)
import qualified Generators.GenFlatCurry as GFC ( genFlatCurry
, genFlatInterface
)
import qualified Generators.GenTypeAnnotatedFlatCurry
as GTAFC (genTypeAnnotatedFlatCurry)
import qualified Generators.GenTypedFlatCurry as GTFC (genTypedFlatCurry)
import Base.Types (Type, PredType)
......@@ -39,11 +42,16 @@ genUntypedAbstractCurry = GAC.genAbstractCurry True
-- |Generate typed FlatCurry
genTypedFlatCurry :: CompilerEnv -> CS.Module Type -> IL.Module
-> AFC.AProg AFC.TypeExpr
-> TFC.TProg
genTypedFlatCurry = GTFC.genTypedFlatCurry
-- |Generate type-annotated FlatCurry
genTypeAnnotatedFlatCurry :: CompilerEnv -> CS.Module Type -> IL.Module
-> AFC.AProg FC.TypeExpr
genTypeAnnotatedFlatCurry = GTAFC.genTypeAnnotatedFlatCurry
-- |Generate FlatCurry
genFlatCurry :: AFC.AProg a -> FC.Prog
genFlatCurry :: TFC.TProg -> FC.Prog
genFlatCurry = GFC.genFlatCurry
-- |Generate a FlatCurry interface
......
src/Generators/GenFlatCurry.hs
View file @ 79782290
......@@ -15,39 +15,39 @@ module Generators.GenFlatCurry (genFlatCurry, genFlatInterface) where
import Curry.FlatCurry.Goodies
import Curry.FlatCurry.Type
import Curry.FlatCurry.Annotated.Goodies
import Curry.FlatCurry.Annotated.Type
import Curry.FlatCurry.Typed.Goodies
import Curry.FlatCurry.Typed.Type
-- transforms annotated FlatCurry code to FlatCurry code
genFlatCurry :: AProg a -> Prog
genFlatCurry = trAProg
genFlatCurry :: TProg -> Prog
genFlatCurry = trTProg
(\name imps types funcs ops ->
Prog name imps types (map genFlatFuncDecl funcs) ops)
genFlatFuncDecl :: AFuncDecl a -> FuncDecl
genFlatFuncDecl = trAFunc
genFlatFuncDecl :: TFuncDecl -> FuncDecl
genFlatFuncDecl = trTFunc
(\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)
genFlatRule :: TRule -> Rule
genFlatRule = trTRule
(\args e -> Rule (map fst args) $ genFlatExpr e)
(const External)
genFlatExpr :: AExpr a -> Expr
genFlatExpr = trAExpr
genFlatExpr :: TExpr -> Expr
genFlatExpr = trTExpr
(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)
(\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)
Or
Case
(\pat e -> Branch (genFlatPattern pat) e)
(\_ e ty -> Typed e ty)
Typed
genFlatPattern :: APattern a -> Pattern
genFlatPattern = trAPattern
(\_ name args -> Pattern (fst name) $ map fst args)
genFlatPattern :: TPattern -> Pattern
genFlatPattern = trTPattern
(\name args -> Pattern (fst name) $ map fst args)
(const LPattern)
-- transforms a FlatCurry module to a FlatCurry interface
......
src/Generators/GenTypeAnnotatedFlatCurry.hs 0 → 100644
View file @ 79782290
This diff is collapsed.
src/Generators/GenTypedFlatCurry.hs
View file @ 79782290
......@@ -28,9 +28,8 @@ import qualified Data.Map as Map (Map, empty, insert, lookup)
import qualified Data.Set as Set (Set, empty, insert, member)
import Curry.Base.Ident
import Curry.FlatCurry.Annotated.Goodies (typeName)
import Curry.FlatCurry.Annotated.Type
import Curry.FlatCurry.Annotated.Typing
import Curry.FlatCurry.Typed.Goodies (typeName)
import Curry.FlatCurry.Typed.Type
import qualified Curry.Syntax as CS
import Base.CurryTypes (toType)
......@@ -45,21 +44,21 @@ import Env.OpPrec (mkPrec)
import Env.TypeConstructor (TCEnv)
import Env.Value (ValueEnv, ValueInfo (..), qualLookupValue)
import qualified IL as IL
import qualified IL
import Transformations (transType)
-- transforms intermediate language code (IL) to typed FlatCurry code
genTypedFlatCurry :: CompilerEnv -> CS.Module Type -> IL.Module
-> AProg TypeExpr
-> TProg
genTypedFlatCurry env mdl il = patchPrelude $ run env mdl (trModule il)
-- -----------------------------------------------------------------------------
-- Addition of primitive types for lists and tuples to the Prelude
-- -----------------------------------------------------------------------------
patchPrelude :: AProg a -> AProg a
patchPrelude p@(AProg n _ ts fs os)
| n == prelude = AProg n [] ts' fs os
patchPrelude :: TProg -> TProg
patchPrelude p@(TProg n _ ts fs os)
| n == prelude = TProg n [] ts' fs os
| otherwise = p
where ts' = sortBy (compare `on` typeName) pts
pts = primTypes ++ ts
......@@ -222,14 +221,14 @@ trIOpDecl _ = return []
-- Translation of a module
-- -----------------------------------------------------------------------------
trModule :: IL.Module -> FlatState (AProg TypeExpr)
trModule :: IL.Module -> FlatState TProg
trModule (IL.Module mid is ds) = do
is' <- getImports is
sns <- getTypeSynonyms >>= concatMapM trTypeSynonym
tds <- concatMapM trTypeDecl ds
fds <- concatMapM (return . map runNormalization <=< trAFuncDecl) ds
fds <- concatMapM (return . map runNormalization <=< trTFuncDecl) ds
ops <- getFixities >>= concatMapM trIOpDecl
return $ AProg (moduleName mid) is' (sns ++ tds) fds ops
return $ TProg (moduleName mid) is' (sns ++ tds) fds ops
-- Translate a type synonym
trTypeSynonym :: CS.Decl a -> FlatState [TypeDecl]
......@@ -291,64 +290,60 @@ cvFixity CS.Infix = InfixOp
-- -----------------------------------------------------------------------------
-- Translate a function declaration
trAFuncDecl :: IL.Decl -> FlatState [AFuncDecl TypeExpr]
trAFuncDecl (IL.FunctionDecl f vs _ e) = do
trTFuncDecl :: IL.Decl -> FlatState [TFuncDecl]
trTFuncDecl (IL.FunctionDecl f vs _ e) = do
f' <- trQualIdent f
a <- getArity f
vis <- getVisibility f
ty' <- trType ty
r' <- trARule ty vs e
return [AFunc f' a vis ty' r']
r' <- trTRule vs e
return [TFunc f' a vis ty' r']
where ty = foldr IL.TypeArrow (IL.typeOf e) $ map fst vs
trAFuncDecl (IL.ExternalDecl f ty) = do
trTFuncDecl (IL.ExternalDecl f ty) = do
f' <- trQualIdent f
a <- getArity f
vis <- getVisibility f
ty' <- trType ty
r' <- trAExternal ty f
return [AFunc f' a vis ty' r']
trAFuncDecl _ = return []
r' <- trTExternal ty f
return [TFunc f' a vis ty' r']
trTFuncDecl _ = return []
-- Translate a function rule.
-- Resets variable index so that for every rule variables start with index 1
trARule :: IL.Type -> [(IL.Type, Ident)] -> IL.Expression
-> FlatState (ARule TypeExpr)
trARule ty vs e = withFreshEnv $ ARule <$> trType ty
<*> mapM (uncurry newVar) vs
<*> trAExpr e
trTRule :: [(IL.Type, Ident)] -> IL.Expression
-> FlatState TRule
trTRule vs e = withFreshEnv $ TRule <$> mapM (uncurry newVar) vs
<*> trTExpr e
trAExternal :: IL.Type -> QualIdent -> FlatState (ARule TypeExpr)
trAExternal ty f = flip AExternal (qualName f) <$> trType ty
trTExternal :: IL.Type -> QualIdent -> FlatState TRule
trTExternal ty f = flip TExternal (qualName f) <$> trType ty
-- Translate an expression
trAExpr :: IL.Expression -> FlatState (AExpr TypeExpr)
trAExpr (IL.Literal ty l) = ALit <$> trType ty <*> trLiteral l
trAExpr (IL.Variable ty v) = AVar <$> trType ty <*> getVarIndex v
trAExpr (IL.Function ty f _) = genCall Fun ty f []
trAExpr (IL.Constructor ty c _) = genCall Con ty c []
trAExpr (IL.Apply e1 e2) = trApply e1 e2
trAExpr c@(IL.Case t e bs) = flip ACase (cvEval t) <$> trType (IL.typeOf c) <*> trAExpr e
trTExpr :: IL.Expression -> FlatState TExpr
trTExpr (IL.Literal ty l) = TLit <$> trType ty <*> trLiteral l
trTExpr (IL.Variable ty v) = TVarE <$> trType ty <*> getVarIndex v
trTExpr (IL.Function ty f _) = genCall Fun ty f []
trTExpr (IL.Constructor ty c _) = genCall Con ty c []
trTExpr (IL.Apply e1 e2) = trApply e1 e2
trTExpr (IL.Case t e bs) = TCase (cvEval t) <$> trTExpr e
<*> mapM (inNestedEnv . trAlt) bs
trAExpr (IL.Or e1 e2) = AOr <$> trType (IL.typeOf e1) <*> trAExpr e1 <*> trAExpr e2
trAExpr (IL.Exist v ty e) = inNestedEnv $ do
trTExpr (IL.Or e1 e2) = TOr <$> trTExpr e1 <*> trTExpr e2
trTExpr (IL.Exist v ty e) = inNestedEnv $ do
v' <- newVar ty v
e' <- trAExpr e
ty' <- trType (IL.typeOf e)
return $ case e' of AFree ty'' vs e'' -> AFree ty'' (v' : vs) e''
_ -> AFree ty' (v' : []) e'
trAExpr (IL.Let (IL.Binding v b) e) = inNestedEnv $ do
e' <- trTExpr e
return $ case e' of TFree vs e'' -> TFree (v' : vs) e''
_ -> TFree (v' : []) e'
trTExpr (IL.Let (IL.Binding v b) e) = inNestedEnv $ do
v' <- newVar (IL.typeOf b) v
b' <- trAExpr b
e' <- trAExpr e
ty' <- trType $ IL.typeOf e
return $ case e' of ALet ty'' bs e'' -> ALet ty'' ((v', b'):bs) e''
_ -> ALet ty' ((v', b'):[]) e'
trAExpr (IL.Letrec bs e) = inNestedEnv $ do
b' <- trTExpr b
e' <- trTExpr e
return $ case e' of TLet bs e'' -> TLet ((v', b'):bs) e''
_ -> TLet ((v', b'):[]) e'
trTExpr (IL.Letrec bs e) = inNestedEnv $ do
let (vs, es) = unzip [ ((IL.typeOf b, v), b) | IL.Binding v b <- bs]
ALet <$> trType (IL.typeOf e)
<*> (zip <$> mapM (uncurry newVar) vs <*> mapM trAExpr es)
<*> trAExpr e
trAExpr (IL.Typed e _) = ATyped <$> ty' <*> trAExpr e <*> ty'
TLet <$> (zip <$> mapM (uncurry newVar) vs <*> mapM trTExpr es)
<*> trTExpr e
trTExpr (IL.Typed e _) = TTyped <$> trTExpr e <*> ty'
where ty' = trType $ IL.typeOf e
-- Translate a literal
......@@ -358,7 +353,7 @@ trLiteral (IL.Int i) = return $ Intc i
trLiteral (IL.Float f) = return $ Floatc f
-- Translate a higher-order application
trApply :: IL.Expression -> IL.Expression -> FlatState (AExpr TypeExpr)
trApply :: IL.Expression -> IL.Expression -> FlatState TExpr
trApply e1 e2 = genFlatApplic e1 [e2]
where
genFlatApplic e es = case e of
......@@ -366,19 +361,19 @@ trApply e1 e2 = genFlatApplic e1 [e2]
IL.Function ty f _ -> genCall Fun ty f es
IL.Constructor ty c _ -> genCall Con ty c es
_ -> do
expr <- trAExpr e
expr <- trTExpr e
genApply expr es
-- Translate an alternative
trAlt :: IL.Alt -> FlatState (ABranchExpr TypeExpr)
trAlt (IL.Alt p e) = ABranch <$> trPat p <*> trAExpr e
trAlt :: IL.Alt -> FlatState TBranchExpr
trAlt (IL.Alt p e) = TBranch <$> trPat p <*> trTExpr e
-- Translate a pattern
trPat :: IL.ConstrTerm -> FlatState (APattern TypeExpr)
trPat (IL.LiteralPattern ty l) = ALPattern <$> trType ty <*> trLiteral l
trPat :: IL.ConstrTerm -> FlatState TPattern
trPat (IL.LiteralPattern ty l) = TLPattern <$> trType ty <*> trLiteral l
trPat (IL.ConstructorPattern ty c vs) = do
qty <- trType $ foldr IL.TypeArrow ty $ map fst vs
APattern <$> trType ty <*> ((\q -> (q, qty)) <$> trQualIdent c) <*> mapM (uncurry newVar) vs
qty <- trType $ foldr (IL.TypeArrow . fst) ty vs
TPattern <$> ((\q -> (q, qty)) <$> trQualIdent c) <*> mapM (uncurry newVar) vs
trPat (IL.VariablePattern _ _) = internalError "GenTypedFlatCurry.trPat"
-- Convert a case type
......@@ -390,16 +385,16 @@ data Call = Fun | Con
-- Generate a function or constructor call
genCall :: Call -> IL.Type -> QualIdent -> [IL.Expression]
-> FlatState (AExpr TypeExpr)
-> FlatState TExpr
genCall call ty f es = do
f' <- trQualIdent f
arity <- getArity f
case compare supplied arity of
LT -> genAComb ty f' es (part call (arity - supplied))
EQ -> genAComb ty f' es (full call)
LT -> genTComb ty f' es (part call (arity - supplied))
EQ -> genTComb ty f' es (full call)
GT -> do
let (es1, es2) = splitAt arity es
funccall <- genAComb ty f' es1 (full call)
funccall <- genTComb ty f' es1 (full call)
genApply funccall es2
where
supplied = length es
......@@ -408,21 +403,19 @@ genCall call ty f es = do
part Fun = FuncPartCall
part Con = ConsPartCall
genAComb :: IL.Type -> QName -> [IL.Expression] -> CombType -> FlatState (AExpr TypeExpr)
genAComb ty qid es ct = do
genTComb :: IL.Type -> QName -> [IL.Expression] -> CombType -> FlatState TExpr
genTComb ty qid es ct = do
ty' <- trType ty
let ty'' = defunc ty' (length es)
AComb ty'' ct (qid, ty') <$> mapM trAExpr es
where
defunc t 0 = t
defunc (FuncType _ t2) n = defunc t2 (n - 1)
defunc _ _ = internalError "GenTypedFlatCurry.genAComb.defunc"
TComb ct (qid, ty') <$> mapM trTExpr es
genApply :: AExpr TypeExpr -> [IL.Expression] -> FlatState (AExpr TypeExpr)
genApply :: TExpr -> [IL.Expression] -> FlatState TExpr
genApply e es = do
ap <- trQualIdent $ qApplyId
es' <- mapM trAExpr es
return $ foldl (\e1 e2 -> let FuncType ty1 ty2 = typeOf e1 in AComb ty2 FuncCall (ap, FuncType (FuncType ty1 ty2) (FuncType ty1 ty2)) [e1, e2]) e es'
es' <- mapM trTExpr es
return $ foldl (\e1 e2 -> let FuncType ty1 ty2 = typeOf e1
in TComb FuncCall (ap, FuncType (FuncType ty1 ty2)
(FuncType ty1 ty2)) [e1, e2])
e es'
-- -----------------------------------------------------------------------------
-- Normalization
......@@ -453,43 +446,40 @@ instance Normalize TypeExpr where
ForallType <$> mapM normalize is <*> normalize ty
instance Normalize b => Normalize (a, b) where
normalize (x, y) = ((,) x) <$> normalize y
normalize (x, y) = (,) x <$> normalize y
instance Normalize a => Normalize (AFuncDecl a) where
normalize (AFunc f a v ty r) = AFunc f a v <$> normalize ty <*> normalize r
instance Normalize TFuncDecl where
normalize (TFunc f a v ty r) = TFunc f a v <$> normalize ty <*> normalize r
instance Normalize a => Normalize (ARule a) where
normalize (ARule ty vs e) = ARule <$> normalize ty
<*> mapM normalize vs
instance Normalize TRule where
normalize (TRule vs e) = TRule <$> mapM normalize vs
<*> normalize e
normalize (AExternal ty s) = flip AExternal s <$> normalize ty
instance Normalize a => Normalize (AExpr a) where
normalize (AVar ty v) = flip AVar v <$> normalize ty
normalize (ALit ty l) = flip ALit l <$> normalize ty
normalize (AComb ty ct f es) = flip AComb ct <$> normalize ty
<*> normalize f
<*> mapM normalize es
normalize (ALet ty ds e) = ALet <$> normalize ty
<*> mapM normalizeBinding ds
normalize (TExternal ty s) = flip TExternal s <$> normalize ty
instance Normalize TExpr where
normalize (TVarE ty v) = flip TVarE v <$> normalize ty
normalize (TLit ty l) = flip TLit l <$> normalize ty
normalize (TComb ct f es) = TComb ct <$> normalize f
<*> mapM normalize es
normalize (TLet ds e) = TLet <$> mapM normalizeBinding ds
<*> normalize e
where normalizeBinding (v, b) = (,) <$> normalize v <*> normalize b
normalize (AOr ty a b) = AOr <$> normalize ty <*> normalize a
normalize (TOr a b) = TOr <$> normalize a
<*> normalize b
normalize (ACase ty ct e bs) = flip ACase ct <$> normalize ty <*> normalize e
<*> mapM normalize bs
normalize (AFree ty vs e) = AFree <$> normalize ty <*> mapM normalize vs
normalize (TCase ct e bs) = TCase ct <$> normalize e
<*> mapM normalize bs
normalize (TFree vs e) = TFree <$> mapM normalize vs
<*> normalize e
normalize (ATyped ty e ty') = ATyped <$> normalize ty <*> normalize e
normalize (TTyped e ty') = TTyped <$> normalize e
<*> normalize ty'
instance Normalize a => Normalize (ABranchExpr a) where
normalize (ABranch p e) = ABranch <$> normalize p <*> normalize e
instance Normalize TBranchExpr where
normalize (TBranch p e) = TBranch <$> normalize p <*> normalize e
instance Normalize a => Normalize (APattern a) where
normalize (APattern ty c vs) = APattern <$> normalize ty <*> normalize c
instance Normalize TPattern where
normalize (TPattern c vs) = TPattern <$> normalize c
<*> mapM normalize vs
normalize (ALPattern ty l) = flip ALPattern l <$> normalize ty
normalize (TLPattern ty l) = flip TLPattern l <$> normalize ty
-- -----------------------------------------------------------------------------
-- Helper functions
......
src/Modules.hs
View file @ 79782290
......@@ -327,7 +327,7 @@ matchInterface ifn i = do
writeFlat :: Options -> CompilerEnv -> CS.Module Type -> IL.Module -> CYIO ()
writeFlat opts env mdl il = do
(_, tfc) <- dumpWith opts show (FC.ppProg . genFlatCurry) DumpTypedFlatCurry (env, tfcyProg)
(_, tfc) <- dumpWith opts show (FC.ppProg . genFlatCurry) DumpTypedFlatCurry (env, tfcyProg) -- TODO ???
when tfcyTarget $ liftIO $ FC.writeFlatCurry (useSubDir tfcyName) tfc
when fcyTarget $ do
(_, fc) <- dumpWith opts show FC.ppProg DumpFlatCurry (env, fcyProg)
......
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