AST node class generator

Question

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.

Answer 1

IO::Path

my $path = IO::Spec::Unix.catpath(,ドル $out-dir, "$base-class.cs");

You need to work with IO::Path type. You can do $out-dir.IO.add: "$base-class.cs", but I recommend doing the IO part in MAINs signature. Also your code doesn't check if the $out-dir exists. So I would make these changes:

unit sub MAIN(IO::Path(Str) :o(:$out-dir) = 'src');

$out-dir.mkdir: 0o755 unless $out-dir.d;
my $path = $out-dir.add: "$base-class.cs";

format function

There is no need to use where clauses in your signature, you can specify the singature of &fn. You can also drop the sub and &fn parameters:

multi format(&fn:($), @xs, $sep = "\n") { @xs.map(&fn).join($sep) }
multi format(&fn:(,ドル $), @xs, $sep = "\n") { @xs.map(&fn).join($sep) }

If you do that, then there's no need for a multi:

sub format(&fn:(,ドル $?), @xs, $sep = "\n") { @xs.map(&fn).join($sep) }

If you don't know

I'll mention some things that can be personal preferences, but maybe it can be of value if you don't know them already.

You can enable/disable things in quoting constructs, so you can disable closures if you are not going to use them, so you won't have to escape braces:

$source ~= qq:!c:to/END/;
namespace Lox;
internal abstract class $base-class {
END

You can use single quotes and temporary use interpolation in it:

$source ~= q:to/END/;
internal interface IVisitor<T> {
 \qq「{format({ "public T Visit($^type expr);" }, %classes.keys)}」
}
internal abstract T Accept<T>(IVisitor<T> visitor);
}
END

You can call methods in strings:

qq:!c「internal $type $name.tc() { get; }」

Same for functions:

"$type &rename-reserved-word($name)"

Update: There is no need to declare/initialize $source separately:

my $source = qq:to/END/;
namespace Lox;
internal abstract class $base-class \{
END

Alternative solutions

With your format function you're doing extra iterations, this can be a design decision, but you can do everything in one loop.

for %classes.kv -> $class-name, @names-and-types {
 my (@fields, @parameters, @initializers);
 for @names-and-types -> (:key($name), :value($type)) {
 @fields.append: qq:!c「internal $type $name.tc() { get; }」;
 @parameters.append: "$type &rename-reserved-word($name)";
 @initializers.append: "$name.tc() = &rename-reserved-word($name);";
 }
 $source ~= qq:to/END/;
 internal class $class-name : $base-class \{
 @fields.join("\n")
 internal {$class-name}(@parameters.join(', ')) \{
 @initializers.join("\n")
 }
 internal override T Accept<T>(IVisitor<T> visitor) => visitor.Visit(this);
 }
 END
}

You can eliminate the Map::Ordered dependecy by using Arrays/Lists the way you did for inner lists and put your base classes in one Map:

my %base-class is Map =
 Expr => [Binary => [left => 'Expr', operator => 'Token', right => 'Expr'],
 Grouping => [expression => 'Expr'],
 Literal => [value => 'object?'],
 Unary => [operator => 'Token', right => 'Expr']],
 Stmt => [ExpressionStatement => [expression => 'Expr'],
 Print => [expression => 'Expr']];
for %base-class.kv -> $base-class, @classes {
 generate :$base-class, :@classes, :$out-dir;
}

Then you can also eliminate the format call for IVisitor and remove the format function:

my @visits;
for @classes -> (:key($class-name), :value(@names-and-types)) {
 my (@fields, @parameters, @initializers);
 for @names-and-types -> (:key($name), :value($type)) {
 @fields.append: qq:!c「internal $type $name.tc() { get; }」;
 @parameters.append: "$type &rename-reserved-word($name)";
 @initializers.append: "$name.tc() = &rename-reserved-word($name);";
 }
 $source ~= qq:to/END/;
 internal class $class-name : $base-class \{
 @fields.join("\n")
 internal {$class-name}(@parameters.join(', ')) \{
 @initializers.join("\n")
 }
 internal override T Accept<T>(IVisitor<T> visitor) => visitor.Visit(this);
 }
 END
 @visits.append: "public T Visit($class-name expr);"
}
$source ~= qq:to/END/;
internal interface IVisitor<T> \{
 @visits.join("\n")
}
internal abstract T Accept<T>(IVisitor<T> visitor);
}
END