gren-lang/compiler
1
1
Fork 0
mirror of https://github.com/gren-lang/compiler.git synced 2024-09-11 16:56:29 +03:00
Code Issues Actions Packages Projects Releases Wiki Activity

Merge pull request #27 from gren-lang/upgrade-ghc

Browse Source 
Upgrade GHC to 9.2.1
This commit is contained in:
Robin Heggelund Hansen 2022-02-11 12:06:45 +01:00 committed by GitHub
commit 4b9faaa2c1
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
13 changed files with 46 additions and 60 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.github/workflows/haskell.yml vendored
View File

@ -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

3
builder/src/Deps/Solver.hs
View File

@ -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 =

8
compiler/src/Data/Name.hs
View File

@ -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 ->

28
compiler/src/Data/Utf8.hs
View File

@ -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)

2
compiler/src/Elm/Compiler/Type.hs
View File

@ -1,5 +1,5 @@
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_GHC -Wall -Wno-incomplete-uni-patterns #-}
module Elm.Compiler.Type
( Type (..),

9
compiler/src/Json/Decode.hs
View File

@ -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 ->

9
compiler/src/Parse/Primitives.hs
View File

@ -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 ->

4
compiler/src/Parse/Variable.hs
View File

@ -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#)

3
compiler/src/Reporting/Render/Code.hs
View File

@ -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,

16
compiler/src/Reporting/Result.hs
View File

@ -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?

14
compiler/src/Type/Unify.hs
View File

@ -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 _ ->

4
gren.cabal
View File

@ -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,

4
terminal/src/Repl.hs
View File

@ -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