Update stack resolver

* Update lexer to text 2 (utf-8). * Change code that used to rely on utf-16 indices to work with a mix of utf-8 text and utf-16 indices (from LSP).
ollef · Jan 25, 2024 · 51bbb6e · 51bbb6e
1 parent be84946
commit 51bbb6e
Show file tree

Hide file tree

Showing 54 changed files with 639 additions and 781 deletions.
diff --git a/src/Assembly.hs b/src/Assembly.hs
@@ -167,21 +167,21 @@ instance Pretty Instruction where
           Return local -> pretty local <+> "= "
           <> "switch"
           <+> pretty scrutinee
-            <> line
-            <> indent
-              2
-              ( vsep
-                  [ pretty i
-                    <+> "->"
-                      <> line
-                      <> indent 2 (pretty basicBlock)
-                  | (i, basicBlock) <- branches
-                  ]
+          <> line
+          <> indent
+            2
+            ( vsep
+                [ pretty i
+                  <+> "->"
                   <> line
-                  <> "_ -> "
-                  <> line
-                  <> indent 2 (pretty default_)
-              )
+                  <> indent 2 (pretty basicBlock)
+                | (i, basicBlock) <- branches
+                ]
+                <> line
+                <> "_ -> "
+                <> line
+                <> indent 2 (pretty default_)
+            )
     where
       voidInstr name args =
         name <+> hsep (pretty <$> args)
@@ -197,23 +197,23 @@ instance Pretty Definition where
           <+> pretty type_
           <+> "constant"
           <+> "="
-            <> line
-            <> indent 2 (pretty knownConstant)
+          <> line
+          <> indent 2 (pretty knownConstant)
       ConstantDefinition type_ returnType constantParameters basicBlock ->
         pretty type_
           <+> "constant"
           <+> pretty returnType
           <+> tupled (pretty <$> constantParameters)
           <+> "="
-            <> line
-            <> indent 2 (pretty basicBlock)
+          <> line
+          <> indent 2 (pretty basicBlock)
       FunctionDefinition returnType args basicBlock ->
         "function"
           <+> pretty returnType
           <+> tupled (pretty <$> args)
           <+> "="
-            <> line
-            <> indent 2 (pretty basicBlock)
+          <> line
+          <> indent 2 (pretty basicBlock)
 
 instance Pretty BasicBlock where
   pretty (BasicBlock instrs result) =
@@ -222,7 +222,7 @@ instance Pretty BasicBlock where
       , pretty result
       ]
 
-instance Pretty a => Pretty (Return a) where
+instance (Pretty a) => Pretty (Return a) where
   pretty voided = case voided of
     Void -> "void"
     Return a -> pretty a

diff --git a/src/AssemblyToLLVM.hs b/src/AssemblyToLLVM.hs
@@ -102,13 +102,13 @@ llvmReturnType result =
     Assembly.Void -> "void"
     Assembly.Return type_ -> llvmType type_
 
-alignment :: Num a => a
+alignment :: (Num a) => a
 alignment = 8
 
-wordBytes :: Num a => a
+wordBytes :: (Num a) => a
 wordBytes = 8
 
-wordBits :: Num a => a
+wordBits :: (Num a) => a
 wordBits = 64
 
 wordSizedInt :: Builder

diff --git a/src/ClosureConversion.hs b/src/ClosureConversion.hs
@@ -15,7 +15,7 @@ import Telescope (Telescope)
 import qualified Telescope
 
 convertDefinition
-  :: MonadFetch Query m
+  :: (MonadFetch Query m)
   => LambdaLifted.Definition
   -> m ClosureConverted.Definition
 convertDefinition def =
@@ -33,7 +33,7 @@ convertDefinition def =
       ClosureConverted.ParameterisedDataDefinition boxity <$> convertParameterisedDataDefinition tele
 
 convertParameterisedDataDefinition
-  :: MonadFetch Query m
+  :: (MonadFetch Query m)
   => Telescope Name LambdaLifted.Type LambdaLifted.ConstructorDefinitions v
   -> m (Telescope Name ClosureConverted.Type ClosureConverted.ConstructorDefinitions v)
 convertParameterisedDataDefinition tele =
@@ -47,14 +47,14 @@ convertParameterisedDataDefinition tele =
         <*> convertParameterisedDataDefinition tele'
 
 convertTerm
-  :: MonadFetch Query m
+  :: (MonadFetch Query m)
   => LambdaLifted.Term v
   -> m (ClosureConverted.Term v)
 convertTerm term =
   convertAppliedTerm term []
 
 convertAppliedTerm
-  :: MonadFetch Query m
+  :: (MonadFetch Query m)
   => LambdaLifted.Term v
   -> [ClosureConverted.Term v]
   -> m (ClosureConverted.Term v)
@@ -91,7 +91,7 @@ convertAppliedTerm term args =
           <*> mapM convertTerm defaultBranch
 
 convertGlobal
-  :: MonadFetch Query m
+  :: (MonadFetch Query m)
   => Name.Lifted
   -> [ClosureConverted.Term v]
   -> m (ClosureConverted.Term v)
@@ -132,7 +132,7 @@ convertGlobal global args = do
     LambdaLifted.DataDefinition _ tele ->
       functionCase tele
 
-convertTypeDeclaration :: MonadFetch Query m => LambdaLifted.Type Void -> m (ClosureConverted.Type Void)
+convertTypeDeclaration :: (MonadFetch Query m) => LambdaLifted.Type Void -> m (ClosureConverted.Type Void)
 convertTypeDeclaration type_ =
   case LambdaLifted.pisView identity type_ of
     Telescope.Empty _ ->
@@ -141,7 +141,7 @@ convertTypeDeclaration type_ =
       ClosureConverted.Function <$> Telescope.hoistA convertTerm convertTerm tele
 
 convertBranches
-  :: MonadFetch Query m
+  :: (MonadFetch Query m)
   => LambdaLifted.Branches v
   -> m (ClosureConverted.Branches v)
 convertBranches branches =
@@ -154,7 +154,7 @@ convertBranches branches =
         <$> OrderedHashMap.mapMUnordered convertTerm literalBranches
 
 convertTelescope
-  :: MonadFetch Query m
+  :: (MonadFetch Query m)
   => Telescope Name LambdaLifted.Type LambdaLifted.Term v
   -> m (Telescope Name ClosureConverted.Type ClosureConverted.Term v)
 convertTelescope tele =
@@ -168,7 +168,7 @@ convertTelescope tele =
         <*> convertTelescope tele'
 
 applyArgs
-  :: Monad m
+  :: (Monad m)
   => [ClosureConverted.Term v]
   -> m (ClosureConverted.Term v)
   -> m (ClosureConverted.Term v)

diff --git a/src/ClosureConverted/Readback.hs b/src/ClosureConverted/Readback.hs
@@ -84,7 +84,7 @@ readbackGroupedElimination env eliminee elimination =
         readback env branch'
       pure $ Syntax.Case eliminee branches' defaultBranch'
 
-readbackGroupedSpine :: Foldable f => Domain.Environment v -> Syntax.Term v -> f Domain.GroupedElimination -> M (Syntax.Term v)
+readbackGroupedSpine :: (Foldable f) => Domain.Environment v -> Syntax.Term v -> f Domain.GroupedElimination -> M (Syntax.Term v)
 readbackGroupedSpine =
   foldlM . readbackGroupedElimination
 

diff --git a/src/ClosureConverted/Representation.hs b/src/ClosureConverted/Representation.hs
@@ -294,7 +294,7 @@ data Branches v
   | TaggedConstructorBranches !Boxity [(Int, Telescope Name Syntax.Type Syntax.Term v)]
   deriving (Eq, Show)
 
-compileBranches :: MonadFetch Query m => Syntax.Branches v -> m (Branches v)
+compileBranches :: (MonadFetch Query m) => Syntax.Branches v -> m (Branches v)
 compileBranches branches =
   case branches of
     Syntax.LiteralBranches literalBranches ->

diff --git a/src/ClosureConverted/TypeOf.hs b/src/ClosureConverted/TypeOf.hs
@@ -112,7 +112,7 @@ typeOfHead context head =
           pure type'
 
 typeOfSpineApplication
-  :: Foldable f
+  :: (Foldable f)
   => Context v
   -> Domain.Type
   -> f Domain.Elimination

diff --git a/src/ClosureConvertedToAssembly.hs b/src/ClosureConvertedToAssembly.hs
@@ -83,10 +83,10 @@ emit :: Assembly.Instruction -> Builder ()
 emit instruction =
   modify \s -> s {instructions = s.instructions Tsil.:> instruction}
 
-tagBytes :: Num a => a
+tagBytes :: (Num a) => a
 tagBytes = wordBytes
 
-wordBytes :: Num a => a
+wordBytes :: (Num a) => a
 wordBytes = 8
 
 -------------------------------------------------------------------------------
@@ -503,7 +503,7 @@ forceDirect operand =
 
 -------------------------------------------------------------------------------
 
-pointerBytes :: Num a => a
+pointerBytes :: (Num a) => a
 pointerBytes =
   8
 

diff --git a/src/Command/Watch.hs b/src/Command/Watch.hs
@@ -23,7 +23,7 @@ watch argumentFiles = do
   watcher <- FileSystem.watcherFromArguments argumentFiles
   signalChangeVar <- newEmptyMVar
   fileStateVar <- newMVar mempty
-  FSNotify.withManagerConf config \manager -> do
+  FSNotify.withManager \manager -> do
     stopListening <- FileSystem.runWatcher watcher manager \(changedFiles, sourceDirectories, files) -> do
       modifyMVar_ fileStateVar \(changedFiles', _, _) ->
         pure (changedFiles <> changedFiles', sourceDirectories, files)
@@ -34,11 +34,6 @@ watch argumentFiles = do
       forever $ do
         (changedFiles, sourceDirectories, files) <- waitForChanges signalChangeVar fileStateVar driverState
         checkAndPrintErrors driverState changedFiles sourceDirectories files
-  where
-    config =
-      FSNotify.defaultConfig
-        { FSNotify.confDebounce = FSNotify.Debounce 0.010
-        }
 
 waitForChanges
   :: MVar ()

diff --git a/src/Core/Domain.hs b/src/Core/Domain.hs
@@ -138,7 +138,7 @@ foldl f e spine =
     spine' :> elim ->
       f (Core.Domain.foldl f e spine') elim
 
-foldlM :: Monad m => (a -> Elimination -> m a) -> a -> Spine -> m a
+foldlM :: (Monad m) => (a -> Elimination -> m a) -> a -> Spine -> m a
 foldlM f e spine =
   case spine of
     Empty ->
@@ -147,7 +147,7 @@ foldlM f e spine =
       a <- Core.Domain.foldlM f e spine'
       f a elim
 
-mapM :: Monad m => (Elimination -> m a) -> Spine -> m (Tsil a)
+mapM :: (Monad m) => (Elimination -> m a) -> Spine -> m (Tsil a)
 mapM f spine =
   case spine of
     Empty ->
@@ -157,7 +157,7 @@ mapM f spine =
       a <- f elim
       pure $ as Tsil.:> a
 
-mapM_ :: Monad m => (Elimination -> m ()) -> Spine -> m ()
+mapM_ :: (Monad m) => (Elimination -> m ()) -> Spine -> m ()
 mapM_ f spine =
   case spine of
     Empty ->