Things that depend on newtype constructors should depend on the newtypes

Fixes #1511
GaloisInc · Mar 29, 2023 · 05412e9 · 05412e9
1 parent cb551e4
commit 05412e9
Show file tree

Hide file tree

Showing 4 changed files with 43 additions and 18 deletions.
diff --git a/src/Cryptol/ModuleSystem/Renamer.hs b/src/Cryptol/ModuleSystem/Renamer.hs
@@ -453,8 +453,16 @@ renameTopDecls' ds =
 
 
          (noNameDs,nameDs) = partitionEithers (map topDeclName ds1)
-         ctrs = [ nm | (_,nm@(ConstratintAt {})) <- nameDs ]
-
+         ctrs = [ nm | (_,nm@(ConstratintAt {}),_) <- nameDs ]
+         indirect = Map.fromList [ (y,x)
+                                 | (_,x,ys) <- nameDs, y <- ys ]
+         mkDepName x = case Map.lookup x fromParams of
+                         Just dn -> dn
+                         Nothing -> NamedThing x
+         depsFor x =
+           [ Map.findWithDefault (mkDepName y) (NamedThing y) indirect
+           | y <- Set.toList (Map.findWithDefault Set.empty x deps)
+           ]
 
          {- See [NOTE: Dependencies on Top Level Constraints] -}
          addCtr nm ctr =
@@ -493,15 +501,9 @@ renameTopDecls' ds =
                                          Nothing -> []
              _ -> []
 
-         mkDepName x = case Map.lookup x fromParams of
-                         Just dn -> dn
-                         Nothing -> NamedThing x
-
-         toNode (d,x) = ((d,x),x, addCtrs (d,x) ++
-                                  addModParams d ++
-                               map mkDepName
-                             ( Set.toList
-                             ( Map.findWithDefault Set.empty x deps) ))
+         toNode (d,x,_) = ((d,x),x, addCtrs (d,x) ++
+                                    addModParams d ++
+                                    depsFor x)
 
          ordered = stronglyConnComp (map toNode nameDs)
          fromSCC x =
@@ -588,28 +590,32 @@ declName decl =
   where
   bad x = panic "declName" [x]
 
-topDeclName :: TopDecl Name -> Either (TopDecl Name) (TopDecl Name, DepName)
+topDeclName ::
+  TopDecl Name ->
+  Either (TopDecl Name) (TopDecl Name, DepName, [DepName])
 topDeclName topDecl =
   case topDecl of
     Decl d                  -> hasName (declName (tlValue d))
     DPrimType d             -> hasName (thing (primTName (tlValue d)))
-    TDNewtype d             -> hasName (thing (nName (tlValue d)))
+    TDNewtype d             -> hasName' (thing (nName (tlValue d)))
+                                        [ nConName (tlValue d) ]
     DModule d               -> hasName (thing (mName m))
       where NestedModule m = tlValue d
 
-    DInterfaceConstraint _ ds -> Right (topDecl, ConstratintAt (srcRange ds))
+    DInterfaceConstraint _ ds -> special (ConstratintAt (srcRange ds))
 
     DImport {}              -> noName
 
-    DModParam m             -> Right ( topDecl
-                                     , ModParamName (srcRange (mpSignature m))
-                                                    (mpName m))
+    DModParam m             -> special (ModParamName (srcRange (mpSignature m))
+                                                     (mpName m))
 
     Include {}              -> bad "Include"
     DParamDecl {}           -> bad "DParamDecl"
   where
   noName    = Left topDecl
-  hasName n = Right (topDecl, NamedThing n)
+  hasName n = hasName' n []
+  hasName' n ms = Right (topDecl, NamedThing n, map NamedThing ms)
+  special x = Right (topDecl, x, [])
   bad x     = panic "topDeclName" [x]
 
 
@@ -877,6 +883,8 @@ instance Rename Newtype where
     do nameT <- rnLocated (renameType NameBind) (nName n)
        nameC <- renameVar  NameBind (nConName n)
 
+       depsOf (NamedThing nameC) (addDep (thing nameT))
+
        depsOf (NamedThing (thing nameT)) $
          do ps'   <- traverse rename (nParams n)
             body' <- traverse (traverse rename) (nBody n)

diff --git a/tests/issues/issue1511.cry b/tests/issues/issue1511.cry
@@ -0,0 +1,11 @@
+module M where
+
+v: [1]
+v = MOOD.SAD.value
+
+newtype MOOD_t = { value: [1] }
+
+MOOD = { HAPPY = MOOD_t { value = 0b1 }
+       , SAD   = MOOD_t { value = 0b0 }
+       }
+
diff --git a/tests/issues/issue1511.icry b/tests/issues/issue1511.icry
@@ -0,0 +1,2 @@
+:load issue1511.cry
+v
diff --git a/tests/issues/issue1511.icry.stdout b/tests/issues/issue1511.icry.stdout
@@ -0,0 +1,4 @@
+Loading module Cryptol
+Loading module Cryptol
+Loading module M
+0x0