genzmq.p6

#!/usr/bin/env perl6

use lib $?FILE.IO.parent.child('lib');

use C::Parser::Grammar;

class CFunction {
    has $.name;
    has $.return = Any;
    has @.args = ();

    method Str () {
        "sub $!name ({@!args.join: ', '}) {"returns $!return " if $!return.defined}is native('zmq') \{*};";
    }
}

sub MAIN (Str $header = 'zmq-pp.h') {
    my $source = slurp $header;
    my $parse = C::Parser::Grammar.parse($source);
    $parse = $parse<translation-unit><external-declaration>;
    
    for @$parse {
        my $declaration = $_<declaration>;
        next unless $declaration<init-declarator-list> :exists;
        next unless $declaration<init-declarator-list><init-declarator>[0]<declarator> :exists;
        my $declarator = $declaration<init-declarator-list><init-declarator>[0]<declarator>;
        my $name = $declarator<direct-declarator><direct-declarator-first><ident><name>;
        next unless $name && $name ~~ /^zmq_/;

        my $return;
        my $pointer = ?($declarator<direct-declarator><pointer> || $declarator<pointer>);
        my $type = nativecall-type
            $declaration<declaration-specifiers><declaration-specifier>[*-1]<type-specifier>,
            $pointer;
        $return = $type unless $type eq 'void';

        my @args;
        for $declarator<direct-declarator><direct-declarator-rest>[0]<parameter-type-list><parameter-list><parameter-declaration>.list {
            my $pointer = ?($_<declarator><pointer> or $_<abstract-declarator> && $_<abstract-declarator><pointer>);
            push @args, nativecall-type
                $_<declaration-specifiers><declaration-specifier>[*-1]<type-specifier>,
                $pointer;
        }
        @args = () if @args eqv ['void'];

        my $cfunc = CFunction.new: :$name, :$return, :@args;
        say ~$cfunc;
    }
}

sub nativecall-type ($c-type is copy, Bool $pointer = False) {
    $c-type .= trim;

    $pointer ??  do given $c-type {
        when 'char' { 'Str' }
        default { 'OpaquePointer' }
    } !!  do given $c-type {
        when 'size_t' | 'long' { 'int32' }
        when / ^ u? (int\d*) [_t]? $ / { $0 }
        default { $_ }
    }
}