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

simplify lexical grammar

Browse source 
this is a core language after all
This commit is contained in:
rhiannon morris 2022-05-07 21:26:16 +02:00
parent 1c8b2b205b
commit 809a0fc859
2 changed files with 31 additions and 75 deletions
Download patch file Download diff file Expand all files Collapse all files

72
lib/Quox/Lexer.idr
View file

@ -27,17 +27,12 @@ nameCont = pred $ \c => isAlphaNum c || c == '_' || c == '\''
name = nameStart <+> many nameCont <+> reject nameCont
wild = exact "_" <+> reject nameCont
wild = is '_' <+> reject nameCont
%hide Text.Lexer.symbol
symbol = exact "'" <+> name
symbol = is '\'' <+> name
number : Lexer -> Lexer
number char = char <+> many (opt (is '_') <+> char) <+> reject nameCont
octal = approx "0o" <+> number octDigit
decimal = number digit
hexadecimal = approx "0x" <+> number hexDigit
decimal = some digit <+> reject nameCont
natToNumber : Nat -> Number
@ -46,32 +41,11 @@ natToNumber 1 = One
natToNumber k = Other k
toHexit : Char -> Nat
toHexit c = cast $
if '0' <= c && c <= '9' then
ord c - ord '0'
else if 'a' <= c && c <= 'f' then
ord c - ord 'a' + 10
else if 'A' <= c && c <= 'F' then
ord c - ord 'A' + 10
else 0
parameters (base : Nat) (single : Char -> Nat)
makeNat : Nat -> List Char -> Nat
makeNat acc [] = acc
makeNat acc ('_' :: lst) = makeNat acc lst
makeNat acc (d :: lst) = makeNat (acc * base + single d) lst
makeOct = makeNat 8 toHexit 0 . unpack
makeDec = makeNat 10 toHexit 0 . unpack
makeHex = makeNat 16 toHexit 0 . unpack
skip : Lexer -> Tokenizer (Maybe a)
skip lex = match lex $ const Nothing
simple : List String -> a -> Tokenizer (Maybe a)
simple strs = match (choice $ map exact strs) . const . Just
simple : Char -> a -> Tokenizer (Maybe a)
simple ch = match (is ch) . const . Just
keyword : String -> Keyword -> Tokenizer (Maybe Token)
keyword str = match (exact str <+> reject nameCont) . const . Just . K
@ -90,31 +64,31 @@ tokens = choice [
skip $ blockComment (exact "{-") (exact "-}"),
skip spaces,
simple ["("] $ P LParen, simple [")"] $ P RParen,
simple ["["] $ P LSquare, simple ["]"] $ P RSquare,
simple ["{"] $ P LBrace, simple ["}"] $ P RBrace,
simple [","] $ P Comma,
simple ["::", "∷"] $ P DblColon,
simple [":"] $ P Colon, -- needs to be after "::"
simple ["."] $ P Dot,
simple '(' $ P LParen, simple ')' $ P RParen,
simple '[' $ P LSquare, simple ']' $ P RSquare,
simple '{' $ P LBrace, simple '}' $ P RBrace,
simple ',' $ P Comma,
simple '∷' $ P DblColon,
simple ':' $ P Colon, -- needs to be after '::'
simple '.' $ P Dot,
simple ["->", "→"] $ P Arrow,
simple ["=>", "⇒"] $ P DblArrow,
simple ["**", "×"] $ P Times,
simple ["<<", "⊲"] $ P Triangle,
simple '→' $ P Arrow,
simple '⇒' $ P DblArrow,
simple '×' $ P Times,
simple '⊲' $ P Triangle,
match wild $ const $ P Wild,
keyword "fun" Fun, keyword "λ" Fun,
keyword "let" Let, keyword "in" In,
keyword "case" Case, keyword "of" Of,
keyword "ω" Omega, simple ["#"] $ K Omega,
keyword "λ" Lam,
keyword "let" Let, keyword "in" In,
keyword "case" Case, keyword "of" Of,
keyword "ω" Omega,
keyword "Π" Pi, keyword "Σ" Sigma, keyword "W" W,
simple '★' $ K TYPE,
match name $ Name,
match symbol $ Symbol . assert_total strTail,
match decimal $ N . natToNumber . makeDec,
match hexadecimal $ N . natToNumber . makeHex . drop 2,
match octal $ N . natToNumber . makeOct . drop 2
match decimal $ N . natToNumber . cast
]