mirror of
https://github.com/gren-lang/compiler.git
synced 2024-09-11 16:56:29 +03:00
commit
4b9faaa2c1
2
.github/workflows/haskell.yml
vendored
2
.github/workflows/haskell.yml
vendored
@ -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
|
||||
|
@ -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 =
|
||||
|
@ -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 ->
|
||||
|
@ -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)
|
||||
|
@ -1,5 +1,5 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# OPTIONS_GHC -Wall #-}
|
||||
{-# OPTIONS_GHC -Wall -Wno-incomplete-uni-patterns #-}
|
||||
|
||||
module Elm.Compiler.Type
|
||||
( Type (..),
|
||||
|
@ -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 ->
|
||||
|
@ -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 ->
|
||||
|
@ -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#)
|
||||
|
@ -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,
|
||||
|
@ -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?
|
||||
|
@ -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 _ ->
|
||||
|
@ -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,
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user