diff --git a/golden/read/peculiar-identifier-dot/read b/golden/read/peculiar-identifier-dot/read index b907b33..7008166 100644 --- a/golden/read/peculiar-identifier-dot/read +++ b/golden/read/peculiar-identifier-dot/read @@ -1,7 +1,67 @@ -[ SynNone :< SimpleF +[ MkAnn + { syntax = SynNone + , position = Just + ( SourcePos + { sourceName = "golden/read/peculiar-identifier-dot/source.scm" + , sourceLine = Pos 1 + , sourceColumn = Pos 1 + } + ) + } :< SimpleF + ( SimpleSymbol "..." ) +, MkAnn + { syntax = SynNone + , position = Just + ( SourcePos + { sourceName = "golden/read/peculiar-identifier-dot/source.scm" + , sourceLine = Pos 2 + , sourceColumn = Pos 1 + } + ) + } :< SimpleF ( SimpleSymbol ".." ) -, SynNone :< SimpleF +, MkAnn + { syntax = SynNone + , position = Just + ( SourcePos + { sourceName = "golden/read/peculiar-identifier-dot/source.scm" + , sourceLine = Pos 3 + , sourceColumn = Pos 1 + } + ) + } :< SimpleF ( SimpleSymbol ".abc" ) -, SynNone :< SimpleF +, MkAnn + { syntax = SynNone + , position = Just + ( SourcePos + { sourceName = "golden/read/peculiar-identifier-dot/source.scm" + , sourceLine = Pos 4 + , sourceColumn = Pos 1 + } + ) + } :< SimpleF ( SimpleSymbol "....abcc" ) +, MkAnn + { syntax = SynNone + , position = Just + ( SourcePos + { sourceName = "golden/read/peculiar-identifier-dot/source.scm" + , sourceLine = Pos 5 + , sourceColumn = Pos 1 + } + ) + } :< SimpleF + ( SimpleSymbol ".++-" ) +, MkAnn + { syntax = SynNone + , position = Just + ( SourcePos + { sourceName = "golden/read/peculiar-identifier-dot/source.scm" + , sourceLine = Pos 6 + , sourceColumn = Pos 1 + } + ) + } :< SimpleF + ( SimpleSymbol ".-" ) ] \ No newline at end of file diff --git a/golden/read/peculiar-identifier-dot/source.scm b/golden/read/peculiar-identifier-dot/source.scm index 01fdb9d..9a537dc 100644 --- a/golden/read/peculiar-identifier-dot/source.scm +++ b/golden/read/peculiar-identifier-dot/source.scm @@ -1 +1,6 @@ -.. .abc ....abcc +... +.. +.abc +....abcc +.++- +.- diff --git a/golden/read/peculiar-identifier-sign/read b/golden/read/peculiar-identifier-sign/read index 0321ef5..b3c5d89 100644 --- a/golden/read/peculiar-identifier-sign/read +++ b/golden/read/peculiar-identifier-sign/read @@ -20,4 +20,59 @@ ) } :< SimpleF ( SimpleSymbol "-" ) +, MkAnn + { syntax = SynNone + , position = Just + ( SourcePos + { sourceName = "golden/read/peculiar-identifier-sign/source.scm" + , sourceLine = Pos 3 + , sourceColumn = Pos 1 + } + ) + } :< SimpleF + ( SimpleSymbol "+." ) +, MkAnn + { syntax = SynNone + , position = Just + ( SourcePos + { sourceName = "golden/read/peculiar-identifier-sign/source.scm" + , sourceLine = Pos 3 + , sourceColumn = Pos 4 + } + ) + } :< SimpleF + ( SimpleSymbol "+.." ) +, MkAnn + { syntax = SynNone + , position = Just + ( SourcePos + { sourceName = "golden/read/peculiar-identifier-sign/source.scm" + , sourceLine = Pos 3 + , sourceColumn = Pos 8 + } + ) + } :< SimpleF + ( SimpleSymbol "-." ) +, MkAnn + { syntax = SynNone + , position = Just + ( SourcePos + { sourceName = "golden/read/peculiar-identifier-sign/source.scm" + , sourceLine = Pos 3 + , sourceColumn = Pos 11 + } + ) + } :< SimpleF + ( SimpleSymbol "-...abc" ) +, MkAnn + { syntax = SynNone + , position = Just + ( SourcePos + { sourceName = "golden/read/peculiar-identifier-sign/source.scm" + , sourceLine = Pos 3 + , sourceColumn = Pos 19 + } + ) + } :< SimpleF + ( SimpleSymbol "-abc.." ) ] \ No newline at end of file diff --git a/golden/read/peculiar-identifier-sign/source.scm b/golden/read/peculiar-identifier-sign/source.scm index c52cc3a..895c240 100644 --- a/golden/read/peculiar-identifier-sign/source.scm +++ b/golden/read/peculiar-identifier-sign/source.scm @@ -1 +1,3 @@ + - + ++. +.. -. -...abc -abc.. diff --git a/src/Gyehoek/Sexp/Read.hs b/src/Gyehoek/Sexp/Read.hs index 1d6ffb0..3f778af 100644 --- a/src/Gyehoek/Sexp/Read.hs +++ b/src/Gyehoek/Sexp/Read.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ApplicativeDo #-} module Gyehoek.Sexp.Read ( readFile , readString @@ -20,6 +21,7 @@ import qualified Data.Text as T import Data.Char (GeneralCategory(..), generalCategory) import Data.Scientific (Scientific) import Gyehoek.Jalmot +import Data.Foldable readFile :: (Jalmot :> es, IOE :> es) => FilePath -> Eff es (List Datum) @@ -104,18 +106,51 @@ verb = L.symbol sc identifier :: P Text identifier = label "identifier" . lexeme . choice $ - [ typical-- , delimited, peculiar + [ typical + -- , delimited + , peculiar ] where typical = T.cons <$> initial <*> subsequent - where - subsequent = takeWhileP Nothing \c -> - isInitial c || - c `hasCategory` [SpacingCombiningMark, EnclosingMark, DecimalNumber] - || c == '.' || c == '@' || c == '+' || c == '-' - initial = satisfy isInitial + subsequent = takeWhileP Nothing \c -> + isInitial c || + c `hasCategory` [SpacingCombiningMark, EnclosingMark, DecimalNumber] + || c == '.' || c == '@' || c == '+' || c == '-' + initial = satisfy isInitial delimited = _ - peculiar = _ + peculiar = peculiarSign <|> peculiarDot + + -- peculiarSign과 R⁷RS의 이 production 새 개들은 같음: + -- ⟨explicit sign⟩ + -- ⟨explicit sign⟩ ⟨sign subsequent⟩ ⟨subsequent⟩* + -- ⟨explicit sign⟩ . ⟨dot subsequent⟩ ⟨subsequent⟩* + -- 같음: + -- ⟨explicit sign⟩ + -- ((⟨sign subsequent⟩ | . ⟨dot subsequent⟩) ⟨subsequent⟩*)? + peculiarSign = do + sign <- explicitSign + r <- fold <$> optional do + neck <- choice + [ T.singleton <$> signSubsequent + , T.cons <$> single '.' <*> (T.singleton <$> dotSubsequent) + ] + subs <- subsequent + pure $ neck <> subs + pure $ T.cons sign r + + -- . ⟨dot subsequent⟩ ⟨subsequent⟩* + peculiarDot = do + dot <- single '.' + dotSub <- dotSubsequent + subs <- subsequent + pure $ T.cons dot $ T.cons dotSub subs + + dotSubsequent = single '.' <|> signSubsequent + "dot subsequent" + explicitSign = (satisfy \c -> c == '+' || c == '-') + "explicit sign" + signSubsequent = initial <|> explicitSign <|> satisfy (=='@') + "sign subsequent" hasCategory c xs = generalCategory c `elem` xs isInitial c = (c `hasCategory` @@ -207,7 +242,7 @@ simpleDatum = choice , SimpleNumber <$> try number -- , SimpleCharacter <$> character , SimpleString <$> string - , SimpleSymbol <$> symbol + , SimpleSymbol <$> try symbol -- , SimpleBytevector <$> bytevector ] diff --git a/src/Gyehoek/Sexp/Syntax.hs b/src/Gyehoek/Sexp/Syntax.hs index f8d5b4f..83b069a 100644 --- a/src/Gyehoek/Sexp/Syntax.hs +++ b/src/Gyehoek/Sexp/Syntax.hs @@ -69,7 +69,9 @@ data DatumF a | CompoundF (CompoundF a) | LabeledF Label a | LabelRefF Label + -- | Should not be used outside of the "Gyehoek.Sexp.QQ" implementation. | MetaF Text + -- | Should not be used outside of the "Gyehoek.Sexp.QQ" implementation. | MetaSpliceF Text deriving stock (Show, Eq, Data, Generic, Lift, Functor, Foldable, Traversable) deriving anyclass (NFData) @@ -94,7 +96,12 @@ data CompoundF a deriving anyclass (NFData) data Prefix - = Quote | Backtick | Comma | CommaAt + = Quote -- ^ @'@ + | Backtick -- ^ @`@ + | Comma -- ^ @,@ + | CommaAt -- ^ @,\@@ + | PoundQuote -- ^ @#'@ + | PoundBacktick -- ^ @#`@ deriving stock (Show, Eq, Data, Generic, Lift) deriving anyclass (NFData) diff --git a/test/Gyehoek/Test/Sexp/Read.hs b/test/Gyehoek/Test/Sexp/Read.hs index d85d53e..28b87ad 100644 --- a/test/Gyehoek/Test/Sexp/Read.hs +++ b/test/Gyehoek/Test/Sexp/Read.hs @@ -20,7 +20,6 @@ brokenReaderTests :: List String brokenReaderTests = [ "delimited-identifier" , "string-line-continuation" - , "peculiar-identifier-dot" , "meta-splice-expression-interior-brace" , "datum-comment" ]