move name lexing stuff to Quox.Name
This commit is contained in:
parent
b9825fee55
commit
be94422668
2 changed files with 35 additions and 32 deletions
|
@ -3,6 +3,8 @@ module Quox.Name
|
||||||
import public Data.SnocList
|
import public Data.SnocList
|
||||||
import Data.List
|
import Data.List
|
||||||
import Derive.Prelude
|
import Derive.Prelude
|
||||||
|
import Quox.CharExtra
|
||||||
|
import Text.Lexer
|
||||||
|
|
||||||
%hide TT.Name
|
%hide TT.Name
|
||||||
|
|
||||||
|
@ -95,3 +97,34 @@ fromListP (x ::: xs) = go [<] x xs where
|
||||||
export %inline
|
export %inline
|
||||||
fromList : List1 String -> Name
|
fromList : List1 String -> Name
|
||||||
fromList = fromPName . fromListP
|
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)
|
||||||
|
|
|
@ -59,39 +59,9 @@ match t f = Tokenizer.match t (Just . f)
|
||||||
%hide Tokenizer.match
|
%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
|
private
|
||||||
name : Tokenizer TokenW
|
name : Tokenizer TokenW
|
||||||
name = match nameL $ Name . fromListP . split (== '.') . normalizeNfc
|
name = match name $ Name . fromListP . split (== '.') . normalizeNfc
|
||||||
|
|
||||||
||| [todo] escapes other than `\"` and (accidentally) `\\`
|
||| [todo] escapes other than `\"` and (accidentally) `\\`
|
||||||
export
|
export
|
||||||
|
@ -113,7 +83,7 @@ nat = match (some (range '0' '9')) (Nat . cast)
|
||||||
|
|
||||||
private
|
private
|
||||||
tag : Tokenizer TokenW
|
tag : Tokenizer TokenW
|
||||||
tag = match (is '\'' <+> nameL) (Tag . drop 1)
|
tag = match (is '\'' <+> name) (Tag . drop 1)
|
||||||
<|> match (is '\'' <+> stringLit) (Tag . fromStringLit . drop 1)
|
<|> match (is '\'' <+> stringLit) (Tag . fromStringLit . drop 1)
|
||||||
|
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue