lexer

tests/Tests.idr

@@ -4,6 +4,7 @@ import TAP
 import Tests.Reduce
 import Tests.Equal
 import Tests.Typechecker
+import Tests.Lexer
 import System
 
 
@@ -11,7 +12,8 @@ allTests : List Test
 allTests = [
   Reduce.tests,
   Equal.tests,
-  Typechecker.tests
+  Typechecker.tests,
+  Lexer.tests
 ]
 
 main : IO ()

tests/Tests/Lexer.idr

@@ -0,0 +1,150 @@
+module Tests.Lexer
+
+import Quox.Name
+import Quox.Lexer
+import Text.Lexer.Tokenizer
+import TAP
+
+
+private
+data Failure = LexError Lexer.Error
+             | WrongLex (List Token) (List Token)
+             | ExpectedFail (List Token)
+
+private
+ToInfo Failure where
+  toInfo (LexError err) =
+    [("type", "LexError"),
+     ("info", show err)]
+  toInfo (WrongLex want got) =
+    [("type", "WrongLex"),
+     ("want", show want),
+     ("got",  show got)]
+  toInfo (ExpectedFail got) =
+    [("type", "ExpectedFail"),
+     ("got",  show got)]
+
+
+private
+denewline : String -> String
+denewline = pack . map (\case '\n' => '␤'; c => c) . unpack
+
+private
+lexes : String -> List Token -> Test
+lexes str toks = test "｢\{denewline str}｣" {e = Failure} $
+  case lex str of
+    Left  err => throwError $ LexError err
+    Right res =>
+      let res = map val res in
+      unless (toks == res) $ throwError $ WrongLex toks res
+
+private
+lexFail : String -> Test
+lexFail str = test "｢\{denewline str}｣   # fails" {e = Failure} $
+  case lex str of
+    Left  err => pure ()
+    Right res => throwError $ ExpectedFail $ map val res
+
+export
+tests : Test
+tests = "lexer" :- [
+  "comments" :- [
+    lexes "" [],
+    lexes "    " [],
+    lexes "-- line comment" [],
+    lexes "name -- line comment" [I "name"],
+    lexes "-- line comment\nnameBetween -- and another" [I "nameBetween"],
+    lexes "{- block comment -}" [],
+    lexes "{- {- nested -} block comment -}" []
+  ],
+
+  "identifiers & keywords" :- [
+    lexes "abc" [I "abc"],
+    lexes "abc def" [I "abc", I "def"],
+    lexes "abc{-comment-}def" [I "abc", I "def"],
+    lexes "λ" [R "λ"],
+    lexes "fun" [R "λ"],
+    lexes "δ" [R "δ"],
+    lexes "dfun" [R "δ"],
+    lexes "funky" [I "funky"],
+    lexes "δελτα" [I "δελτα"],
+    lexes "a.b.c.d.e" [I $ MakeName [< "a","b","c","d"] "e"],
+    lexes "normalïse" [I "normalïse"],
+      -- ↑ replace i + combining ¨ with precomposed ï
+
+    todo "check for reserved words in a qname",
+    -- lexes "abc.fun.def" [I "abc", R ".", R "λ", R ".", I "def"],
+
+    lexes "+" [I "+"],
+    lexes "*" [I "*"],
+    lexes "**" [R "×"],
+    lexes "***" [I "***"],
+    lexes "+**" [I "+**"],
+    lexes "+.+.+" [I $ MakeName [< "+", "+"] "+"],
+    lexes "a.+" [I $ MakeName [< "a"] "+"],
+    lexes "+.a" [I $ MakeName [< "+"] "a"],
+
+    lexes "+a" [I "+", I "a"],
+
+    lexes "x." [I "x", R "."],
+    lexes "&." [I "&", R "."],
+    lexes ".x" [R ".", I "x"],
+    lexes "a.b.c." [I $ MakeName [< "a", "b"] "c", R "."],
+
+    lexes "case" [R "case"],
+    lexes "caseω" [R "caseω"],
+    lexes "case#" [R "caseω"],
+    lexes "case1" [R "case1"],
+    lexes "case0" [I "case0"],
+    lexes "case##" [I "case##"],
+
+    lexes "_" [R "_"],
+    lexes "_a" [I "_a"],
+    lexes "a_" [I "a_"],
+
+    lexes "a'" [I "a'"],
+    lexes "+'" [I "+'"],
+    lexFail "'+"
+  ],
+
+  "syntax characters" :- [
+    lexes "()" [R "(", R ")"],
+    lexes "(a)" [R "(", I "a", R ")"],
+    lexes "(^)" [R "(", I "^", R ")"],
+    lexes "`{a,b}" [R "`{", I "a", R ",", I "b", R "}"],
+    lexes "`{+,-}" [R "`{", I "+", R ",", I "-", R "}"],
+    lexFail "` {}",
+    -- [todo] should this be lexed as "`{", "-", "mid", etc?
+    lexFail "`{-mid token comment-}{}"
+  ],
+
+  "tags" :- [
+    lexes "`a" [T "a"],
+    lexes "`abc" [T "abc"],
+    lexes "`+" [T "+"],
+    lexes "`$$$" [T "$$$"],
+    lexes #"`"multi word tag""# [T "multi word tag"],
+    lexFail "`",
+    lexFail "``"
+  ],
+
+  "strings" :- [
+    lexes #" "" "# [S ""],
+    lexes #" "abc" "# [S "abc"],
+    lexes #" "\"" "# [S "\""],
+    lexes #" "\\" "# [S "\\"],
+    lexes #" "\\\"" "# [S "\\\""],
+    todo "other escapes"
+  ],
+
+  "universes" :- [
+    lexes "Type0" [TYPE 0],
+    lexes "Type₀" [TYPE 0],
+    lexes "Type9999999" [TYPE 9999999],
+    lexes "★₀" [TYPE 0],
+    lexes "★₆₉" [TYPE 69],
+    lexes "★4" [TYPE 4],
+    lexes "Type" [R "★"],
+    lexes "★" [R "★"]
+  ]
+]