Haskell codegen uses collectVars from the compiler

mlabs-haskell · Jul 10, 2024 · a08502f · a08502f
1 parent 785d2c6
commit a08502f
Show file tree

Hide file tree

Showing 2 changed files with 6 additions and 21 deletions.
diff --git a/lambda-buffers-codegen/src/LambdaBuffers/Codegen/Haskell/Backend/Plutarch/Derive.hs b/lambda-buffers-codegen/src/LambdaBuffers/Codegen/Haskell/Backend/Plutarch/Derive.hs
@@ -81,7 +81,7 @@ printPEqInstanceDef :: MonadHaskellBackend t m => PC.Ty -> Doc ann -> m (Doc ann
 printPEqInstanceDef ty implDefDoc = do
   Print.importClass PlRefs.peqQClassName
   Print.importClass PlRefs.pisDataQClassName
-  let freeVars = Haskell.collectTyVars ty
+  let freeVars = PC.collectTyVars ty
   headDoc <- Haskell.printConstraint PlRefs.peqQClassName ty
   case freeVars of
     [] -> return $ "instance" <+> headDoc <+> "where" <> hardline <> space <> space <> implDefDoc
@@ -170,7 +170,7 @@ printPlutusTypeInstanceDef ty implDefDoc = do
   Print.importType PlRefs.pdataQTyName
   headDoc <- Haskell.printConstraint PlRefs.plutusTypeQClassName ty
   tyDoc <- Haskell.printTyInner ty
-  let freeVars = Haskell.collectTyVars ty
+  let freeVars = PC.collectTyVars ty
       pinnerDefDoc = "type PInner" <+> tyDoc <+> "=" <+> Haskell.printHsQTyName PlRefs.pdataQTyName
   case freeVars of
     [] ->
@@ -272,7 +272,7 @@ printPTryFromPAsDataInstanceDef ty implDefDoc = do
         Haskell.printHsQClassName PlRefs.ptryFromQClassName
           <+> Haskell.printHsQTyName PlRefs.pdataQTyName
           <+> parens (Haskell.printHsQTyName PlRefs.pasDataQTyName <+> tyDoc)
-      freeVars = Haskell.collectTyVars ty
+      freeVars = PC.collectTyVars ty
       pinnerDefDoc =
         "type PTryFromExcess"
           <+> Haskell.printHsQTyName PlRefs.pdataQTyName
@@ -332,7 +332,7 @@ printPTryFromInstanceDef ty = do
         Haskell.printHsQClassName PlRefs.ptryFromQClassName
           <+> Haskell.printHsQTyName PlRefs.pdataQTyName
           <+> tyDoc
-      freeVars = Haskell.collectTyVars ty
+      freeVars = PC.collectTyVars ty
 
       pinnerDefDoc =
         "type PTryFromExcess"

diff --git a/lambda-buffers-codegen/src/LambdaBuffers/Codegen/Haskell/Print/InstanceDef.hs b/lambda-buffers-codegen/src/LambdaBuffers/Codegen/Haskell/Print/InstanceDef.hs
@@ -1,9 +1,5 @@
-module LambdaBuffers.Codegen.Haskell.Print.InstanceDef (printInstanceDef, printConstraint, collectTyVars, printInstanceContext, printInstanceContext', printConstraint') where
+module LambdaBuffers.Codegen.Haskell.Print.InstanceDef (printInstanceDef, printConstraint, printInstanceContext, printInstanceContext', printConstraint') where
 
-import Control.Lens (view)
-import Data.Foldable (Foldable (toList))
-import Data.Set (Set)
-import Data.Set qualified as Set
 import LambdaBuffers.Codegen.Haskell.Backend (MonadHaskellBackend)
 import LambdaBuffers.Codegen.Haskell.Print.Syntax qualified as HsSyntax
 import LambdaBuffers.Codegen.Haskell.Print.TyDef (printTyInner)
@@ -23,7 +19,7 @@ instance (SomeClass a, SomeClass b, SomeClass c) => SomeClass (SomeTy a b c) whe
 -}
 printInstanceDef :: forall t m ann. MonadHaskellBackend t m => HsSyntax.QClassName -> PC.Ty -> m (Doc ann -> m (Doc ann))
 printInstanceDef hsQClassName ty = do
-  let freeVars = collectTyVars ty
+  let freeVars = PC.collectTyVars ty
   headDoc <- printConstraint hsQClassName ty
   return $ case freeVars of
     [] -> \implDoc -> return $ "instance" <+> headDoc <+> "where" <> hardline <> space <> space <> implDoc
@@ -47,14 +43,3 @@ printConstraint' qcn tys = do
   let crefDoc = HsSyntax.printHsQClassName qcn
   tyDocs <- traverse printTyInner tys
   return $ crefDoc <+> hsep tyDocs
-
-collectTyVars :: PC.Ty -> [PC.Ty]
-collectTyVars = fmap (`PC.withInfoLess` (PC.TyVarI . PC.TyVar)) . toList . collectVars
-
-collectVars :: PC.Ty -> Set (PC.InfoLess PC.VarName)
-collectVars = collectVars' mempty
-
-collectVars' :: Set (PC.InfoLess PC.VarName) -> PC.Ty -> Set (PC.InfoLess PC.VarName)
-collectVars' collected (PC.TyVarI tv) = Set.insert (PC.mkInfoLess . view #varName $ tv) collected
-collectVars' collected (PC.TyAppI (PC.TyApp _ args _)) = collected `Set.union` (Set.unions . fmap collectVars $ args)
-collectVars' collected _ = collected