Add compiler flag for effect encapsulation #211

base/Prelude.toml

@@ -6,7 +6,7 @@
 # Metadata                                                                   #
 ##############################################################################
 
-version = 4
+version = 5
 module-name = 'Prelude'
 library-name = 'Base'
 exported-types = [
@@ -83,6 +83,7 @@ exported-values = [
   arity           = 2
   effects         = []
   needs-free-args = true
+  encapsulates-effects = false
 
 [[functions]]
   haskell-type    = 'Prelude.Bool -> Prelude.Bool -> Prelude.Bool'
@@ -92,6 +93,7 @@ exported-values = [
   arity           = 2
   effects         = []
   needs-free-args = true
+  encapsulates-effects = false
 
 ##############################################################################
 # Integer                                                                    #
@@ -112,6 +114,7 @@ exported-values = [
   arity           = 2
   effects         = []
   needs-free-args = true
+  encapsulates-effects = false
 
 [[functions]]
   haskell-type    = 'Prelude.Integer -> Prelude.Integer -> Prelude.Integer'
@@ -121,6 +124,7 @@ exported-values = [
   arity           = 2
   effects         = []
   needs-free-args = true
+  encapsulates-effects = false
 
 [[functions]]
   haskell-type    = 'Prelude.Integer -> Prelude.Integer -> Prelude.Integer'
@@ -130,6 +134,7 @@ exported-values = [
   arity           = 2
   effects         = []
   needs-free-args = true
+  encapsulates-effects = false
 
 [[functions]]
   haskell-type    = 'Prelude.Integer -> Prelude.Integer -> Prelude.Integer'
@@ -139,6 +144,7 @@ exported-values = [
   arity           = 2
   effects         = ['Partiality']
   needs-free-args = true
+  encapsulates-effects = false
 
 [[functions]]
   haskell-type    = 'Prelude.Integer -> Prelude.Integer -> Prelude.Bool'
@@ -148,6 +154,7 @@ exported-values = [
   arity           = 2
   effects         = []
   needs-free-args = true
+  encapsulates-effects = false
 
 [[functions]]
   haskell-type    = 'Prelude.Integer -> Prelude.Integer -> Prelude.Bool'
@@ -157,6 +164,7 @@ exported-values = [
   arity           = 2
   effects         = []
   needs-free-args = true
+  encapsulates-effects = false
 
 [[functions]]
   haskell-type    = 'Prelude.Integer -> Prelude.Integer -> Prelude.Bool'
@@ -166,6 +174,7 @@ exported-values = [
   arity           = 2
   effects         = []
   needs-free-args = true
+  encapsulates-effects = false
 
 [[functions]]
   haskell-type    = 'Prelude.Integer -> Prelude.Integer -> Prelude.Bool'
@@ -175,6 +184,7 @@ exported-values = [
   arity           = 2
   effects         = []
   needs-free-args = true
+  encapsulates-effects = false
 
 [[functions]]
   haskell-type    = 'Prelude.Integer -> Prelude.Integer -> Prelude.Bool'
@@ -184,6 +194,7 @@ exported-values = [
   arity           = 2
   effects         = []
   needs-free-args = true
+  encapsulates-effects = false
 
 [[functions]]
   haskell-type    = 'Prelude.Integer -> Prelude.Integer -> Prelude.Bool'
@@ -193,6 +204,7 @@ exported-values = [
   arity           = 2
   effects         = []
   needs-free-args = true
+  encapsulates-effects = false
 
 [[functions]]
   haskell-type    = 'Prelude.Integer -> Prelude.Integer'
@@ -202,6 +214,7 @@ exported-values = [
   arity           = 1
   effects         = []
   needs-free-args = true
+  encapsulates-effects = false
 
 ##############################################################################
 # Lists                                                                      #

base/Test/QuickCheck.toml

@@ -7,7 +7,7 @@
 # Metadata                                                                   #
 ##############################################################################
 
-version = 4
+version = 5
 module-name = 'Test.QuickCheck'
 library-name = 'Base'
 exported-types = [
@@ -45,6 +45,7 @@ exported-values = [
   arity           = 1
   effects         = []
   needs-free-args = true
+  encapsulates-effects = true
 
 ##############################################################################
 # Operators                                                                  #
@@ -58,6 +59,7 @@ exported-values = [
   arity           = 2
   effects         = []
   needs-free-args = true
+  encapsulates-effects = true
 
 [[functions]]
   haskell-type    = 'a -> a -> Test.QuickCheck.Property'
@@ -67,6 +69,7 @@ exported-values = [
   arity           = 2
   effects         = []
   needs-free-args = true
+  encapsulates-effects = true
 
 [[functions]]
   haskell-type    = 'a -> a -> Test.QuickCheck.Property'
@@ -76,6 +79,7 @@ exported-values = [
   arity           = 2
   effects         = []
   needs-free-args = true
+  encapsulates-effects = true
 
 [[functions]]
   haskell-type    = 'Test.QuickCheck.Property -> Test.QuickCheck.Property -> Test.QuickCheck.Property'
@@ -85,6 +89,7 @@ exported-values = [
   arity           = 2
   effects         = []
   needs-free-args = true
+  encapsulates-effects = true
 
 [[functions]]
   haskell-type    = 'Test.QuickCheck.Property -> Test.QuickCheck.Property -> Test.QuickCheck.Property'
@@ -94,6 +99,7 @@ exported-values = [
   arity           = 2
   effects         = []
   needs-free-args = true
+  encapsulates-effects = true
 
 ##############################################################################
 # Imported from `Prelude`                                                    #

free-compiler.cabal

@@ -174,6 +174,7 @@ library freec-internal
                       , FreeC.Pass.EffectAnalysisPass
                       , FreeC.Pass.EtaConversionPass
                       , FreeC.Pass.ExportPass
+                      , FreeC.Pass.FlattenExprPass
                       , FreeC.Pass.ImplicitPreludePass
                       , FreeC.Pass.ImportPass
                       , FreeC.Pass.KindCheckPass
@@ -183,6 +184,7 @@ library freec-internal
                       , FreeC.Pass.ResolverPass
                       , FreeC.Pass.TypeInferencePass
                       , FreeC.Pass.TypeSignaturePass
+                      , FreeC.Pass.SharingAnalysisPass
                       , FreeC.Pipeline
                       , FreeC.Pretty
                       , FreeC.Util.Config
@@ -258,6 +260,7 @@ test-suite freec-unit-tests
                     , FreeC.Pass.EffectAnalysisPassTests
                     , FreeC.Pass.EtaConversionPassTests
                     , FreeC.Pass.ExportPassTests
+                    , FreeC.Pass.FlattenExprPassTests
                     , FreeC.Pass.KindCheckPassTests
                     , FreeC.Pass.LetSortPassTests
                     , FreeC.Pass.ResolverPassTests

src/exe/FreeC/Backend.hs

@@ -16,6 +16,7 @@ import           FreeC.Backend.Agda.Pretty           ()
 import qualified FreeC.Backend.Coq.Base              as Coq.Base
 import qualified FreeC.Backend.Coq.Converter.Module  as Coq.Converter
 import           FreeC.Backend.Coq.Pretty            ()
+import           FreeC.IR.Strip                      ( stripExprType )
 import qualified FreeC.IR.Syntax                     as IR
 import           FreeC.Monad.Application
 import           FreeC.Pretty                        ( showPretty )
@@ -51,11 +52,12 @@ defaultBackend = backendName coqBackend
 -------------------------------------------------------------------------------
 -- | A dummy backend that just pretty prints the IR.
 irBackend :: Backend
-irBackend = Backend { backendName          = "ir"
-                    , backendConvertModule = return . showPretty
-                    , backendFileExtension = "ir"
-                    , backendSpecialAction = return ()
-                    }
+irBackend = Backend
+  { backendName          = "ir"
+  , backendConvertModule = return . showPretty . stripExprType
+  , backendFileExtension = "ir"
+  , backendSpecialAction = return ()
+  }
 
 -------------------------------------------------------------------------------
 -- Coq Backend                                                               --

src/lib/FreeC/Backend/Coq/Converter/FuncDecl/Rec/WithHelpers.hs

@@ -162,9 +162,10 @@ transformRecFuncDecl
     -- Even though we know the type of the original and additional arguments
     -- the return type is unknown, since the right-hand side of @case@
     -- expressions is not annotated.
-    -- The helper function uses all effects that are used by the original 
+    -- The helper function uses all effects that are used by the original
     -- function.
     freeArgsNeeded <- inEnv $ needsFreeArgs name
+    encEffects <- inEnv $ encapsulatesEffects name
     effects <- inEnv $ lookupEffects name
     _entry <- renameAndAddEntry
       $ FuncEntry
@@ -175,6 +176,7 @@ transformRecFuncDecl
       , entryStrictArgs    = map IR.varPatIsStrict helperArgs
       , entryReturnType    = fromJust helperReturnType
       , entryNeedsFreeArgs = freeArgsNeeded
+      , entryEncapsulatesEffects = encEffects
       , entryEffects       = effects
       , entryName          = helperName
       , entryIdent         = undefined -- filled by renamer

src/lib/FreeC/Environment.hs

@@ -18,6 +18,7 @@ module FreeC.Environment
   , addEffectsToEntry
     -- * Looking up Entries from the Environment
   , lookupEntry
+  , encapsulatesEffects
   , isFunction
   , isVariable
   , isPureVar
@@ -158,6 +159,14 @@ addEffectsToEntry name effects env = case lookupEntry IR.ValueScope name env of
 -------------------------------------------------------------------------------
 -- Looking up Entries from the Environment                                   --
 -------------------------------------------------------------------------------
+
+-- | Tests whether the function with the given name encapsulates effects.
+--
+--   Returns @False@ if there is no such function.
+encapsulatesEffects :: IR.QName -> Environment -> Bool
+encapsulatesEffects = maybe False (isFuncEntry .&&. entryEncapsulatesEffects)
+  .: lookupEntry IR.ValueScope
+
 -- | Looks up the entry with the given original name in the given scope of
 --   the given environment.
 lookupEntry :: IR.Scope -> IR.QName -> Environment -> Maybe EnvEntry

src/lib/FreeC/Environment/Entry.hs

@@ -102,6 +102,8 @@ data EnvEntry
       , entryNeedsFreeArgs :: Bool
         -- ^ Whether the arguments of the @Free@ monad need to be
         --   passed to the function.
+      , entryEncapsulatesEffects :: Bool
+        -- ^ Whether the function should encapsulate effects.
       , entryEffects       :: [Effect]
         -- ^ The effects of the function, i.e. which type classes are needed
         --   during the translation.

src/lib/FreeC/Environment/ModuleInterface/Decoder.hs

@@ -135,8 +135,9 @@ import           FreeC.Util.Config
 --   a breaking change is made to the encoder or decoder, it is less likely
 --   that the implementation of the corresponding change in the other module
 --   is forgotten.
+-- TODO bump version number
 moduleInterfaceFileFormatVersion :: Integer
-moduleInterfaceFileFormatVersion = 4
+moduleInterfaceFileFormatVersion = 5
 
 -- | Parses an IR AST node from an Aeson string.
 parseAesonIR :: Parseable a => Text -> Aeson.Parser a
@@ -271,6 +272,7 @@ instance Aeson.FromJSON ModuleInterface where
       haskellType <- obj .: "haskell-type"
       effects <- obj .: "effects"
       freeArgsNeeded <- obj .: "needs-free-args"
+      effectsEncapsulated <- obj .: "encapsulates-effects"
       coqName <- obj .: "coq-name"
       agdaName <- obj .: "agda-name"
       -- TODO this does not work with vanishing type arguments.
@@ -284,6 +286,7 @@ instance Aeson.FromJSON ModuleInterface where
         , entryStrictArgs    = replicate arity False
         , entryReturnType    = returnType
         , entryNeedsFreeArgs = freeArgsNeeded
+        , entryEncapsulatesEffects = effectsEncapsulated
         , entryEffects       = effects
         , entryIdent         = coqName
         , entryAgdaIdent     = agdaName

src/lib/FreeC/Environment/ModuleInterface/Encoder.hs

@@ -43,7 +43,7 @@ import           FreeC.Util.Config
 --   that the implementation of the corresponding change in the other module
 --   is forgotten.
 moduleInterfaceFileFormatVersion :: Integer
-moduleInterfaceFileFormatVersion = 4
+moduleInterfaceFileFormatVersion = 5
 
 instance Aeson.ToJSON IR.QName where
   toJSON = Aeson.toJSON . showPretty
@@ -124,6 +124,7 @@ encodeEntry entry
     , "arity" .= arity
     , "effects" .= effects
     , "needs-free-args" .= freeArgsNeeded
+    , "encapsulates-effects" .= effectsEncapsulated
     ]
   | otherwise = error "encodeEntry: Cannot serialize (type) variable entry."
  where
@@ -156,6 +157,9 @@ encodeEntry entry
   freeArgsNeeded :: Aeson.Value
   freeArgsNeeded = Aeson.toJSON (entryNeedsFreeArgs entry)
 
+  effectsEncapsulated :: Aeson.Value
+  effectsEncapsulated = Aeson.toJSON (entryEncapsulatesEffects entry)
+
   haskellType :: Aeson.Value
   haskellType = Aeson.toJSON (foldr (IR.FuncType NoSrcSpan)
                               (entryReturnType entry) (entryArgTypes entry))

src/lib/FreeC/IR/Strip.hs

@@ -21,6 +21,10 @@ import qualified FreeC.IR.Syntax  as IR
 class StripExprType node where
   stripExprType :: node -> node
 
+instance StripExprType IR.Module where
+  stripExprType ast
+    = ast { IR.modFuncDecls = map stripExprType (IR.modFuncDecls ast) }
+
 -- | Strips the expression type annotations from function declarations.
 instance StripExprType IR.FuncDecl where
   stripExprType funcDecl