@@ -340,16 +340,8 @@ varPrim isGoodFirstChar =
340340 (# newOffset, newLength, newCol #) =
341341 varPrimHelp array (offset + size) (length - size) (col + 1)
342342
343− !newSize =
344− newOffset - offset
345−
346− makeArray =
347− do mutableArray <- Text.new newSize
348− Text.copyI mutableArray 0 array offset newSize
349− return mutableArray
350−
351343 copiedText =
352− Text.Text (Text.run makeArray) 0 newSize
344+ copyText array offset (newOffset - offset)
353345 in
354346 if Set.member copiedText keywords then
355347 eerr (loneTheory row newCol Variable)
@@ -360,6 +352,18 @@ varPrim isGoodFirstChar =
360352 eerr (loneTheory row col Variable)
361353
362354
355+{-# INLINE copyText #-}
356+copyText :: Text.Array -> Int -> Int -> Text.Text
357+copyText array offset size =
358+ let
359+ makeArray =
360+ do mutableArray <- Text.new size
361+ Text.copyI mutableArray 0 array offset size
362+ return mutableArray
363+ in
364+ Text.Text (Text.run makeArray) 0 size
365+
366+
363367{-# INLINE peek #-}
364368peek :: Text.Array -> Int -> Text.Iter
365369peek array offset =
@@ -428,22 +432,13 @@ infixOp =
428432 cerr err
429433
430434 Right ( newOffset, newLength, newCol ) ->
431− let
432− !newSize =
433− newOffset - offset
434−
435− makeArray =
436− do mutableArray <- Text.new newSize
437− Text.copyI mutableArray 0 array offset newSize
438− return mutableArray
439− in
440− case Text.Text (Text.run makeArray) 0 newSize of
441− "=" -> cerr (ParseError row col Dot)
442− "|" -> cerr (ParseError row col Pipe)
443− ":" -> cerr (ParseError row col Arrow)
444− "." -> cerr (ParseError row col Equals)
445− "->" -> cerr (ParseError row col HasType)
446− op -> cok op (State array newOffset newLength indent row newCol)
435+ case copyText array offset (newOffset - offset) of
436+ "=" -> cerr (ParseError row col Dot)
437+ "|" -> cerr (ParseError row col Pipe)
438+ ":" -> cerr (ParseError row col Arrow)
439+ "." -> cerr (ParseError row col Equals)
440+ "->" -> cerr (ParseError row col HasType)
441+ op -> cok op (State array newOffset newLength indent row newCol)
447442
448443
449444infixOpHelp :: Text.Array -> Int -> Int -> Int -> Int -> Either ParseError (Int, Int, Int)
@@ -645,19 +640,9 @@ docComment =
645640 cerr err
646641
647642 Right (newOffset, newLength, newRow, newCol) ->
648− let
649− !newSize =
650− newOffset - offset
651−
652− makeArray =
653− do mutableArray <- Text.new newSize
654− Text.copyI mutableArray 0 array offset newSize
655− return mutableArray
656−
657− comment =
658− Text.Text (Text.run makeArray) 0 newSize
659− in
660− cok comment (State array newOffset newLength indent newRow newCol)
643+ cok
644+ (copyText array offset (newOffset - offset))
645+ (State array newOffset newLength indent newRow newCol)
661646
662647
663648
@@ -739,13 +724,8 @@ singleString array offset length row col initialOffset builder =
739724 Left err ->
740725 Left err
741726
742− Right ( size, char ) ->
743− let
744− !newOffset = offset + size
745− chunk = Text.Text array initialOffset (offset - initialOffset)
746− newBuilder = builder <> LB.fromText chunk <> LB.singleton char
747− in
748− singleString array newOffset (length - size) row (col + size) newOffset newBuilder
727+ Right size ->
728+ singleString array (offset + size) (length - size) row (col + size) initialOffset builder
749729
750730 else if word < 0xD800 || word > 0xDBFF then
751731 singleString array (offset + 1) (length - 1) row (col + 1) initialOffset builder
@@ -754,58 +734,34 @@ singleString array offset length row col initialOffset builder =
754734 singleString array (offset + 2) (length - 2) row (col + 1) initialOffset builder
755735
756736
757−eatEscape :: Text.Array -> Int -> Int -> Int -> Int -> Problem -> Either ParseError ( Int, Char )
737+eatEscape :: Text.Array -> Int -> Int -> Int -> Int -> Problem -> Either ParseError Int
758738eatEscape array offset length row col problem =
759739 if length == 0 then
760740 Left (ParseError row col problem)
761741
762742 else
763743 case Text.unsafeIndex array offset of
764− 0x0061 {- a -} -> Right ( 2, '\a' )
765− 0x0062 {- b -} -> Right ( 2, '\b' )
766− 0x0066 {- f -} -> Right ( 2, '\f' )
767− 0x006E {- n -} -> Right ( 2, '\n' )
768− 0x0072 {- r -} -> Right ( 2, '\r' )
769− 0x0074 {- t -} -> Right ( 2, '\t' )
770− 0x0076 {- v -} -> Right ( 2, '\v' )
771− 0x0022 {- " -} -> Right ( 2, '\"' )
772− 0x005C {- \ -} -> Right ( 2, '\\' )
773− 0x0027 {- ' -} -> Right ( 2, '\'' )
774− 0x0078 {- x -} ->
775− case eatHex array (offset + 1) (length - 1) 0 of
776− Nothing ->
777− Left (ParseError row col BadEscape)
778−
779− Just (newOffset, code) ->
780− if code <= 0x10FFFF then
781− Right ( 1 + (newOffset - offset), toEnum (fromInteger code) )
782− else
783− Left (ParseError row col BadEscape)
784−
744+ 0x0061 {- a -} -> Right 2
745+ 0x0062 {- b -} -> Right 2
746+ 0x0066 {- f -} -> Right 2
747+ 0x006E {- n -} -> Right 2
748+ 0x0072 {- r -} -> Right 2
749+ 0x0074 {- t -} -> Right 2
750+ 0x0076 {- v -} -> Right 2
751+ 0x0022 {- " -} -> Right 2
752+ 0x005C {- \ -} -> Right 2
753+ 0x0027 {- ' -} -> Right 2
754+ 0x0075 {- u -} | length >= 5 && fourHex array offset -> Right 6
785755 _ ->
786756 Left (ParseError row col BadEscape)
787757
788758
789−eatHex :: Text.Array -> Int -> Int -> Integer -> Maybe ( Int, Integer )
790−eatHex array offset length n =
791− if length < 3 then
792− Nothing
793−
794− else
795− let
796− !word = Text.unsafeIndex array offset
797− in
798− if 0x0030 <= word && word <= 0x0039 then
799− eatHex array (offset + 1) (length - 1) (16 * n + fromIntegral (word - 0x0030))
800−
801− else if 0x0061 <= word && word <= 0x0066 then
802− eatHex array (offset + 1) (length - 1) (16 * n + 10 + fromIntegral (word - 0x0061))
803−
804− else if 0x0041 <= word && word <= 0x0046 then
805− eatHex array (offset + 1) (length - 1) (16 * n + 10 + fromIntegral (word - 0x0041))
806−
807− else
808− Just (offset, n)
759+fourHex :: Text.Array -> Int -> Bool
760+fourHex array offset =
761+ isHex (Text.unsafeIndex array (offset + 1))
762+ && isHex (Text.unsafeIndex array (offset + 2))
763+ && isHex (Text.unsafeIndex array (offset + 3))
764+ && isHex (Text.unsafeIndex array (offset + 4))
809765
810766
811767
@@ -854,13 +810,8 @@ multiString array offset length row col initialOffset builder =
854810 Left err ->
855811 Left err
856812
857− Right ( size, char ) ->
858− let
859− !newOffset = offset + size
860− chunk = Text.Text array initialOffset (offset - initialOffset)
861− newBuilder = builder <> LB.fromText chunk <> LB.singleton char
862− in
863− multiString array newOffset (length - size) row (col + size) newOffset newBuilder
813+ Right size ->
814+ multiString array (offset + size) (length - size) row (col + size) initialOffset builder
864815
865816 else if word < 0xD800 || word > 0xDBFF then
866817 multiString array (offset + 1) (length - 1) row (col + 1) initialOffset builder
@@ -873,7 +824,7 @@ multiString array offset length row col initialOffset builder =
873824-- CHARACTER
874825
875826
876−character :: Parser Char
827+character :: Parser Text
877828character =
878829 Parser $ \(State array offset length indent row col) cok cerr _ eerr ->
879830 if length == 0 then
@@ -891,40 +842,37 @@ character =
891842 Left err ->
892843 cerr err
893844
894− Right ( size, char ) ->
845+ Right (endCol, size) ->
895846 let
896847 !newOffset = offset + size + 1
897848 !newLength = length - size - 1
898849 in
899− if newLength == 0 then
850+ if newLength == 0 || Text.unsafeIndex array newOffset /= 0x0027 {- ' -} then
900851 cerr (ParseError row col BadChar)
901852
902− else if Text.unsafeIndex array newOffset == 0x0027 {- ' -} then
903− cok char (State array (newOffset + 1) (newLength - 1) indent row (col + size + 2))
904−
905853 else
906− cerr (ParseError row col BadChar)
854+ cok
855+ (copyText array (offset + 1) size)
856+ (State array (newOffset + 1) (newLength - 1) indent row endCol)
907857
908858
909−characterHelp :: Text.Array -> Int -> Int -> Int -> Int -> Either ParseError ( Int, Char )
859+characterHelp :: Text.Array -> Int -> Int -> Int -> Int -> Either ParseError ( Int, Int )
910860characterHelp array offset length row col =
911861 let
912862 !word = Text.unsafeIndex array offset
913863 in
914− if word == 0x0027 {- ' -} then
864+ if word == 0x0027 {- ' -} || word == 0x000A {- \n -} then
915865 Left (ParseError row col BadChar)
916866
917867 else if word == 0x005C {- \ -} then
918− eatEscape array (offset + 1) (length - 1) row (col + 1) BadChar
919−
920− else if word == 0x000A {- \n -} then
921− Left (ParseError row col BadChar)
868+ do n <- eatEscape array (offset + 1) (length - 1) row (col + 1) BadChar
869+ return (col + n + 2, n)
922870
923871 else if word < 0xD800 || word > 0xDBFF then
924− Right (1, unsafeChr word)
872+ Right (col + 3, 1)
925873
926874 else if length > 2 then
927− Right (2, chr2 word (Text.unsafeIndex array offset))
875+ Right (col + 3, 2)
928876
929877 else
930878 Left (ParseError row col BadChar)