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

79782290 · Kai-Oliver Prott · Finn Teegen · 242037ad · 79782290 · 79782290
Commit 79782290 authored Jun 10, 2018 by Kai-Oliver Prott Committed by Finn Teegen Jul 09, 2018
8 changed files
--- a/curry-frontend.cabal
+++ b/curry-frontend.cabal
@@ -108,6 +108,7 @@ Library
    , Generators.GenAbstractCurry
    , Generators.GenFlatCurry
    , Generators.GenTypedFlatCurry
+    , Generators.GenTypeAnnotatedFlatCurry
    , Html.CurryHtml
    , Html.SyntaxColoring
    , IL

--- a/src/CompilerOpts.hs
+++ b/src/CompilerOpts.hs
@@ -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 }))

--- a/src/CurryBuilder.hs
+++ b/src/CurryBuilder.hs
@@ -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

--- a/src/Generators.hs
+++ b/src/Generators.hs
@@ -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

--- a/src/Generators/GenFlatCurry.hs
+++ b/src/Generators/GenFlatCurry.hs
@@ -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

--- a/src/Generators/GenTypeAnnotatedFlatCurry.hs
+++ b/src/Generators/GenTypeAnnotatedFlatCurry.hs
--- a/src/Generators/GenTypedFlatCurry.hs
+++ b/src/Generators/GenTypedFlatCurry.hs
@@ -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

--- a/src/Modules.hs
+++ b/src/Modules.hs
@@ -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)