diff --git a/compiler/daml-lf-ast/src/DA/Daml/LF/Ast/Base.hs b/compiler/daml-lf-ast/src/DA/Daml/LF/Ast/Base.hs index 18186af681..6df712eeb0 100644 --- a/compiler/daml-lf-ast/src/DA/Daml/LF/Ast/Base.hs +++ b/compiler/daml-lf-ast/src/DA/Daml/LF/Ast/Base.hs @@ -613,55 +613,8 @@ data DefValue = DefValue -- ^ Is the value maked as a test to be run as a scenario? , dvalBody :: !Expr -- ^ Expression whose value to bind to the name. - , dvalInfo :: !(Maybe DefValueInfo) - -- ^ Includes additional info that we use in the simplifier. Note that - -- this information is generated by 'DA.Daml.LF.Ast.DefValueInfo' and - -- _not_ contained in the proto. } -{- -TODO currently we do not recognize proxies to variant constructors, -since they're not required for contract keys, but if we were these data structures -should work. - -data VariantConstructorProxyType = - VCPTNormal - -- ^ normal constructor proxy: just pass an argument through - | VCPTRecord - { vcptType :: !(Qualified TypeConName) - , vcptTyVars :: ![TypeVarName] - } - -- ^ constructors deriving from types like - -- - -- @ - -- data Foo = Bar with bar: Int; baz: Bool | ... - -- @ - -- - -- which will induce constructor proxies that take @bar@ and - -- @baz@ as parameters and construct the record directly. --} - --- | Some additional metadata we generate for each value definition, --- mostly used by the simplifier. -data DefValueInfo = - DVIRecordConstructorProxy - { dviRecConTyCon :: !(Qualified TypeConName) - } - {- - TODO currently we do not recognize proxies to variant constructors, - since they're not required for contract keys, but if we were these data structures - should work. - | DVIVariantConstructorProxy - { dviVarConTyCon :: !(Qualified TypeConName) - , dviVarConVariant :: !VariantConName - , dviVarConType :: !VariantConstructorProxyType - } - -} - | DVIRecordProjectionProxy - { dviRecProjType :: !(Qualified TypeConName) - , dviRecProjField :: !FieldName - } - data TemplateKey = TemplateKey { tplKeyType :: !Type , tplKeyBody :: !Expr @@ -787,14 +740,12 @@ concatSequenceA $ , makePrisms ''Scenario , makePrisms ''DataCons , makePrisms ''Package - -- , makePrisms ''VariantConstructorProxyType , makeUnderscoreLenses ''DefDataType , makeUnderscoreLenses ''DefValue , makeUnderscoreLenses ''TemplateChoice , makeUnderscoreLenses ''Template , makeUnderscoreLenses ''Module , makeUnderscoreLenses ''Package - , makeUnderscoreLenses ''DefValueInfo , makeUnderscoreLenses ''TemplateKey ] ++ map (makeInstancesExcept [''FromJSON]) @@ -824,8 +775,6 @@ concatSequenceA $ , ''TemplateChoice , ''FeatureFlags , ''TemplateKey - -- , ''VariantConstructorProxyType - , ''DefValueInfo ] ++ map (makeInstancesExcept [''Ord, ''FromJSON]) [ ''Template @@ -884,7 +833,5 @@ instance NFData Type instance NFData TypeConApp instance NFData RetrieveByKey instance NFData Update --- instance NFData VariantConstructorProxyType -instance NFData DefValueInfo instance NFData a => NFData (Qualified a) diff --git a/compiler/daml-lf-ast/src/DA/Daml/LF/Ast/Optics.hs b/compiler/daml-lf-ast/src/DA/Daml/LF/Ast/Optics.hs index bd65b8fc2c..5bdfa2e01a 100644 --- a/compiler/daml-lf-ast/src/DA/Daml/LF/Ast/Optics.hs +++ b/compiler/daml-lf-ast/src/DA/Daml/LF/Ast/Optics.hs @@ -136,9 +136,6 @@ instance MonoTraversable ModuleRef Template instance MonoTraversable ModuleRef FeatureFlags instance MonoTraversable ModuleRef Module -instance MonoTraversable ModuleRef DefValueInfo --- instance MonoTraversable ModuleRef VariantConstructorProxyType - exprPartyLiteral :: forall f. Applicative f => (PartyLiteral -> f PartyLiteral) -> (Expr -> f Expr) diff --git a/compiler/daml-lf-ast/src/DA/Daml/LF/Ast/Pretty.hs b/compiler/daml-lf-ast/src/DA/Daml/LF/Ast/Pretty.hs index 97c125a475..c46648296b 100644 --- a/compiler/daml-lf-ast/src/DA/Daml/LF/Ast/Pretty.hs +++ b/compiler/daml-lf-ast/src/DA/Daml/LF/Ast/Pretty.hs @@ -419,25 +419,14 @@ instance Pretty DefDataType where "|" <-> prettyName name <-> pPrintPrec prettyNormal precHighest typ instance Pretty DefValue where - pPrint (DefValue mbLoc binder (HasNoPartyLiterals noParties) (IsTest isTest) body mbInfo) = + pPrint (DefValue mbLoc binder (HasNoPartyLiterals noParties) (IsTest isTest) body) = withSourceLoc mbLoc $ - vcat $ concat - [ case mbInfo of - Nothing -> [] - Just info -> [text "--" <-> pretty info] - , [ hang (keyword_ kind <-> annot <-> prettyNameAndType binder <-> "=") 2 (pretty body) ] - ] + vcat + [ hang (keyword_ kind <-> annot <-> prettyNameAndType binder <-> "=") 2 (pretty body) ] where kind = if isTest then "test" else "def" annot = if noParties then mempty else "@partyliterals" -instance Pretty DefValueInfo where - pPrint = \case - DVIRecordConstructorProxy tyCon -> - text "proxy for record" <-> pretty tyCon - DVIRecordProjectionProxy tyCon fld -> - text "proxy for field" <-> text (unTagged fld) <-> text "of record" <-> pretty tyCon - prettyTemplateChoice :: ModuleName -> TypeConName -> TemplateChoice -> Doc ann prettyTemplateChoice modName tpl (TemplateChoice mbLoc name isConsuming actor selfBinder argBinder retType update) = diff --git a/compiler/daml-lf-proto/src/DA/Daml/LF/Proto3/DecodeV1.hs b/compiler/daml-lf-proto/src/DA/Daml/LF/Proto3/DecodeV1.hs index 9e55fa4a35..a392aee928 100644 --- a/compiler/daml-lf-proto/src/DA/Daml/LF/Proto3/DecodeV1.hs +++ b/compiler/daml-lf-proto/src/DA/Daml/LF/Proto3/DecodeV1.hs @@ -90,7 +90,6 @@ decodeDefValue (LF1.DefValue mbBinder mbBody noParties isTest mbLoc) = <*> pure (HasNoPartyLiterals noParties) <*> pure (IsTest isTest) <*> mayDecode "defValueExpr" mbBody decodeExpr - <*> pure Nothing decodeDefTemplate :: LF1.DefTemplate -> Decode Template decodeDefTemplate LF1.DefTemplate{..} = diff --git a/compiler/daml-lf-proto/src/DA/Daml/LF/Proto3/DecodeVDev.hs b/compiler/daml-lf-proto/src/DA/Daml/LF/Proto3/DecodeVDev.hs index 5f24740a70..055acf5591 100644 --- a/compiler/daml-lf-proto/src/DA/Daml/LF/Proto3/DecodeVDev.hs +++ b/compiler/daml-lf-proto/src/DA/Daml/LF/Proto3/DecodeVDev.hs @@ -81,7 +81,6 @@ decodeDefValue (LF1.DefValue mbBinder mbBody noParties isTest mbLoc) = <*> pure (HasNoPartyLiterals noParties) <*> pure (IsTest isTest) <*> mayDecode "defValueExpr" mbBody decodeExpr - <*> pure Nothing decodeDefTemplate :: LF1.DefTemplate -> Decode Template decodeDefTemplate LF1.DefTemplate{..} = diff --git a/compiler/daml-lf-tools/src/DA/Daml/LF/TypeChecker/Check.hs b/compiler/daml-lf-tools/src/DA/Daml/LF/TypeChecker/Check.hs index 7050af5d56..7445a19d53 100644 --- a/compiler/daml-lf-tools/src/DA/Daml/LF/TypeChecker/Check.hs +++ b/compiler/daml-lf-tools/src/DA/Daml/LF/TypeChecker/Check.hs @@ -488,7 +488,7 @@ checkDefDataType (DefDataType _loc _name _serializable params dataCons) = traverse_ (`checkType` KStar) types checkDefValue :: MonadGamma m => DefValue -> m () -checkDefValue (DefValue _loc (_, typ) _noParties (IsTest isTest) expr _info) = do +checkDefValue (DefValue _loc (_, typ) _noParties (IsTest isTest) expr) = do checkType typ KStar checkExpr expr typ when isTest $ diff --git a/daml-foundations/daml-ghc/src/DA/Daml/GHC/Compiler/Convert.hs b/daml-foundations/daml-ghc/src/DA/Daml/GHC/Compiler/Convert.hs index 9f8173029b..4359c3a10c 100644 --- a/daml-foundations/daml-ghc/src/DA/Daml/GHC/Compiler/Convert.hs +++ b/daml-foundations/daml-ghc/src/DA/Daml/GHC/Compiler/Convert.hs @@ -1115,7 +1115,7 @@ defDataType name params constrs = defValue :: NamedThing a => a -> (ExprValName, LF.Type) -> LF.Expr -> Definition defValue loc binder@(name, lftype) body = - DValue $ DefValue (convNameLoc loc) binder (HasNoPartyLiterals True) (IsTest isTest) body Nothing + DValue $ DefValue (convNameLoc loc) binder (HasNoPartyLiterals True) (IsTest isTest) body where isTest = case view _TForalls lftype of (_, LF.TScenario _) -> True diff --git a/daml-foundations/daml-ghc/src/DA/Daml/GHC/Compiler/UtilLF.hs b/daml-foundations/daml-ghc/src/DA/Daml/GHC/Compiler/UtilLF.hs index 097e2e47d7..b9900223f7 100644 --- a/daml-foundations/daml-ghc/src/DA/Daml/GHC/Compiler/UtilLF.hs +++ b/daml-foundations/daml-ghc/src/DA/Daml/GHC/Compiler/UtilLF.hs @@ -107,7 +107,6 @@ ghcPrim = Module , varVariant = conName , varArg = EBuiltin (BEEnumCon ECUnit) } - , dvalInfo = Nothing } ghcTypes :: Module @@ -140,7 +139,6 @@ ghcTypes = Module , varVariant = mkVariantCon con , varArg = EBuiltin (BEEnumCon ECUnit) } - , dvalInfo = Nothing } dataProxy = DefDataType { dataLocation= Nothing @@ -160,6 +158,5 @@ ghcTypes = Module , dvalBody = ETyLam (Tagged "a", KStar) (ERecCon (TypeConApp (qual (dataTypeCon dataProxy)) [TVar (Tagged "a")]) []) - , dvalInfo = Nothing }