peculiar identifiers

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
   ]
 

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)