Skip to content

Instantly share code, notes, and snippets.

View arnsholt's full-sized avatar

Arne Skjærholt arnsholt

View GitHub Profile
@arnsholt
arnsholt / nativecall.t
Created September 3, 2013 19:24
NativeCall weirdness
plan(1);
my $arg_hash;
my $return_hash;
class Call is repr('NativeCall') { }
class CPointer is repr('CPointer') { }
my $printf := nqp::create(Call);
$arg_hash := nqp::hash();
From cdeabc2ba7f357b886184c2a73b8beb48e1720c9 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Arne=20Skj=C3=A6rholt?= <arnsholt@gmail.com>
Date: Thu, 29 Aug 2013 17:51:29 +0200
Subject: [PATCH] Temporary commit for jnthn.
---
lib/NativeCall.pm6 | 7 +++++--
t/02-simple-args.t | 14 +++++++-------
2 files changed, 12 insertions(+), 9 deletions(-)
sub foo() { say "in sub"; }
role Test {
method postcircumfix:<( )>($args) {
say "overridden";
}
}
role Other {
method bar() { say "foo"; }
# Expects to be live in .../zavolaj/
use lib '.';
use t::CompileTestLib;
use NativeCall;
compile_test_lib('08-callbacks');
sub TakeACallback(&cb()) is native('./08-callbacks') { * }
sub simple_callback() {
/*
* Grammar production: [Cat, [Cat]] or [Cat, Term]
* DI: [Cat, Consumed, Left]
*/
%disr(Rest, Stack, Grammar) :- fail.
disr(Input, Grammar) :- disr(Input, [], Grammar).
% SHIFT: Word of category Cat next word in input: ``push Cat -> Word \dot'' onto stack.
disr([W|Rest], Stack, Grammar) :- grammar_terminal(Grammar, W, Cat), DI = [Cat, [W], []], disr(Rest, [DI|Stack], Grammar).
% SEED: Given a completed DI of category CatB on top of the stack and a production CatA -> CatB ..., replace the top item with a new DI [CatA, [CatB], ...]
use lib '.';
use t::CompileTestLib;
use NativeCall;
compile_test_lib('08-callbacks');
sub TakeACallback(&cb()) is native('./08-callbacks') { * }
sub simple_callback() {
say 'simple callback';
@arnsholt
arnsholt / VTABLE_does.c
Created March 23, 2013 13:40
Tweaked VTABLE_does
VTABLE INTVAL does(STRING *what) {
PMC *decont = decontainerize(interp, SELF);
if (Parrot_str_equal(interp, what, CONST_STRING(interp, "invokable"))) {
return 1;
}
else if (Parrot_str_equal(interp, what, CONST_STRING(interp, "array"))) {
return Parrot_str_equal(interp, REPR(decont)->name, CONST_STRING(interp, "VMArray"));
}
else if (Parrot_str_equal(interp, what, CONST_STRING(interp, "hash"))) {
QAST::Operations.add_core_op('list', :inlinable(1), -> $qastcomp, $op {
# Create register for the resulting list and make an empty one.
my $arr := $qastcomp.as_post(QAST::Op.new(:op('create'), QAST::Op.new(:op('hlllist'))));
# Push all the things.
if +$op.list {
my $list_reg := $*REGALLOC.fresh_p();
my $ops := PIRT::Ops.new(:result($list_reg));
$ops.push_pirop('set', $list_reg, $arr);
static PMC *boot_type(PARROT_INTERP, PMC *knowhow, char *type_name, char *repr_name) {
PMC *knowhow_how = STABLE(knowhow)->HOW;
PMC *meta_obj = REPR(knowhow_how)->allocate(interp, STABLE(knowhow_how));
PMC *sc = SC_get_sc(interp, Parrot_str_new_constant(interp, "__6MODEL_CORE__"));
REPROps *repr;
PMC *type_obj;
REPR(meta_obj)->initialize(interp, STABLE(meta_obj), OBJECT_BODY(meta_obj));
/* XXX: Doesn't look like NQP/Parrot 6model types have a name... */
repr = REPR_get_by_name(interp, Parrot_str_new_constant(interp, repr_name));
@arnsholt
arnsholt / nativeconstant.pl
Created February 23, 2013 21:57
Multisub and native type constant oddness.
my int $x = 4;
my int constant y = 4;
foo($x);
foo(y);
multi sub foo(int $x) { say "int" }
multi sub foo(Str $x) { say "Str" }