From 2d777b055b750c40d2698422202c4d3950822a0c Mon Sep 17 00:00:00 2001
From: Jesse Luehrs <doy@tozt.net>
Date: Wed, 17 Jul 2013 00:28:52 -0400
Subject: initial sketch of the framework

now, just need to expose the parser functions to perl
---
 Keyword.xs           | 64 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 dist.ini             |  3 +++
 lib/Parse/Keyword.pm | 30 ++++++++++++++++++++++++
 3 files changed, 97 insertions(+)
 create mode 100644 Keyword.xs

diff --git a/Keyword.xs b/Keyword.xs
new file mode 100644
index 0000000..4531169
--- /dev/null
+++ b/Keyword.xs
@@ -0,0 +1,64 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "callparser1.h"
+#include "XSUB.h"
+
+static OP *parser_callback(pTHX_ GV *namegv, SV *psobj, U32 *flagsp)
+{
+    dSP;
+    SV *args_generator;
+
+    // call the parser callback
+    // it should take no arguments and return a coderef which, when called,
+    // produces the arguments to the keyword function
+    // the optree we want to generate is for something like
+    //   mykeyword($code->())
+    // where $code is the thing returned by the parser function
+
+    PUSHMARK(SP);
+    call_sv(psobj, G_SCALAR);
+    SPAGAIN;
+    args_generator = SvREFCNT_inc(POPs);
+    PUTBACK;
+
+    if (!SvROK(args_generator) || SvTYPE(SvRV(args_generator)) != SVt_PVCV) {
+        croak("The parser function for %s must return a coderef, not %"SVf,
+              GvNAME(namegv), args_generator);
+    }
+
+    return newUNOP(OP_ENTERSUB, OPf_STACKED,
+                   newCVREF(0,
+                            Perl_scalar(newSVOP(OP_CONST, 0,
+                                                args_generator))));
+}
+
+// we will need helper functions for
+// - lexer functions
+//   - lex_read_space
+//   - lex_peek_unichar
+//   - lex_stuff_sv
+// - parser functions (OP* return values should become coderefs)
+//   - parse_arithexpr
+//   - parse_barestmt
+//   - parse_block
+//   - parse_fullexpr
+//   - parse_fullstmt
+//   - parse_label
+//   - parse_listexpr
+//   - parse_stmtseq
+//   - parse_termexpr
+// - random other things
+//   - "read a variable name"
+//   - "read a quoted string"
+//   - "create a new lexical variable" (should return a reference to it)
+
+MODULE = Parse::Keyword  PACKAGE = Parse::Keyword
+
+PROTOTYPES: DISABLE
+
+void
+install_keyword_handler(keyword, handler)
+    SV *keyword
+    SV *handler
+  CODE:
+    cv_set_call_parser((CV*)SvRV(keyword), parser_callback, handler);
diff --git a/dist.ini b/dist.ini
index a58d238..1482b99 100644
--- a/dist.ini
+++ b/dist.ini
@@ -9,7 +9,10 @@ dist = Parse-Keyword
 repository = github
 bugtracker_web = https://github.com/doy/parse-keyword/issues
 bugtracker_mailto =
+awesome = =inc::MakeMaker
 
 [AutoPrereqs]
+[Prereqs / ConfigureRequires]
+Devel::CallParser = 0
 
 [ContributorsFromGit]
diff --git a/lib/Parse/Keyword.pm b/lib/Parse/Keyword.pm
index e69de29..b2e2709 100644
--- a/lib/Parse/Keyword.pm
+++ b/lib/Parse/Keyword.pm
@@ -0,0 +1,30 @@
+package Parse::Keyword;
+use strict;
+use warnings;
+use 5.014;
+# ABSTRACT: write syntax extensions in perl
+
+use Devel::CallParser;
+use XSLoader;
+
+XSLoader::load(
+    __PACKAGE__,
+    exists $Parse::Keyword::{VERSION} ? ${ $Parse::Keyword::{VERSION} } : (),
+);
+
+sub import {
+    my $package = shift;
+    my ($keywords) = @_;
+
+    my $caller = caller;
+
+    for my $keyword (keys %$keywords) {
+        my $sub = do {
+            no strict 'refs';
+            \&{ $caller . '::' . $keyword };
+        };
+        install_keyword_handler($sub, $keywords->{$keyword});
+    }
+}
+
+1;
-- 
cgit v1.2.3-54-g00ecf