Robert Acock

Over the past year, I’ve been self-studying XS and have now decided to share my learning journey through a series of blog posts. This tenth post introduces you to what I call closures in XS.

Firstly lets start with the basics of programming and Scope?

Scope refers to the visibility and lifetime of variables and functions in a program. In Perl, scope is determined by where variables are declared and how they are used. Subroutines have access only to variables within their own scope, and this depends on where those variables are declared. In contrast, C is a statically typed language and handles scope differently, variables and functions have fixed types and their visibility is determined by their declaration context, such as within a function, file, or globally. This difference in how scope is managed makes certain Perl features, like closures, more challenging to implement directly in C.

Closures?

In Perl, a closure is an anonymous subroutine that captures variables from its surrounding lexical scope. This means the subroutine "remembers" the values of those variables even after the outer scope has finished executing. A simple example of a closure in perl is the following:

sub closure {
    my ($self) = @_;
    return sub {
        my ($x) = @_;
        return $self + $x;
    };
}

Now, as mentioned, C works differently closures aren’t built into the language. While you can use libraries like 'Block' or roll your own closure like mechanism in C, it's difficult. They are also not built into XS however during my learning journey I’ve discovered a straightforward approach to achieving closure like behaviour, which I’ll now share in this post.

Today we are going to reimplement the following perl code:

package Pet::Cat;

use parent 'Exporter';

our @EXPORT = qw/cat/;

sub cat {
    my ($name, $hunger, $happiness) = @_;
    $hunger ||= 5;
    $happiness ||= 5;
    return sub {
        my $action = @_;
        if ($action) {
            if ($action eq 'feed') {
                $hunger = $hunger > 0 ? $hunger - 1 : 0;
                return "$name purrs contentedly. Hunger is now $hunger.";
            } elsif ($action eq 'play') {
                $happiness++;
                return "$name chases a laser pointer! Happiness is now $happiness.";
            }  else {
                $happiness--;
                $hunger++;
            }
        }
        return "$name curls up and waits for attention.";
    }
}

1;

You would then call this module like:

use Pet::Cat;

my $simba = cat("Simba");

say $simba->('feed'); # Simba purrs contentedly. Hunger is now 4
say $simba->('play'); # Simba chases a laser pointer! Happiness is now 6
say $simba->('fetch'); # Simba curls up and waits for attention

Today so I can try to demonstrate how to achieve the above in XS I will implement the relevant XSUBs in multiple steps. First lets create a new distribution using module starter:

module-starter --module="Pet::Cat" --author="Your Name" --email="your email"

Update the Makefile.PL to include XSMULTI then open lib/Pet/Cat.pm and fix the boilerplat code:

package Pet::Cat;

use 5.006;
use strict;
use warnings;

our $VERSION = '0.01';

require XSLoader;
XSLoader::load("Pet::Cat", $VERSION);

1;

Now create the XS file lib/Pet/Cat.xs and add the following code:

#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

MODULE = Pet::Cat  PACKAGE = Pet::Cat
PROTOTYPES: DISABLE

We will start today by implementing a very simple closure that simply returns the passed in name of our cat first lets add a temporary test we will later remove:

use Test::More;

use Pet::Cat;

my $simba = Pet::Cat::cat("Simba");
is(ref($simba), 'CODE', 'cat returns a code reference');

is($simba->(), 'Simba', 'TEMPORARY TEST: cat closure returns the cat name');

done_testing();

To implement this we will need to create two new XSUbs in lib/Pet/Cat.xs, one the entry point 'cat' which returns the second 'cat_closure' as a 'anonymous subroutine' or 'closure'. The code to pass the test is as follows:

SV *
cat_closure(...)
    CODE:
        SV * self = CvXSUBANY(cv).any_ptr;
        RETVAL = self;
    OUTPUT:
       RETVAL

CV *
cat(name, ...)
    SV * name
    CODE:
        CV * kitty = newXS(NULL, XS_Pet__Cat_cat_closure, __FILE__);
        CvXSUBANY(kitty).any_ptr = (void *)name;
        SvREFCNT_inc(kitty);
        RETVAL = kitty;
    OUTPUT:
        RETVAL

To explain this code above we have two XSUBs called 'cat_closure' and 'cat', cat creates an anonymous code reference using newXS, which as mentioned in previous posts is a way to create a new XSUB in XS, by passing the first argument as NULL this makes it anonymous without a fixed namespace. We then use 'CvXSUBANY' which is a macro that allow us to access the XSUBANY union associated with the CV, all complicated stuff... then we use 'any_ptr' which is used to store an arbitrary C pointer inside an XSUB’s context
.
Now we can run our test and it should pass:

perl Makefile.PL
make
make test

Next we will need to modify what we store in 'any_pty' as we have to keep track of additional parameters, the hunger and happiness of our cat. We will do this by using a HV, update the 'new' XSUB to the following:

CV *
cat(name, ...)
    SV * name
    CODE:
        CV * kitty = newXS(NULL, XS_Pet__Cat_cat_closure, __FILE__);
        HV * stash = newHV();
        hv_store(stash, "name", 4, newSVsv(name), 0);
        hv_store(stash, "happiness", 9, items > 1 ? newSVsv(ST(1)) : newSViv(5), 0);
        hv_store(stash, "hunger", 6, items > 2 ? newSVsv(ST(2)) : newSViv(5), 0);
        CvXSUBANY(kitty).any_ptr = (void *)stash;
        SvREFCNT_inc(kitty);
        RETVAL = kitty;
    OUTPUT:
        RETVAL

Then modify the 'cat_closure' XSUB to retrieve the values from the HV.

SV *
cat_closure(...)
    CODE:
        HV * self = CvXSUBANY(cv).any_ptr;
        SV * name = *hv_fetch(self, "name", 4, 0);
        RETVAL = name;
    OUTPUT:
        RETVAL

Now we can run our test again and it should still pass. Next lets remove the temporary test and add the real functionality to our closure. We will modify the 'cat_closure' XSUB to handle the actions of feeding and playing.

is($simba->('feed'), 'Simba purrs contentedly. Hunger is now 4');
is($simba->('play'), 'Simba chases a laser pointer! Happiness is now 6');
is($simba->('fetch'), 'Simba curls up and waits for attention');

To implement this we will modify the 'cat_closure' XSUB to handle the actions:

SV *
cat_closure(...)
    CODE:
        STRLEN retlen;
        HV * self = CvXSUBANY(cv).any_ptr;
        SV * name = *hv_fetch(self, "name", 4, 0);
        SV * happiness = *hv_fetch(self, "happiness", 9, 0);
        SV * hunger = *hv_fetch(self, "hunger", 6, 0);
        RETVAL = newSVpvf("%s curls up and waits for attention", SvPV(name, retlen));

        if (items > 0 && SvOK(ST(0)) && SvTYPE(ST(0)) == SVt_PV) {
            const char *action = SvPV(ST(0), retlen);

            if (strcmp(action, "feed") == 0) {
                SvREFCNT_dec(RETVAL);
                int hunger_val = SvIV(hunger);
                if (hunger_val > 0) hunger_val--;
                sv_setiv(hunger, hunger_val);
                RETVAL = newSVpvf("%s purrs contentedly. Hunger is now %d", SvPV(name, retlen), hunger_val);
            } else if (strcmp(action, "play") == 0) {
                SvREFCNT_dec(RETVAL);
                int happiness_val = SvIV(happiness);
                sv_setiv(happiness, ++happiness_val);
                RETVAL = newSVpvf("%s chases a laser pointer! Happiness is now %d", SvPV(name, retlen), happiness_val);
            } else {
                int happiness_val = SvIV(happiness);
                int hunger_val = SvIV(hunger);
                sv_setiv(happiness, --happiness_val);
                sv_setiv(hunger, ++hunger_val);
            }
        } 
    OUTPUT:
       RETVAL

This code retrieves the name, happiness, and hunger values from the HV, then checks if an action is provided. If the action is 'feed', it decreases hunger and returns a message. If the action is 'play', it increases happiness and returns a message. If an unrecognized action is provided, it decreases happiness and increases hunger, returning a default message. If undef is passed or any param not a string it just returns the default message. The only new function you may have not seen in the previous posts is 'sv_setiv' we use it to update the integer internal value of the SVs.

Now make test and your tests should pass.

Finally to complete our module we need to add an import XSUB to allow the use of the 'cat' function in a more Perl-like way. Add the following code to lib/Pet/Cat.xs:

void
import(...)
    CODE:
        char *pkg = HvNAME((HV*)CopSTASH(PL_curcop));
        int name_len = strlen(pkg) + 6;
        char *name = (char *)malloc(name_len);
        snprintf(name, name_len, "%s::cat", pkg);
        newXS(name, XS_Pet__Cat_cat, __FILE__);

And that completes our XS module. Today we have learned how to implement closure-like behaviour in XS by using a hash to store the state of our cat, allowing us to maintain the values of hunger and happiness across calls. This approach mimics the closure functionality found in Perl, enabling us to create a simple yet effective way to manage scope in XS.

I hope you found this post helpful. If you have any questions or suggestions for future posts, feel free to reach out.