view release on metacpan or  search on metacpan

lib/Perl6/PVIP.xs  view on Meta::CPAN

#ifdef __cplusplus
extern "C" {
#endif

#define PERL_NO_GET_CONTEXT /* we want efficiency */
#include <EXTERN.h>
#include <perl.h>
#include <XSUB.h>

#ifdef __cplusplus
} /* extern "C" */
#endif

#define NEED_newSVpvn_flags
#include "ppport.h"

#include <string.h>
#include "pvip.h"
#include "const.h"


#define XS_STATE(type, x)     (INT2PTR(type, SvROK(x) ? SvIV(SvRV(x)) : SvIV(x)))

#define XS_STRUCT2OBJ(sv, class, obj, is_root) \
    sv = newSViv(PTR2IV(obj));  \
    sv = newRV_noinc(sv); \
    sv_magic(sv, sv_2mortal(newSViv(is_root)), PERL_MAGIC_ext, NULL, 0); \
    sv_bless(sv, gv_stashpv(class, 1)); \
    SvREADONLY_on(sv);

MODULE = Perl6::PVIP    PACKAGE = Perl6::PVIP

PROTOTYPES: DISABLE

BOOT:
    setup_pvip_const();

void
_parse_string(code)
    SV *code;
PREINIT:
    size_t len;
    const char *buf;
    PVIPNode *node;
    SV *sv;
    SV *errpv;
PPCODE:
    buf = SvPV(code, len);
    PVIPString* err;
    node = PVIP_parse_string(buf, len, 0, &err);
    if (node) {
        XS_STRUCT2OBJ(sv, "Perl6::PVIP::Node", node, 1);
        XPUSHs(sv);
    } else {
        XPUSHs(&PL_sv_undef);
        errpv = newSVpv(err->buf, err->len);
        XPUSHs(errpv);
        PVIP_string_destroy(err);
    }

MODULE = Perl6::PVIP    PACKAGE = Perl6::PVIP::Node

int
type(self)
    SV *self;
CODE:
    PVIPNode *node = XS_STATE(PVIPNode*, self);
    RETVAL = node->type;
OUTPUT:
    RETVAL

int
line_number(self)
    SV *self;
CODE:
    PVIPNode *node = XS_STATE(PVIPNode*, self);
    RETVAL = node->line_number;
OUTPUT:
    RETVAL

SV*
as_sexp(self)
    SV *self;
PREINIT:
    SV *ret;
CODE:
    PVIPNode *node = XS_STATE(PVIPNode*, self);
    PVIPString * buf = PVIP_string_new();
    PVIP_node_as_sexp(node, buf);
    ret = newSVpv(buf->buf, buf->len);
    PVIP_string_destroy(buf);
    RETVAL = ret;
OUTPUT:
    RETVAL

int
category(self)
    SV *self;
CODE:
    PVIPNode *node = XS_STATE(PVIPNode*, self);
    RETVAL = PVIP_node_category(node->type);
OUTPUT:
    RETVAL

const char*
name(self)
    SV *self;