add transformation

anoma · Oct 30, 2024 · 18c71b6 · 18c71b6
1 parent 30750ac
commit 18c71b6
Show file tree

Hide file tree

Showing 5 changed files with 10 additions and 4 deletions.
diff --git a/src/Juvix/Compiler/Core/Data/TransformationId.hs b/src/Juvix/Compiler/Core/Data/TransformationId.hs
@@ -17,6 +17,7 @@ data TransformationId
   | UnrollRecursion
   | ComputeTypeInfo
   | ComputeCaseANF
+  | DetectConstantSideConditions
   | DetectRedundantPatterns
   | MatchToCase
   | EtaExpandApps
@@ -59,10 +60,10 @@ data PipelineId
 type TransformationLikeId = TransformationLikeId' TransformationId PipelineId
 
 toTypecheckTransformations :: [TransformationId]
-toTypecheckTransformations = [DetectRedundantPatterns, MatchToCase]
+toTypecheckTransformations = [DetectConstantSideConditions, DetectRedundantPatterns, MatchToCase]
 
 toStoredTransformations :: [TransformationId]
-toStoredTransformations = [EtaExpandApps, DetectRedundantPatterns, MatchToCase, NatToPrimInt, IntToPrimInt, ConvertBuiltinTypes, OptPhaseEval, DisambiguateNames]
+toStoredTransformations = [EtaExpandApps, DetectConstantSideConditions, DetectRedundantPatterns, MatchToCase, NatToPrimInt, IntToPrimInt, ConvertBuiltinTypes, OptPhaseEval, DisambiguateNames]
 
 combineInfoTablesTransformations :: [TransformationId]
 combineInfoTablesTransformations = [CombineInfoTables, FilterUnreachable]
@@ -84,6 +85,7 @@ instance TransformationId' TransformationId where
     LambdaLetRecLifting -> strLifting
     LetRecLifting -> strLetRecLifting
     TopEtaExpand -> strTopEtaExpand
+    DetectConstantSideConditions -> strDetectConstantSideConditions
     DetectRedundantPatterns -> strDetectRedundantPatterns
     MatchToCase -> strMatchToCase
     EtaExpandApps -> strEtaExpandApps

diff --git a/src/Juvix/Compiler/Core/Data/TransformationId/Strings.hs b/src/Juvix/Compiler/Core/Data/TransformationId/Strings.hs
@@ -29,6 +29,9 @@ strLetRecLifting = "letrec-lifting"
 strTopEtaExpand :: Text
 strTopEtaExpand = "top-eta-expand"
 
+strDetectConstantSideConditions :: Text
+strDetectConstantSideConditions = "detect-constant-side-conditions"
+
 strDetectRedundantPatterns :: Text
 strDetectRedundantPatterns = "detect-redundant-patterns"
 

diff --git a/src/Juvix/Compiler/Core/Transformation.hs b/src/Juvix/Compiler/Core/Transformation.hs
@@ -22,6 +22,7 @@ import Juvix.Compiler.Core.Transformation.CombineInfoTables (combineInfoTables)
 import Juvix.Compiler.Core.Transformation.ComputeCaseANF
 import Juvix.Compiler.Core.Transformation.ComputeTypeInfo
 import Juvix.Compiler.Core.Transformation.ConvertBuiltinTypes
+import Juvix.Compiler.Core.Transformation.DetectConstantSideConditions
 import Juvix.Compiler.Core.Transformation.DetectRedundantPatterns
 import Juvix.Compiler.Core.Transformation.DisambiguateNames
 import Juvix.Compiler.Core.Transformation.Eta
@@ -76,6 +77,7 @@ applyTransformations ts tbl = foldM (flip appTrans) tbl ts
       ComputeTypeInfo -> return . computeTypeInfo
       ComputeCaseANF -> return . computeCaseANF
       UnrollRecursion -> unrollRecursion
+      DetectConstantSideConditions -> return . detectConstantSideConditions
       DetectRedundantPatterns -> mapError (JuvixError @CoreError) . detectRedundantPatterns
       MatchToCase -> mapError (JuvixError @CoreError) . matchToCase
       EtaExpandApps -> return . etaExpansionApps

diff --git a/src/Juvix/Compiler/Core/Transformation/DetectRedundantPatterns.hs b/src/Juvix/Compiler/Core/Transformation/DetectRedundantPatterns.hs
@@ -52,7 +52,7 @@ goDetectRedundantPatterns md node = case node of
             unless (check matrix row) $
               throw
                 CoreError
-                  { _coreErrorMsg = ppOutput ("Redundant pattern" <> seq <> ": " <> pat),
+                  { _coreErrorMsg = ppOutput ("Redundant pattern" <> seq <> ": " <> pat <> "\nPerhaps you mistyped a constructor name in an earlier pattern?"),
                     _coreErrorNode = Nothing,
                     _coreErrorLoc = fromMaybe defaultLoc (getInfoLocation _matchBranchInfo)
                   }

diff --git a/tests/Compilation/negative/test001.juvix b/tests/Compilation/negative/test001.juvix
@@ -9,4 +9,3 @@ f : List Nat -> List Nat -> Nat
   | _ nil := 0;
 
 main : Nat := f (1 :: nil) (2 :: nil);
-