Derive XS prereqs from parcel prereqs
Add "host_module_name" to host-specific JSON and use it to derive
XS prereqs automatically.
diff --git a/compiler/perl/lib/Clownfish/CFC.xs b/compiler/perl/lib/Clownfish/CFC.xs
index 6292f01..8caa0b7 100644
--- a/compiler/perl/lib/Clownfish/CFC.xs
+++ b/compiler/perl/lib/Clownfish/CFC.xs
@@ -1192,6 +1192,7 @@
included = 16
prereq_parcels = 20
inherited_parcels = 22
+ get_xs_module = 24
PPCODE:
{
START_SET_OR_GET_SWITCH
@@ -1245,6 +1246,11 @@
FREEMEM(parcels);
}
break;
+ case 24: {
+ const char *xs_module = CFCParcel_get_host_module_name(self);
+ retval = newSVpvn(xs_module, strlen(xs_module));
+ }
+ break;
END_SET_OR_GET_SWITCH
}
diff --git a/compiler/perl/lib/Clownfish/CFC/Perl/Build.pm b/compiler/perl/lib/Clownfish/CFC/Perl/Build.pm
index 96d1d88..58b9296 100644
--- a/compiler/perl/lib/Clownfish/CFC/Perl/Build.pm
+++ b/compiler/perl/lib/Clownfish/CFC/Perl/Build.pm
@@ -399,8 +399,8 @@
push @$c_files, @{ $self->rscan_dir( $source_dir, qr/\.c$/ ) };
}
my $autogen_src_dir = catdir( $AUTOGEN_DIR, 'source' );
- for my $parcel ( @{ $module->{parcels} } ) {
- $parcel = Clownfish::CFC::Model::Parcel->acquire($parcel);
+ for my $parcel_name ( @{ $module->{parcels} } ) {
+ my $parcel = Clownfish::CFC::Model::Parcel->acquire($parcel_name);
my $prefix = $parcel->get_prefix;
# Assume *_parcel.c is built with make.
push @$c_files, catfile( $autogen_src_dir, "${prefix}parcel.c" )
@@ -490,10 +490,8 @@
my $lib_file = catfile( $archdir, "$class_name.$Config{dlext}" );
if ( !$self->up_to_date( [ @objects, $AUTOGEN_DIR ], $lib_file ) ) {
my $linker_flags = $self->extra_linker_flags;
- if ( $module->{xs_prereqs} ) {
- push @$linker_flags,
- $self->cf_linker_flags( @{ $module->{xs_prereqs} } );
- }
+ my @xs_prereqs = $self->_cf_find_xs_prereqs($module);
+ push @$linker_flags, $self->cf_linker_flags(@xs_prereqs);
$cbuilder->link(
module_name => $module_name,
objects => \@objects,
@@ -512,6 +510,47 @@
}
}
+sub _cf_find_xs_prereqs {
+ my ( $self, $module ) = @_;
+
+ my $modules = $self->clownfish_params('modules');
+ my @xs_prereqs;
+
+ for my $parcel_name ( @{ $module->{parcels} } ) {
+ my $parcel = Clownfish::CFC::Model::Parcel->acquire($parcel_name);
+
+ for my $prereq_parcel ( @{ $parcel->prereq_parcels } ) {
+ my $prereq_module;
+
+ if ($prereq_parcel->included) {
+ $prereq_module = $prereq_parcel->get_xs_module;
+ }
+ else {
+ my $prereq_parcel_name = $prereq_parcel->get_name;
+
+ for my $candidate (@$modules) {
+ my @matches = grep {
+ $_ eq $prereq_parcel_name
+ } @{ $candidate->{parcels} };
+
+ if (@matches) {
+ $prereq_module = $candidate->{name};
+ last;
+ }
+ }
+ }
+
+ die("No XS module found for parcel $parcel_name")
+ if !defined($prereq_module);
+ push @xs_prereqs, $prereq_module
+ if $prereq_module ne $module->{name}
+ && !grep { $_ eq $prereq_module } @xs_prereqs;
+ }
+ }
+
+ return @xs_prereqs;
+}
+
sub ACTION_code {
my $self = shift;
@@ -629,12 +668,10 @@
name => 'My::Module',
c_source_dirs => 'xs',
parcels => [ 'MyModule' ],
- xs_prereqs => [ 'Clownfish' ],
},
{
name => 'My::Module::Test',
parcels => [ 'TestMyModule' ],
- xs_prereqs => [ 'Clownfish', 'My::Module' ],
},
],
},
diff --git a/compiler/src/CFCBindCore.c b/compiler/src/CFCBindCore.c
index ecdc091..95e0206 100644
--- a/compiler/src/CFCBindCore.c
+++ b/compiler/src/CFCBindCore.c
@@ -783,6 +783,15 @@
const char *parcel_name = CFCParcel_get_name(parcel);
CFCVersion *version = CFCParcel_get_version(parcel);
const char *vstring = CFCVersion_get_vstring(version);
+ char *json_pairs = CFCUtil_strdup("");
+
+ const char *host_module_name = CFCParcel_get_host_module_name(parcel);
+ if (host_module_name != NULL) {
+ const char *pattern = " \"host_module\": \"%s\"";
+ char *pair = CFCUtil_sprintf(pattern, host_module_name);
+ json_pairs = CFCUtil_cat(json_pairs, pair, NULL);
+ FREEMEM(pair);
+ }
char *classes_json = CFCUtil_strdup("");
CFCClass **ordered = CFCHierarchy_ordered_classes(self->hierarchy);
@@ -805,25 +814,35 @@
}
FREEMEM(ordered);
+ if (classes_json[0] != '\0') {
+ const char *pattern =
+ " \"classes\": {\n"
+ "%s\n"
+ " }";
+ char *pair = CFCUtil_sprintf(pattern, classes_json);
+ const char *sep = json_pairs[0] == '\0' ? "" : ",\n";
+ json_pairs = CFCUtil_cat(json_pairs, sep, pair, NULL);
+ FREEMEM(pair);
+ }
+
char *filepath = CFCUtil_sprintf("%s" CHY_DIR_SEP "%s" CHY_DIR_SEP "%s"
CHY_DIR_SEP "parcel_%s.json", dest_dir,
parcel_name, vstring, host_lang);
remove(filepath);
- if (classes_json[0] != '\0') {
+ if (json_pairs[0] != '\0') {
const char *pattern =
"{\n"
- " \"classes\": {\n"
"%s\n"
- " }\n"
"}\n";
- char *json = CFCUtil_sprintf(pattern, classes_json);
+ char *json = CFCUtil_sprintf(pattern, json_pairs);
CFCUtil_write_file(filepath, json, strlen(json));
FREEMEM(json);
}
FREEMEM(filepath);
FREEMEM(classes_json);
+ FREEMEM(json_pairs);
}
diff --git a/compiler/src/CFCParcel.c b/compiler/src/CFCParcel.c
index c8e74f4..25cc77c 100644
--- a/compiler/src/CFCParcel.c
+++ b/compiler/src/CFCParcel.c
@@ -35,6 +35,7 @@
CFCBase base;
char *name;
char *nickname;
+ char *host_module_name;
CFCVersion *version;
CFCVersion *major_version;
CFCFileSpec *file_spec;
@@ -357,6 +358,7 @@
CFCParcel_destroy(CFCParcel *self) {
FREEMEM(self->name);
FREEMEM(self->nickname);
+ FREEMEM(self->host_module_name);
CFCBase_decref((CFCBase*)self->version);
CFCBase_decref((CFCBase*)self->major_version);
CFCBase_decref((CFCBase*)self->file_spec);
@@ -396,6 +398,24 @@
return self->nickname;
}
+const char*
+CFCParcel_get_host_module_name(CFCParcel *self) {
+ return self->host_module_name;
+}
+
+void
+CFCParcel_set_host_module_name(CFCParcel *self, const char *name) {
+ if (self->host_module_name != NULL) {
+ if (strcmp(self->host_module_name, name) != 0) {
+ CFCUtil_die("Conflicting host modules '%s' and '%s' for parcel %s",
+ self->host_module_name, name, self->name);
+ }
+ }
+ else {
+ self->host_module_name = CFCUtil_strdup(name);
+ }
+}
+
int
CFCParcel_is_installed(CFCParcel *self) {
return self->is_installed;
@@ -532,17 +552,25 @@
if (!extra_data) {
CFCUtil_die("Invalid JSON in file '%s'", path);
}
- CFCJson *class_hash = CFCJson_find_hash_elem(extra_data, "classes");
- if (!class_hash) { return; }
- CFCJson **children = CFCJson_get_children(class_hash);
- for (int i = 0; children[i]; i += 2) {
- const char *class_name = CFCJson_get_string(children[i]);
- CFCClass *klass = CFCClass_fetch_singleton(class_name);
- if (!klass) {
- CFCUtil_die("Class '%s' in '%s' not found", class_name, path);
+ CFCJson *host_module_json
+ = CFCJson_find_hash_elem(extra_data, "host_module");
+ if (host_module_json) {
+ const char *name = CFCJson_get_string(host_module_json);
+ CFCParcel_set_host_module_name(self, name);
+ }
+
+ CFCJson *class_hash = CFCJson_find_hash_elem(extra_data, "classes");
+ if (class_hash) {
+ CFCJson **children = CFCJson_get_children(class_hash);
+ for (int i = 0; children[i]; i += 2) {
+ const char *class_name = CFCJson_get_string(children[i]);
+ CFCClass *klass = CFCClass_fetch_singleton(class_name);
+ if (!klass) {
+ CFCUtil_die("Class '%s' in '%s' not found", class_name, path);
+ }
+ CFCClass_read_host_data_json(klass, children[i+1], path);
}
- CFCClass_read_host_data_json(klass, children[i+1], path);
}
CFCJson_destroy(extra_data);
diff --git a/compiler/src/CFCParcel.h b/compiler/src/CFCParcel.h
index da86703..d173079 100644
--- a/compiler/src/CFCParcel.h
+++ b/compiler/src/CFCParcel.h
@@ -90,6 +90,12 @@
const char*
CFCParcel_get_nickname(CFCParcel *self);
+const char*
+CFCParcel_get_host_module_name(CFCParcel *self);
+
+void
+CFCParcel_set_host_module_name(CFCParcel *self, const char *name);
+
int
CFCParcel_is_installed(CFCParcel *self);
diff --git a/compiler/src/CFCPerl.c b/compiler/src/CFCPerl.c
index 62a7f48..e9ef8bd 100644
--- a/compiler/src/CFCPerl.c
+++ b/compiler/src/CFCPerl.c
@@ -540,14 +540,21 @@
char *hand_rolled_xs = CFCUtil_strdup("");
for (size_t i = 0; parcels[i]; ++i) {
+ CFCParcel *parcel = parcels[i];
+
+ // Set host_module_name for parcel.
+ if (!CFCParcel_included(parcel) && CFCParcel_is_installed(parcel)) {
+ CFCParcel_set_host_module_name(parcel, boot_class);
+ }
+
// Bake the parcel privacy defines into the XS, so it can be compiled
// without any extra compiler flags.
- const char *privacy_sym = CFCParcel_get_privacy_sym(parcels[i]);
+ const char *privacy_sym = CFCParcel_get_privacy_sym(parcel);
privacy_syms = CFCUtil_cat(privacy_syms, "#define ", privacy_sym,
"\n", NULL);
// Bootstrap calls.
- const char *prefix = CFCParcel_get_prefix(parcels[i]);
+ const char *prefix = CFCParcel_get_prefix(parcel);
includes = CFCUtil_cat(includes, "#include \"", prefix, "perl.h\"\n",
NULL);
bootstrap_calls = CFCUtil_cat(bootstrap_calls, " ", prefix,
diff --git a/runtime/perl/buildlib/Clownfish/Build.pm b/runtime/perl/buildlib/Clownfish/Build.pm
index 0efe35a..c038ebc 100644
--- a/runtime/perl/buildlib/Clownfish/Build.pm
+++ b/runtime/perl/buildlib/Clownfish/Build.pm
@@ -85,7 +85,6 @@
name => 'Clownfish::Test',
parcels => [ 'TestClownfish' ],
make_target => 'test_objects',
- xs_prereqs => [ 'Clownfish' ],
},
],
};
