fix compilation after rebase

anoma · Mar 16, 2023 · 497618c · 497618c
1 parent 077c126
commit 497618c
Show file tree

Hide file tree

Showing 4 changed files with 32 additions and 26 deletions.
diff --git a/app/Commands/Compile.hs b/app/Commands/Compile.hs
@@ -30,5 +30,8 @@ runCommand opts@CompileOptions {..} = do
 writeCoreFile :: (Members '[Embed IO, App] r) => Compile.PipelineArg -> Sem r ()
 writeCoreFile Compile.PipelineArg {..} = do
   coreFile <- Compile.outputFile _pipelineArgOptions _pipelineArgFile
-  let tab = Core.toEval _pipelineArgInfoTable
-  embed $ TIO.writeFile (toFilePath coreFile) (show $ Core.ppOutDefault (Core.disambiguateNames tab))
+  r <- runError @JuvixError $ Core.toEval _pipelineArgInfoTable
+  case r of
+    Left e -> exitJuvixError e
+    Right tab ->
+      embed $ TIO.writeFile (toFilePath coreFile) (show $ Core.ppOutDefault (Core.disambiguateNames tab))
diff --git a/src/Juvix/Compiler/Core/Data/TransformationId.hs b/src/Juvix/Compiler/Core/Data/TransformationId.hs
@@ -48,7 +48,7 @@ toStrippedTransformations =
   toEvalTransformations ++ [LambdaLetRecLifting, TopEtaExpand, MoveApps, RemoveTypeArgs]
 
 toGebTransformations :: [TransformationId]
-toGebTransformations = toEvalTransformations ++ [UnrollRecursion, ComputeTypeInfo]
+toGebTransformations = toEvalTransformations ++ [LetRecLifting, CheckGeb, UnrollRecursion, ComputeTypeInfo]
 
 toEvalTransformations :: [TransformationId]
 toEvalTransformations = [EtaExpandApps, MatchToCase, NatToInt, ConvertBuiltinTypes]

diff --git a/src/Juvix/Compiler/Core/Transformation/CheckGeb.hs b/src/Juvix/Compiler/Core/Transformation/CheckGeb.hs
@@ -27,7 +27,7 @@ checkGeb tab = checkNoRecursion >> mapAllNodesM checkTypes tab
                   CoreError
                     { _coreErrorMsg = "polymorphism not supported for the GEB target",
                       _coreErrorNode = Just node,
-                      _coreErrorLoc = fromMaybe defaultLoc (getInfoLocation _piInfo)
+                      _coreErrorLoc = fromMaybe defaultLoc (_piBinder ^. binderLocation)
                     }
           _ -> return node
 

diff --git a/src/Juvix/Compiler/Pipeline/ExpressionContext.hs b/src/Juvix/Compiler/Pipeline/ExpressionContext.hs
@@ -58,25 +58,28 @@ mainModuleScope e = fromJust (moduleScope e (mainModuleTopPath e))
 mainModuleTopPath :: ExpressionContext -> C.TopModulePath
 mainModuleTopPath = (^. contextScoperResult . Scoper.mainModule . C.modulePath . S.nameConcrete)
 
-runTransformations :: [TransformationId] -> InfoTable -> Node -> (InfoTable, Node)
-runTransformations ts tab n = snd $ run $ runInfoTableBuilder tab $ do
-  sym <- freshSymbol
-  registerIdentNode sym n
-  -- `n` will get filtered out by the transformations unless it has a
-  -- corresponding entry in `infoIdentifiers`
-  let name = freshIdentName tab "_repl"
-      ii =
-        IdentifierInfo
-          { _identifierName = name,
-            _identifierSymbol = sym,
-            _identifierLocation = Nothing,
-            _identifierArgsNum = 0,
-            _identifierArgsInfo = [],
-            _identifierType = mkDynamic',
-            _identifierIsExported = False,
-            _identifierBuiltin = Nothing
-          }
-  registerIdent name ii
-  tab' <- applyTransformations ts <$> getInfoTable
-  let node' = lookupDefault impossible sym (tab' ^. identContext)
-  return (tab', node')
+runTransformations :: Member (Error JuvixError) r => [TransformationId] -> InfoTable -> Node -> Sem r (InfoTable, Node)
+runTransformations ts tab n = snd <$> runInfoTableBuilder tab e
+  where
+    e = do
+      sym <- freshSymbol
+      registerIdentNode sym n
+      -- `n` will get filtered out by the transformations unless it has a
+      -- corresponding entry in `infoIdentifiers`
+      let name = freshIdentName tab "_repl"
+          ii =
+            IdentifierInfo
+              { _identifierName = name,
+                _identifierSymbol = sym,
+                _identifierLocation = Nothing,
+                _identifierArgsNum = 0,
+                _identifierArgsInfo = [],
+                _identifierType = mkDynamic',
+                _identifierIsExported = False,
+                _identifierBuiltin = Nothing
+              }
+      registerIdent name ii
+      tab0 <- getInfoTable
+      tab' <- applyTransformations ts tab0
+      let node' = lookupDefault impossible sym (tab' ^. identContext)
+      return (tab', node')