ddc-core-flow 0.4.2.1 → 0.4.3.1

raw patch · 46 files changed

+1002/−150 lines, 46 filesdep −ddc-basedep ~basedep ~ddc-coredep ~ddc-core-saltPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: ddc-base

Dependency ranges changed: base, ddc-core, ddc-core-salt, ddc-core-simpl, ddc-core-tetra, transformers

API changes (from Hackage documentation)

Files

• DDC/Core/Flow/Compounds.hs +2/−2
• DDC/Core/Flow/Convert.hs +17/−14
• DDC/Core/Flow/Convert/Base.hs +3/−4
• DDC/Core/Flow/Convert/Exp.hs +3/−1
• DDC/Core/Flow/Convert/Type.hs +7/−4
• DDC/Core/Flow/Exp.hs +4/−3
• DDC/Core/Flow/Exp/Simple/Collect.hs +77/−0
• DDC/Core/Flow/Exp/Simple/Compounds.hs +287/−0
• DDC/Core/Flow/Exp/Simple/Exp.hs +196/−0
• DDC/Core/Flow/Lower.hs +12/−4
• DDC/Core/Flow/Prim.hs +3/−3
• DDC/Core/Flow/Prim/DaConFlow.hs +3/−3
• DDC/Core/Flow/Prim/DaConPrim.hs +7/−7
• DDC/Core/Flow/Prim/KiConFlow.hs +3/−3
• DDC/Core/Flow/Prim/OpConcrete.hs +3/−3
• DDC/Core/Flow/Prim/OpControl.hs +3/−3
• DDC/Core/Flow/Prim/OpPrim.hs +2/−2
• DDC/Core/Flow/Prim/OpSeries.hs +3/−3
• DDC/Core/Flow/Prim/OpStore.hs +3/−3
• DDC/Core/Flow/Prim/OpVector.hs +4/−5
• DDC/Core/Flow/Prim/TyConFlow.hs +3/−3
• DDC/Core/Flow/Prim/TyConPrim.hs +2/−2
• DDC/Core/Flow/Process/Pretty.hs +1/−1
• DDC/Core/Flow/Profile.hs +28/−12
• DDC/Core/Flow/Transform/Annotate.hs +88/−0
• DDC/Core/Flow/Transform/Concretize.hs +15/−14
• DDC/Core/Flow/Transform/Deannotate.hs +74/−0
• DDC/Core/Flow/Transform/Extract.hs +1/−1
• DDC/Core/Flow/Transform/Melt.hs +2/−2
• DDC/Core/Flow/Transform/Rates/Clusters/Greedy.hs +4/−4
• DDC/Core/Flow/Transform/Rates/Clusters/Linear.hs +10/−8
• DDC/Core/Flow/Transform/Rates/CnfFromExp.hs +1/−0
• DDC/Core/Flow/Transform/Rates/Combinators.hs +3/−3
• DDC/Core/Flow/Transform/Rates/Fail.hs +1/−1
• DDC/Core/Flow/Transform/Rates/Graph.hs +2/−2
• DDC/Core/Flow/Transform/Rates/SeriesOfVector.hs +4/−4
• DDC/Core/Flow/Transform/Rates/SizeInference.hs +5/−4
• DDC/Core/Flow/Transform/Schedule/Error.hs +1/−1
• DDC/Core/Flow/Transform/Slurp.hs +1/−1
• DDC/Core/Flow/Transform/Slurp/Context.hs +2/−2
• DDC/Core/Flow/Transform/Slurp/Error.hs +2/−2
• DDC/Core/Flow/Transform/Slurp/Operator.hs +1/−1
• DDC/Core/Flow/Transform/Slurp/Resize.hs +2/−2
• DDC/Core/Flow/Transform/TransformUpX.hs +85/−0
• LICENSE +1/−1
• ddc-core-flow.cabal +21/−12

@@ -1,7 +1,7 @@  -- | Short-hands for constructing compound expressions. module DDC.Core.Flow.Compounds-        ( module DDC.Core.Exp.Simple.Compounds+        ( module DDC.Core.Flow.Exp.Simple.Compounds            -- * Fragment specific kinds         , kRate@@ -71,4 +71,4 @@ import DDC.Core.Flow.Prim.OpSeries import DDC.Core.Flow.Prim.OpStore import DDC.Core.Flow.Prim.OpPrim-import DDC.Core.Exp.Simple.Compounds+import DDC.Core.Flow.Exp.Simple.Compounds

@@ -10,7 +10,7 @@ import DDC.Core.Flow.Convert.Exp import DDC.Core.Exp.Annot import DDC.Core.Module-import DDC.Control.Monad.Check+import DDC.Control.Check  import qualified DDC.Core.Flow.Prim      as F import qualified DDC.Core.Salt.Name      as T@@ -77,9 +77,12 @@                 -- We're only using whole module compilation for                 -- flow programs, so there aren't any imports.                 , moduleImportDataDefs  = []+                , moduleImportTypeDefs  = []+                 , moduleDataDefsLocal   = []+                , moduleTypeDefsLocal   = [] -                , moduleBody           = body' }+                , moduleBody            = body' }          -- Initialise the salt heap.         -- Hardcode this for now, because eventually this will target tetra.@@ -93,8 +96,8 @@ --------------------------------------------------------------------------------------------------- -- | Convert an export spec. convertExportM-        :: (F.Name, ExportSource F.Name)                -        -> ConvertM (T.Name, ExportSource T.Name)+        :: (F.Name, ExportSource F.Name (Type F.Name))+        -> ConvertM (T.Name, ExportSource T.Name (Type T.Name))  convertExportM (n, esrc)  = do   n'      <- convertName n@@ -104,8 +107,8 @@  -- Convert an export source. convertExportSourceM -        :: ExportSource F.Name-        -> ConvertM (ExportSource T.Name)+        :: ExportSource F.Name (Type F.Name)+        -> ConvertM (ExportSource T.Name (Type T.Name))  convertExportSourceM esrc  = case esrc of@@ -122,8 +125,8 @@ --------------------------------------------------------------------------------------------------- -- | Convert an import spec. convertImportNameTypeM-        :: (F.Name, ImportType F.Name)-        -> ConvertM (T.Name, ImportType T.Name)+        :: (F.Name, ImportType F.Name (Type F.Name))+        -> ConvertM (T.Name, ImportType T.Name (Type T.Name))  convertImportNameTypeM (n, isrc)  = do   n'      <- convertImportNameM n@@ -133,8 +136,8 @@  -- | Convert an import spec. convertImportNameValueM-        :: (F.Name, ImportValue F.Name)-        -> ConvertM (T.Name, ImportValue T.Name)+        :: (F.Name, ImportValue F.Name (Type F.Name))+        -> ConvertM (T.Name, ImportValue T.Name (Type T.Name))  convertImportNameValueM (n, isrc)  = do   n'      <- convertImportNameM n@@ -155,8 +158,8 @@  -- | Convert an import source. convertImportTypeM -        :: ImportType F.Name-        -> ConvertM (ImportType T.Name)+        :: ImportType F.Name (Type F.Name)+        -> ConvertM (ImportType T.Name (Type T.Name))  convertImportTypeM isrc  = case isrc of@@ -171,8 +174,8 @@  -- | Convert an import value spec. convertImportValueM -        :: ImportValue F.Name-        -> ConvertM (ImportValue T.Name)+        :: ImportValue F.Name (Type F.Name)+        -> ConvertM (ImportValue T.Name (Type T.Name))  convertImportValueM isrc  = case isrc of

@@ -5,11 +5,10 @@         ,  withRateXLAM, isRateXLAM         ,  withSuspFns,   isSuspFn) where-import DDC.Base.Pretty-import DDC.Core.Exp.Annot.Compounds-import DDC.Type.Exp+import DDC.Data.Pretty+import DDC.Core.Exp.Annot import DDC.Core.Flow.Prim                       as F-import qualified DDC.Control.Monad.Check        as G+import qualified DDC.Control.Check              as G  import qualified Data.Set                       as S import Data.Maybe

@@ -269,7 +269,9 @@  where   anno = annotOfExp f -convertDaCon :: DaCon F.Name -> ConvertM (DaCon T.Name)+convertDaCon +        :: DaCon F.Name (Type F.Name)+        -> ConvertM (DaCon T.Name (Type T.Name)) convertDaCon dd  = case dd of    DaConUnit

@@ -12,7 +12,7 @@ where import DDC.Core.Flow.Convert.Base import DDC.Core.Exp.Annot-import DDC.Control.Monad.Check                  (throw)+import DDC.Control.Check                        (throw) import DDC.Type.Transform.BoundT  import qualified DDC.Core.Flow.Prim             as F@@ -93,11 +93,14 @@     TCon c      -> TCon    <$> convertTyCon c -    TForall b t-     -> TForall <$> convertBind  b <*> convertType t+    TAbs b t+     -> TAbs    <$> convertBind b <*> convertType t      TApp p q-     -> TApp    <$> convertType  p <*> convertType q+     -> TApp    <$> convertType p <*> convertType q++    TForall b t+     -> TForall <$> convertBind b <*> convertType t      TSum _t      -> return $ TSum $ TypeSumBot $ kData -- throw    $ ErrorUnexpectedSum

@@ -1,6 +1,6 @@  module DDC.Core.Flow.Exp-        ( module DDC.Core.Exp.Simple.Exp+        ( module DDC.Core.Flow.Exp.Simple.Exp         , KindEnvF, TypeEnvF         , TypeF         , ModuleF@@ -15,8 +15,9 @@ where import DDC.Core.Module import DDC.Core.Flow.Prim-import DDC.Core.Exp.Simple.Exp-import DDC.Type.Env             (Env)+import DDC.Core.Flow.Exp.Simple.Exp+import DDC.Core.Flow.Exp.Simple.Collect ()+import DDC.Type.Env                     (Env)  type KindEnvF   = Env Name type TypeEnvF   = Env Name

@@ -0,0 +1,77 @@+-- | Collecting sets of variables and constructors.+module DDC.Core.Flow.Exp.Simple.Collect+        ()+where+import DDC.Core.Collect.BindStruct+import DDC.Core.Collect.FreeX+import DDC.Core.Flow.Exp.Simple.Exp+++-- Exp ------------------------------------------------------------------------+instance BindStruct (Exp a n) n where+ slurpBindTree xx+  = case xx of+        XAnnot _ x+         -> slurpBindTree x+        XVar u+         -> [BindUse BoundExp u]++        XCon dc+         -> case dc of+                DaConBound n    -> [BindCon BoundExp (UName n) Nothing]+                _               -> []++        XApp x1 x2              -> slurpBindTree x1 ++ slurpBindTree x2+        XLAM b x                -> [bindDefT BindLAM [b] [x]]+        XLam b x                -> [bindDefX BindLam [b] [x]]      ++        XLet (LLet b x1) x2+         -> slurpBindTree x1+         ++ [bindDefX BindLet [b] [x2]]++        XLet (LRec bxs) x2+         -> [bindDefX BindLetRec +                     (map fst bxs) +                     (map snd bxs ++ [x2])]+        +        XLet (LPrivate bsR mtExtend bs) x2                         +         -> (case mtExtend of+                Nothing -> []+                Just tR -> slurpBindTree tR)+         ++ [ BindDef  BindLetRegions bsR+             [bindDefX BindLetRegionWith bs [x2]] ]++        XCase x alts    -> slurpBindTree x ++ concatMap slurpBindTree alts+        XCast c x       -> slurpBindTree c ++ slurpBindTree x+        XType t         -> slurpBindTree t+        XWitness w      -> slurpBindTree w+++instance BindStruct (Cast a n) n where+ slurpBindTree cc+  = case cc of+        CastWeakenEffect  eff   -> slurpBindTree eff+        CastPurify w            -> slurpBindTree w+        CastBox                 -> []+        CastRun                 -> []+++instance BindStruct (Alt a n) n where+ slurpBindTree alt+  = case alt of+        AAlt PDefault x+         -> slurpBindTree x++        AAlt (PData _ bs) x+         -> [bindDefX BindCasePat bs [x]]+++instance BindStruct (Witness a n) n where+ slurpBindTree ww+  = case ww of+        WVar u          -> [BindUse BoundWit u]+        WCon{}          -> []+        WApp  w1 w2     -> slurpBindTree w1 ++ slurpBindTree w2+        WType t         -> slurpBindTree t+        WAnnot _ w      -> slurpBindTree w+

@@ -0,0 +1,287 @@++-- | Utilities for constructing and destructing compound expressions.+--+--   For the Simple version of the AST.+module DDC.Core.Flow.Exp.Simple.Compounds+        ( module DDC.Type.Exp.Simple.Compounds++          -- * Lambdas+        , xLAMs+        , xLams+        , makeXLamFlags+        , takeXLAMs+        , takeXLams+        , takeXLamFlags++          -- * Applications+        , xApps+        , takeXApps+        , takeXApps1+        , takeXAppsAsList+        , takeXConApps+        , takeXPrimApps++          -- * Lets+        , xLets+        , splitXLets +        , bindsOfLets+        , specBindsOfLets+        , valwitBindsOfLets++          -- * Patterns+        , bindsOfPat++          -- * Alternatives+        , takeCtorNameOfAlt++          -- * Witnesses+        , wApp+        , wApps+        , takeXWitness+        , takeWAppsAsList+        , takePrimWiConApps++          -- * Types+        , takeXType++          -- * Data Constructors+        , xUnit, C.dcUnit+        , C.takeNameOfDaCon+        , C.takeTypeOfDaCon)+where+import DDC.Core.Flow.Exp.Simple.Exp+import DDC.Type.Exp.Simple.Compounds+import qualified DDC.Core.Exp.Annot     as C+++-- Lambdas ---------------------------------------------------------------------+-- | Make some nested type lambdas.+xLAMs :: [Bind n] -> Exp a n -> Exp a n+xLAMs bs x+        = foldr XLAM x bs+++-- | Make some nested value or witness lambdas.+xLams :: [Bind n] -> Exp a n -> Exp a n+xLams bs x+        = foldr XLam x bs+++-- | Split type lambdas from the front of an expression,+--   or `Nothing` if there aren't any.+takeXLAMs :: Exp a n -> Maybe ([Bind n], Exp a n)+takeXLAMs xx+ = let  go bs (XLAM b x) = go (b:bs) x+        go bs x            = (reverse bs, x)+   in   case go [] xx of+         ([], _)        -> Nothing+         (bs, body)     -> Just (bs, body)+++-- | Split nested value or witness lambdas from the front of an expression,+--   or `Nothing` if there aren't any.+takeXLams :: Exp a n -> Maybe ([Bind n], Exp a n)+takeXLams xx+ = let  go bs (XLam b x) = go (b:bs) x+        go bs x          = (reverse bs, x)+   in   case go [] xx of+         ([], _)        -> Nothing+         (bs, body)     -> Just (bs, body)+++-- | Make some nested lambda abstractions,+--   using a flag to indicate whether the lambda is a+--   level-1 (True), or level-0 (False) binder.+makeXLamFlags :: [(Bool, Bind n)] -> Exp a n -> Exp a n+makeXLamFlags fbs x+ = foldr (\(f, b) x'+           -> if f then XLAM b x'+                   else XLam b x')+                x fbs+++-- | Split nested lambdas from the front of an expression, +--   with a flag indicating whether the lambda was a level-1 (True), +--   or level-0 (False) binder.+takeXLamFlags :: Exp a n -> Maybe ([(Bool, Bind n)], Exp a n)+takeXLamFlags xx+ = let  go bs (XLAM b x)  = go ((True,  b):bs) x+        go bs (XLam b x)  = go ((False, b):bs) x+        go bs x           = (reverse bs, x)+   in   case go [] xx of+         ([], _)        -> Nothing+         (bs, body)     -> Just (bs, body)+++-- Applications ---------------------------------------------------------------+-- | Build sequence of value applications.+xApps   :: Exp a n -> [Exp a n] -> Exp a n+xApps t1 ts     = foldl XApp t1 ts+++-- | Flatten an application into the function part and its arguments.+--+--   Returns `Nothing` if there is no outer application.+takeXApps :: Exp a n -> Maybe (Exp a n, [Exp a n])+takeXApps xx+ = case takeXAppsAsList xx of+        (x1 : xsArgs)   -> Just (x1, xsArgs)+        _               -> Nothing+++-- | Flatten an application into the function part and its arguments.+--+--   This is like `takeXApps` above, except we know there is at least one argument.+takeXApps1 :: Exp a n -> Exp a n -> (Exp a n, [Exp a n])+takeXApps1 x1 x2+ = case takeXApps x1 of+        Nothing          -> (x1,  [x2])+        Just (x11, x12s) -> (x11, x12s ++ [x2])+++-- | Flatten an application into the function parts and arguments, if any.+takeXAppsAsList  :: Exp a n -> [Exp a n]+takeXAppsAsList xx+ = case xx of+        XApp x1 x2      -> takeXAppsAsList x1 ++ [x2]+        _               -> [xx]+++-- | Flatten an application of a primop into the variable+--   and its arguments.+--   +--   Returns `Nothing` if the expression isn't a primop application.+takeXPrimApps :: Exp a n -> Maybe (n, [Exp a n])+takeXPrimApps xx+ = case takeXAppsAsList xx of+        XVar (UPrim p _) : xs -> Just (p, xs)+        _                     -> Nothing++-- | Flatten an application of a data constructor into the constructor+--   and its arguments. +--+--   Returns `Nothing` if the expression isn't a constructor application.+takeXConApps :: Exp a n -> Maybe (DaCon n (Type n), [Exp a n])+takeXConApps xx+ = case takeXAppsAsList xx of+        XCon dc : xs  -> Just (dc, xs)+        _             -> Nothing+++-- Lets -----------------------------------------------------------------------+-- | Wrap some let-bindings around an expression.+xLets :: [Lets a n] -> Exp a n -> Exp a n+xLets lts x+ = foldr XLet x lts+++-- | Split let-bindings from the front of an expression, if any.+splitXLets :: Exp a n -> ([Lets a n], Exp a n)+splitXLets xx+ = case xx of+        XLet lts x +         -> let (lts', x')      = splitXLets x+            in  (lts : lts', x')++        _ -> ([], xx)+++-- | Take the binds of a `Lets`.+--+--   The level-1 and level-0 binders are returned separately.+bindsOfLets :: Lets a n -> ([Bind n], [Bind n])+bindsOfLets ll+ = case ll of+        LLet b _          -> ([],  [b])+        LRec bxs          -> ([],  map fst bxs)+        LPrivate bs _ bbs -> (bs, bbs)+++-- | Like `bindsOfLets` but only take the spec (level-1) binders.+specBindsOfLets :: Lets a n -> [Bind n]+specBindsOfLets ll+ = case ll of+        LLet _ _         -> []+        LRec _           -> []+        LPrivate bs _ _  -> bs+++-- | Like `bindsOfLets` but only take the value and witness (level-0) binders.+valwitBindsOfLets :: Lets a n -> [Bind n]+valwitBindsOfLets ll+ = case ll of+        LLet b _        -> [b]+        LRec bxs        -> map fst bxs+        LPrivate _ _ bs -> bs+++-- Alternatives ---------------------------------------------------------------+-- | Take the constructor name of an alternative, if there is one.+takeCtorNameOfAlt :: Alt a n -> Maybe n+takeCtorNameOfAlt aa+ = case aa of+        AAlt (PData dc _) _     -> C.takeNameOfDaCon dc+        _                       -> Nothing+++-- Patterns -------------------------------------------------------------------+-- | Take the binds of a `Pat`.+bindsOfPat :: Pat n -> [Bind n]+bindsOfPat pp+ = case pp of+        PDefault          -> []+        PData _ bs        -> bs+++-- Witnesses ------------------------------------------------------------------+-- | Construct a witness application+wApp :: Witness a n -> Witness a n -> Witness a n+wApp = WApp+++-- | Construct a sequence of witness applications+wApps :: Witness a n -> [Witness a n] -> Witness a n+wApps = foldl wApp+++-- | Take the witness from an `XWitness` argument, if any.+takeXWitness :: Exp a n -> Maybe (Witness a n)+takeXWitness xx+ = case xx of+        XWitness t -> Just t+        _          -> Nothing+++-- | Flatten an application into the function parts and arguments, if any.+takeWAppsAsList :: Witness a n -> [Witness a n]+takeWAppsAsList ww+ = case ww of+        WApp w1 w2 -> takeWAppsAsList w1 ++ [w2]+        _          -> [ww]+++-- | Flatten an application of a witness into the witness constructor+--   name and its arguments.+--+--   Returns nothing if there is no witness constructor in head position.+takePrimWiConApps :: Witness a n -> Maybe (n, [Witness a n])+takePrimWiConApps ww+ = case takeWAppsAsList ww of+        WCon wc : args | WiConBound (UPrim n _) _ <- wc+          -> Just (n, args)+        _ -> Nothing+++-- Types ----------------------------------------------------------------------+-- | Take the type from an `XType` argument, if any.+takeXType :: Exp a n -> Maybe (Type n)+takeXType xx+ = case xx of+        XType t -> Just t+        _       -> Nothing+++-- Units -----------------------------------------------------------------------+-- | Construct a value of unit type.+xUnit   :: Exp a n+xUnit = XCon C.dcUnit

@@ -0,0 +1,196 @@++-- | Core language AST with a separate node to hold annotations.+--+--   This version of the AST is used when generating code where most or all+--   of the annotations would be empty. General purpose transformations should+--   deal with the fully annotated version of the AST instead.+--+module DDC.Core.Flow.Exp.Simple.Exp +        ( module DDC.Type.Exp++          -- * Expressions+        , Exp           (..)+        , Cast          (..)+        , Lets          (..)+        , Alt           (..)+        , Pat           (..)++          -- * Witnesses+        , Witness       (..)++          -- * Data Constructors+        , DaCon         (..)++          -- * Witness Constructors+        , WiCon         (..))+where+import DDC.Core.Exp             (WiCon (..))+import DDC.Core.Exp             (DaCon (..))+import DDC.Type.Exp+import DDC.Type.Sum             ()+import Control.DeepSeq+++-- Values ---------------------------------------------------------------------+-- | Well-typed expressions have types of kind `Data`.+data Exp a n+        -- | Annotation.+        = XAnnot a (Exp a n)++        -- | Value variable   or primitive operation.+        | XVar  !(Bound n)++        -- | Data constructor or literal.+        | XCon  !(DaCon n (Type n))++        -- | Type abstraction (level-1).+        | XLAM  !(Bind n)   !(Exp a n)++        -- | Value and Witness abstraction (level-0).+        | XLam  !(Bind n)   !(Exp a n)++        -- | Application.+        | XApp  !(Exp a n)  !(Exp a n)++        -- | Possibly recursive bindings.+        | XLet  !(Lets a n) !(Exp a n)++        -- | Case branching.+        | XCase !(Exp a n)  ![Alt a n]++        -- | Type cast.+        | XCast !(Cast a n) !(Exp a n)++        -- | Type can appear as the argument of an application.+        | XType    !(Type n)++        -- | Witness can appear as the argument of an application.+        | XWitness !(Witness a n)+        deriving (Show, Eq)+++-- | Possibly recursive bindings.+data Lets a n+        -- | Non-recursive expression binding.+        = LLet     !(Bind n) !(Exp a n)++        -- | Recursive binding of lambda abstractions.+        | LRec     ![(Bind n, Exp a n)]++        -- | Bind a local region variable,+        --   and witnesses to its properties.+        | LPrivate ![Bind n] !(Maybe (Type n)) ![Bind n]+        deriving (Show, Eq)+++-- | Case alternatives.+data Alt a n+        = AAlt !(Pat n) !(Exp a n)+        deriving (Show, Eq)+++-- | Pattern matching.+data Pat n+        -- | The default pattern always succeeds.+        = PDefault+        +        -- | Match a data constructor and bind its arguments.+        | PData !(DaCon n (Type n)) ![Bind n]+        deriving (Show, Eq)+++-- | When a witness exists in the program it guarantees that a+--   certain property of the program is true.+data Witness a n+        = WAnnot a (Witness a n)++        -- | Witness variable.+        | WVar  !(Bound n)+        +        -- | Witness constructor.+        | WCon  !(WiCon n)+        +        -- | Witness application.+        | WApp  !(Witness a n) !(Witness a n)++        -- | Type can appear as the argument of an application.+        | WType !(Type n)+        deriving (Show, Eq)+++-- | Type casts.+data Cast a n+        -- | Weaken the effect of an expression.+        --   The given effect is added to the effect+        --   of the body.+        = CastWeakenEffect  !(Effect n)+        +        -- | Purify the effect (action) of an expression.+        | CastPurify        !(Witness a n)++        -- | Box up a computation, +        --   capturing its effects in the S computation type.+        | CastBox ++        -- | Run a computation,+        --   releasing its effects into the environment.+        | CastRun+        deriving (Show, Eq)+++-- NFData ---------------------------------------------------------------------+instance (NFData a, NFData n) => NFData (Exp a n) where+ rnf xx+  = case xx of+        XAnnot a x      -> rnf a   `seq` rnf x+        XVar   u        -> rnf u+        XCon   dc       -> rnf dc+        XLAM   b x      -> rnf b   `seq` rnf x+        XLam   b x      -> rnf b   `seq` rnf x+        XApp   x1 x2    -> rnf x1  `seq` rnf x2+        XLet   lts x    -> rnf lts `seq` rnf x+        XCase  x alts   -> rnf x   `seq` rnf alts+        XCast  c x      -> rnf c   `seq` rnf x+        XType  t        -> rnf t+        XWitness w      -> rnf w+++instance (NFData a, NFData n) => NFData (Cast a n) where+ rnf cc+  = case cc of+        CastWeakenEffect e      -> rnf e+        CastPurify w            -> rnf w+        CastBox                 -> ()+        CastRun                 -> ()+++instance (NFData a, NFData n) => NFData (Lets a n) where+ rnf lts+  = case lts of+        LLet b x                -> rnf b `seq` rnf x+        LRec bxs                -> rnf bxs+        LPrivate bs1 t2 bs3     -> rnf bs1  `seq` rnf t2 `seq` rnf bs3+++instance (NFData a, NFData n) => NFData (Alt a n) where+ rnf aa+  = case aa of+        AAlt w x                -> rnf w `seq` rnf x+++instance NFData n => NFData (Pat n) where+ rnf pp+  = case pp of+        PDefault                -> ()+        PData dc bs             -> rnf dc `seq` rnf bs+++instance (NFData a, NFData n) => NFData (Witness a n) where+ rnf ww+  = case ww of+        WAnnot a w              -> rnf a `seq` rnf w+        WVar   u                -> rnf u+        WCon   c                -> rnf c+        WApp   w1 w2            -> rnf w1 `seq` rnf w2+        WType  t                -> rnf t+

@@ -9,10 +9,14 @@         , Lifting       (..)         , lowerModule) where+import DDC.Core.Transform.TransformUpX                  () import DDC.Core.Flow.Transform.Slurp import DDC.Core.Flow.Transform.Schedule import DDC.Core.Flow.Transform.Schedule.Base import DDC.Core.Flow.Transform.Extract+import DDC.Core.Flow.Transform.TransformUpX+import DDC.Core.Flow.Transform.Annotate+import DDC.Core.Flow.Transform.Deannotate import DDC.Core.Flow.Process import DDC.Core.Flow.Procedure import DDC.Core.Flow.Compounds@@ -21,9 +25,6 @@ import DDC.Core.Flow.Exp import DDC.Core.Module -import DDC.Core.Transform.TransformUpX-import DDC.Core.Transform.Annotate-import DDC.Core.Transform.Deannotate  import qualified DDC.Core.Simplifier                    as C import qualified DDC.Core.Simplifier.Recipe             as C@@ -159,12 +160,19 @@    = case tt of       TVar{} -> tt       TCon{} -> tt-      TForall bind tt' -> TForall bind (replaceProcTy tt')++      TAbs bind tt'+       -> TAbs bind (replaceProcTy tt')+       TApp l r        | Just (NameTyConFlow TyConFlowProcess, [_,_]) <- takePrimTyConApps tt        -> tUnit        | otherwise        -> TApp (replaceProcTy l) (replaceProcTy r)++      TForall bind tt'+       -> TForall bind (replaceProcTy tt')+       TSum ts        -> TSum ts  

@@ -75,7 +75,7 @@ import DDC.Core.Flow.Prim.OpVector import DDC.Core.Flow.Prim.OpPrim -import DDC.Core.Lexer.Names             (isVarStart)+import DDC.Core.Lexer.Tokens            (isVarStart)  import DDC.Core.Salt.Name         ( readPrimTyCon@@ -93,8 +93,8 @@         , readLitWordOfBits         , readLitFloatOfBits)         -import DDC.Base.Pretty-import DDC.Base.Name+import DDC.Data.Name+import DDC.Data.Pretty import DDC.Data.ListUtils import Control.DeepSeq import Data.Char        

@@ -5,9 +5,9 @@ where import DDC.Core.Flow.Prim.TyConFlow import DDC.Core.Flow.Prim.Base-import DDC.Core.Exp.Simple.Exp-import DDC.Core.Exp.Simple.Compounds-import DDC.Base.Pretty+import DDC.Core.Flow.Exp.Simple.Exp+import DDC.Core.Flow.Exp.Simple.Compounds+import DDC.Data.Pretty import Data.List import Data.Char import Control.DeepSeq

@@ -9,8 +9,8 @@ import DDC.Core.Flow.Prim.TyConPrim import DDC.Core.Flow.Prim.DaConFlow import DDC.Core.Flow.Prim.Base-import DDC.Core.Exp.Simple.Compounds-import DDC.Core.Exp.Simple.Exp+import DDC.Core.Flow.Exp.Simple.Compounds+import DDC.Core.Flow.Exp.Simple.Exp   -- | A literal @Bool#@@@ -19,7 +19,7 @@   -- | A literal @Bool#@ data constructor.-dcBool  :: Bool -> DaCon Name+dcBool  :: Bool -> DaCon Name (Type Name) dcBool b = DaConPrim (NameLitBool b) tBool  @@ -29,12 +29,12 @@   -- | A Literal @Nat#@ data constructor.-dcNat   :: Integer -> DaCon Name+dcNat   :: Integer -> DaCon Name (Type Name) dcNat i   = DaConPrim (NameLitNat i) tNat   -- | Data constructor for @Tuple1#@-dcTuple1 :: DaCon Name+dcTuple1 :: DaCon Name (Type Name) dcTuple1  = DaConPrim (NameDaConFlow (DaConFlowTuple 1))                       (typeDaConFlow (DaConFlowTuple 1)) @@ -50,13 +50,13 @@   -- | Data constructor for @Tuple2#@-dcTuple2 :: DaCon Name+dcTuple2 :: DaCon Name (Type Name) dcTuple2  = DaConPrim   (NameDaConFlow (DaConFlowTuple 2))                         (typeDaConFlow (DaConFlowTuple 2))   -- | Data constructor for n-tuples-dcTupleN :: Int -> DaCon Name+dcTupleN :: Int -> DaCon Name (Type Name) dcTupleN n           = DaConPrim   (NameDaConFlow (DaConFlowTuple n))                         (typeDaConFlow (DaConFlowTuple n))

@@ -5,9 +5,9 @@         , kProc ) where import DDC.Core.Flow.Prim.Base-import DDC.Core.Exp.Simple.Exp-import DDC.Type.Compounds-import DDC.Base.Pretty+import DDC.Core.Flow.Exp.Simple.Exp+import DDC.Type.Exp.Simple.Compounds+import DDC.Data.Pretty import Control.DeepSeq  

@@ -17,9 +17,9 @@ import DDC.Core.Flow.Prim.TyConFlow import DDC.Core.Flow.Prim.TyConPrim import DDC.Core.Flow.Prim.Base-import DDC.Core.Exp.Simple.Compounds-import DDC.Core.Exp.Simple.Exp-import DDC.Base.Pretty+import DDC.Core.Flow.Exp.Simple.Compounds+import DDC.Core.Flow.Exp.Simple.Exp+import DDC.Data.Pretty import Control.DeepSeq import Data.List import Data.Char

@@ -12,9 +12,9 @@ import DDC.Core.Flow.Prim.TyConPrim import DDC.Core.Flow.Prim.TyConFlow import DDC.Core.Flow.Prim.Base-import DDC.Core.Exp.Simple.Compounds-import DDC.Core.Exp.Simple.Exp-import DDC.Base.Pretty+import DDC.Core.Flow.Exp.Simple.Compounds+import DDC.Core.Flow.Exp.Simple.Exp+import DDC.Data.Pretty import Control.DeepSeq import Data.Char import Data.List

@@ -14,8 +14,8 @@ import DDC.Core.Flow.Prim.TyConFlow import DDC.Core.Flow.Prim.KiConFlow import DDC.Core.Flow.Prim.Base-import DDC.Core.Exp.Simple.Compounds-import DDC.Core.Exp.Simple.Exp+import DDC.Core.Flow.Exp.Simple.Compounds+import DDC.Core.Flow.Exp.Simple.Exp   -- | Take the type of a primitive cast.

@@ -10,10 +10,10 @@ import DDC.Core.Flow.Prim.TyConFlow import DDC.Core.Flow.Prim.TyConPrim import DDC.Core.Flow.Prim.Base+import DDC.Core.Flow.Exp.Simple.Compounds+import DDC.Core.Flow.Exp.Simple.Exp import DDC.Core.Transform.BoundT-import DDC.Core.Exp.Simple.Compounds-import DDC.Core.Exp.Simple.Exp-import DDC.Base.Pretty+import DDC.Data.Pretty import Control.DeepSeq import Data.List import Data.Char        

@@ -15,9 +15,9 @@ import DDC.Core.Flow.Prim.TyConFlow import DDC.Core.Flow.Prim.TyConPrim import DDC.Core.Flow.Prim.Base-import DDC.Core.Exp.Simple.Compounds-import DDC.Core.Exp.Simple.Exp-import DDC.Base.Pretty+import DDC.Core.Flow.Exp.Simple.Compounds+import DDC.Core.Flow.Exp.Simple.Exp+import DDC.Data.Pretty import Control.DeepSeq import Data.List import Data.Char

@@ -1,14 +1,13 @@ module DDC.Core.Flow.Prim.OpVector         ( readOpVector-        , typeOpVector-        )+        , typeOpVector) where import DDC.Core.Flow.Prim.TyConFlow import DDC.Core.Flow.Prim.TyConPrim import DDC.Core.Flow.Prim.Base-import DDC.Core.Exp.Simple.Compounds-import DDC.Core.Exp.Simple.Exp-import DDC.Base.Pretty+import DDC.Core.Flow.Exp.Simple.Compounds+import DDC.Core.Flow.Exp.Simple.Exp+import DDC.Data.Pretty import Control.DeepSeq import Data.List import Data.Char        

@@ -36,9 +36,9 @@ where import DDC.Core.Flow.Prim.KiConFlow import DDC.Core.Flow.Prim.Base-import DDC.Core.Exp.Simple.Compounds-import DDC.Core.Exp.Simple.Exp-import DDC.Base.Pretty+import DDC.Core.Flow.Exp.Simple.Compounds+import DDC.Core.Flow.Exp.Simple.Exp+import DDC.Data.Pretty import Control.DeepSeq import Data.Char import Data.List

@@ -10,8 +10,8 @@         , tVec) where import DDC.Core.Flow.Prim.Base-import DDC.Core.Exp.Simple.Compounds-import DDC.Core.Exp.Simple.Exp+import DDC.Core.Flow.Exp.Simple.Compounds+import DDC.Core.Flow.Exp.Simple.Exp   -- | Yield the kind of a type constructor.

@@ -3,8 +3,8 @@ import DDC.Core.Flow.Process.Process import DDC.Core.Flow.Process.Operator import DDC.Core.Flow.Context-import DDC.Base.Pretty import DDC.Core.Pretty          ()+import DDC.Data.Pretty   instance Pretty Process where

@@ -12,7 +12,7 @@ import DDC.Core.Fragment import DDC.Core.Lexer import DDC.Type.Exp-import DDC.Data.Token+import DDC.Data.SourcePos import Control.Monad.State.Strict import DDC.Type.Env             (Env) import qualified DDC.Type.Env   as Env@@ -29,9 +29,23 @@         , profilePrimTypes              = primTypeEnv         , profileTypeIsUnboxed          = const False          , profileNameIsHole             = Nothing -        , profileMakeStringName         = Nothing }+        , profileMakeLiteralName        = Just makeLiteralName }  +-- | Convert a literal to a Salt name.+makeLiteralName :: SourcePos -> Literal -> Bool -> Maybe Name+makeLiteralName _ lit True+ = case lit of+        LNat    n       -> Just $ NameLitNat     n+        LInt    i       -> Just $ NameLitInt     i+        LWord   i b     -> Just $ NameLitWord    i b+        LFloat  f b     -> Just $ NameLitFloat   (toRational f) b+        _               -> Nothing++makeLiteralName _ _ _+ = Nothing++ features :: Features features          = Features@@ -58,25 +72,27 @@ -- | Lex a string to tokens, using primitive names. -- --   The first argument gives the starting source line number.-lexModuleString :: String -> Int -> String -> [Token (Tok Name)]+lexModuleString :: String -> Int -> String -> [Located (Token Name)] lexModuleString sourceName lineStart str  = map rn $ lexModuleWithOffside sourceName lineStart str- where rn (Token strTok sp) -        = case renameTok readName strTok of-                Just t' -> Token t' sp-                Nothing -> Token (KErrorJunk "lexical error") sp+ where +        rn (Located sp strTok) +         = case renameToken readName strTok of+                Just t' -> Located sp t'+                Nothing -> Located sp (KErrorJunk "lexical error")   -- | Lex a string to tokens, using primitive names. -- --   The first argument gives the starting source line number.-lexExpString :: String -> Int -> String -> [Token (Tok Name)]+lexExpString :: String -> Int -> String -> [Located (Token Name)] lexExpString sourceName lineStart str  = map rn $ lexExp sourceName lineStart str- where rn (Token strTok sp) -        = case renameTok readName strTok of-                Just t' -> Token t' sp-                Nothing -> Token (KErrorJunk "lexical error") sp+ where+        rn (Located sp strTok) +         = case renameToken readName strTok of+                Just t' -> Located sp t'+                Nothing -> Located sp (KErrorJunk "lexical error")   -- | Create a new type variable name that is not in the given environment.

@@ -0,0 +1,88 @@++module DDC.Core.Flow.Transform.Annotate+        (Annotate (..))+where+import qualified DDC.Core.Exp.Annot             as A+import qualified DDC.Core.Flow.Exp.Simple.Exp   as S+++-- | Convert the `Simple` version of the AST to the `Annot` version,+--   using a the provided default annotation value.+class Annotate  +        (c1 :: * -> * -> *) +        (c2 :: * -> * -> *) | c1 -> c2 + where+ annotate :: a -> c1 a n -> c2 a n+++instance Annotate S.Exp A.Exp where+ annotate def xx+  = let down     = annotate def+    in case xx of+        S.XAnnot _ (S.XAnnot a x)       -> down (S.XAnnot a x)+        S.XAnnot a (S.XVar   u)         -> A.XVar      a u+        S.XAnnot a (S.XCon   dc)        -> A.XCon      a dc+        S.XAnnot a (S.XLAM   b x)       -> A.XLAM      a b   (down x)+        S.XAnnot a (S.XLam   b x)       -> A.XLam      a b   (down x)+        S.XAnnot a (S.XApp   x1 x2)     -> A.XApp      a     (down x1)  (down x2)+        S.XAnnot a (S.XLet   lts x)     -> A.XLet      a     (down lts) (down x)+        S.XAnnot a (S.XCase  x alts)    -> A.XCase     a     (down x)   (map down alts)+        S.XAnnot a (S.XCast  c x)       -> A.XCast     a     (down c)   (down x)+        S.XAnnot a (S.XType    t)       -> A.XType     a t+        S.XAnnot a (S.XWitness w)       -> A.XWitness  a (down w)++        S.XVar  u                       -> A.XVar      def u+        S.XCon  dc                      -> A.XCon      def dc+        S.XLAM  b x                     -> A.XLAM      def b (down x)+        S.XLam  b x                     -> A.XLam      def b (down x)+        S.XApp  x1 x2                   -> A.XApp      def   (down x1)  (down x2)+        S.XLet  lts x                   -> A.XLet      def   (down lts) (down x)+        S.XCase x alts                  -> A.XCase     def   (down x)   (map down alts)+        S.XCast c x                     -> A.XCast     def   (down c)   (down x)+        S.XType t                       -> A.XType     def t+        S.XWitness w                    -> A.XWitness  def (down w)+++instance Annotate S.Cast A.Cast where+ annotate def cc+  = let down    = annotate def+    in case cc of+        S.CastWeakenEffect eff          -> A.CastWeakenEffect  eff+        S.CastPurify w                  -> A.CastPurify        (down w)+        S.CastBox                       -> A.CastBox+        S.CastRun                       -> A.CastRun+++instance Annotate S.Lets A.Lets where+ annotate def lts+  = let down    = annotate def+    in case lts of+        S.LLet b x                      -> A.LLet b (down x)+        S.LRec bxs                      -> A.LRec [(b, down x) | (b, x) <- bxs]+        S.LPrivate bks mT bts           -> A.LPrivate bks mT bts+++instance Annotate S.Alt A.Alt where+ annotate def alt+  = let down    = annotate def+    in case alt of+        S.AAlt S.PDefault x             -> A.AAlt  A.PDefault (down x)+        S.AAlt (S.PData dc bs) x        -> A.AAlt (A.PData dc bs) (down x)+++instance Annotate S.Witness A.Witness where+ annotate def wit+  = let down    = annotate def+    in case wit of+        S.WAnnot _ (S.WAnnot a x)       -> down (S.WAnnot a x)+        S.WAnnot a (S.WVar  u)          -> A.WVar  a u+        S.WAnnot a (S.WCon  wc)         -> A.WCon  a wc+        S.WAnnot a (S.WApp  w1 w2)      -> A.WApp  a (down w1) (down w2)+        S.WAnnot a (S.WType t)          -> A.WType a t++        S.WVar  u                       -> A.WVar  def u+        S.WCon  dc                      -> A.WCon  def dc        +        S.WApp  x1 x2                   -> A.WApp  def (down x1) (down x2)+        S.WType t                       -> A.WType def t++

@@ -6,8 +6,9 @@ import DDC.Core.Flow.Compounds import DDC.Core.Flow.Prim import DDC.Core.Flow.Exp-import DDC.Core.Transform.TransformUpX-import qualified DDC.Type.Env           as Env+import DDC.Core.Flow.Transform.TransformUpX+import DDC.Core.Env.EnvX                (EnvX)+import qualified DDC.Core.Env.EnvX      as EnvX import qualified Data.Map               as Map  @@ -15,21 +16,21 @@ --   use value level ones. concretizeModule :: Module () Name -> Module () Name concretizeModule mm-        = transformSimpleUpX concretizeX Env.empty Env.empty mm+        = transformSimpleUpX concretizeX EnvX.empty mm   -- | Rewrite an expression to use concrete operators. concretizeX -        :: KindEnvF -> TypeEnvF+        :: EnvX Name         -> ExpF     -> Maybe ExpF -concretizeX _kenv tenv xx+concretizeX env xx          -- loop# -> loopn#         -- using an existing RateNat in the environment.         | Just ( NameOpControl OpControlLoop                , [XType tK, xF]) <- takeXPrimApps xx-        , Just nRN               <- findRateNatWithRate tenv tK+        , Just nRN               <- findRateNatWithRate env tK         , xRN                    <- XVar (UName nRN)         = Just         $ xLoopN tK xRN xF@@ -38,7 +39,7 @@         -- using the length of a series to get the rate.         | Just ( NameOpControl OpControlLoop                , [XType tK, xF])   <- takeXPrimApps xx-        , Just (nS, tP, _, tA)     <- findSeriesWithRate tenv tK+        , Just (nS, tP, _, tA)     <- findSeriesWithRate env tK         , xS                       <- XVar (UName nS)         = Just          $ xLoopN @@ -49,7 +50,7 @@         -- newVectorR# -> newVector#         | Just ( NameOpStore OpStoreNewVectorR                , [XType tA, XType tK])  <- takeXPrimApps xx-        , Just (nS, tP, _, tS)          <- findSeriesWithRate tenv tK+        , Just (nS, tP, _, tS)          <- findSeriesWithRate env tK         , xS                            <- XVar (UName nS)         = Just         $ xNewVector@@ -64,12 +65,12 @@ -- | Search the given environment for the name of a RateNat with the --   given rate parameter. We only look at named binders. findRateNatWithRate -        :: TypeEnvF             -- ^ Type Environment.+        :: EnvX Name            -- ^ Type Environment.         -> Type Name            -- ^ Rate type.         -> Maybe Name                                 -- ^ RateNat name-findRateNatWithRate tenv tR- = go (Map.toList (Env.envMap tenv))+findRateNatWithRate env tR+ = go (Map.toList (EnvX.envxMap env))  where  go []           = Nothing         go ((n, tRN) : moar)          | isRateNatTypeOfRate tR tRN = Just n@@ -95,12 +96,12 @@ -- | Search the given environment for the name of a series with the --   given result rate parameter. We only look at named binders. findSeriesWithRate -        :: TypeEnvF             -- ^ Type Environment.+        :: EnvX Name             -- ^ Type Environment.         -> Type Name            -- ^ Rate type.         -> Maybe (Name, Type Name, Type Name, Type Name)         -- ^ Series name, process, result rate, element type.-findSeriesWithRate tenv tK- = go (Map.toList (Env.envMap tenv))+findSeriesWithRate env tK+ = go (Map.toList (EnvX.envxMap env))  where  go []           = Nothing         go ((n, tS) : moar)          = case isSeriesTypeOfRate tK tS of

@@ -0,0 +1,74 @@++module DDC.Core.Flow.Transform.Deannotate+        (Deannotate(..))+where+import qualified DDC.Core.Exp.Annot             as A+import qualified DDC.Core.Flow.Exp.Simple.Exp   as S+++-- | Convert the `Annot` version of the AST to the `Simple` version,+--   using the provided function to decide when to keep the annotation.+class Deannotate +        (c1 :: * -> * -> *)+        (c2 :: * -> * -> *) | c1 -> c2+ where  + deannotate :: (a -> Maybe a) -> c1 a n -> c2 a n+++instance Deannotate A.Exp S.Exp where+ deannotate f xx+  = let down      = deannotate f +        wrap a x  = case f a of+                        Nothing -> x+                        Just a' -> S.XAnnot a' x+    in case xx of+        A.XVar  a u             -> wrap a (S.XVar u)+        A.XCon  a dc            -> wrap a (S.XCon dc)+        A.XLAM  a b x           -> wrap a (S.XLAM b (down x))+        A.XLam  a b x           -> wrap a (S.XLam b (down x))+        A.XApp  a x1 x2         -> wrap a (S.XApp   (down x1)  (down x2))+        A.XLet  a lts x2        -> wrap a (S.XLet   (down lts) (down x2))+        A.XCase a x alts        -> wrap a (S.XCase  (down x)   (map down alts))+        A.XCast a cc x          -> wrap a (S.XCast  (down cc)  (down x))+        A.XType a t             -> wrap a (S.XType t)+        A.XWitness a w          -> wrap a (S.XWitness (down w))+++instance Deannotate A.Lets S.Lets where+ deannotate f lts+  = let down    = deannotate f+    in case lts of+        A.LLet b x              -> S.LLet b (down x)+        A.LRec bxs              -> S.LRec [(b, down x) | (b, x) <- bxs]+        A.LPrivate bks mt bts   -> S.LPrivate bks mt bts+++instance Deannotate A.Alt S.Alt where+ deannotate f aa+  = case aa of+        A.AAlt A.PDefault x      -> S.AAlt  S.PDefault (deannotate f x)+        A.AAlt (A.PData dc bs) x -> S.AAlt (S.PData dc bs) (deannotate f x)+++instance Deannotate A.Witness S.Witness where+ deannotate f ww+  = let down     = deannotate f+        wrap a x = case f a of+                        Nothing -> x+                        Just a' -> S.WAnnot a' x+    in case ww of+        A.WVar  a u             -> wrap a (S.WVar u)+        A.WCon  a wc            -> wrap a (S.WCon wc)+        A.WApp  a w1 w2         -> wrap a (S.WApp  (down w1) (down w2))+        A.WType a t             -> wrap a (S.WType t)+++instance Deannotate A.Cast S.Cast where+ deannotate f cc+  = let down    = deannotate f+    in case cc of+        A.CastWeakenEffect e    -> S.CastWeakenEffect e+        A.CastPurify w          -> S.CastPurify (down w)+        A.CastBox               -> S.CastBox+        A.CastRun               -> S.CastRun+

@@ -8,7 +8,7 @@ import DDC.Core.Flow.Prim import DDC.Core.Flow.Prim.OpStore import DDC.Core.Flow.Exp-import DDC.Core.Transform.Annotate+import DDC.Core.Flow.Transform.Annotate import DDC.Core.Module  

@@ -7,8 +7,8 @@ import DDC.Core.Flow.Exp import DDC.Core.Flow.Compounds import DDC.Core.Module-import DDC.Core.Transform.Annotate-import DDC.Core.Transform.Deannotate+import DDC.Core.Flow.Transform.Annotate+import DDC.Core.Flow.Transform.Deannotate import Control.Monad.Writer.Strict      hiding (Alt(..)) import qualified Data.Set               as Set import Data.Set                         (Set)

@@ -1,12 +1,12 @@ module DDC.Core.Flow.Transform.Rates.Clusters.Greedy     (cluster_greedy)- where--import DDC.Base.Pretty+where import DDC.Core.Flow.Transform.Rates.Graph import DDC.Core.Flow.Transform.Rates.Clusters.Base -cluster_greedy :: (Ord n, Eq t, Show n, Pretty n) => Graph n t -> TransducerMap n -> [[n]]+cluster_greedy +        :: (Ord n, Eq t) +        => Graph n t -> TransducerMap n -> [[n]] cluster_greedy g trans  -- First find a greedy vertical clustering, then merge any leftover horizontal opportunities  --

@@ -3,7 +3,7 @@     (solve_linear)  where -import DDC.Base.Pretty+import DDC.Data.Pretty import DDC.Core.Flow.Transform.Rates.Graph import DDC.Core.Flow.Transform.Rates.Clusters.Base @@ -79,12 +79,14 @@   -- | Create constraints for edges and weights-getConstraints :: (Ord n, Eq t, Show n)-               => Int -> Graph n t-               -> [((n,n),Bool)]-               -> [(Int,n,n)]-               -> TransducerMap n-               -> Constraint (ZVar n) (RVar n) IntDouble+getConstraints +        :: (Ord n, Eq t)+        => Int -> Graph n t+        -> [((n,n),Bool)]+        -> [(Int,n,n)]+        -> TransducerMap n+        -> Constraint (ZVar n) (RVar n) IntDouble+ getConstraints bigN g arcs ws trans  = mconcat $  map edgeConstraint arcs            ++ map weightConstraint ws@@ -237,7 +239,7 @@   -- | Create linear program for graph, and put all the pieces together.-lp :: (Ord n, Eq t, Show n) => Graph n t -> TransducerMap n -> Program (ZVar n) (RVar n) IntDouble+lp :: (Ord n, Eq t) => Graph n t -> TransducerMap n -> Program (ZVar n) (RVar n) IntDouble lp g trans  = minimise (gobjective names weights)             (getConstraints nNodes g arcs weights trans)

@@ -1,6 +1,7 @@ module DDC.Core.Flow.Transform.Rates.CnfFromExp         (cnfOfExp, takeXLamFlags_safe) where import DDC.Core.Collect+import DDC.Core.Flow.Exp.Simple.Collect () import DDC.Core.Flow.Compounds import DDC.Core.Flow.Prim import DDC.Core.Flow.Exp

@@ -10,7 +10,7 @@         , seriesInputsOfCluster         )  where-import DDC.Base.Pretty+import DDC.Data.Pretty import DDC.Core.Flow.Exp (ExpF) import Data.Maybe (catMaybes) import Data.List  (nub)@@ -247,12 +247,12 @@ -- == Pretty printing -- This is just the notation I used in the prototype. -instance (Pretty s, Pretty a) => Pretty (Fun s a) where+instance Pretty s => Pretty (Fun s a) where  ppr (Fun _ ss)   = encloseSep lbrace rbrace space   $ map ppr ss -instance (Pretty s, Pretty a) => Pretty (Scalar s a) where+instance Pretty s => Pretty (Scalar s a) where  ppr (Scalar _ Nothing)   = text "-"  ppr (Scalar _ (Just s))

@@ -5,7 +5,7 @@         , warn, run) where import DDC.Core.Flow.Prim-import DDC.Base.Pretty+import DDC.Data.Pretty import Control.Monad.Writer import Data.List 

@@ -147,7 +147,7 @@    = Nothing  -invertMap :: (Ord k, Ord v) => Map.Map k v -> Map.Map v [k]+invertMap :: Ord v => Map.Map k v -> Map.Map v [k] invertMap m  = Map.foldWithKey go Map.empty m  where@@ -199,7 +199,7 @@   -- | Convert @Graph@ to a lists of nodes and a list of edges-listOfGraph :: Ord n => Graph n t -> ([(n,Maybe t)], [((n,n),Bool)])+listOfGraph :: Graph n t -> ([(n,Maybe t)], [((n,n),Bool)]) listOfGraph (Graph g)  = (nodes, edges)  where

@@ -3,7 +3,6 @@         (seriesOfVectorModule         ,seriesOfVectorFunction) where-import DDC.Core.Collect import DDC.Core.Flow.Compounds import DDC.Core.Flow.Prim import DDC.Core.Flow.Exp                           as DDC@@ -11,11 +10,12 @@ import DDC.Core.Flow.Transform.Rates.CnfFromExp import DDC.Core.Flow.Transform.Rates.Fail import DDC.Core.Flow.Transform.Rates.Graph-import qualified DDC.Core.Flow.Transform.Rates.SizeInference as SI import DDC.Core.Flow.Transform.Rates.Clusters+import DDC.Core.Flow.Transform.Annotate+import DDC.Core.Flow.Transform.Deannotate import DDC.Core.Module-import DDC.Core.Transform.Annotate-import DDC.Core.Transform.Deannotate+import DDC.Core.Collect+import qualified DDC.Core.Flow.Transform.Rates.SizeInference as SI import qualified DDC.Type.Env           as Env  import qualified Data.Map as Map

@@ -5,9 +5,10 @@     , lookupV     , iter     , parents-    , trans ) where-import DDC.Base.Pretty+    , trans ) +where import DDC.Core.Flow.Transform.Rates.Combinators+import DDC.Data.Pretty  import Data.List import Data.Function (on)@@ -205,7 +206,7 @@   -- | Gamma |- lets ~> Gamma |- C-generateLets :: Ord a => Env a -> [Bind s a] -> (Env a, Constraint a)+generateLets :: Env a -> [Bind s a] -> (Env a, Constraint a) generateLets e bs  = foldl go (e, CTrue) bs  where@@ -214,7 +215,7 @@      in  (e'', c' `CAnd` c'')  -- | Gamma | z |- bind ~> Gamma |- C-generateBind :: Ord a => Env a -> Bind s a -> (Env a, Constraint a)+generateBind :: Env a -> Bind s a -> (Env a, Constraint a) generateBind env b  = case b of    ABind z (MapN _ xs)

@@ -5,7 +5,7 @@ import DDC.Core.Flow.Exp import DDC.Core.Flow.Prim import DDC.Core.Flow.Process.Operator-import DDC.Core.Transform.Annotate+import DDC.Core.Flow.Transform.Annotate import DDC.Core.Pretty import qualified DDC.Core.Flow.Transform.Slurp.Error    as Slurp 

@@ -13,7 +13,7 @@ import DDC.Core.Flow.Process import DDC.Core.Flow.Compounds import DDC.Core.Flow.Exp-import DDC.Core.Transform.Deannotate+import DDC.Core.Flow.Transform.Deannotate import DDC.Core.Module import qualified DDC.Type.Env           as Env import DDC.Type.Env                     (TypeEnv)

@@ -8,8 +8,8 @@ import DDC.Core.Flow.Transform.Slurp.Error import DDC.Core.Flow.Transform.Slurp.Resize import DDC.Core.Flow.Prim-import DDC.Core.Exp.Simple.Compounds-import DDC.Core.Exp.Simple.Exp+import DDC.Core.Flow.Exp.Simple.Compounds+import DDC.Core.Flow.Exp.Simple.Exp import Data.List     (nub)  

@@ -4,10 +4,10 @@ where import DDC.Core.Flow.Exp import DDC.Core.Flow.Prim-import DDC.Core.Transform.Annotate-import DDC.Core.Pretty+import DDC.Core.Flow.Transform.Annotate import DDC.Core.Flow.Context import DDC.Core.Flow.Process.Pretty ()+import DDC.Core.Pretty   -- | Things that can go wrong when slurping a process spec from

@@ -7,7 +7,7 @@ import DDC.Core.Flow.Process.Operator import DDC.Core.Flow.Exp import DDC.Core.Flow.Prim-import DDC.Core.Exp.Simple.Compounds+import DDC.Core.Flow.Exp.Simple.Compounds import DDC.Core.Pretty                  () import Control.Monad 

@@ -7,8 +7,8 @@ where import DDC.Core.Flow.Transform.Slurp.Error import DDC.Core.Flow.Prim-import DDC.Core.Exp.Simple.Compounds-import DDC.Core.Exp.Simple.Exp+import DDC.Core.Flow.Exp.Simple.Compounds+import DDC.Core.Flow.Exp.Simple.Exp import qualified Data.Map               as Map  type Ty = Type Name

@@ -0,0 +1,85 @@++-- | General purpose tree walking boilerplate.+module DDC.Core.Flow.Transform.TransformUpX+        ( TransformUpMX(..)+        , transformUpX+        , transformUpX'++          -- * Via the Simple AST+        , transformSimpleUpMX+        , transformSimpleUpX+        , transformSimpleUpX')+where+import DDC.Core.Exp.Annot+import DDC.Core.Transform.TransformUpX  +import DDC.Core.Flow.Transform.Annotate+import DDC.Core.Flow.Transform.Deannotate+import Data.Functor.Identity+import DDC.Core.Env.EnvX                        (EnvX)+import qualified DDC.Core.Flow.Exp.Simple.Exp   as S+import qualified DDC.Core.Env.EnvX              as EnvX+++-- Simple ---------------------------------------------------------------------+-- | Like `transformUpMX`, but the worker takes the Simple version of the AST.+--+--   * To avoid repeated conversions between the different versions of the AST,+--     the worker should return `Nothing` if the provided expression is unchanged.+transformSimpleUpMX +        :: (Ord n, TransformUpMX m c, Monad m)+        => (EnvX n -> S.Exp a n -> m (Maybe (S.Exp a n)))+                        -- ^ The worker function is given the current+                        --     kind and type environments.+        -> EnvX n       -- ^ Initial type environment.+        -> c a n        -- ^ Transform thing thing.+        -> m (c a n)++transformSimpleUpMX f env0 xx0+ = let  +        f' env xx+         = do   let a    = annotOfExp xx+                let sxx  = deannotate (const Nothing) xx+                msxx'    <- f env sxx+                case msxx' of+                     Nothing   -> return $ xx+                     Just sxx' -> return $ annotate a sxx'++   in   transformUpMX f' env0 xx0+++-- | Like `transformUpX`, but the worker takes the Simple version of the AST.+--+--   * To avoid repeated conversions between the different versions of the AST,+--     the worker should return `Nothing` if the provided expression is unchanged.+transformSimpleUpX+        :: forall (c :: * -> * -> *) a n+        .  (Ord n, TransformUpMX Identity c)+        => (EnvX n -> S.Exp a n -> Maybe (S.Exp a n))+                        -- ^ The worker function is given the current+                        --     kind and type environments.+        -> EnvX n       -- ^ Initial type environment.+        -> c a n        -- ^ Transform this thing.+        -> c a n++transformSimpleUpX f env xx+        = runIdentity +        $ transformSimpleUpMX +                (\env' x -> return (f env' x)) env xx+++-- | Like `transformUpX'`, but the worker takes the Simple version of the AST.+--+--   * To avoid repeated conversions between the different versions of the AST,+--     the worker should return `Nothing` if the provided expression is unchanged.+transformSimpleUpX'+        :: forall (c :: * -> * -> *) a n+        .  (Ord n, TransformUpMX Identity c)+        => (S.Exp a n -> Maybe (S.Exp a n))+                        -- ^ The worker function is given the current+                        --      kind and type environments.+        -> c a n        -- ^ Transform this thing.+        -> c a n++transformSimpleUpX' f xx+        = transformSimpleUpX (\_ -> f) EnvX.empty xx+

@@ -1,7 +1,7 @@ -------------------------------------------------------------------------------- The Disciplined Disciple Compiler License (MIT style) -Copyrite (K) 2007-2014 The Disciplined Disciple Compiler Strike Force+Copyrite (K) 2007-2016 The Disciplined Disciple Compiler Strike Force All rights reversed.  Permission is hereby granted, free of charge, to any person obtaining a copy

@@ -1,5 +1,5 @@ Name:           ddc-core-flow-Version:        0.4.2.1+Version:        0.4.3.1 License:        MIT License-file:   LICENSE Author:         The Disciplined Disciple Compiler Strike Force@@ -30,19 +30,18 @@  Library   Build-Depends: -        base            >= 4.6 && < 4.9,+        base            >= 4.6 && < 4.10,         array           >= 0.4 && < 0.6,         deepseq         >= 1.3 && < 1.5,         containers      == 0.5.*,         limp            == 0.3.2.*,         limp-cbc        == 0.3.2.*,-        transformers    == 0.4.*,+        transformers    == 0.5.*,         mtl             == 2.2.1.*,-        ddc-base        == 0.4.2.*,-        ddc-core        == 0.4.2.*,-        ddc-core-salt   == 0.4.2.*,-        ddc-core-simpl  == 0.4.2.*,-        ddc-core-tetra  == 0.4.2.*+        ddc-core        == 0.4.3.*,+        ddc-core-salt   == 0.4.3.*,+        ddc-core-simpl  == 0.4.3.*,+        ddc-core-tetra  == 0.4.3.*    Exposed-modules: @@ -64,13 +63,16 @@         DDC.Core.Flow.Transform.Rates.SeriesOfVector         DDC.Core.Flow.Transform.Rates.SizeInference +        DDC.Core.Flow.Transform.Annotate         DDC.Core.Flow.Transform.Concretize+        DDC.Core.Flow.Transform.Deannotate         DDC.Core.Flow.Transform.Extract         DDC.Core.Flow.Transform.Forward         DDC.Core.Flow.Transform.Melt         DDC.Core.Flow.Transform.Schedule         DDC.Core.Flow.Transform.Slurp         DDC.Core.Flow.Transform.Thread+        DDC.Core.Flow.Transform.TransformUpX         DDC.Core.Flow.Transform.Wind          DDC.Core.Flow.Compounds@@ -116,6 +118,10 @@         DDC.Core.Flow.Transform.Slurp.Operator         DDC.Core.Flow.Transform.Slurp.Resize +        DDC.Core.Flow.Exp.Simple.Collect+        DDC.Core.Flow.Exp.Simple.Compounds+        DDC.Core.Flow.Exp.Simple.Exp+            GHC-options:         -Wall@@ -125,13 +131,16 @@         -fno-warn-unused-do-bind    Extensions:-        KindSignatures         NoMonomorphismRestriction+        FunctionalDependencies+        MultiParamTypeClasses+        FlexibleContexts         ScopedTypeVariables         StandaloneDeriving-        PatternGuards-        ParallelListComp         DeriveDataTypeable-        ViewPatterns         FlexibleInstances+        ParallelListComp+        KindSignatures+        PatternGuards+        ViewPatterns         BangPatterns