parse lists

golden/reader/list-dot-flat/read

@@ -0,0 +1,25 @@
+[ Fix
+    ( CompoundF
+        ( DotListF
+            ( Fix
+                ( SimpleF
+                    ( Symbol "가" )
+                ) :|
+                [ Fix
+                    ( SimpleF
+                        ( Symbol "나" )
+                    )
+                , Fix
+                    ( SimpleF
+                        ( Symbol "다" )
+                    )
+                ]
+            )
+            ( Fix
+                ( SimpleF
+                    ( Symbol "라" )
+                )
+            )
+        )
+    )
+]

golden/reader/list-dot-flat/source.scm

@@ -0,0 +1 @@
+(가 나 다 . 라)

golden/reader/list-flat/read

@@ -0,0 +1,35 @@
+[ Fix
+    ( CompoundF
+        ( ListF
+            [ Fix
+                ( SimpleF
+                    ( Symbol "가" )
+                )
+            , Fix
+                ( SimpleF
+                    ( Symbol "나" )
+                )
+            , Fix
+                ( SimpleF
+                    ( Symbol "다" )
+                )
+            , Fix
+                ( SimpleF
+                    ( Symbol "라" )
+                )
+            , Fix
+                ( SimpleF
+                    ( Number 1.0 )
+                )
+            , Fix
+                ( SimpleF
+                    ( Number 2.0 )
+                )
+            , Fix
+                ( SimpleF
+                    ( Number 3.0 )
+                )
+            ]
+        )
+    )
+]

golden/reader/list-flat/source.scm

@@ -0,0 +1 @@
+(가 나 다 라 1 2 3)

golden/reader/list/read

@@ -0,0 +1,60 @@
+[ Fix
+    ( CompoundF
+        ( DotListF
+            ( Fix
+                ( SimpleF
+                    ( Symbol "a" )
+                ) :|
+                [ Fix
+                    ( SimpleF
+                        ( Symbol "b" )
+                    )
+                , Fix
+                    ( CompoundF
+                        ( ListF
+                            [ Fix
+                                ( SimpleF
+                                    ( Symbol "c" )
+                                )
+                            , Fix
+                                ( SimpleF
+                                    ( Symbol "d" )
+                                )
+                            ]
+                        )
+                    )
+                ]
+            )
+            ( Fix
+                ( CompoundF
+                    ( ListF
+                        [ Fix
+                            ( SimpleF
+                                ( Symbol "가" )
+                            )
+                        , Fix
+                            ( CompoundF
+                                ( DotListF
+                                    ( Fix
+                                        ( SimpleF
+                                            ( Symbol "나" )
+                                        ) :| []
+                                    )
+                                    ( Fix
+                                        ( SimpleF
+                                            ( Symbol "다" )
+                                        )
+                                    )
+                                )
+                            )
+                        , Fix
+                            ( SimpleF
+                                ( Symbol "라" )
+                            )
+                        ]
+                    )
+                )
+            )
+        )
+    )
+]

golden/reader/list/source.scm

@@ -0,0 +1 @@
+(a b (c d) . (가 (나 . 다) 라))

golden/reader/typical-identifier/read

@@ -26,4 +26,12 @@
     ( SimpleF
         ( Symbol "學" )
     )
+, Fix
+    ( SimpleF
+        ( Symbol "車室." )
+    )
+, Fix
+    ( SimpleF
+        ( Symbol "三個女人一臺戲。" )
+    )
 ]

golden/reader/typical-identifier/source.scm

@@ -1 +1,5 @@
 abc balahwa$ x!!! z z123 나는너무졸리다 學
+
+車室.
+
+三個女人一臺戲。

src/Gyehoek/Sexp/Read.hs

@@ -11,7 +11,7 @@ import Gyehoek.Prelude hiding (Simple, (:<))
 import qualified Data.Text.IO as T
 import System.IO (stderr, hPutStrLn)
 import Prelude hiding (readFile)
-import Data.Functor (($>))
+import Data.Functor (($>), void)
 import qualified Data.Text as T
 import Data.Char (GeneralCategory(..), generalCategory)
 import Control.Exception hiding (try)
@@ -57,25 +57,28 @@ verb = L.symbol sc
 identifier :: P Text
 identifier = label "identifier" . lexeme . choice $
   [ typical-- , delimited, peculiar
-                    ]
+  ]
   where
     typical = T.cons <$> initial <*> subsequent
       where
-        subsequent = takeWhileP Nothing identChar
-        initial = satisfy \c ->
-          identChar c && not (c `hasCategory`
-            [DecimalNumber,SpacingCombiningMark,EnclosingMark])
+        subsequent = takeWhileP Nothing \c ->
+          isInitial c ||
+          c `hasCategory` [SpacingCombiningMark, EnclosingMark, DecimalNumber]
+          || c == '.' || c == '@' || c == '+' || c == '-'
+        initial = satisfy isInitial
     delimited = _
     peculiar = _
 
     hasCategory c xs = generalCategory c `elem` xs
-    identChar c = c `hasCategory`
+    isInitial c = (c `hasCategory`
       [ UppercaseLetter, LowercaseLetter, TitlecaseLetter, ModifierLetter
-      , OtherLetter, SpacingCombiningMark, EnclosingMark, DecimalNumber
+      , OtherLetter
+      -- , SpacingCombiningMark, EnclosingMark, DecimalNumber
       , LetterNumber, OtherNumber, DashPunctuation, ConnectorPunctuation
-      , OpenPunctuation, CurrencySymbol, OtherPunctuation, MathSymbol
+      , CurrencySymbol, OtherPunctuation, MathSymbol
       , ModifierSymbol, OtherSymbol, PrivateUse ]
-      || c == '\x200c' || c == '\x200d'
+      || c == '\x200c' || c == '\x200d')
+      && c /= ';' && c /= '|' && c /= '"' && c /= '.'
 
 boolean :: P Bool
 boolean = label "boolean" . lexeme $ choice
@@ -98,6 +101,18 @@ number = label "number" . lexeme $ num
 
 lparen = lexeme $ char '('
 rparen = lexeme $ char ')'
+dot = lexeme $ char '.'
+verticalLine = lexeme $ char '|'
+
+-- delimiter :: P ()
+-- delimiter = choice
+--   [ sc
+--   , void verticalLine
+--   , void lparen
+--   , void rparen
+--   , void (char '"')
+--   , void (char ';')
+--   ]
 
 string :: P Text
 string = label "string" . lexeme $
@@ -116,8 +131,8 @@ file = many datum <* eof
 
 datum :: P Datum
 datum = choice
-  [ Fix . SimpleF <$> simpleDatum
-  -- , Fix . CompoundF <$> compoundDatum
+  [ Fix . CompoundF <$> compoundDatum
+  , Fix . SimpleF <$> simpleDatum
   -- , labeled
   -- , labelRef
   ]
@@ -131,3 +146,18 @@ simpleDatum = choice
   , Symbol <$> symbol
   -- , Bytevector <$> bytevector
   ]
+
+compoundDatum :: P Compound
+compoundDatum = choice
+  [ list
+  ]
+
+list :: P Compound
+list = label "list" . between lparen rparen $ do
+  optional datum >>= \case
+    Nothing -> pure $ ListF []
+    Just x -> do
+      xs <- many datum
+      optional (dot *> datum) >>= \case
+        Nothing -> pure $ ListF (x:xs)
+        Just y -> pure $ DotListF (x:|xs) y

src/Gyehoek/Sexp/Syntax.hs

@@ -11,6 +11,7 @@ module Gyehoek.Sexp.Syntax
   , Datum
   , Cofree((:<))
   , Fix(..)
+  , Compound
   ) where
 
 import Language.Haskell.TH.Syntax (Lift)
@@ -74,3 +75,4 @@ deriveShow1 ''DatumF
 
 
 type Datum = Fix DatumF
+type Compound = CompoundF Datum