Remove early Perl 5 and Python versions of the ADT generator
This commit is contained in:
Suzanne Dupéron
parent
ded76b41d6
commit
b536d3f591
@ -1,212 +0,0 @@
|
||||
#!/usr/bin/env perl
|
||||
use strict;
|
||||
use warnings;
|
||||
use 5.010;
|
||||
use Data::Dumper; $Data::Dumper::Useqq = 1; # use double quotes when dumping (we have a few "prime'" names)
|
||||
sub enumerate { my $i = 0; [map { [ $i++, $_ ] } @{$_[0]}] }
|
||||
|
||||
my $moduleName = "A";
|
||||
my $variant = "_ _variant";
|
||||
my $record = "_ _ record"; my $true = 1; my $false = 0;
|
||||
sub poly { $_[0] }
|
||||
my $adts_raw = [
|
||||
# typename, kind, fields_or_ctors
|
||||
["root", $variant, [
|
||||
# ctor, builtin?, type
|
||||
["A", $false, "rootA"],
|
||||
["B", $false, "rootB"],
|
||||
["C", $true, "string"],
|
||||
]],
|
||||
["a", $record, [
|
||||
# field, builtin?, type
|
||||
["a1", $false, "ta1"],
|
||||
["a2", $false, "ta2"],
|
||||
]],
|
||||
["ta1", $variant, [
|
||||
["X", $false, "root"],
|
||||
["Y", $false, "ta2"],
|
||||
]],
|
||||
["ta2", $variant, [
|
||||
["Z", $false, "ta2"],
|
||||
["W", $true, "unit"],
|
||||
]],
|
||||
# polymorphic type
|
||||
["rootA", poly("list"),
|
||||
[
|
||||
# Position (0..n-1), builtin?, type argument
|
||||
[0, $false, "a"]
|
||||
]],
|
||||
["rootB", poly("list"),
|
||||
[
|
||||
# Position (0..n-1), builtin?, type argument
|
||||
[0, $true, "int"]
|
||||
]],
|
||||
];
|
||||
|
||||
|
||||
|
||||
|
||||
my $adts = [map {
|
||||
my ($name , $kind, $ctorsOrFields) = @$_;
|
||||
{
|
||||
"name" => $name ,
|
||||
"newName" => "${name}'" ,
|
||||
"kind" => $kind ,
|
||||
"ctorsOrFields" => [map {
|
||||
my ($cf, $isBuiltin, $type) = @$_;
|
||||
{
|
||||
name => $cf ,
|
||||
newName => "${cf}'" ,
|
||||
isBuiltin => $isBuiltin ,
|
||||
type => $type ,
|
||||
newType => $isBuiltin ? $type : "${type}'"
|
||||
}
|
||||
} @$ctorsOrFields],
|
||||
}
|
||||
} @$adts_raw];
|
||||
|
||||
# print Dumper $adts ;
|
||||
|
||||
say "(* This is an auto-generated file. Do not edit. *)";
|
||||
|
||||
say "";
|
||||
say "open ${moduleName}";
|
||||
|
||||
say "";
|
||||
foreach (@{enumerate($adts)}) {
|
||||
my ($index, $t) = @$_;
|
||||
my %t = %$t;
|
||||
my $typeOrAnd = $index == 0 ? "type" : "and";
|
||||
say "${typeOrAnd} $t{newName} =";
|
||||
if ($t{kind} eq $variant) {
|
||||
foreach (@{$t{ctorsOrFields}}) {
|
||||
my %c = %$_;
|
||||
say " | $c{newName} of $c{newType}"
|
||||
}
|
||||
}
|
||||
elsif ($t{kind} eq $record) {
|
||||
say " {";
|
||||
foreach (@{$t{ctorsOrFields}}) {
|
||||
my %f = %$_;
|
||||
say " $f{newName} : $f{newType} ;";
|
||||
}
|
||||
say " }";
|
||||
} else {
|
||||
print " ";
|
||||
foreach (@{$t{ctorsOrFields}}) {
|
||||
my %a = %$_;
|
||||
print "$a{newType} ";
|
||||
}
|
||||
print "$t{kind}";
|
||||
say "";
|
||||
}
|
||||
}
|
||||
|
||||
say "";
|
||||
say "type 'state continue_fold =";
|
||||
say " {";
|
||||
foreach (@$adts) {
|
||||
my %t = %$_;
|
||||
say " $t{name} : $t{name} -> 'state -> ($t{newName} * 'state) ;";
|
||||
foreach (@{$t{ctorsOrFields}}) {
|
||||
my %c = %$_;
|
||||
say " $t{name}_$c{name} : $c{type} -> 'state -> ($c{newType} * 'state) ;"
|
||||
}
|
||||
}
|
||||
say " }";
|
||||
|
||||
say "";
|
||||
say "type 'state fold_config =";
|
||||
say " {";
|
||||
foreach (@$adts) {
|
||||
my %t = %$_;
|
||||
say " $t{name} : $t{name} -> 'state -> ('state continue_fold) -> ($t{newName} * 'state) ;";
|
||||
say " $t{name}_pre_state : $t{name} -> 'state -> 'state ;";
|
||||
say " $t{name}_post_state : $t{name} -> $t{newName} -> 'state -> 'state ;";
|
||||
foreach (@{$t{ctorsOrFields}}) {
|
||||
my %c = %$_;
|
||||
say " $t{name}_$c{name} : $c{type} -> 'state -> ('state continue_fold) -> ($c{newType} * 'state) ;";
|
||||
}
|
||||
}
|
||||
say " }";
|
||||
|
||||
say "";
|
||||
say '(* Curries the "visitor" argument to the folds (non-customizable traversal functions). *)';
|
||||
say "let rec mk_continue_fold : type state . state fold_config -> state continue_fold = fun visitor ->";
|
||||
say " {";
|
||||
foreach (@$adts) {
|
||||
my %t = %$_;
|
||||
say " $t{name} = fold_$t{name} visitor ;";
|
||||
foreach (@{$t{ctorsOrFields}}) {
|
||||
my %c = %$_;
|
||||
say " $t{name}_$c{name} = fold_$t{name}_$c{name} visitor ;";
|
||||
}
|
||||
}
|
||||
say "}";
|
||||
say "";
|
||||
|
||||
foreach (@$adts) {
|
||||
my %t = %$_;
|
||||
say "and fold_$t{name} : type state . state fold_config -> $t{name} -> state -> ($t{newName} * state) = fun visitor x state ->";
|
||||
say " let continue_fold : state continue_fold = mk_continue_fold visitor in";
|
||||
say " let state = visitor.$t{name}_pre_state x state in";
|
||||
say " let (new_x, state) = visitor.$t{name} x state continue_fold in";
|
||||
say " let state = visitor.$t{name}_post_state x new_x state in";
|
||||
say " (new_x, state)";
|
||||
say "";
|
||||
foreach (@{$t{ctorsOrFields}}) {
|
||||
my %c = %$_;
|
||||
say "and fold_$t{name}_$c{name} : type state . state fold_config -> $c{type} -> state -> ($c{newType} * state) = fun visitor x state ->";
|
||||
say " let continue_fold : state continue_fold = mk_continue_fold visitor in";
|
||||
say " visitor.$t{name}_$c{name} x state continue_fold";
|
||||
say "";
|
||||
}
|
||||
}
|
||||
|
||||
say "let no_op : 'a fold_config = {";
|
||||
foreach (@$adts) {
|
||||
my %t = %$_;
|
||||
say " $t{name} = (fun v state continue ->";
|
||||
say " match v with";
|
||||
if ($t{kind} eq $variant) {
|
||||
foreach (@{$t{ctorsOrFields}}) {
|
||||
my %c = %$_;
|
||||
say " | $c{name} v -> let (v, state) = continue.$t{name}_$c{name} v state in ($c{newName} v, state)";
|
||||
}
|
||||
} elsif ($t{kind} eq $record) {
|
||||
print " { ";
|
||||
foreach (@{$t{ctorsOrFields}}) {
|
||||
my %f = %$_;
|
||||
print "$f{name}; ";
|
||||
}
|
||||
say "} ->";
|
||||
foreach (@{$t{ctorsOrFields}}) {
|
||||
my %f = %$_;
|
||||
say " let ($f{newName}, state) = continue.$t{name}_$f{name} $f{name} state in";
|
||||
}
|
||||
print " ({ ";
|
||||
foreach (@{$t{ctorsOrFields}}) {
|
||||
my %f = %$_;
|
||||
print "$f{newName}; "
|
||||
}
|
||||
say "}, state)";
|
||||
} else {
|
||||
print " v -> fold_$t{kind} v state ( ";
|
||||
print join(", ", map { my %f = %$_; "continue.$t{name}_$f{name}" } @{$t{ctorsOrFields}});
|
||||
say " )";
|
||||
}
|
||||
say " );";
|
||||
say " $t{name}_pre_state = (fun v state -> ignore v; state) ;";
|
||||
say " $t{name}_post_state = (fun v new_v state -> ignore (v, new_v); state) ;";
|
||||
foreach (@{$t{ctorsOrFields}}) {
|
||||
my %c = %$_;
|
||||
print " $t{name}_$c{name} = (fun v state continue -> ";
|
||||
if ($c{isBuiltin}) {
|
||||
print "ignore continue; (v, state)";
|
||||
} else {
|
||||
print "continue.$c{type} v state";
|
||||
}
|
||||
say ") ;";
|
||||
}
|
||||
}
|
||||
say "}";
|
||||
@ -1,171 +0,0 @@
|
||||
#!/usr/bin/env python3
|
||||
import pprint
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
moduleName = "A"
|
||||
variant="_ _variant"
|
||||
record="_ _record"
|
||||
def poly(x): return x
|
||||
adts = [
|
||||
# typename, kind, fields_or_ctors
|
||||
("root", variant, [
|
||||
# ctor, builtin?, type
|
||||
("A", False, "rootA"),
|
||||
("B", False, "rootB"),
|
||||
("C", True, "string"),
|
||||
]),
|
||||
("a", record, [
|
||||
# field, builtin?, type
|
||||
("a1", False, "ta1"),
|
||||
("a2", False, "ta2"),
|
||||
]),
|
||||
("ta1", variant, [
|
||||
("X", False, "root"),
|
||||
("Y", False, "ta2"),
|
||||
]),
|
||||
("ta2", variant, [
|
||||
("Z", False, "ta2"),
|
||||
("W", True, "unit"),
|
||||
]),
|
||||
# polymorphic type
|
||||
("rootA", poly("list"),
|
||||
[
|
||||
# Position (0..n-1), builtin?, type argument
|
||||
(0, False, "a")
|
||||
]),
|
||||
("rootB", poly("list"),
|
||||
[
|
||||
# Position (0..n-1), builtin?, type argument
|
||||
(0, True, "int")
|
||||
]),
|
||||
]
|
||||
|
||||
from collections import namedtuple
|
||||
adt = namedtuple('adt', ['name', 'newName', 'kind', 'ctorsOrFields'])
|
||||
ctorOrField = namedtuple('ctorOrField', ['name', 'newName', 'isBuiltin', 'type_', 'newType'])
|
||||
adts = [
|
||||
adt(
|
||||
name = name,
|
||||
newName = f"{name}'",
|
||||
kind = kind,
|
||||
ctorsOrFields = [
|
||||
ctorOrField(
|
||||
name = cf,
|
||||
newName = f"{cf}'",
|
||||
isBuiltin = isBuiltin,
|
||||
type_ = type_,
|
||||
newType = type_ if isBuiltin else f"{type_}'",
|
||||
)
|
||||
for (cf, isBuiltin, type_) in ctors
|
||||
],
|
||||
)
|
||||
for (name, kind, ctors) in adts
|
||||
]
|
||||
|
||||
# pprint.PrettyPrinter(compact=False, indent=4).pprint(adts)
|
||||
|
||||
print("(* This is an auto-generated file. Do not edit. *)")
|
||||
|
||||
print("")
|
||||
print("open %s" % moduleName)
|
||||
|
||||
print("")
|
||||
for (index, t) in enumerate(adts):
|
||||
typeOrAnd = "type" if index == 0 else "and"
|
||||
print(f"{typeOrAnd} {t.newName} =")
|
||||
if t.kind == variant:
|
||||
for c in t.ctorsOrFields:
|
||||
print(f" | {c.newName} of {c.newType}")
|
||||
elif t.kind == record:
|
||||
print(" {")
|
||||
for f in t.ctorsOrFields:
|
||||
print(f" {f.newName} : {f.newType} ;")
|
||||
print(" }")
|
||||
else:
|
||||
print(" ", end='')
|
||||
for a in t.ctorsOrFields:
|
||||
print(f"{a.newType}", end=' ')
|
||||
print(t.kind, end='')
|
||||
print("")
|
||||
|
||||
print("")
|
||||
print(f"type 'state continue_fold =")
|
||||
print(" {")
|
||||
for t in adts:
|
||||
print(f" {t.name} : {t.name} -> 'state -> ({t.newName} * 'state) ;")
|
||||
for c in t.ctorsOrFields:
|
||||
print(f" {t.name}_{c.name} : {c.type_} -> 'state -> ({c.newType} * 'state) ;")
|
||||
print(" }")
|
||||
|
||||
print("")
|
||||
print(f"type 'state fold_config =")
|
||||
print(" {")
|
||||
for t in adts:
|
||||
print(f" {t.name} : {t.name} -> 'state -> ('state continue_fold) -> ({t.newName} * 'state) ;")
|
||||
print(f" {t.name}_pre_state : {t.name} -> 'state -> 'state ;")
|
||||
print(f" {t.name}_post_state : {t.name} -> {t.newName} -> 'state -> 'state ;")
|
||||
for c in t.ctorsOrFields:
|
||||
print(f" {t.name}_{c.name} : {c.type_} -> 'state -> ('state continue_fold) -> ({c.newType} * 'state) ;")
|
||||
print(" }")
|
||||
|
||||
print("")
|
||||
print('(* Curries the "visitor" argument to the folds (non-customizable traversal functions). *)')
|
||||
print("let rec mk_continue_fold : type state . state fold_config -> state continue_fold = fun visitor ->")
|
||||
print(" {")
|
||||
for t in adts:
|
||||
print(f" {t.name} = fold_{t.name} visitor ;")
|
||||
for c in t.ctorsOrFields:
|
||||
print(f" {t.name}_{c.name} = fold_{t.name}_{c.name} visitor ;")
|
||||
print("}")
|
||||
print("")
|
||||
|
||||
for t in adts:
|
||||
print(f"and fold_{t.name} : type state . state fold_config -> {t.name} -> state -> ({t.newName} * state) = fun visitor x state ->")
|
||||
print(" let continue_fold : state continue_fold = mk_continue_fold visitor in")
|
||||
print(f" let state = visitor.{t.name}_pre_state x state in")
|
||||
print(f" let (new_x, state) = visitor.{t.name} x state continue_fold in")
|
||||
print(f" let state = visitor.{t.name}_post_state x new_x state in")
|
||||
print(" (new_x, state)")
|
||||
print("")
|
||||
for c in t.ctorsOrFields:
|
||||
print(f"and fold_{t.name}_{c.name} : type state . state fold_config -> {c.type_} -> state -> ({c.newType} * state) = fun visitor x state ->")
|
||||
print(" let continue_fold : state continue_fold = mk_continue_fold visitor in")
|
||||
print(f" visitor.{t.name}_{c.name} x state continue_fold")
|
||||
print("")
|
||||
|
||||
print("let no_op : 'a fold_config = {")
|
||||
for t in adts:
|
||||
print(f" {t.name} = (fun v state continue ->")
|
||||
print(" match v with")
|
||||
if t.kind == variant:
|
||||
for c in t.ctorsOrFields:
|
||||
print(f" | {c.name} v -> let (v, state) = continue.{t.name}_{c.name} v state in ({c.newName} v, state)")
|
||||
elif t.kind == record:
|
||||
print(" {", end=' ')
|
||||
for f in t.ctorsOrFields:
|
||||
print(f"{f.name};", end=' ')
|
||||
print("} ->")
|
||||
for f in t.ctorsOrFields:
|
||||
print(f" let ({f.newName}, state) = continue.{t.name}_{f.name} {f.name} state in")
|
||||
print(" ({", end=' ')
|
||||
for f in t.ctorsOrFields:
|
||||
print(f"{f.newName};", end=' ')
|
||||
print("}, state)")
|
||||
else:
|
||||
print(f" v -> fold_{t.kind} v state (", end=' ')
|
||||
print(", ".join([f"continue.{t.name}_{f.name}" for f in t.ctorsOrFields]), end='')
|
||||
print(" )")
|
||||
print(" );")
|
||||
print(f" {t.name}_pre_state = (fun v state -> ignore v; state) ;")
|
||||
print(f" {t.name}_post_state = (fun v new_v state -> ignore (v, new_v); state) ;")
|
||||
for c in t.ctorsOrFields:
|
||||
print(f" {t.name}_{c.name} = (fun v state continue ->", end=' ')
|
||||
if c.isBuiltin:
|
||||
print("ignore continue; (v, state)", end='')
|
||||
else:
|
||||
print(f"continue.{c.type_} v state", end='')
|
||||
print(") ;")
|
||||
print("}")
|
||||
Loading…
Reference in New Issue
Block a user