Deselect declarations transitively depending on omitted declarations

dschrempf · dschrempf · commit 77c4927dad54 · 2025-11-26T13:22:29.000+01:00
Warn user in such cases
diff --git a/hs-bindgen/examples/golden/program-analysis/selection_omit.h b/hs-bindgen/examples/golden/program-analysis/selection_omit.h
@@ -0,0 +1,7 @@
+struct Omitted {
+  int n;
+};
+
+struct DependsOnOmitted {
+  struct Omitted o;
+};
diff --git a/hs-bindgen/examples/golden/program-analysis/selection_omit.yaml b/hs-bindgen/examples/golden/program-analysis/selection_omit.yaml
@@ -0,0 +1,9 @@
+version:
+  hs_bindgen: 0.1.0
+  binding_specification: '1.0'
+hsmodule: Example
+ctypes:
+- omit:
+    headers: program-analysis/selection_omit.h
+    cname: struct Omitted
+hstypes: []
diff --git a/hs-bindgen/fixtures/program-analysis/selection_omit/Example.pp.hs b/hs-bindgen/fixtures/program-analysis/selection_omit/Example.pp.hs
@@ -0,0 +1 @@
+module Example () where
diff --git a/hs-bindgen/fixtures/program-analysis/selection_omit/Example/FunPtr.pp.hs b/hs-bindgen/fixtures/program-analysis/selection_omit/Example/FunPtr.pp.hs
@@ -0,0 +1 @@
+module Example.FunPtr () where
diff --git a/hs-bindgen/fixtures/program-analysis/selection_omit/Example/Global.pp.hs b/hs-bindgen/fixtures/program-analysis/selection_omit/Example/Global.pp.hs
@@ -0,0 +1 @@
+module Example.Global () where
diff --git a/hs-bindgen/fixtures/program-analysis/selection_omit/Example/Safe.pp.hs b/hs-bindgen/fixtures/program-analysis/selection_omit/Example/Safe.pp.hs
@@ -0,0 +1 @@
+module Example.Safe () where
diff --git a/hs-bindgen/fixtures/program-analysis/selection_omit/Example/Unsafe.pp.hs b/hs-bindgen/fixtures/program-analysis/selection_omit/Example/Unsafe.pp.hs
@@ -0,0 +1 @@
+module Example.Unsafe () where
diff --git a/hs-bindgen/fixtures/program-analysis/selection_omit/bindingspec.yaml b/hs-bindgen/fixtures/program-analysis/selection_omit/bindingspec.yaml
@@ -0,0 +1,9 @@
+version:
+  hs_bindgen: 0.1.0
+  binding_specification: '1.0'
+hsmodule: Example
+ctypes:
+- omit:
+    headers: program-analysis/selection_omit.h
+    cname: struct Omitted
+hstypes: []
diff --git a/hs-bindgen/fixtures/program-analysis/selection_omit/th.txt b/hs-bindgen/fixtures/program-analysis/selection_omit/th.txt
@@ -0,0 +1 @@
+-- addDependentFile examples/golden/program-analysis/selection_omit.h
diff --git a/hs-bindgen/src-internal/HsBindgen/Frontend/Pass/ResolveBindingSpecs.hs b/hs-bindgen/src-internal/HsBindgen/Frontend/Pass/ResolveBindingSpecs.hs
@@ -460,10 +460,6 @@ instance Resolve C.Type where
         Reader.ask >>= \MEnv{..} -> State.get >>= \MState{..} -> do
           let cQualName = C.QualName qualDeclIdName qualDeclIdKind
               cQualPrelimDeclId = C.qualDeclIdToQualPrelimDeclId cQualDeclId
-          -- Check for type omitted by binding specification
-          when (Map.member cQualPrelimDeclId stateOmitTypes) $
-            State.modify' $
-              insertTrace (ResolveBindingSpecsOmittedTypeUse cQualName)
           -- Check for selected external binding
           case Map.lookup cQualPrelimDeclId stateExtTypes of
             Just ty -> do
@@ -530,8 +526,6 @@ resolveExtBinding cQualName cQualPrelimDeclId declPaths  = do
               insertTrace (ResolveBindingSpecsExtHsRefNoIdentifier cQualName)
             return Nothing
       Just (_hsModuleName, BindingSpec.Omit, _mHsTypeSpec) -> do
-        State.modify' $
-          insertTrace (ResolveBindingSpecsOmittedTypeUse cQualName)
         return Nothing
       Nothing ->
         return Nothing
diff --git a/hs-bindgen/src-internal/HsBindgen/Frontend/Pass/ResolveBindingSpecs/IsPass.hs b/hs-bindgen/src-internal/HsBindgen/Frontend/Pass/ResolveBindingSpecs/IsPass.hs
@@ -71,7 +71,6 @@ data ResolvedExtBinding = ResolvedExtBinding{
 data ResolveBindingSpecsMsg =
     ResolveBindingSpecsModuleMismatch       Hs.ModuleName Hs.ModuleName
   | ResolveBindingSpecsExtHsRefNoIdentifier C.QualName
-  | ResolveBindingSpecsOmittedTypeUse       C.QualName
   | ResolveBindingSpecsTypeNotUsed          C.QualName
   | ResolveBindingSpecsExtDecl              C.QualName
   | ResolveBindingSpecsExtType              C.QualName C.QualName
@@ -82,39 +81,35 @@ data ResolveBindingSpecsMsg =
 instance PrettyForTrace ResolveBindingSpecsMsg where
   prettyForTrace = \case
       ResolveBindingSpecsModuleMismatch hsModuleName pSpecHsModuleName ->
-        "prescriptive binding specification for module"
+        "Prescriptive binding specification for module"
           <+> prettyForTrace pSpecHsModuleName
           <+> "cannot be used to generate"
           <+> prettyForTrace hsModuleName
       ResolveBindingSpecsExtHsRefNoIdentifier cQualName ->
         "Haskell identifier not specified in binding specification:"
           <+> prettyForTrace cQualName
-      ResolveBindingSpecsOmittedTypeUse cQualName ->
-        "type omitted by binding specification used:"
-          <+> prettyForTrace cQualName
       ResolveBindingSpecsTypeNotUsed cQualName ->
-        "binding specification for type not used:"
+        "Binding specification for type not used:"
           <+> prettyForTrace cQualName
       ResolveBindingSpecsExtDecl cQualName ->
-        "declaration with external binding dropped:"
+        "Declaration with external binding dropped:"
           <+> prettyForTrace cQualName
       ResolveBindingSpecsExtType ctx cQualName ->
-        "within declaration"
+        "Within declaration"
           <+> prettyForTrace ctx
           <+> "type replaced with external binding:"
           <+> prettyForTrace cQualName
       ResolveBindingSpecsPrescriptiveRequire cQualName ->
-        "prescriptive binding specification found:"
+        "Prescriptive binding specification found:"
           <+> prettyForTrace cQualName
       ResolveBindingSpecsPrescriptiveOmit cQualName ->
-        "declaration omitted by prescriptive binding specification:"
+        "Declaration omitted by prescriptive binding specification:"
           <+> prettyForTrace cQualName
 
 instance IsTrace Level ResolveBindingSpecsMsg where
   getDefaultLogLevel = \case
     ResolveBindingSpecsModuleMismatch{}       -> Error
     ResolveBindingSpecsExtHsRefNoIdentifier{} -> Error
-    ResolveBindingSpecsOmittedTypeUse{}       -> Error
     ResolveBindingSpecsTypeNotUsed{}          -> Error
     ResolveBindingSpecsExtDecl{}              -> Info
     ResolveBindingSpecsExtType{}              -> Info
diff --git a/hs-bindgen/src-internal/HsBindgen/Frontend/Pass/Select.hs b/hs-bindgen/src-internal/HsBindgen/Frontend/Pass/Select.hs
@@ -121,6 +121,7 @@ selectDecls
         getTransitiveAvailability :: DeclId -> TransitiveAvailability
         getTransitiveAvailability x = mconcat [
               availabilityFromSet notAttemptedTransDeps UnavailableParseNotAttempted
+            , availabilityFromSet omittedTransDeps      UnavailableOmitted
             , availabilityFromSet failedTransDeps       UnavailableParseFailed
             , availabilityFromSet failedMacrosTransDeps UnavailableHandleMacrosFailed
             , availabilityFromSet nonselectedTransDeps  UnavailableNotSelected
@@ -136,6 +137,7 @@ selectDecls
             notAttemptedTransDeps, failedTransDeps :: Set DeclId
             failedMacrosTransDeps, nonselectedTransDeps :: Set DeclId
             notAttemptedTransDeps = Set.intersection transDeps notAttempted
+            omittedTransDeps      = Set.intersection transDeps omitted
             failedTransDeps       = Set.intersection transDeps failed
             failedMacrosTransDeps = Set.intersection transDeps failedMacros
             nonselectedTransDeps  = transDeps \\ selectedIds
@@ -189,6 +191,7 @@ selectDecls
   where
     notAttempted, failed, failedMacros :: Set DeclId
     notAttempted = Map.keysSet index.notAttempted
+    omitted      = Map.keysSet index.omitted
     failed       = Map.keysSet index.failed
     failedMacros = Map.keysSet index.failedMacros
 
diff --git a/hs-bindgen/src-internal/HsBindgen/Frontend/Pass/Select/IsPass.hs b/hs-bindgen/src-internal/HsBindgen/Frontend/Pass/Select/IsPass.hs
@@ -107,6 +107,7 @@ data SelectStatus =
 -- it, if it was not selected).
 data UnavailabilityReason =
     UnavailableParseNotAttempted
+  | UnavailableOmitted
   | UnavailableNotSelected
   | UnavailableParseFailed
   | UnavailableHandleMacrosFailed
@@ -116,6 +117,8 @@ instance PrettyForTrace UnavailabilityReason where
   prettyForTrace r = case r of
     UnavailableParseNotAttempted ->
       "parse of transitive dependency not attempted: (!) adjust parse predicate"
+    UnavailableOmitted ->
+      "transitive dependency omitted by prescriptive binding specification"
     UnavailableParseFailed ->
       "parse of transitive dependency failed"
     UnavailableHandleMacrosFailed ->
diff --git a/hs-bindgen/test/hs-bindgen/Test/HsBindgen/Golden.hs b/hs-bindgen/test/hs-bindgen/Test/HsBindgen/Golden.hs
@@ -927,6 +927,18 @@ test_program_analysis_selection_foo =
       _other -> Nothing
   }
 
+test_program_analysis_selection_omit :: TestCase
+test_program_analysis_selection_omit =
+  (defaultTest "program-analysis/selection_omit"){
+    testPrescriptiveBindingSpec = Just "examples/golden/program-analysis/selection_omit.yaml"
+  , testTracePredicate = customTracePredicate' ["DependsOnOmitted"] $ \case
+      (TraceFrontend (FrontendSelect
+        (TransitiveDependencyOfDeclarationUnavailable x _
+          _ UnavailableOmitted _))) ->
+          Just $ expectFromDeclSelect x
+      _other -> Nothing
+  }
+
 test_program_analysis_program_slicing_selection :: TestCase
 test_program_analysis_program_slicing_selection =
   (defaultTest "program-analysis/program_slicing_selection"){
@@ -1087,6 +1099,7 @@ testCases = manualTestCases ++ [
     , test_program_analysis_selection_fail_variant_2
     , test_program_analysis_selection_fail_variant_3
     , test_program_analysis_selection_foo
+    , test_program_analysis_selection_omit
     , test_types_complex_complex_non_float_test
     , test_types_complex_hsb_complex_test
     , test_types_complex_vector_test

Original file line number	Diff line number	Diff line change
`@@ -0,0 +1 @@`
	`1`	`+-- addDependentFile examples/golden/program-analysis/selection_omit.h`