mirror of
https://github.com/roc-lang/roc.git
synced 2025-09-27 05:49:08 +00:00
Remove accidentally committed parser generator
This commit is contained in:
Joshua Warner
parent
f7bdc59ac0
commit
a15e6c5c37
1 changed files with 0 additions and 384 deletions
|
|
@ -1,384 +0,0 @@
|
||||||
app "generator"
|
|
||||||
packages {
|
|
||||||
pf: "https://github.com/roc-lang/basic-cli/releases/download/0.1.3/5SXwdW7rH8QAOnD71IkHcFxCmBEPtFSLAIkclPEgjHQ.tar.br",
|
|
||||||
}
|
|
||||||
imports [
|
|
||||||
pf.Stdout,
|
|
||||||
pf.File,
|
|
||||||
pf.Path,
|
|
||||||
pf.Task.{ Task },
|
|
||||||
]
|
|
||||||
|
|
||||||
provides [main] to pf
|
|
||||||
|
|
||||||
RenderTree : [
|
|
||||||
Text Str,
|
|
||||||
Items (List RenderTree),
|
|
||||||
Line (List RenderTree),
|
|
||||||
Indent (List RenderTree),
|
|
||||||
Import {modu: List Str, name: Str},
|
|
||||||
]
|
|
||||||
|
|
||||||
renderFile : RenderTree -> Str
|
|
||||||
renderFile = \tree ->
|
|
||||||
render (Items [
|
|
||||||
formatImports (findImports tree),
|
|
||||||
tree
|
|
||||||
])
|
|
||||||
|
|
||||||
findImports : RenderTree -> Set { modu: (List Str), name: Str }
|
|
||||||
findImports = \tree ->
|
|
||||||
when tree is
|
|
||||||
Text _ -> Set.empty
|
|
||||||
Items list | Indent list | Line list ->
|
|
||||||
List.walk list Set.empty \acc, item -> Set.union acc (findImports item)
|
|
||||||
Import import -> Set.single import
|
|
||||||
|
|
||||||
formatImports : Set { modu: (List Str), name: Str } -> RenderTree
|
|
||||||
formatImports = \set ->
|
|
||||||
if hasDupImports set then
|
|
||||||
crash "Duplicate imports!"
|
|
||||||
else
|
|
||||||
Items (
|
|
||||||
set
|
|
||||||
|> Set.toList
|
|
||||||
# TODO: Sort by module name
|
|
||||||
|> List.map \{ modu, name } ->
|
|
||||||
Line [
|
|
||||||
Text "use ",
|
|
||||||
Text (Str.joinWith (List.map modu \m -> Str.concat m "::") ""),
|
|
||||||
Text name,
|
|
||||||
Text ";",
|
|
||||||
]
|
|
||||||
)
|
|
||||||
|
|
||||||
hasDupImports : Set { modu: (List Str), name: Str } -> Bool
|
|
||||||
hasDupImports = \set ->
|
|
||||||
nameSet =
|
|
||||||
set
|
|
||||||
|> Set.toList
|
|
||||||
|> List.map \{ modu: _, name } -> name
|
|
||||||
|> Set.fromList
|
|
||||||
|
|
||||||
Set.len nameSet != Set.len nameSet
|
|
||||||
|
|
||||||
render : RenderTree -> Str
|
|
||||||
render = \tree ->
|
|
||||||
Tuple text _ = renderInner tree 0 Bool.true
|
|
||||||
text
|
|
||||||
|
|
||||||
renderGroup : List RenderTree, Nat, Bool -> [Tuple Str Bool]
|
|
||||||
renderGroup = \list, indent, newlineBefore ->
|
|
||||||
List.walk list (Tuple "" newlineBefore) \(Tuple text nlb), item ->
|
|
||||||
Tuple ntext nla = renderInner item indent nlb
|
|
||||||
(Tuple
|
|
||||||
(Str.concat text ntext)
|
|
||||||
nla
|
|
||||||
)
|
|
||||||
|
|
||||||
|
|
||||||
renderInner : RenderTree, Nat, Bool -> [Tuple Str Bool]
|
|
||||||
renderInner = \tree, indent, newlineBefore ->
|
|
||||||
when tree is
|
|
||||||
Text text ->
|
|
||||||
result = if newlineBefore then
|
|
||||||
Str.concat (Str.repeat " " (4*indent)) text
|
|
||||||
else
|
|
||||||
text
|
|
||||||
Tuple result Bool.false
|
|
||||||
Items list -> renderGroup list indent newlineBefore
|
|
||||||
Line list ->
|
|
||||||
Tuple ntext nla = renderGroup list indent Bool.true
|
|
||||||
res = if newlineBefore then
|
|
||||||
# Already added the newline, no need!
|
|
||||||
ntext
|
|
||||||
else
|
|
||||||
Str.concat "\n" ntext
|
|
||||||
res2 = if nla then
|
|
||||||
res
|
|
||||||
else
|
|
||||||
Str.concat res "\n"
|
|
||||||
(Tuple res2 Bool.true)
|
|
||||||
Indent list -> renderGroup list (indent + 1) newlineBefore
|
|
||||||
Import {modu: _, name} ->
|
|
||||||
Tuple name Bool.false
|
|
||||||
|
|
||||||
parserTrait = \t, e ->
|
|
||||||
genCall (Import {modu: ["crate", "parser"], name: "Parser"}) [Text "'a", t, e]
|
|
||||||
|
|
||||||
parseFunction : Str, RenderTree, RenderTree, RenderTree -> RenderTree
|
|
||||||
parseFunction = \name, ty, err, body ->
|
|
||||||
Items [
|
|
||||||
Line [
|
|
||||||
Text "pub fn \(name)<'a>() -> impl ",
|
|
||||||
parserTrait ty err,
|
|
||||||
Text " {",
|
|
||||||
],
|
|
||||||
Indent [body, Line [Text ".trace(\"\(name)\")" ] ],
|
|
||||||
Line [Text "}"],
|
|
||||||
Line [Text ""],
|
|
||||||
]
|
|
||||||
|
|
||||||
Type : RenderTree
|
|
||||||
ErrTy : RenderTree
|
|
||||||
|
|
||||||
Parser : [
|
|
||||||
Loc Parser,
|
|
||||||
Specialize ErrTy Parser,
|
|
||||||
Record Str (List { name: Str, parser: Parser }),
|
|
||||||
Builtin RenderTree Type,
|
|
||||||
# Named ParserName (World -> Parser),
|
|
||||||
]
|
|
||||||
|
|
||||||
errHeader : Str -> ErrTy
|
|
||||||
errHeader = \name ->
|
|
||||||
Items [
|
|
||||||
Import { modu: ["crate", "parser"], name: "EHeader" },
|
|
||||||
Text "::",
|
|
||||||
Text name,
|
|
||||||
]
|
|
||||||
|
|
||||||
fnCall : RenderTree, List RenderTree -> RenderTree
|
|
||||||
fnCall = \fnName, args ->
|
|
||||||
Items [
|
|
||||||
fnName,
|
|
||||||
Text "(",
|
|
||||||
Items (List.intersperse args (Text ",")),
|
|
||||||
Text ")",
|
|
||||||
]
|
|
||||||
|
|
||||||
fn : RenderTree -> (List RenderTree -> RenderTree)
|
|
||||||
fn = \fnName -> \args -> fnCall fnName args
|
|
||||||
|
|
||||||
genCall : RenderTree, List RenderTree -> RenderTree
|
|
||||||
genCall = \genName, args ->
|
|
||||||
Items [
|
|
||||||
genName,
|
|
||||||
Text "<",
|
|
||||||
Items (List.intersperse args (Text ", ")),
|
|
||||||
Text ">",
|
|
||||||
]
|
|
||||||
|
|
||||||
gen : RenderTree -> (List RenderTree -> RenderTree)
|
|
||||||
gen = \genName -> \args -> genCall genName args
|
|
||||||
|
|
||||||
ref : RenderTree -> RenderTree
|
|
||||||
ref = \name -> Items [Text "&'a ", name]
|
|
||||||
|
|
||||||
slice : RenderTree -> RenderTree
|
|
||||||
slice = \name -> Items [Text "[", name, Text "]"]
|
|
||||||
|
|
||||||
refSlice : RenderTree -> RenderTree
|
|
||||||
refSlice = \name -> ref (slice name)
|
|
||||||
|
|
||||||
commentOrNewline = genCall (Import {modu: ["crate", "ast"], name: "CommentOrNewline"}) [ Text "'a" ]
|
|
||||||
|
|
||||||
exposedName = genCall (Import {modu: ["crate", "header"], name: "ExposedName"}) [ Text "'a" ]
|
|
||||||
importsEntry = genCall (Import {modu: ["crate", "header"], name: "ImportsEntry"}) [ Text "'a" ]
|
|
||||||
uppercaseIdent = genCall (Import {modu: ["crate", "ident"], name: "UppercaseIdent"}) [ Text "'a" ]
|
|
||||||
|
|
||||||
moduleName = genCall (Import {modu: ["crate", "header"], name: "ModuleName"}) [ Text "'a" ]
|
|
||||||
|
|
||||||
space0E = fn (Import { modu: ["crate", "blankspace"], name: "space0_e" })
|
|
||||||
|
|
||||||
keyword = \keywordName ->
|
|
||||||
Import { modu: ["crate", "header"], name: keywordName }
|
|
||||||
|
|
||||||
spaces = \errorName ->
|
|
||||||
Builtin (space0E [errorName]) (refSlice commentOrNewline)
|
|
||||||
|
|
||||||
loc = gen (Import {modu: ["roc_region", "all"], name: "Loc"})
|
|
||||||
|
|
||||||
keywordItem = \kw, ty ->
|
|
||||||
genCall (Import {modu: ["crate", "header"], name: "KeywordItem"}) [ Text "'a", kw, ty ]
|
|
||||||
|
|
||||||
collection = \ty ->
|
|
||||||
genCall (Import {modu: ["crate", "ast"], name: "Collection"}) [ Text "'a", ty ]
|
|
||||||
|
|
||||||
spaced = \ty ->
|
|
||||||
genCall (Import {modu: ["crate", "ast"], name: "Spaced"}) [ Text "'a", ty ]
|
|
||||||
|
|
||||||
moduleNameHelp = \err ->
|
|
||||||
Builtin (fnCall (Import {modu: ["crate", "module"], name: "module_name_help" }) [ err ]) moduleName
|
|
||||||
|
|
||||||
exposesValues =
|
|
||||||
Builtin (fnCall (Import {modu: ["crate", "module"], name: "exposes_values"}) []) (keywordItem (keyword "ExposesKeyword") (collection (loc [spaced exposedName])))
|
|
||||||
|
|
||||||
imports =
|
|
||||||
Builtin (fnCall (Import {modu: ["crate", "module"], name: "imports"}) []) (keywordItem (keyword "ImportsKeyword") (collection (loc [spaced importsEntry])))
|
|
||||||
|
|
||||||
generates =
|
|
||||||
Builtin (fnCall (Import {modu: ["crate", "module"], name: "generates"}) []) (keywordItem (keyword "GeneratesKeyword") uppercaseIdent)
|
|
||||||
|
|
||||||
generatesWith =
|
|
||||||
Builtin (fnCall (Import {modu: ["crate", "module"], name: "generates_with"}) []) (keywordItem (keyword "WithKeyword") (collection (loc [spaced exposedName])))
|
|
||||||
|
|
||||||
|
|
||||||
interfaceHeader = Record "InterfaceHeader" [
|
|
||||||
{name: "before_name", parser: spaces (errHeader "IndentStart")},
|
|
||||||
{name: "name", parser: Loc (moduleNameHelp (errHeader "ModuleName"))},
|
|
||||||
{name: "exposes", parser: Specialize (errHeader "Exposes") exposesValues },
|
|
||||||
{name: "imports", parser: Specialize (errHeader "Imports") imports },
|
|
||||||
]
|
|
||||||
|
|
||||||
hostedHeader = Record "HostedHeader" [
|
|
||||||
{name: "before_name", parser: spaces (errHeader "IndentStart")},
|
|
||||||
{name: "name", parser: Loc (moduleNameHelp (errHeader "ModuleName"))},
|
|
||||||
{name: "exposes", parser: Specialize (errHeader "Exposes") exposesValues},
|
|
||||||
{name: "imports", parser: Specialize (errHeader "Imports") imports},
|
|
||||||
{name: "generates", parser: Specialize (errHeader "Generates") generates},
|
|
||||||
{name: "generates_with", parser: Specialize (errHeader "GeneratesWith") generatesWith},
|
|
||||||
]
|
|
||||||
|
|
||||||
printCombinatorParserFunction = \parser ->
|
|
||||||
parseFunction (lowerName (resolveName parser)) (resolveType parser) (Text "EHeader<'a>") (printCombinatorParser parser)
|
|
||||||
|
|
||||||
resolveName : Parser -> Str
|
|
||||||
resolveName = \parser ->
|
|
||||||
when parser is
|
|
||||||
Loc _p -> crash "Unnamed parser!"
|
|
||||||
Specialize _err _p -> crash "Unnamed parser!"
|
|
||||||
Builtin _name _ty -> crash "Unnamed parser!"
|
|
||||||
Record name _fields -> name
|
|
||||||
|
|
||||||
underscoreScalar = 95
|
|
||||||
aLowerScalar = 97
|
|
||||||
aUpperScalar = 65
|
|
||||||
zUpperScalar = 90
|
|
||||||
|
|
||||||
# map from a lower_case_name to a UpperCaseName
|
|
||||||
upperName : Str -> Str
|
|
||||||
upperName = \name ->
|
|
||||||
result = Str.walkScalars name {text: "", needUpper: Bool.true} \{text, needUpper}, c ->
|
|
||||||
if c == underscoreScalar then
|
|
||||||
{text, needUpper: Bool.true}
|
|
||||||
else
|
|
||||||
newText =
|
|
||||||
if needUpper then
|
|
||||||
Str.appendScalar text (c - aLowerScalar + aUpperScalar) |> orCrash
|
|
||||||
else
|
|
||||||
Str.appendScalar text c |> orCrash
|
|
||||||
{text: newText, needUpper: Bool.false}
|
|
||||||
result.text
|
|
||||||
|
|
||||||
expect (upperName "hello_world") == "HelloWorld"
|
|
||||||
|
|
||||||
orCrash : Result a e -> a
|
|
||||||
orCrash = \result ->
|
|
||||||
when result is
|
|
||||||
Ok a -> a
|
|
||||||
Err _e -> crash "orCrash"
|
|
||||||
|
|
||||||
lowerName : Str -> Str
|
|
||||||
lowerName = \name ->
|
|
||||||
result = Str.walkScalars name {text: "", needUnder: Bool.false} \{text, needUnder}, c ->
|
|
||||||
newText =
|
|
||||||
if c >= aUpperScalar && c <= zUpperScalar then
|
|
||||||
if needUnder then
|
|
||||||
text
|
|
||||||
|> Str.appendScalar underscoreScalar
|
|
||||||
|> orCrash
|
|
||||||
|> Str.appendScalar (c - aUpperScalar + aLowerScalar)
|
|
||||||
|> orCrash
|
|
||||||
else
|
|
||||||
text
|
|
||||||
|> Str.appendScalar (c - aUpperScalar + aLowerScalar)
|
|
||||||
|> orCrash
|
|
||||||
else
|
|
||||||
Str.appendScalar text c |> orCrash
|
|
||||||
|
|
||||||
{text: newText, needUnder: Bool.true}
|
|
||||||
|
|
||||||
result.text
|
|
||||||
|
|
||||||
expect
|
|
||||||
theResult = (lowerName "HelloWorld")
|
|
||||||
theResult == "hello_world"
|
|
||||||
|
|
||||||
resolveType : Parser -> RenderTree
|
|
||||||
resolveType = \parser ->
|
|
||||||
when parser is
|
|
||||||
Loc p -> loc [resolveType p]
|
|
||||||
Specialize _err p -> resolveType p
|
|
||||||
Record name _fields -> Items [ Import {modu: ["crate", "generated_ast"], name}, Text "<'a>"]
|
|
||||||
Builtin _name ty -> ty
|
|
||||||
|
|
||||||
printCombinatorParser : Parser -> RenderTree
|
|
||||||
printCombinatorParser = \parser ->
|
|
||||||
when parser is
|
|
||||||
Loc p ->
|
|
||||||
printed = printCombinatorParser p
|
|
||||||
value : RenderTree
|
|
||||||
value = Items [ (Text "loc!("), printed, (Text ")") ]
|
|
||||||
value
|
|
||||||
Specialize err p ->
|
|
||||||
printed = printCombinatorParser p
|
|
||||||
Items [
|
|
||||||
Import {modu: ["crate", "parser"], name: "specialize"},
|
|
||||||
Text "(",
|
|
||||||
err,
|
|
||||||
(Text ", "),
|
|
||||||
printed,
|
|
||||||
(Text ")"),
|
|
||||||
]
|
|
||||||
Record name fields ->
|
|
||||||
Items [
|
|
||||||
Text "record!(\(name) {",
|
|
||||||
(Indent
|
|
||||||
(fields
|
|
||||||
|> List.map \f ->
|
|
||||||
Line [Text "\(f.name): ", printCombinatorParser f.parser, Text ","]
|
|
||||||
)
|
|
||||||
),
|
|
||||||
Text "})"
|
|
||||||
]
|
|
||||||
Builtin name _ty -> name
|
|
||||||
|
|
||||||
printAst : Parser -> RenderTree
|
|
||||||
printAst = \parser ->
|
|
||||||
when parser is
|
|
||||||
Record name fields ->
|
|
||||||
Items [
|
|
||||||
Line [ Text "#[derive(Clone, Debug, PartialEq)]" ],
|
|
||||||
Line [ Text "pub struct \(name)<'a> {" ],
|
|
||||||
(Indent (
|
|
||||||
fields
|
|
||||||
|> List.map \f ->
|
|
||||||
Line [Text "pub \(f.name): ", resolveType f.parser, Text ","]
|
|
||||||
)),
|
|
||||||
Line [Text "}"],
|
|
||||||
Line [Text ""],
|
|
||||||
]
|
|
||||||
_ -> crash "Not implemented"
|
|
||||||
|
|
||||||
expect (render (Text "foo")) == "foo"
|
|
||||||
expect (render (Line [Text "foo"])) == "foo\n"
|
|
||||||
expect (render (Indent [Text "foo"])) == " foo"
|
|
||||||
expect (render (Line [Indent [Text "foo"]])) == " foo\n"
|
|
||||||
|
|
||||||
expect
|
|
||||||
res = (render (Items [Text "{", Indent [Line [Text "foo"]], Text "}"]))
|
|
||||||
res ==
|
|
||||||
"""
|
|
||||||
{
|
|
||||||
foo
|
|
||||||
}
|
|
||||||
"""
|
|
||||||
|
|
||||||
allSyntaxItems = [interfaceHeader, hostedHeader]
|
|
||||||
|
|
||||||
printedAstItems = Items (allSyntaxItems |> List.map printAst)
|
|
||||||
printedParserItems = Items (allSyntaxItems |> List.map printCombinatorParserFunction)
|
|
||||||
|
|
||||||
|
|
||||||
# main : Task {} []*
|
|
||||||
main =
|
|
||||||
task =
|
|
||||||
_ <- File.writeUtf8 (Path.fromStr "generated_ast.rs") (renderFile printedAstItems) |> Task.await
|
|
||||||
|
|
||||||
File.writeUtf8 (Path.fromStr "generated_parser.rs") (renderFile printedParserItems)
|
|
||||||
|
|
||||||
Task.attempt task \result ->
|
|
||||||
when result is
|
|
||||||
Ok _ -> Stdout.line "Success!"
|
|
||||||
Err _e -> Stdout.line "Failed to write file"
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue