AST node class generator
Given two hashes, my script generates two (poorly formatted) C# source files containing some classes that represent several AST nodes a programming language needs and an implementation of the Visitor pattern for each. While I care a lot about the formatting of my Raku code, the formatting of the C# output is of no particular concern—I let Rider clean it up for me.
My program has one dependency aside from the standard library: version 0.0.6 of the Map::Ordered
module (installable using zef install --/test "Map::Ordered:ver<0.0.6>:auth<zef:lizmat>"
).
It also assumes your terminal supports ANSI colors (and that you want to see them). By default, the script writes the files to the src
directory relative to the current working directory, but you can specify a different directory using the -o
/--out-dir
option.
When you run it, it looks like this:
✓ Wrote Expr classes to src/Expr.cs ✓ Wrote Stmt classes to src/Stmt.cs
(I've also uploaded the output files to GitHub Gist, should you want to see them.)
The code
#!/usr/bin/env raku
use Map::Ordered:ver<0.0.6>:auth<zef:lizmat>;
unit sub MAIN(Str :o(:$out-dir) = 'src');
my %exprs is Map::Ordered =
Binary => [left => 'Expr', operator => 'Token', right => 'Expr'],
Grouping => [expression => 'Expr'],
Literal => [value => 'object?'],
Unary => [operator => 'Token', right => 'Expr'];
my %stmts is Map::Ordered =
ExpressionStatement => [expression => 'Expr'],
Print => [expression => 'Expr'];
generate :base-class('Expr'), :classes(%exprs), :$out-dir;
generate :base-class('Stmt'), :classes(%stmts), :$out-dir;
sub generate(:$base-class!, :%classes!, :$out-dir!) {
my $source = '';
$source ~= qq:to/END/;
namespace Lox;
internal abstract class $base-class \{
END
for %classes.kv -> $class-name, @fields {
my @types = @fields.map: *.value;
my @names = @fields.map: *.key;
my @names-and-types = flat @names Z @types;
my $fields = format(-> $type, $name { "internal $type {$name.tc} \{ get; \}" }, @names-and-types);
my $parameters = format(-> $type, $name { "$type {rename-reserved-word($name)}" }, @names-and-types, ', ');
my $initializers = format(-> $name { "{$name.tc} = {rename-reserved-word($name)};" }, @names);
$source ~= qq:to/END/;
internal class $class-name : $base-class \{
$fields
internal {$class-name}($parameters) \{
$initializers
}
internal override T Accept<T>(IVisitor<T> visitor) => visitor.Visit(this);
}
END
}
$source ~= qq:to/END/;
internal interface IVisitor<T> \{
{format({ "public T Visit($^type expr);" }, %classes.keys)}
}
internal abstract T Accept<T>(IVisitor<T> visitor);
}
END
my $path = IO::Spec::Unix.catpath(,ドル $out-dir, "$base-class.cs");
spurt $path, $source;
say "\e[1;32m\c[CHECK MARK]\e[0m Wrote \e[36m{$base-class}\e[0m classes to \e[1;4m$path\e[0m";
}
sub rename-reserved-word($identifier) { $identifier eq 'operator' ?? '@operator' !! $identifier }
multi sub format(&fn where *.signature.params == 1, @xs, $sep = "\n") { @xs.map(&fn).join($sep) }
multi sub format(&fn where *.signature.params == 2, @xs, $sep = "\n") { @xs.map({ fn($^b, $^a) }).join($sep) }
The only line I'm really not sure about is this one:
my $path = IO::Spec::Unix.catpath(,ドル $out-dir, "$base-class.cs");
It feels strange to have to use a platform-specific function right there in the middle of a script that is otherwise pretty platform-agnostic, but I couldn't find a function in the standard library that does the right thing across all platforms. In a review, I'd like for that to be addressed, as well as the usual stuff.