move

anoma · Nov 22, 2024 · 8b3f47b · 8b3f47b
1 parent 7f97da9
commit 8b3f47b
Showing 1 changed file with 24 additions and 24 deletions.
diff --git a/src/Juvix/Compiler/Internal/Translation/FromConcrete.hs b/src/Juvix/Compiler/Internal/Translation/FromConcrete.hs
@@ -594,7 +594,7 @@ deriveOrd DerivingArgs {..} = do
             _ordBuiltinGt = bgt,
             _ordBuiltinEq = beq
           }
-  lam <- compareConstructors (getLoc _derivingInstanceName) bs arg
+  lam <- genOrdCompare (getLoc _derivingInstanceName) bs arg
   let ty = Internal.foldFunType _derivingParameters ret
       body = mkOrd Internal.@@ lam
   pragmas' <- goPragmas _derivingPragmas
@@ -618,14 +618,14 @@ deriveOrd DerivingArgs {..} = do
     args :: [Internal.ApplicationArg]
     (ordName, args) = _derivingReturnType
 
-compareConstructors ::
+genOrdCompare ::
   forall r.
   (Members '[NameIdGen] r) =>
   Interval ->
   OrdBuiltins ->
   [ConstructorInfo] ->
   Sem r Internal.Expression
-compareConstructors loc bs cs = do
+genOrdCompare loc bs cs = do
   res <-
     fmap nonEmpty
       . execOutputList
@@ -651,7 +651,7 @@ compareConstructors loc bs cs = do
       let mkPat = Internal.genConstructorPattern loc Explicit c
       (p1, v1) <- mkPat
       (p2, v2) <- mkPat
-      lord <- lexOrder loc bs (zipExact v1 v2)
+      lord <- lexOrder (zipExact v1 v2)
       let sameConstr =
             Internal.LambdaClause
               { _lambdaPatterns = p1 :| [p2],
@@ -674,26 +674,26 @@ compareConstructors loc bs cs = do
               _lambdaBody = Internal.toExpression (bs ^. ordBuiltinGt)
             }
 
-lexOrder :: forall r. (Members '[NameIdGen] r) => Interval -> OrdBuiltins -> [(Internal.VarName, Internal.VarName)] -> Sem r Internal.Expression
-lexOrder loc bs = go
-  where
-    cmp :: Internal.VarName -> Internal.VarName -> Internal.Expression
-    cmp a b = (bs ^. ordBuiltinCompare) Internal.@@ a Internal.@@ b
-
-    go :: [(Internal.VarName, Internal.VarName)] -> Sem r Internal.Expression
-    go = \case
-      [] -> return (Internal.toExpression (bs ^. ordBuiltinEq))
-      (x, x') : vs
-        | null vs -> return (cmp x x')
-        | otherwise -> do
-            v <- Internal.freshVar loc "ltGt"
-            let pv = Internal.mkVarPattern v Explicit
-                mkPat :: Internal.Name -> Internal.PatternArg
-                mkPat p = Internal.mkConstructorVarPattern Explicit p []
-                branchNEq = Internal.mkCaseBranch pv (Internal.toExpression v)
-            branchEq <- Internal.mkCaseBranch (mkPat (bs ^. ordBuiltinEq)) <$> go vs
-            let branches = branchEq :| [branchNEq]
-            return (Internal.mkCase (cmp x x') branches)
+    lexOrder :: forall r'. (Members '[NameIdGen] r') => [(Internal.VarName, Internal.VarName)] -> Sem r' Internal.Expression
+    lexOrder = lexgo
+      where
+        cmp :: Internal.VarName -> Internal.VarName -> Internal.Expression
+        cmp a b = (bs ^. ordBuiltinCompare) Internal.@@ a Internal.@@ b
+
+        lexgo :: [(Internal.VarName, Internal.VarName)] -> Sem r' Internal.Expression
+        lexgo = \case
+          [] -> return (Internal.toExpression (bs ^. ordBuiltinEq))
+          (x, x') : vs
+            | null vs -> return (cmp x x')
+            | otherwise -> do
+                v <- Internal.freshVar loc "ltGt"
+                let pv = Internal.mkVarPattern v Explicit
+                    mkPat :: Internal.Name -> Internal.PatternArg
+                    mkPat p = Internal.mkConstructorVarPattern Explicit p []
+                    branchNEq = Internal.mkCaseBranch pv (Internal.toExpression v)
+                branchEq <- Internal.mkCaseBranch (mkPat (bs ^. ordBuiltinEq)) <$> lexgo vs
+                let branches = branchEq :| [branchNEq]
+                return (Internal.mkCase (cmp x x') branches)
 
 derivingGetConstrs ::
   (Members '[Error ScoperError, State LocalTable, Reader S.InfoTable, Reader Internal.InfoTable] r) =>