More documentation, rename PreviousInputs

README.md

@@ -332,7 +332,7 @@ The source of the YieldFSM compiler is present in the `src/FSM` directory.
 
 Various transformations are defined in the `src/FSM/Process` directory, including:
 
-* Desugaring - `DesugarOutputs.hs`, `DesugarLoops.hs`, some desugaring also occurs in the parser.
+* Desugaring - `DesugarOutputs.hs`, `DesugarLoops.hs`, `DesugarMagicPrimes.hs`, some desugaring also occurs in the parser.
 * Local mutable variables - `MakeLocalVars.hs`.
 * Lambda lifting - `LambdaLift.hs`.
 * Normalization - `Normalization.hs`.

src/FSM.hs

@@ -34,8 +34,8 @@ mkFSM str = do
             p1 <- desugarLoops =<< desugarOutputs p
             TH.runIO $ hPutStrLn stderr $ "desugarLoops:"
             TH.runIO $ hPutStrLn stderr $ HPJ.render $ prettyProgHPJ p1
-            p' <- fmap previousInputs . refreshVars =<< refreshFunctions p1
-            TH.runIO $ hPutStrLn stderr $ "previousInputs:"
+            p' <- fmap desugarMagicPrimes . refreshVars =<< refreshFunctions p1
+            TH.runIO $ hPutStrLn stderr $ "desugarMagicPrimes:"
             TH.runIO $ hPutStrLn stderr $ HPJ.render $ prettyProgHPJ p'
             p'' <- simplifyCase <$> makeLocalVars p'
             TH.runIO $ hPutStrLn stderr $ "makeLocalVars:"

src/FSM/LangProcess.hs

@@ -7,7 +7,7 @@ Program transformations.
 -}
 module FSM.LangProcess(
     lambdaLift, refreshFunctions, normalization, removeEpsilon, makeLocalVars,
-    stackReify, previousInputs, flattenTuples,
+    stackReify, desugarMagicPrimes, flattenTuples,
     foldInit, refreshVars, simplifyCase, simplifyCaseN, simplifyCaseNFull,
     cleanUnusedConstructors, cleanUnusedArgs, cleanUnusedConts,
     argumentPropagation, integrateCase, testFreshness, desugarLoops,
@@ -23,7 +23,7 @@ import FSM.Process.RemoveEpsilon
 import FSM.Process.LambdaLift
 import FSM.Process.FoldInit
 import FSM.Process.SimplifyCase
-import FSM.Process.PreviousInputs
+import FSM.Process.DesugarMagicPrimes
 import FSM.Process.FlattenTuples
 import FSM.Process.CleanUnusedConstructors
 import FSM.Process.CleanUnusedArgs

src/FSM/Process/PreviousInputs.hs → src/FSM/Process/DesugarMagicPrimes.hs

@@ -2,8 +2,10 @@
 Copyright  :  (C) 2022 Marek Materzok
 License    :  BSD2 (see the file LICENSE)
 Maintainer :  Marek Materzok <tilk@tilk.eu>
+
+This module defines magic prime desugaring.
 -}
-module FSM.Process.PreviousInputs(previousInputs) where
+module FSM.Process.DesugarMagicPrimes(desugarMagicPrimes) where
 
 import FSM.Lang
 import FSM.FreeVars
@@ -35,8 +37,31 @@ primName n k = TH.mkName $ n ++ replicate k '\''
 addVar :: (IsDesugared l, WithAssign l) => TH.Name -> Stmt l -> Stmt l
 addVar n = SLet VarMut n (VExp $ TH.VarE 'CP.undefined)
 
-previousInputs :: (IsDesugared l, WithAssign l) => Prog l -> Prog l
-previousInputs prog 
+{-|
+Desugars magic primes. References to inputs with primes are replaced with
+additional mutable variables, holding previous values of these inputs.
+
+Example:
+
+> input i
+> forever:
+>     yield i
+>     if i':
+>         yield True
+
+Is translated to:
+
+> input i
+> var i' = undefined
+> forever:
+>     i' = i
+>     yield i
+>     if i':
+>         i' = i
+>         yield True
+-}
+desugarMagicPrimes :: (IsDesugared l, WithAssign l) => Prog l -> Prog l
+desugarMagicPrimes prog 
     | length pvars > 0 = prog { progBody = flip (foldr addVar) (map fst pvars) $ updateYieldsStmt (map (\(n, n') -> SAssign n (TH.VarE n')) pvars) $ progBody prog }
     | otherwise = prog
     where

src/FSM/Process/FlattenTuples.hs

@@ -2,6 +2,8 @@
 Copyright  :  (C) 2022 Marek Materzok
 License    :  BSD2 (see the file LICENSE)
 Maintainer :  Marek Materzok <tilk@tilk.eu>
+
+Defines the tuple flattening transform.
 -}
 module FSM.Process.FlattenTuples(flattenTuples) where
 
@@ -84,6 +86,25 @@ isTupP :: TH.Pat -> Bool
 isTupP (TH.TupP _) = True
 isTupP _ = False
 
+{-|
+Tuple flattening transform. Some other transforms lead to deeply nested
+tuples occuring in function parameters, which are unreadable and hard
+to process. This transform flattens tuples in function parameters.
+
+Example:
+
+> fun f ((x, y), z):
+>     ...
+>     ret call f ((a, b), c)
+> ret call f ((1, 2), 3)
+
+Is translated to:
+
+> fun f (x, y, z):
+>     ...
+>     ret call f (a, b, c)
+> ret call f (1, 2, 3)
+-}
 flattenTuples :: IsLifted l => NProg l -> NProg l
 flattenTuples prog = prog {
         nProgFuns = flattenFunMap flatPat $ nProgFuns prog,

src/FSM/Process/HoistFromConstructors.hs

@@ -1,3 +1,10 @@
+{-|
+Copyright  :  (C) 2022 Marek Materzok
+License    :  BSD2 (see the file LICENSE)
+Maintainer :  Marek Materzok <tilk@tilk.eu>
+
+Defines the hoisting from constructors transform.
+-}
 {-# LANGUAGE FlexibleContexts #-}
 module FSM.Process.HoistFromConstructors(hoistFromConstructors) where
 
@@ -49,6 +56,23 @@ hoistCase (p, s) = (p,) <$> hoistStmt s
 hoistFunMap :: (MonadRefresh m, IsLowered l) => FunMap l -> m (FunMap l)
 hoistFunMap = mapM hoistCase
 
+{-|
+Hoisting from constructors transform. For correctness and performance reasons,
+only constructor expressions (built only from constructors, constants and variables)
+are considered for substitution. This limitation can inhibit other optimizations.
+This transform creates new let definitions for constructor arguments, splitting
+large expressions into smaller ones which could be eligible for substitution.
+
+Example:
+
+> let x = (f a, g b)
+
+Is translated to:
+
+> let y = f a
+> let z = g b
+> let x = (y, z)
+-}
 hoistFromConstructors :: (MonadRefresh m, IsLowered l) => NProg l -> m (NProg l)
 hoistFromConstructors prog = do
     prog' <- hoistFunMap $ nProgFuns prog

src/FSM/Process/IntegrateCase.hs

@@ -2,6 +2,8 @@
 Copyright  :  (C) 2022 Marek Materzok
 License    :  BSD2 (see the file LICENSE)
 Maintainer :  Marek Materzok <tilk@tilk.eu>
+
+Defines the case integration transform.
 -}
 module FSM.Process.IntegrateCase(integrateCase) where
 
@@ -61,6 +63,26 @@ integrateCaseFunMap fs = M.map f fs
         where
         cm = M.map fromJust $ M.filter isJust $ canIntegrateCaseStmt (boundVars p `S.difference` boundAsVars p) s
 
+{-|
+Case integration transform. If a @case@ statement is used to deconstruct
+a function argument, the case pattern can be integrated into the
+function definition. This transform can enable other optimizations.
+
+Example:
+
+> fun f x:
+>    case x
+>    | (y, z):
+>        yield y
+>        ret call f (y + 1, z - 1)
+
+Is translated to:
+
+> fun f (y, z):
+>    yield y
+>    ret call f (y + 1, z - 1)
+
+-}
 integrateCase :: IsLifted l => NProg l -> NProg l
 integrateCase prog = prog { nProgFuns = integrateCaseFunMap $ nProgFuns prog }
 

src/FSM/Process/ReturningFuns.hs

@@ -2,6 +2,8 @@
 Copyright  :  (C) 2022 Marek Materzok
 License    :  BSD2 (see the file LICENSE)
 Maintainer :  Marek Materzok <tilk@tilk.eu>
+
+This module defines returning function analysis.
 -}
 module FSM.Process.ReturningFuns(returningFuns, returningFunsFlat) where
 
@@ -40,9 +42,18 @@ returningFunsH cg ns = saturateSet (flip (M.findWithDefault S.empty) tailCalled)
     where
     tailCalled = M.fromListWith S.union $ map (\e -> (cgEdgeDst e, S.singleton $ cgEdgeSrc e)) $ filter cgEdgeTail cg
 
+{-|
+Performs the returning function analysis. A function is returning if it
+contains a value return statement or tail calls another returning function.
+Returns the set of names of returning functions.
+-}
 returningFuns :: IsDesugared l => Stmt l -> S.Set TH.Name
 returningFuns s = returningFunsH (callGraph s) (directRet s)
 
+{-|
+Performs the returning function analysis. Variant for 'FunMap',
+used on lambda-lifted programs.
+-}
 returningFunsFlat :: IsDesugared l => FunMap l -> S.Set TH.Name
 returningFunsFlat fs = returningFunsH (callGraphFlat fs) (directRetFunMap fs)
 

src/FSM/Process/SimplifyCase.hs

@@ -2,6 +2,10 @@
 Copyright  :  (C) 2022 Marek Materzok
 License    :  BSD2 (see the file LICENSE)
 Maintainer :  Marek Materzok <tilk@tilk.eu>
+
+Defines case and let statement simplification transform.
+
+Note: this transform does too many things and possibly needs to be refactored.
 -}
 module FSM.Process.SimplifyCase(
     simplifyCase, simplifyCaseN, simplifyCaseNFull, simplifyCaseGen, mkLetGen
@@ -32,6 +36,11 @@ matchableExp (TH.UnboxedSumE _ _ _) = True
 matchableExp (TH.RecConE _ _) = True
 matchableExp _ = False
 
+{-|
+Tries to match an expression to a pattern, and binds the subexpressions
+to corresponding variables. This is an internal function, exported
+for use in other transforms.
+-}
 simplifyCaseGen :: (TH.Name -> TH.Exp -> a -> a) -> TH.Exp -> TH.Pat -> a -> MMaybe a
 simplifyCaseGen m e (TH.VarP n) s = MJust $ m n e s
 simplifyCaseGen _ (TH.LitE l) (TH.LitP l') s | l == l' = MJust s
@@ -55,6 +64,11 @@ simplifyCaseDo m e cs = mmaybe (SCase e (map (simplifyCaseCase m) cs)) id $ msum
 simplifyCaseCase :: IsDesugared l => KindMap -> (TH.Pat, Stmt l) -> (TH.Pat, Stmt l)
 simplifyCaseCase m (p, s) = (p, simplifyCaseStmt (setVars VarLet (boundVars p) m) s)
 
+{-|
+Creates a let definition or substitutes it, depending on correctness and
+performance considerations. This is an internal function, exported for
+use in other transforms.
+-}
 mkLetGen :: (FreeVars a, Subst a) => (KindMap -> a -> a) -> (TH.Name -> TH.Exp -> a -> a) -> KindMap -> TH.Name -> TH.Exp -> a -> a
 mkLetGen f g m n e s
     | (TH.VarE n') <- e, Just VarLet <- M.lookup n' m = f m $ substSingle n e s
@@ -85,16 +99,40 @@ simplifyCaseStmt m   (SLet t n vs s) = SLet t n vs (simplifyCaseStmt m s)
 simplifyCaseFunMap :: IsDesugared l => KindMap -> FunMap l -> FunMap l
 simplifyCaseFunMap m = M.map (simplifyCaseCase m)
 
+{-|
+Case and let statement simplification transform.
+When the matching case is statically known, the @case@ statement is replaced
+with @let@ definitions. This transform also substitutes @let@ definitions,
+when correctness and performance considerations allow it.
+
+Example:
+
+> case (1, 2)
+> | (x, y):
+>     yield x + y
+
+Is translated to:
+
+> yield 1 + 2
+-}
 simplifyCase :: IsDesugared l => Prog l -> Prog l
 simplifyCase prog = prog { progBody = simplifyCaseStmt m $ progBody prog }
     where
     m = setVars VarMut (boundVars $ progInputs prog) $ setVars VarLet (freeVars $ progBody prog) M.empty
 
+{-|
+Case and let statement simplification transform.
+Variant for 'NProg'.
+-}
 simplifyCaseN :: IsDesugared l => NProg l -> NProg l
 simplifyCaseN prog = prog { nProgFuns = simplifyCaseFunMap m $ nProgFuns prog }
     where
     m = setVars VarMut (boundVars $ nProgInputs prog) $ setVars VarLet (freeVarsFunMap $ nProgFuns prog) M.empty
 
+{-|
+Case and let statement simplification transform.
+Variant for 'NProg', correct only for normalized programs.
+-}
 simplifyCaseNFull :: IsDesugared l => NProg l -> NProg l
 simplifyCaseNFull prog = prog { nProgFuns = simplifyCaseFunMap m $ nProgFuns prog }
     where

src/FSM/Process/TailCallSCC.hs

@@ -2,6 +2,8 @@
 Copyright  :  (C) 2022 Marek Materzok
 License    :  BSD2 (see the file LICENSE)
 Maintainer :  Marek Materzok <tilk@tilk.eu>
+
+Strongly connected components analysis.
 -}
 module FSM.Process.TailCallSCC(Partition(..), partitionSet, partitionLookup, tailCallSCCFunMap, tailCallSCC, tailCallSCCN) where
 
@@ -27,15 +29,25 @@ funsStmt (SIf _ st sf) = funsStmt st `S.union` funsStmt sf
 funsStmt (SCase _ cs) = S.unions $ map (funsStmt . snd) cs
 funsStmt SNop = S.empty
 
+{-|
+Represents strongly connected components and the condensation graph
+(the graph whose nodes are SCCs). Each component receives a unique number.
+-}
 data Partition a = Partition {
-    partitionMap :: M.Map a Int,
-    partitionSets :: M.Map Int (S.Set a),
-    partitionEdges :: S.Set (Int, Int)
+    partitionMap :: M.Map a Int,          -- ^ Maps each element to the number of the SCC which contains it.
+    partitionSets :: M.Map Int (S.Set a), -- ^ Maps SCC numbers to sets of contained elements.
+    partitionEdges :: S.Set (Int, Int)    -- ^ Represents edges in the condensation graph.
 } deriving Show
 
+{-|
+Gets the number of the SCC containing an element.
+-}
 partitionLookup :: Ord a => a -> Partition a -> Int
 partitionLookup k = fromJust . M.lookup k . partitionMap
 
+{-|
+Gets the elements in the SCC with a given number.
+-}
 partitionSet :: Int -> Partition a -> S.Set a
 partitionSet n = fromJust . M.lookup n . partitionSets
 
@@ -53,15 +65,24 @@ tailCallSCCGen gr fs x = Partition pMap pSets pEdges
     funToGr n = M.singleton n S.empty
     toSCC (n, ns) = (n, n, S.toList ns)
 
+{-|
+Finds strongly connected components in the tail call graph of 'FunMap'.
+-}
 tailCallSCCFunMap :: IsDesugared l => FunMap l -> Partition TH.Name
 tailCallSCCFunMap = tailCallSCCGen callGraphFlat M.keys
 
 tailCallSCCStmt :: IsDesugared l => Stmt l -> Partition TH.Name
 tailCallSCCStmt = tailCallSCCGen callGraph (S.toList . funsStmt)
 
+{-|
+Finds strongly connected components in the tail call graph of 'Prog'.
+-}
 tailCallSCC :: IsDesugared l => Prog l -> Partition TH.Name
 tailCallSCC = tailCallSCCStmt . progBody
 
+{-|
+Finds strongly connected components in the tail call graph of 'NProg'.
+-}
 tailCallSCCN :: IsDesugared l => NProg l -> Partition TH.Name
 tailCallSCCN = tailCallSCCGen callGraphNProg (M.keys . nProgFuns)
 

src/FSM/Process/TestFreshness.hs

@@ -2,6 +2,8 @@
 Copyright  :  (C) 2022 Marek Materzok
 License    :  BSD2 (see the file LICENSE)
 Maintainer :  Marek Materzok <tilk@tilk.eu>
+
+Freshness check.
 -}
 module FSM.Process.TestFreshness(testFreshness) where
 
@@ -53,6 +55,10 @@ testFreshnessFunMap = M.map testFreshnessFun
     where
     testFreshnessFun= flip evalState S.empty . testFreshnessCase
 
+{-|
+Sanity check for testing if all variable names occuring in the programs are
+distinct. This is used because some of the transforms assume this property.
+-}
 testFreshness :: IsDesugared l => NProg l -> NProg l
 testFreshness prog = prog { nProgFuns = testFreshnessFunMap $ nProgFuns prog }
 

yieldfsm.cabal

@@ -115,7 +115,7 @@ library
     FSM.Process.CleanUnusedArgs
     FSM.Process.CleanUnusedConstructors
     FSM.Process.FlattenTuples
-    FSM.Process.PreviousInputs
+    FSM.Process.DesugarMagicPrimes
     FSM.Process.StackReify
     FSM.Process.CallGraph
     FSM.Process.ReturningFuns