diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index ff64d1e42..ce6dd1d9f 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -18,7 +18,7 @@ jobs: - uses: haskell/actions/setup@v1 with: - ghc-version: '8.10' + ghc-version: '9.2.1' cabal-version: '3.6' - name: Cache diff --git a/builder/src/Deps/Solver.hs b/builder/src/Deps/Solver.hs index 59fb9d683..2b90ee449 100644 --- a/builder/src/Deps/Solver.hs +++ b/builder/src/Deps/Solver.hs @@ -278,9 +278,6 @@ instance Applicative Solver where in solverFunc state okF back err instance Monad Solver where - return a = - Solver $ \state ok back _ -> ok state a back - (>>=) (Solver solverA) callback = Solver $ \state ok back err -> let okA stateA a backA = diff --git a/compiler/src/Data/Name.hs b/compiler/src/Data/Name.hs index b1500e4a3..5f65bdb8b 100644 --- a/compiler/src/Data/Name.hs +++ b/compiler/src/Data/Name.hs @@ -233,7 +233,7 @@ fromTypeVariable name@(Utf8.Utf8 ba#) index = else let len# = sizeofByteArray# ba# end# = indexWord8Array# ba# (len# -# 1#) - in if isTrue# (leWord# 0x30## end#) && isTrue# (leWord# end# 0x39##) + in if isTrue# (leWord8# (wordToWord8# 0x30##) end#) && isTrue# (leWord8# end# (wordToWord8# 0x39##)) then runST ( do @@ -298,11 +298,11 @@ fromManyNames names = ( ST $ \s -> case newByteArray# (len# +# 3#) s of (# s, mba# #) -> - case writeWord8Array# mba# 0# 0x5F## {-_-} s of + case writeWord8Array# mba# 0# (wordToWord8# 0x5F## {-_-}) s of s -> - case writeWord8Array# mba# 1# 0x4D## {-M-} s of + case writeWord8Array# mba# 1# (wordToWord8# 0x4D## {-M-}) s of s -> - case writeWord8Array# mba# 2# 0x24## s of + case writeWord8Array# mba# 2# (wordToWord8# 0x24##) s of s -> case copyByteArray# ba# 0# mba# 3# len# s of s -> diff --git a/compiler/src/Data/Utf8.hs b/compiler/src/Data/Utf8.hs index a3ec14311..1c9c85435 100644 --- a/compiler/src/Data/Utf8.hs +++ b/compiler/src/Data/Utf8.hs @@ -90,11 +90,11 @@ contains :: Word8 -> Utf8 t -> Bool contains (W8# word#) (Utf8 ba#) = containsHelp word# ba# 0# (sizeofByteArray# ba#) -containsHelp :: Word# -> ByteArray# -> Int# -> Int# -> Bool +containsHelp :: Word8# -> ByteArray# -> Int# -> Int# -> Bool containsHelp word# ba# !offset# len# = if isTrue# (offset# <# len#) then - if isTrue# (eqWord# word# (indexWord8Array# ba# offset#)) + if isTrue# (eqWord8# word# (indexWord8Array# ba# offset#)) then True else containsHelp word# ba# (offset# +# 1#) len# else False @@ -116,7 +116,7 @@ startsWithChar isGood bytes@(Utf8 ba#) = if isEmpty bytes then False else - let !w# = indexWord8Array# ba# 0# + let !w# = indexWord8ArrayAsWord# ba# 0# !char | isTrue# (ltWord# w# 0xC0##) = C# (chr# (word2Int# w#)) | isTrue# (ltWord# w# 0xE0##) = chr2 ba# 0# w# @@ -130,7 +130,7 @@ endsWithWord8 :: Word8 -> Utf8 t -> Bool endsWithWord8 (W8# w#) (Utf8 ba#) = let len# = sizeofByteArray# ba# in isTrue# (len# ># 0#) - && isTrue# (eqWord# w# (indexWord8Array# ba# (len# -# 1#))) + && isTrue# (eqWord8# w# (indexWord8Array# ba# (len# -# 1#))) -- SPLIT @@ -146,12 +146,12 @@ splitHelp str start offsets = offset : offsets -> unsafeSlice str start offset : splitHelp str (offset + 1) offsets -findDividers :: Word# -> ByteArray# -> Int# -> Int# -> [Int] -> [Int] +findDividers :: Word8# -> ByteArray# -> Int# -> Int# -> [Int] -> [Int] findDividers divider# ba# !offset# len# revOffsets = if isTrue# (offset# <# len#) then findDividers divider# ba# (offset# +# 1#) len# $ - if isTrue# (eqWord# divider# (indexWord8Array# ba# offset#)) + if isTrue# (eqWord8# divider# (indexWord8Array# ba# offset#)) then I# offset# : revOffsets else revOffsets else reverse revOffsets @@ -286,7 +286,7 @@ toCharsHelp ba# offset# len# = if isTrue# (offset# >=# len#) then [] else - let !w# = indexWord8Array# ba# offset# + let !w# = indexWord8ArrayAsWord# ba# offset# !(# char, width# #) | isTrue# (ltWord# w# 0xC0##) = (# C# (chr# (word2Int# w#)), 1# #) | isTrue# (ltWord# w# 0xE0##) = (# chr2 ba# offset# w#, 2# #) @@ -300,7 +300,7 @@ toCharsHelp ba# offset# len# = chr2 :: ByteArray# -> Int# -> Word# -> Char chr2 ba# offset# firstWord# = let !i1# = word2Int# firstWord# - !i2# = word2Int# (indexWord8Array# ba# (offset# +# 1#)) + !i2# = word2Int# (indexWord8ArrayAsWord# ba# (offset# +# 1#)) !c1# = uncheckedIShiftL# (i1# -# 0xC0#) 6# !c2# = i2# -# 0x80# in C# (chr# (c1# +# c2#)) @@ -309,8 +309,8 @@ chr2 ba# offset# firstWord# = chr3 :: ByteArray# -> Int# -> Word# -> Char chr3 ba# offset# firstWord# = let !i1# = word2Int# firstWord# - !i2# = word2Int# (indexWord8Array# ba# (offset# +# 1#)) - !i3# = word2Int# (indexWord8Array# ba# (offset# +# 2#)) + !i2# = word2Int# (indexWord8ArrayAsWord# ba# (offset# +# 1#)) + !i3# = word2Int# (indexWord8ArrayAsWord# ba# (offset# +# 2#)) !c1# = uncheckedIShiftL# (i1# -# 0xE0#) 12# !c2# = uncheckedIShiftL# (i2# -# 0x80#) 6# !c3# = i3# -# 0x80# @@ -320,9 +320,9 @@ chr3 ba# offset# firstWord# = chr4 :: ByteArray# -> Int# -> Word# -> Char chr4 ba# offset# firstWord# = let !i1# = word2Int# firstWord# - !i2# = word2Int# (indexWord8Array# ba# (offset# +# 1#)) - !i3# = word2Int# (indexWord8Array# ba# (offset# +# 2#)) - !i4# = word2Int# (indexWord8Array# ba# (offset# +# 3#)) + !i2# = word2Int# (indexWord8ArrayAsWord# ba# (offset# +# 1#)) + !i3# = word2Int# (indexWord8ArrayAsWord# ba# (offset# +# 2#)) + !i4# = word2Int# (indexWord8ArrayAsWord# ba# (offset# +# 3#)) !c1# = uncheckedIShiftL# (i1# -# 0xF0#) 18# !c2# = uncheckedIShiftL# (i2# -# 0x80#) 12# !c3# = uncheckedIShiftL# (i3# -# 0x80#) 6# @@ -386,7 +386,7 @@ escape :: Word8 -> Word8 -> Ptr a -> Utf8 t -> Int -> Int -> Int -> IO () escape before@(W8# before#) after ptr name@(Utf8 ba#) offset@(I# offset#) len@(I# len#) i@(I# i#) = if isTrue# (i# <# len#) then - if isTrue# (eqWord# before# (indexWord8Array# ba# (offset# +# i#))) + if isTrue# (eqWord8# before# (indexWord8Array# ba# (offset# +# i#))) then do writeWordToPtr ptr i after escape before after ptr name offset len (i + 1) diff --git a/compiler/src/Elm/Compiler/Type.hs b/compiler/src/Elm/Compiler/Type.hs index 395c093bf..9dfbab192 100644 --- a/compiler/src/Elm/Compiler/Type.hs +++ b/compiler/src/Elm/Compiler/Type.hs @@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} -{-# OPTIONS_GHC -Wall #-} +{-# OPTIONS_GHC -Wall -Wno-incomplete-uni-patterns #-} module Elm.Compiler.Type ( Type (..), diff --git a/compiler/src/Json/Decode.hs b/compiler/src/Json/Decode.hs index 8aad424ed..008283c73 100644 --- a/compiler/src/Json/Decode.hs +++ b/compiler/src/Json/Decode.hs @@ -100,7 +100,9 @@ instance Functor (Decoder x) where instance Applicative (Decoder x) where {-# INLINE pure #-} - pure = return + pure a = + Decoder $ \_ ok _ -> + ok a {-# INLINE (<*>) #-} (<*>) (Decoder decodeFunc) (Decoder decodeArg) = @@ -111,11 +113,6 @@ instance Applicative (Decoder x) where in decodeFunc ast okF err instance Monad (Decoder x) where - {-# INLINE return #-} - return a = - Decoder $ \_ ok _ -> - ok a - {-# INLINE (>>=) #-} (>>=) (Decoder decodeA) callback = Decoder $ \ast ok err -> diff --git a/compiler/src/Parse/Primitives.hs b/compiler/src/Parse/Primitives.hs index 2280c8bc3..c3e5e24ea 100644 --- a/compiler/src/Parse/Primitives.hs +++ b/compiler/src/Parse/Primitives.hs @@ -82,7 +82,9 @@ instance Functor (Parser x) where instance Applicative.Applicative (Parser x) where {-# INLINE pure #-} - pure = return + pure value = + Parser $ \state _ eok _ _ -> + eok value state {-# INLINE (<*>) #-} (<*>) (Parser parserFunc) (Parser parserArg) = @@ -152,11 +154,6 @@ oowfHelp state cok eok cerr parsers fallback = -- MONAD instance Monad (Parser x) where - {-# INLINE return #-} - return value = - Parser $ \state _ eok _ _ -> - eok value state - {-# INLINE (>>=) #-} (Parser parserA) >>= callback = Parser $ \state cok eok cerr eerr -> diff --git a/compiler/src/Parse/Variable.hs b/compiler/src/Parse/Variable.hs index 266cd181d..ea0a78929 100644 --- a/compiler/src/Parse/Variable.hs +++ b/compiler/src/Parse/Variable.hs @@ -25,7 +25,7 @@ import qualified Data.Name as Name import qualified Data.Set as Set import Data.Word (Word8) import Foreign.Ptr (Ptr, plusPtr) -import GHC.Exts (Char (C#), Int#, chr#, uncheckedIShiftL#, word2Int#, (+#), (-#)) +import GHC.Exts (Char (C#), Int#, chr#, uncheckedIShiftL#, word2Int#, word8ToWord#, (+#), (-#)) import GHC.Word (Word8 (W8#)) import Parse.Primitives (Col, Parser, Row, unsafeIndex) import qualified Parse.Primitives as P @@ -305,4 +305,4 @@ chr4 pos firstWord = unpack :: Word8 -> Int# unpack (W8# word#) = - word2Int# word# + word2Int# (word8ToWord# word#) diff --git a/compiler/src/Reporting/Render/Code.hs b/compiler/src/Reporting/Render/Code.hs index cc645af9b..0bf5aab1f 100644 --- a/compiler/src/Reporting/Render/Code.hs +++ b/compiler/src/Reporting/Render/Code.hs @@ -18,6 +18,7 @@ import qualified Data.ByteString.UTF8 as UTF8_BS import qualified Data.Char as Char import qualified Data.IntSet as IntSet import qualified Data.List as List +import qualified Data.Maybe as Maybe import qualified Data.Name as Name import qualified Data.Set as Set import Data.Word (Word16) @@ -146,7 +147,7 @@ renderPair source@(Source sourceLines) region1 region2 = spaces2 = replicate (fromIntegral (startCol2 - endCol1)) ' ' zigzag2 = replicate (fromIntegral (endCol2 - startCol2)) '^' - (Just line) = List.lookup startRow1 sourceLines + line = Maybe.fromJust $ List.lookup startRow1 sourceLines in OneLine $ D.vcat [ D.fromChars lineNumber <> "| " <> D.fromChars line, diff --git a/compiler/src/Reporting/Result.hs b/compiler/src/Reporting/Result.hs index 694791c49..85bbf4d23 100644 --- a/compiler/src/Reporting/Result.hs +++ b/compiler/src/Reporting/Result.hs @@ -83,20 +83,16 @@ instance Applicative (Result i w e) where in kv i1 w1 bad2 good2 in kf i w bad1 good1 -instance Monad (Result i w e) where - return = ok + (*>) (Result ka) (Result kb) = + Result $ \i w bad good -> + let good1 i1 w1 _ = + kb i1 w1 bad good + in ka i w bad good1 +instance Monad (Result i w e) where (>>=) (Result ka) callback = Result $ \i w bad good -> let good1 i1 w1 a = case callback a of Result kb -> kb i1 w1 bad good in ka i w bad good1 - - (>>) (Result ka) (Result kb) = - Result $ \i w bad good -> - let good1 i1 w1 _ = - kb i1 w1 bad good - in ka i w bad good1 - --- PERF add INLINE to these? diff --git a/compiler/src/Type/Unify.hs b/compiler/src/Type/Unify.hs index 249d88f10..95d8c934e 100644 --- a/compiler/src/Type/Unify.hs +++ b/compiler/src/Type/Unify.hs @@ -73,11 +73,12 @@ instance Applicative Unify where in kv vars1 ok2 err in kf vars ok1 err -instance Monad Unify where - return a = - Unify $ \vars ok _ -> - ok vars a + (*>) (Unify ka) (Unify kb) = + Unify $ \vars ok err -> + let ok1 vars1 _ = kb vars1 ok err + in ka vars ok1 err +instance Monad Unify where (>>=) (Unify ka) callback = Unify $ \vars ok err -> let ok1 vars1 a = @@ -85,11 +86,6 @@ instance Monad Unify where Unify kb -> kb vars1 ok err in ka vars ok1 err - (>>) (Unify ka) (Unify kb) = - Unify $ \vars ok err -> - let ok1 vars1 _ = kb vars1 ok err - in ka vars ok1 err - register :: IO Variable -> Unify Variable register mkVar = Unify $ \vars ok _ -> diff --git a/gren.cabal b/gren.cabal index b0697707a..1fa970fd7 100644 --- a/gren.cabal +++ b/gren.cabal @@ -193,9 +193,9 @@ Executable gren Build-depends: ansi-terminal >= 0.11 && < 0.12, ansi-wl-pprint >= 0.6.8 && < 0.7, - base >=4.11 && <5, + base >=4.16 && <5, binary >= 0.8 && < 0.9, - bytestring >= 0.10 && < 0.11, + bytestring >= 0.11 && < 0.12, containers >= 0.6 && < 0.7, directory >= 1.2.3.0 && < 2.0, edit-distance >= 0.2 && < 0.3, diff --git a/terminal/src/Repl.hs b/terminal/src/Repl.hs index 61916e07b..1b325521f 100644 --- a/terminal/src/Repl.hs +++ b/terminal/src/Repl.hs @@ -31,6 +31,7 @@ import qualified Data.ByteString.UTF8 as BS_UTF8 import qualified Data.Char as Char import qualified Data.List as List import qualified Data.Map as Map +import qualified Data.Maybe as Maybe import qualified Data.Name as N import qualified Directories as Dirs import qualified Elm.Constraint as C @@ -423,8 +424,9 @@ attemptEval (Env root interpreter ansi) oldState newState output = interpret :: FilePath -> B.Builder -> IO Exit.ExitCode interpret interpreter javascript = let createProcess = (Proc.proc interpreter []) {Proc.std_in = Proc.CreatePipe} - in Proc.withCreateProcess createProcess $ \(Just stdin) _ _ handle -> + in Proc.withCreateProcess createProcess $ \maybeStdIn _ _ handle -> do + let stdin = Maybe.fromJust maybeStdIn B.hPutBuilder stdin javascript IO.hClose stdin Proc.waitForProcess handle