Fix LF conversion and typechecker #12051 TODOs (#14890)

* Add per interface choice context in serializability checks

* Update expected errors in daml-test-files

* Drop done todo

* Keep TyCon in InterfaceBinds

* Move convertInterface to top level

* convertInterface now returns a list of definitions

* Refactor convertInterface

* Create interface data type def in convertInterface

* Check for featureSimpleInterfaces in convertInterface

* Check for featureSimpleInterfaces in convertInterfaceInstance

* cleanup convertRequires

* Validate that an interface type constructor has no parameters

changelog_begin
changelog_end

compiler/daml-lf-tools/src/DA/Daml/LF/TypeChecker/Serializability.hs

@@ -176,10 +176,9 @@ checkTemplate mod0 tpl = do
 
 -- | Check whether a template satisfies all serializability constraints.
 checkInterface :: MonadGamma m => Module -> DefInterface -> m ()
-checkInterface _mod0 iface = do
-  -- TODO https://github.com/digital-asset/daml/issues/12051
-  -- Add per interface choice context.
+checkInterface mod0 iface = do
   for_ (intChoices iface) $ \ch -> do
+    withContext (ContextDefInterface mod0 iface (IPChoice ch)) $ do
       checkType SRChoiceArg (snd (chcArgBinder ch))
       checkType SRChoiceRes (chcReturnType ch)
       

compiler/damlc/daml-lf-conversion/src/DA/Daml/LFConversion.hs

@@ -1,5 +1,6 @@
 -- Copyright (c) 2022 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
 -- SPDX-License-Identifier: Apache-2.0
+{-# LANGUAGE BlockArguments #-}
 {-# LANGUAGE MultiWayIf #-}
 {-# OPTIONS_GHC -Wno-unused-matches #-}
 {-# OPTIONS_GHC -Wno-incomplete-patterns #-}
@@ -487,9 +488,9 @@ modInstanceInfoFromDetails ModDetails{..} = MS.fromList
 
 -- | Represents the contents of some interface instance
 data InterfaceBinds = InterfaceBinds
-  { ibLoc :: Maybe SourceLoc
-      -- ^ Location associated to the type declaration, which should
-      -- point to the @interface X@ line in the daml file.
+  { ibTyCon :: TyCon
+      -- ^ Type constructor associated to the interface declaration. Its location
+      -- should point to the @interface X@ line in the daml file.
   , ibViewType :: Maybe GHC.Type
       -- ^ The view type associated with this interface.
   , ibMethods :: MS.Map MethodName (GHC.Type, Maybe SourceLoc)
@@ -499,9 +500,9 @@ data InterfaceBinds = InterfaceBinds
       -- ^ The interfaces required by this interface.
   }
 
-emptyInterfaceBinds :: Maybe SourceLoc -> InterfaceBinds
-emptyInterfaceBinds ibLoc = InterfaceBinds
-  { ibLoc
+emptyInterfaceBinds :: TyCon -> InterfaceBinds
+emptyInterfaceBinds ibTyCon = InterfaceBinds
+  { ibTyCon
   , ibViewType = Nothing
   , ibMethods = MS.empty
   , ibRequires = []
@@ -532,22 +533,20 @@ scrapeInterfaceBinds ::
   -> [TyThing]
   -> [(Var, GHC.Expr Var)]
   -> MS.Map TypeConName InterfaceBinds
-scrapeInterfaceBinds lfVersion tyThings binds
-  | lfVersion `supports` featureSimpleInterfaces =
-      MMS.merge
-        {- drop bind funcs without interfaces -}
-        MMS.dropMissing
-        {- keep interfaces without bind funcs -}
-        MMS.preserveMissing'
-        {- apply bind funcs to interfaces -}
-        (MMS.zipWithMatched (const ($!)))
-        interfaceBindFs
-        interfaces
-  | otherwise = MS.empty
+scrapeInterfaceBinds lfVersion tyThings binds =
+  MMS.merge
+    {- drop bind funcs without interfaces -}
+    MMS.dropMissing
+    {- keep interfaces without bind funcs -}
+    MMS.preserveMissing'
+    {- apply bind funcs to interfaces -}
+    (MMS.zipWithMatched (const ($!)))
+    interfaceBindFs
+    interfaces
   where
     interfaces :: MS.Map TypeConName InterfaceBinds
     interfaces = MS.fromList
-      [ (mkTypeCon [getOccText t], emptyInterfaceBinds (convNameLoc t))
+      [ (mkTypeCon [getOccText t], emptyInterfaceBinds t)
       | ATyCon t <- tyThings
       , hasDamlInterfaceCtx t
       ]
@@ -652,18 +651,16 @@ scrapeInterfaceInstanceBinds ::
      Env
   -> [(Var, GHC.Expr CoreBndr)]
   -> MS.Map TypeConName InterfaceInstanceGroup
-scrapeInterfaceInstanceBinds env binds
-  | envLfVersion env `supports` featureSimpleInterfaces =
-      MMS.merge
-        {- drop group funcs without interface instances -}
-        MMS.dropMissing
-        {- keep interface instances without group funcs -}
-        MMS.preserveMissing'
-        {- apply group funcs to interface instances -}
-        (MMS.zipWithMatched (const ($!)))
-        interfaceInstanceGroupFs
-        interfaceInstanceGroups
-  | otherwise = MS.empty
+scrapeInterfaceInstanceBinds env binds =
+  MMS.merge
+    {- drop group funcs without interface instances -}
+    MMS.dropMissing
+    {- keep interface instances without group funcs -}
+    MMS.preserveMissing'
+    {- apply group funcs to interface instances -}
+    (MMS.zipWithMatched (const ($!)))
+    interfaceInstanceGroupFs
+    interfaceInstanceGroups
   where
     interfaceInstanceGroups :: MS.Map TypeConName InterfaceInstanceGroup
     interfaceInstanceGroups = MS.fromListWith iigUnion
@@ -726,38 +723,59 @@ convertTemplateTyCon :: Env -> (GHC.TyCon -> String) -> GHC.TyCon -> ConvertM (L
 convertTemplateTyCon = convertDamlTyCon hasDamlTemplateCtx "template type"
 
 convertInterfaces :: Env -> ModuleContents -> ConvertM [Definition]
-convertInterfaces env mc = interfaceDefs
-  where
-    interfaceDefs :: ConvertM [Definition]
-    interfaceDefs = sequence
-        [ DInterface <$> convertInterface name ib
-        | (name, ib) <- MS.toList (mcInterfaceBinds mc)
-        ]
+convertInterfaces env mc =
+  concatMapM
+    (\(name, binds) -> convertInterface env mc name binds)
+    (MS.toList (mcInterfaceBinds mc))
 
-    convertInterface :: LF.TypeConName -> InterfaceBinds -> ConvertM DefInterface
-    convertInterface intName ib = do
-        let
-          intLocation = ibLoc ib
-          intParam = this
-        withRange intLocation $ do
-            intRequires <- convertRequires (ibRequires ib)
-            intMethods <- convertMethods (ibMethods ib)
-            intChoices <- convertChoices env mc intName emptyTemplateBinds
-            intCoImplements <- convertCoImplements intName
-            intView <- case ibViewType ib of
-                Nothing -> conversionError $ "No view found for interface " <> renderPretty intName
-                Just viewType -> convertType env viewType
-            pure DefInterface {..}
+convertInterface :: Env -> ModuleContents -> LF.TypeConName -> InterfaceBinds -> ConvertM [Definition]
+convertInterface env mc intName ib =
+  withRange intLocation do
+    unless (envLfVersion env `supports` featureSimpleInterfaces) do
+      unsupported "Daml interfaces are only available with --target=1.15 or higher" ()
+    defInterfaceDataType <- convertDefInterfaceDataType
+    defInterface <- convertDefInterface
+    pure
+      [ defInterfaceDataType
+      , defInterface
+      ]
+  where
+    tyCon = ibTyCon ib
+    intLocation = convNameLoc tyCon
+
+    convertDefInterfaceDataType :: ConvertM Definition
+    convertDefInterfaceDataType = do
+      unless (null (tyConTyVars tyCon)) do
+        unhandled "interface type constructor with type parameters" tyCon
+      pure $ DDataType DefDataType
+        { dataLocation = Nothing
+        , dataTypeCon = intName
+        , dataSerializable = IsSerializable False
+        , dataParams = []
+        , dataCons = DataInterface
+        }
+
+    convertDefInterface :: ConvertM Definition
+    convertDefInterface = do
+      let
+        intParam = this
+      intRequires <- convertRequires (ibRequires ib)
+      intMethods <- convertMethods (ibMethods ib)
+      intChoices <- convertChoices env mc intName emptyTemplateBinds
+      intCoImplements <- convertCoImplements intName
+      intView <- case ibViewType ib of
+          Nothing -> conversionError $ "No view found for interface " <> renderPretty intName
+          Just viewType -> convertType env viewType
+      pure $ DInterface DefInterface {..}
 
     convertRequires :: [(GHC.TyCon, Maybe SourceLoc)] -> ConvertM (S.Set (Qualified TypeConName))
-    convertRequires requires = S.fromList <$> sequence
-      [ withRange mloc $ guardSupportsInterfaceRequires $ convertInterfaceTyCon env handleIsNotInterface iface
-      | (iface, mloc) <- requires
-      ]
+    convertRequires requires = S.fromList <$>
+      forM requires \(iface, mloc) ->
+        withRange mloc do
+          unless (envLfVersion env `supports` featureExtendedInterfaces) do
+            unsupported "Requires in Daml interfaces are only available with --target=1.dev" ()
+          convertInterfaceTyCon env handleIsNotInterface iface
       where
-        guardSupportsInterfaceRequires action
-          | envLfVersion env `supports` featureExtendedInterfaces = action
-          | otherwise = unsupported "Requires in Daml interfaces are only available with --target=1.dev" ()
         handleIsNotInterface tyCon =
           "cannot require '" ++ prettyPrint tyCon ++ "' because it is not an interface"
 
@@ -859,22 +877,9 @@ convertTypeDef env o@(ATyCon t) = withRange (convNameLoc t) $ if
     , n `elementOfUniqSet` desugarTypes
     -> pure []
 
+    -- The type declarations for interfaces are generated by 'convertInterface'
     | hasDamlInterfaceCtx t
-    ->  if envLfVersion env `supports` featureSimpleInterfaces then
-            pure [ DDataType DefDataType
-                { dataLocation = Nothing
-                , dataTypeCon = mkTypeCon [getOccText t]
-                , dataSerializable = IsSerializable False
-                -- TODO https://github.com/digital-asset/daml/issues/12051
-                -- validate that the type has no parameters.
-                , dataParams = []
-                , dataCons = DataInterface
-                }
-            ]
-        else
-            unsupported "Daml interfaces are only available with --target=1.15 or higher" ()
-            -- TODO https://github.com/digital-asset/daml/issues/12051
-            --   Change when interfaces are released.
+    -> pure []
 
     -- Remove guarded exercise instances when Extended Interfaces are unsupported
     | not (envLfVersion env `supports` featureExtendedInterfaces)
@@ -1228,7 +1233,9 @@ convertInterfaceInstance ::
   -> Env
   -> InterfaceInstanceBinds
   -> ConvertM r
-convertInterfaceInstance parent mkR env iib = withRange (iibLoc iib) $ do
+convertInterfaceInstance parent mkR env iib = withRange (iibLoc iib) do
+  unless (envLfVersion env `supports` featureSimpleInterfaces) do
+    unsupported "Daml interfaces are only available with --target=1.15 or higher" ()
   interfaceQualTypeCon <- qualifyInterfaceCon (iibInterface iib)
   templateQualTypeCon <- qualifyTemplateCon (iibTemplate iib)
   checkParent interfaceQualTypeCon templateQualTypeCon

compiler/damlc/tests/daml-test-files/InterfaceSerializabilityArgument.daml

@@ -1,5 +1,5 @@
 -- @SINCE-LF-FEATURE DAML_INTERFACE
--- @ERROR range=17:11-17:12; error type checking interface InterfaceSerializabilityArgument.I : expected serializable type: * reason: choice argument * found: InterfaceSerializabilityArgument:NonSerializableArgument * problem: unserializable data type InterfaceSerializabilityArgument:NonSerializableArgument
+-- @ERROR range=17:11-17:12; error type checking interface InterfaceSerializabilityArgument.I choice NonSerializableArgument: expected serializable type: * reason: choice argument * found: InterfaceSerializabilityArgument:NonSerializableArgument * problem: unserializable data type InterfaceSerializabilityArgument:NonSerializableArgument
 module InterfaceSerializabilityArgument where
 
 data NonSerializable = NonSerializable (() -> ())

compiler/damlc/tests/daml-test-files/InterfaceSerializabilityPayload.daml

@@ -1,5 +1,5 @@
 -- @SINCE-LF-FEATURE DAML_INTERFACE
--- @ERROR range=8:11-8:19; error type checking interface InterfaceSerializabilityPayload.Gettable : expected serializable type: * reason: choice result * found: InterfaceSerializabilityPayload:Gettable * problem: unserializable data type InterfaceSerializabilityPayload:Gettable
+-- @ERROR range=8:11-8:19; error type checking interface InterfaceSerializabilityPayload.Gettable choice Get: expected serializable type: * reason: choice result * found: InterfaceSerializabilityPayload:Gettable * problem: unserializable data type InterfaceSerializabilityPayload:Gettable
 module InterfaceSerializabilityPayload where
 
 -- Test that the interface serializability payload itself is not serializable.

compiler/damlc/tests/daml-test-files/InterfaceSerializabilityResult.daml

@@ -1,5 +1,5 @@
 -- @SINCE-LF-FEATURE DAML_INTERFACE
--- @ERROR range=17:11-17:12; error type checking interface InterfaceSerializabilityResult.I : expected serializable type: * reason: choice result * found: InterfaceSerializabilityResult:NonSerializable * problem: unserializable data type InterfaceSerializabilityResult:NonSerializable
+-- @ERROR range=17:11-17:12; error type checking interface InterfaceSerializabilityResult.I choice NonSerializableResult: expected serializable type: * reason: choice result * found: InterfaceSerializabilityResult:NonSerializable * problem: unserializable data type InterfaceSerializabilityResult:NonSerializable
 module InterfaceSerializabilityResult where
 
 data NonSerializable = NonSerializable (() -> ())