diff --git a/golden/reader/list-dot-flat/read b/golden/reader/list-dot-flat/read new file mode 100644 index 0000000..1276fe6 --- /dev/null +++ b/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 "라" ) + ) + ) + ) + ) +] \ No newline at end of file diff --git a/golden/reader/list-dot-flat/source.scm b/golden/reader/list-dot-flat/source.scm new file mode 100644 index 0000000..13788b9 --- /dev/null +++ b/golden/reader/list-dot-flat/source.scm @@ -0,0 +1 @@ +(가 나 다 . 라) diff --git a/golden/reader/list-flat/read b/golden/reader/list-flat/read new file mode 100644 index 0000000..3bd5792 --- /dev/null +++ b/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 ) + ) + ] + ) + ) +] \ No newline at end of file diff --git a/golden/reader/list-flat/source.scm b/golden/reader/list-flat/source.scm new file mode 100644 index 0000000..d72527e --- /dev/null +++ b/golden/reader/list-flat/source.scm @@ -0,0 +1 @@ +(가 나 다 라 1 2 3) diff --git a/golden/reader/list/read b/golden/reader/list/read new file mode 100644 index 0000000..4db4f9a --- /dev/null +++ b/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 "라" ) + ) + ] + ) + ) + ) + ) + ) +] \ No newline at end of file diff --git a/golden/reader/list/source.scm b/golden/reader/list/source.scm new file mode 100644 index 0000000..7b19db2 --- /dev/null +++ b/golden/reader/list/source.scm @@ -0,0 +1 @@ +(a b (c d) . (가 (나 . 다) 라)) diff --git a/golden/reader/typical-identifier/read b/golden/reader/typical-identifier/read index 31a3925..1a8cb2e 100644 --- a/golden/reader/typical-identifier/read +++ b/golden/reader/typical-identifier/read @@ -4,7 +4,7 @@ ) , Fix ( SimpleF - ( Symbol "balahwa$" ) + ( Symbol "bala-hwa$" ) ) , Fix ( SimpleF @@ -26,4 +26,12 @@ ( SimpleF ( Symbol "學" ) ) +, Fix + ( SimpleF + ( Symbol "車室." ) + ) +, Fix + ( SimpleF + ( Symbol "三個女人一臺戲。" ) + ) ] \ No newline at end of file diff --git a/golden/reader/typical-identifier/source.scm b/golden/reader/typical-identifier/source.scm index bfcfcf8..95d49bc 100644 --- a/golden/reader/typical-identifier/source.scm +++ b/golden/reader/typical-identifier/source.scm @@ -1 +1,5 @@ -abc balahwa$ x!!! z z123 나는너무졸리다 學 +abc bala-hwa$ x!!! z z123 나는너무졸리다 學 + +車室. + +三個女人一臺戲。 diff --git a/src/Gyehoek/Sexp/Read.hs b/src/Gyehoek/Sexp/Read.hs index 0eb5e4d..711c22a 100644 --- a/src/Gyehoek/Sexp/Read.hs +++ b/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 diff --git a/src/Gyehoek/Sexp/Syntax.hs b/src/Gyehoek/Sexp/Syntax.hs index e63420c..ae10e19 100644 --- a/src/Gyehoek/Sexp/Syntax.hs +++ b/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