rhi/quox
rhi/quox
1
0
Fork 0
Code Issues 15 Pull requests 1 Releases Wiki Activity

change some single-character constructor names

Browse source
This commit is contained in:
rhiannon morris 2023-03-08 16:46:29 +01:00
parent 47fca359f4
commit 88985405ce
3 changed files with 158 additions and 140 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

134
lib/Quox/Lexer.idr
View file

@ -16,14 +16,20 @@ import Derive.Prelude
%language ElabReflection %language ElabReflection
||| @ R reserved token ||| @ Reserved reserved token
||| @ I identifier ||| @ Name name, possibly qualified
||| @ N nat literal ||| @ Nat nat literal
||| @ S string literal ||| @ String string literal
||| @ T tag literal ||| @ Tag tag literal
||| @ TYPE "Type" or "★" with subscript ||| @ TYPE "Type" or "★" with subscript
public export public export
data Token = R String | I Name | N Nat | S String | T String | TYPE Nat data Token =
Reserved String
| Name Name
| Nat Nat
| Str String
| Tag String
| TYPE Nat
%runElab derive "Token" [Eq, Ord, Show] %runElab derive "Token" [Eq, Ord, Show]
-- token or whitespace -- token or whitespace
@ -85,7 +91,7 @@ nameL = baseNameL <+> many (is '.' <+> baseNameL)
private private
name : Tokenizer TokenW name : Tokenizer TokenW
name = match nameL $ I . fromList . split (== '.') . normalizeNfc name = match nameL $ Name . fromList . split (== '.') . normalizeNfc
||| [todo] escapes other than `\"` and (accidentally) `\\` ||| [todo] escapes other than `\"` and (accidentally) `\\`
export export
@ -99,16 +105,16 @@ fromStringLit = pack . go . unpack . drop 1 . dropLast 1 where
private private
string : Tokenizer TokenW string : Tokenizer TokenW
string = match stringLit (S . fromStringLit) string = match stringLit (Str . fromStringLit)
private private
nat : Tokenizer TokenW nat : Tokenizer TokenW
nat = match (some (range '0' '9')) (N . cast) nat = match (some (range '0' '9')) (Nat . cast)
private private
tag : Tokenizer TokenW tag : Tokenizer TokenW
tag = match (is '\'' <+> nameL) (T . drop 1) tag = match (is '\'' <+> nameL) (Tag . drop 1)
<|> match (is '\'' <+> stringLit) (T . fromStringLit . drop 1) <|> match (is '\'' <+> stringLit) (Tag . fromStringLit . drop 1)
@ -140,89 +146,91 @@ choice : (xs : List (Tokenizer a)) -> (0 _ : NonEmpty xs) => Tokenizer a
choice (t :: ts) = foldl (\a, b => a <|> b) t ts choice (t :: ts) = foldl (\a, b => a <|> b) t ts
namespace Res namespace Reserved
||| description of a reserved symbol ||| description of a reserved symbol
||| @ W a reserved word (must not be followed by letters, digits, etc) ||| @ Word a reserved word (must not be followed by letters, digits, etc)
||| @ S a reserved symbol (must not be followed by symbolic chars) ||| @ Sym a reserved symbol (must not be followed by symbolic chars)
||| @ X a character that doesn't show up in names (brackets, etc) ||| @ Punc a character that doesn't show up in names (brackets, etc)
public export public export
data Res1 = W String | S String | X Char data Reserved1 = Word String | Sym String | Punc Char
%runElab derive "Res1" [Eq, Ord, Show] %runElab derive "Reserved1" [Eq, Ord, Show]
||| description of a token that might have unicode & ascii-only aliases ||| description of a token that might have unicode & ascii-only aliases
public export public export
data Res = Only Res1 | Or Res1 Res1 data Reserved = Only Reserved1 | Or Reserved1 Reserved1
%runElab derive "Res" [Eq, Ord, Show] %runElab derive "Reserved" [Eq, Ord, Show]
public export public export
S1, W1 : String -> Res Sym1, Word1 : String -> Reserved
S1 = Only . S Sym1 = Only . Sym
W1 = Only . W Word1 = Only . Word
public export public export
X1 : Char -> Res Punc1 : Char -> Reserved
X1 = Only . X Punc1 = Only . Punc
public export public export
resString1 : Res1 -> String resString1 : Reserved1 -> String
resString1 (X x) = singleton x resString1 (Punc x) = singleton x
resString1 (W w) = w resString1 (Word w) = w
resString1 (S s) = s resString1 (Sym s) = s
||| return the representative string for a token description. if there are ||| return the representative string for a token description. if there are
||| two, then it's the first one, which should be the full-unicode one ||| two, then it's the first one, which should be the full-unicode one
public export public export
resString : Res -> String resString : Reserved -> String
resString (Only r) = resString1 r resString (Only r) = resString1 r
resString (r `Or` _) = resString1 r resString (r `Or` _) = resString1 r
private private
resTokenizer1 : Res1 -> String -> Tokenizer TokenW resTokenizer1 : Reserved1 -> String -> Tokenizer TokenW
resTokenizer1 r str = resTokenizer1 r str =
let res : String -> Token := const $ R str in let res : String -> Token := const $ Reserved str in
case r of W w => match (exact w <+> reject idContEnd) res case r of Word w => match (exact w <+> reject idContEnd) res
S s => match (exact s <+> reject symCont) res Sym s => match (exact s <+> reject symCont) res
X x => match (is x) res Punc x => match (is x) res
||| match a reserved token ||| match a reserved token
export export
resTokenizer : Res -> Tokenizer TokenW resTokenizer : Reserved -> Tokenizer TokenW
resTokenizer (Only r) = resTokenizer1 r (resString1 r) resTokenizer (Only r) = resTokenizer1 r (resString1 r)
resTokenizer (r `Or` s) = resTokenizer (r `Or` s) =
resTokenizer1 r (resString1 r) <|> resTokenizer1 s (resString1 r) resTokenizer1 r (resString1 r) <|> resTokenizer1 s (resString1 r)
||| reserved words & symbols. ||| reserved words & symbols.
||| the tokens recognised by ``a `Or` b`` will be `R a`. e.g. `=>` in the input ||| the tokens recognised by ``a `Or` b`` will be `Reserved a`.
||| (if not part of a longer name) will be returned as `R "⇒"`. ||| e.g. `=>` in the input (if not part of a longer name)
||| will be returned as `Reserved "⇒"`.
public export public export
reserved : List Res reserved : List Reserved
reserved = reserved =
[X1 '(', X1 ')', X1 '[', X1 ']', X1 '{', X1 '}', X1 ',', X1 ';', [Punc1 '(', Punc1 ')', Punc1 '[', Punc1 ']', Punc1 '{', Punc1 '}',
S1 "@", Punc1 ',', Punc1 ';',
S1 ":", Sym1 "@",
S "⇒" `Or` S "=>", Sym1 ":",
S "→" `Or` S "->", Sym "⇒" `Or` Sym "=>",
S "×" `Or` S "**", Sym "→" `Or` Sym "->",
S "≡" `Or` S "==", Sym "×" `Or` Sym "**",
S "∷" `Or` S "::", Sym "≡" `Or` Sym "==",
S "·" `Or` X '.', Sym "∷" `Or` Sym "::",
W1 "case", Sym "·" `Or` Punc '.',
W1 "case1", Word1 "case",
W "caseω" `Or` W "case#", Word1 "case1",
W1 "return", Word "caseω" `Or` Word "case#",
W1 "of", Word1 "return",
W1 "_", Word1 "of",
W1 "Eq", Word1 "_",
W "λ" `Or` W "fun", Word1 "Eq",
W "δ" `Or` W "dfun", Word "λ" `Or` Word "fun",
W "ω" `Or` S "#", Word "δ" `Or` Word "dfun",
S "★" `Or` W "Type", Word "ω" `Or` Sym "#",
W1 "def", Sym "★" `Or` Word "Type",
W1 "def0", Word1 "def",
W "defω" `Or` W "def#", Word1 "def0",
S "≔" `Or` S ":="] Word "defω" `Or` Word "def#",
Sym "≔" `Or` Sym ":="]
||| `IsReserved str` is true if `R str` might actually show up in ||| `IsReserved str` is true if `Reserved str` might actually show up in
||| the token stream ||| the token stream
public export public export
IsReserved : String -> Type IsReserved : String -> Type

27
lib/Quox/Parser.idr
View file

@ -19,7 +19,7 @@ Grammar = Core.Grammar () Token
export export
res : (str : String) -> (0 _ : IsReserved str) => Grammar True () res : (str : String) -> (0 _ : IsReserved str) => Grammar True ()
res str = terminal "expecting \"\{str}\"" $ res str = terminal "expecting \"\{str}\"" $
\x => guard $ x == R str \x => guard $ x == Reserved str
export export
resC : (str : String) -> (0 _ : IsReserved str) => Grammar True () resC : (str : String) -> (0 _ : IsReserved str) => Grammar True ()
@ -65,28 +65,28 @@ darr = resC "⇒"
export export
name : Grammar True Name name : Grammar True Name
name = terminal "expecting name" $ name = terminal "expecting name" $
\case I i => Just i; _ => Nothing \case Name i => Just i; _ => Nothing
export export
baseName : Grammar True BaseName baseName : Grammar True BaseName
baseName = terminal "expecting unqualified name" $ baseName = terminal "expecting unqualified name" $
\case I i => guard (null i.mods) $> i.base \case Name i => guard (null i.mods) $> i.base
_ => Nothing _ => Nothing
export export
nat : Grammar True Nat nat : Grammar True Nat
nat = terminal "expecting natural number" $ nat = terminal "expecting natural number" $
\case N n => pure n; _ => Nothing \case Nat n => pure n; _ => Nothing
export export
string : Grammar True String string : Grammar True String
string = terminal "expecting string literal" $ string = terminal "expecting string literal" $
\case S s => pure s; _ => Nothing \case Str s => pure s; _ => Nothing
export export
tag : Grammar True String tag : Grammar True String
tag = terminal "expecting tag constructor" $ tag = terminal "expecting tag constructor" $
\case T t => pure t; _ => Nothing \case Tag t => pure t; _ => Nothing
export export
bareTag : Grammar True String bareTag : Grammar True String
@ -105,7 +105,7 @@ bname = Nothing <$ res "_"
export export
zeroOne : (zero, one : a) -> Grammar True a zeroOne : (zero, one : a) -> Grammar True a
zeroOne zero one = terminal "expecting zero or one" $ zeroOne zero one = terminal "expecting zero or one" $
\case N 0 => Just zero; N 1 => Just one; _ => Nothing \case Nat 0 => Just zero; Nat 1 => Just one; _ => Nothing
export covering export covering
@ -230,14 +230,17 @@ mutual
<|> resC "Eq" *> [|Eq (bracks optBinderTerm) aTerm aTerm|] <|> resC "Eq" *> [|Eq (bracks optBinderTerm) aTerm aTerm|]
<|> [|apply aTerm (many appArg)|] <|> [|apply aTerm (many appArg)|]
where where
data PArg = T PTerm | D PDim data PArg = TermArg PTerm | DimArg PDim
appArg : Grammar True PArg appArg : Grammar True PArg
appArg = [|D $ resC "@" *> dim|] appArg = [|DimArg $ resC "@" *> dim|]
<|> [|T aTerm|] <|> [|TermArg aTerm|]
apply : PTerm -> List PArg -> PTerm apply : PTerm -> List PArg -> PTerm
apply = foldl $ \f, x => case x of T x => f :@ x; D p => f :% p apply = foldl apply1 where
apply1 : PTerm -> PArg -> PTerm
apply1 f (TermArg x) = f :@ x
apply1 f (DimArg p) = f :% p
private covering private covering
aTerm : Grammar True PTerm aTerm : Grammar True PTerm

137
tests/Tests/Lexer.idr
View file

@ -46,97 +46,104 @@ tests = "lexer" :- [
lexes "" [], lexes "" [],
lexes " " [], lexes " " [],
lexes "-- line comment" [], lexes "-- line comment" [],
lexes "name -- line comment" [I "name"], lexes "name -- line comment" [Name "name"],
lexes "-- line comment\nnameBetween -- and another" [I "nameBetween"], lexes "-- line comment\nnameBetween -- and another" [Name "nameBetween"],
lexes "{- block comment -}" [], lexes "{- block comment -}" [],
lexes "{- {- nested -} block comment -}" [] lexes "{- {- nested -} block comment -}" []
], ],
"identifiers & keywords" :- [ "identifiers & keywords" :- [
lexes "abc" [I "abc"], lexes "abc" [Name "abc"],
lexes "abc def" [I "abc", R "def"], lexes "abc def" [Name "abc", Reserved "def"],
lexes "abc_def" [I "abc_def"], lexes "abc_def" [Name "abc_def"],
lexes "abc-def" [I "abc-def"], lexes "abc-def" [Name "abc-def"],
lexes "abc{-comment-}def" [I "abc", R "def"], lexes "abc{-comment-}def" [Name "abc", Reserved "def"],
lexes "λ" [R "λ"], lexes "λ" [Reserved "λ"],
lexes "fun" [R "λ"], lexes "fun" [Reserved "λ"],
lexes "δ" [R "δ"], lexes "δ" [Reserved "δ"],
lexes "dfun" [R "δ"], lexes "dfun" [Reserved "δ"],
lexes "funky" [I "funky"], lexes "funky" [Name "funky"],
lexes "δελτα" [I "δελτα"], lexes "δελτα" [Name "δελτα"],
lexes "★★" [I "★★"], lexes "★★" [Name "★★"],
lexes "Types" [I "Types"], lexes "Types" [Name "Types"],
lexes "a.b.c.d.e" [I $ MakeName [< "a","b","c","d"] "e"], lexes "a.b.c.d.e" [Name $ MakeName [< "a","b","c","d"] "e"],
lexes "normalïse" [I "normalïse"], lexes "normalïse" [Name "normalïse"],
lexes "map#" [I "map#"],
lexes "write!" [I "write!"],
lexes "uhh??!?!?!?" [I "uhh??!?!?!?"],
-- ↑ replace i + combining ¨ with precomposed ï -- ↑ replace i + combining ¨ with precomposed ï
lexes "map#" [Name "map#"],
lexes "write!" [Name "write!"],
lexes "uhh??!?!?!?" [Name "uhh??!?!?!?"],
todo "check for reserved words in a qname", todo "check for reserved words in a qname",
-- lexes "abc.fun.def" [I "abc", R ".", R "λ", R ".", I "def"], {-
lexes "abc.fun.def"
[Name "abc", Reserved ".", Reserved "λ", Reserved ".", Name "def"],
-}
lexes "+" [I "+"], lexes "+" [Name "+"],
lexes "*" [I "*"], lexes "*" [Name "*"],
lexes "**" [R "×"], lexes "**" [Reserved "×"],
lexes "***" [I "***"], lexes "***" [Name "***"],
lexes "+**" [I "+**"], lexes "+**" [Name "+**"],
lexes "+#" [I "+#"], lexes "+#" [Name "+#"],
lexes "+.+.+" [I $ MakeName [< "+", "+"] "+"], lexes "+.+.+" [Name $ MakeName [< "+", "+"] "+"],
lexes "a.+" [I $ MakeName [< "a"] "+"], lexes "a.+" [Name $ MakeName [< "a"] "+"],
lexes "+.a" [I $ MakeName [< "+"] "a"], lexes "+.a" [Name $ MakeName [< "+"] "a"],
lexes "+a" [I "+", I "a"], lexes "+a" [Name "+", Name "a"],
lexes "x." [I "x", R "·"], lexes "x." [Name "x", Reserved "·"],
lexes "&." [I "&", R "·"], lexes "&." [Name "&", Reserved "·"],
lexes ".x" [R "·", I "x"], lexes ".x" [Reserved "·", Name "x"],
lexes "a.b.c." [I $ MakeName [< "a", "b"] "c", R "·"], lexes "a.b.c." [Name $ MakeName [< "a", "b"] "c", Reserved "·"],
lexes "case" [R "case"], lexes "case" [Reserved "case"],
lexes "caseω" [R "caseω"], lexes "caseω" [Reserved "caseω"],
lexes "case#" [R "caseω"], lexes "case#" [Reserved "caseω"],
lexes "case1" [R "case1"], lexes "case1" [Reserved "case1"],
lexes "case0" [I "case0"], lexes "case0" [Name "case0"],
lexes "case##" [I "case##"], lexes "case##" [Name "case##"],
lexes "_" [R "_"], lexes "_" [Reserved "_"],
lexes "_a" [I "_a"], lexes "_a" [Name "_a"],
lexes "a_" [I "a_"], lexes "a_" [Name "a_"],
lexes "a'" [I "a'"], lexes "a'" [Name "a'"],
lexes "+'" [I "+'"] lexes "+'" [Name "+'"]
], ],
"syntax characters" :- [ "syntax characters" :- [
lexes "()" [R "(", R ")"], lexes "()" [Reserved "(", Reserved ")"],
lexes "(a)" [R "(", I "a", R ")"], lexes "(a)" [Reserved "(", Name "a", Reserved ")"],
lexes "(^)" [R "(", I "^", R ")"], lexes "(^)" [Reserved "(", Name "^", Reserved ")"],
lexes "{a,b}" [R "{", I "a", R ",", I "b", R "}"], lexes "{a,b}"
lexes "{+,-}" [R "{", I "+", R ",", I "-", R "}"] [Reserved "{", Name "a", Reserved ",", Name "b", Reserved "}"],
lexes "{+,-}"
[Reserved "{", Name "+", Reserved ",", Name "-", Reserved "}"]
], ],
"tags" :- [ "tags" :- [
lexes #" 'a "# [T "a"], lexes #" 'a "# [Tag "a"],
lexes #" 'abc "# [T "abc"], lexes #" 'abc "# [Tag "abc"],
lexes #" '+ "# [T "+"], lexes #" '+ "# [Tag "+"],
lexes #" '$$$ "# [T "$$$"], lexes #" '$$$ "# [Tag "$$$"],
lexes #" 'tag.with.dots "# [T "tag.with.dots"], lexes #" 'tag.with.dots "# [Tag "tag.with.dots"],
lexes #" '"multi word tag" "# [T "multi word tag"], lexes #" '"multi word tag" "# [Tag "multi word tag"],
lexes #" '"" "# [T ""], lexes #" '"" "# [Tag ""],
lexFail #" ' "#, lexFail #" ' "#,
lexFail #" '' "# lexFail #" '' "#
], ],
"strings" :- [ "strings" :- [
lexes #" "" "# [S ""], lexes #" "" "# [Str ""],
lexes #" "abc" "# [S "abc"], lexes #" "abc" "# [Str "abc"],
lexes #" "\"" "# [S "\""], lexes #" "\"" "# [Str "\""],
lexes #" "\\" "# [S "\\"], lexes #" "\\" "# [Str "\\"],
lexes #" "\\\"" "# [S "\\\""], lexes #" "\\\"" "# [Str "\\\""],
todo "other escapes" todo "other escapes"
], ],
todo "naturals",
"universes" :- [ "universes" :- [
lexes "Type0" [TYPE 0], lexes "Type0" [TYPE 0],
lexes "Type₀" [TYPE 0], lexes "Type₀" [TYPE 0],
@ -144,7 +151,7 @@ tests = "lexer" :- [
lexes "★₀" [TYPE 0], lexes "★₀" [TYPE 0],
lexes "★₆₉" [TYPE 69], lexes "★₆₉" [TYPE 69],
lexes "★4" [TYPE 4], lexes "★4" [TYPE 4],
lexes "Type" [R "★"], lexes "Type" [Reserved "★"],
lexes "★" [R "★"] lexes "★" [Reserved "★"]
] ]
] ]