move name lexing stuff to Quox.Name

This commit is contained in:
rhiannon morris 2023-03-16 18:34:49 +01:00
parent b9825fee55
commit be94422668
2 changed files with 35 additions and 32 deletions

View file

@ -3,6 +3,8 @@ module Quox.Name
import public Data.SnocList
import Data.List
import Derive.Prelude
import Quox.CharExtra
import Text.Lexer
%hide TT.Name
@ -95,3 +97,34 @@ fromListP (x ::: xs) = go [<] x xs where
export %inline
fromList : List1 String -> Name
fromList = fromPName . fromListP
export
syntaxChars : List Char
syntaxChars = ['(', ')', '[', ']', '{', '}', '"', '\'', ',', '.', ';']
export
isSymStart, isSymCont : Char -> Bool
isSymStart c = not (c `elem` syntaxChars) && isSymChar c
isSymCont c = c == '\'' || isSymStart c
export
idStart, idCont, idEnd, idContEnd : Lexer
idStart = pred isIdStart
idCont = pred isIdCont
idEnd = pred $ \c => c `elem` unpack "?!#"
idContEnd = idCont <|> idEnd
export
symStart, symCont : Lexer
symStart = pred isSymStart
symCont = pred isSymCont
export
baseName : Lexer
baseName = idStart <+> many idCont <+> many idEnd
<|> symStart <+> many symCont
export
name : Lexer
name = baseName <+> many (is '.' <+> baseName)

View file

@ -59,39 +59,9 @@ match t f = Tokenizer.match t (Just . f)
%hide Tokenizer.match
export %inline
syntaxChars : List Char
syntaxChars = ['(', ')', '[', ']', '{', '}', '"', '\'', ',', '.', ';']
private
isSymStart, isSymCont : Char -> Bool
isSymStart c = not (c `elem` syntaxChars) && isSymChar c
isSymCont c = c == '\'' || isSymStart c
private
idStart, idCont, idEnd, idContEnd : Lexer
idStart = pred isIdStart
idCont = pred isIdCont
idEnd = pred $ \c => c `elem` unpack "?!#"
idContEnd = idCont <|> idEnd
private
symStart, symCont : Lexer
symStart = pred isSymStart
symCont = pred isSymCont
private
baseNameL : Lexer
baseNameL = idStart <+> many idCont <+> many idEnd
<|> symStart <+> many symCont
private
nameL : Lexer
nameL = baseNameL <+> many (is '.' <+> baseNameL)
private
name : Tokenizer TokenW
name = match nameL $ Name . fromListP . split (== '.') . normalizeNfc
name = match name $ Name . fromListP . split (== '.') . normalizeNfc
||| [todo] escapes other than `\"` and (accidentally) `\\`
export
@ -113,7 +83,7 @@ nat = match (some (range '0' '9')) (Nat . cast)
private
tag : Tokenizer TokenW
tag = match (is '\'' <+> nameL) (Tag . drop 1)
tag = match (is '\'' <+> name) (Tag . drop 1)
<|> match (is '\'' <+> stringLit) (Tag . fromStringLit . drop 1)