quote tags in printer when needed

This commit is contained in:
rhiannon morris 2023-03-16 18:39:24 +01:00
parent be94422668
commit f814b01c5c
3 changed files with 15 additions and 6 deletions

View file

@ -128,3 +128,11 @@ baseName = idStart <+> many idCont <+> many idEnd
export export
name : Lexer name : Lexer
name = baseName <+> many (is '.' <+> baseName) name = baseName <+> many (is '.' <+> baseName)
export
isName : String -> Bool
isName str =
case scan name [] (unpack str) of
Just (_, []) => True
_ => False

View file

@ -115,15 +115,18 @@ prettyCase pi elim r ret arms = do
arms <- prettyArms arms arms <- prettyArms arms
pure $ asep [caseD <++> elim, returnD <++> ret, ofD <++> arms] pure $ asep [caseD <++> elim, returnD <++> ret, ofD <++> arms]
-- [fixme] put delimiters around tags that aren't simple names export
quoteTag : TagVal -> Doc HL
quoteTag tag =
if isName tag then fromString tag else hcat ["\"", fromString tag, "\""]
export export
prettyTag : TagVal -> Doc HL prettyTag : TagVal -> Doc HL
prettyTag t = hl Tag $ "'" <+> fromString t prettyTag t = hl Tag $ "'" <+> quoteTag t
-- [fixme] put delimiters around tags that aren't simple names
export export
prettyTagBare : TagVal -> Doc HL prettyTagBare : TagVal -> Doc HL
prettyTagBare t = hl Tag $ fromString t prettyTagBare t = hl Tag $ quoteTag t
parameters (showSubsts : Bool) parameters (showSubsts : Bool)

View file

@ -132,7 +132,6 @@ tests = "pretty printing terms" :- [
testPrettyT1 [<] [<] (enum []) "{}", testPrettyT1 [<] [<] (enum []) "{}",
testPrettyT1 [<] [<] (enum ["a"]) "{a}", testPrettyT1 [<] [<] (enum ["a"]) "{a}",
testPrettyT1 [<] [<] (enum ["aa", "bb", "cc"]) "{aa, bb, cc}", testPrettyT1 [<] [<] (enum ["aa", "bb", "cc"]) "{aa, bb, cc}",
skipWith "todo: quote non-identifiers" $
testPrettyT1 [<] [<] (enum ["a b c"]) #"{"a b c"}"# testPrettyT1 [<] [<] (enum ["a b c"]) #"{"a b c"}"#
], ],
@ -140,7 +139,6 @@ tests = "pretty printing terms" :- [
testPrettyT1 [<] [<] (Tag "a") "'a", testPrettyT1 [<] [<] (Tag "a") "'a",
testPrettyT1 [<] [<] (Tag "hello") "'hello", testPrettyT1 [<] [<] (Tag "hello") "'hello",
testPrettyT1 [<] [<] (Tag "qualified.tag") "'qualified.tag", testPrettyT1 [<] [<] (Tag "qualified.tag") "'qualified.tag",
skipWith "todo: quote non-identifiers" $
testPrettyT1 [<] [<] (Tag "non-identifier tag") #"'"non-identifier tag""# testPrettyT1 [<] [<] (Tag "non-identifier tag") #"'"non-identifier tag""#
], ],