Generates packages instead of programs

Makefile

@@ -1,3 +1,10 @@
+all: htmlgen
+
+htmlgen: htmlgen.pl test.htmlgen
+	perl $< test.htmlgen
+
+htmlgen.pl: htmlgen.mp
+	perl generated_marpa_parser3.pl $< > $@
 
 generated_marpa_parser.pl: marpa_parser.pl marpa.mp
 	perl -I lib marpa_parser.pl marpa.mp > $@

bin/marp

@@ -0,0 +1,7 @@
+#!/usr/bin/env perl
+use lib 'lib';
+use Marp::App;
+my $app = Marp::App->new();
+$app->parse_args(@ARGV);
+$app->run();
+

examples/add/add.mp

@@ -1,5 +1,6 @@
-
 Number = /\d+/
+Space = /[ \r\n\t]+/
 
-
-Parser ::= Number {{ return $_[1]; }}
+Parser ::= Number WS         {{ return $_[1]; }}
+WS     ::= Null
+WS     ::= Space

examples/add/add.pl

@@ -0,0 +1,7 @@
+
+use MarpaX::Parser::Number;
+use Data::Dumper;
+
+my $p = MarpaX::Parser::Number->new();
+my $tree = $p->parse(*STDIN);
+print Dumper($tree);

examples/htmlgen/htmlgen.mp

@@ -0,0 +1,23 @@
+WS     = /[ \t\n\r]+/
+Id     = /([a-z]+)/
+Tag    = /(\w+)/
+Char   = /([^"])/
+
+Parser     ::= Tree+                                {{ shift; return \@_; }}
+Tree       ::= Space Tag Block                      {{ shift; return { _tag => $_[1], _block => $_[2] } }}
+Tree       ::= Space Tag Attrs                      {{ shift; return { _tag => $_[1], _attrs => $_[2] } }}
+Tree       ::= Space Tag Attrs Block                {{ shift; return { _tag => $_[1], _attrs => $_[2], _block => $_[3] } }}
+Tree       ::= Space AtId                           {{ shift; return $_[1]; }}
+Tree       ::= Space String Space                   {{ shift; return $_[1]; }}
+Tree       ::= Space $? AtId Space Block            {{ shift; return { _if => $_[2], _block => $_[4] } }}
+Block      ::= Space ${ Space Parser Space $} Space {{ shift; return $_[3]; }}
+Block      ::= Space ${ $}                          {{ shift; return []; }}
+Attrs      ::= Attr+                                {{ shift; return \@_; }}
+Attr       ::= Space Id $= String                   {{ shift; return { _id => $_[1], _string => $_[3] } }}
+Attr       ::= Space Id $= AtId                     {{ shift; return { _id => $_[1], _atid => $_[3] } }}
+AtId       ::= $@ Id                                {{ shift; return $_[0].$_[1]; }}
+String     ::= $" Chars $"                          {{ shift; return {_str => $_[1]} }}
+Chars      ::= Null
+Chars      ::= Char+                                {{ shift; return join('', @_); }}
+Space      ::= Null
+Space      ::= WS

examples/htmlgen/htmlgen.pl

@@ -0,0 +1,19 @@
+use strict;
+use lib 'lib';
+use Data::Dumper;
+
+use MarpaX::Parser::HTMLGen;
+use MarpaX::CodeGen::HTMLGen;
+
+my $infile = $ARGV[0];
+
+open my $fh, '<', $infile or die "Can't open '$infile'";
+
+my $codegen = MarpaX::CodeGen::HTMLGen->new;
+
+my $parser = MarpaX::Parser::HTMLGen->new;
+my $parse_tree = $parser->parse($fh);
+print Dumper($parse_tree);
+
+$codegen->generate_code($parse_tree);
+

examples/htmlgen/htmlgenprog.pl

@@ -0,0 +1,131 @@
+#!/usr/bin/perl -w
+use 5.14.1;
+use Data::Dumper;
+
+sub load_program {
+    my ($fh) = @_;
+
+    my @program;
+    my %labels;
+    my %strings;
+
+    while (<$fh>) {
+        chomp;
+
+        s/^\s+//;
+
+        if (m/^\.STR\s+(\w+)\s(.*)$/) {
+            my $k = $1;
+            my $v = $2;
+            $v =~ s/\\n/\n/g;
+            $strings{$k} = $v;
+        }
+        elsif (m/^Emit\s+(\w+)/) {
+            my $k = $1;
+            push @program, [ 'Emit', $strings{$k} ];
+        }
+        elsif (m/^Emit\s+\@(\w+)$/) {
+            my $key = $1;
+            push @program, [ 'Emit_Field', $key ];
+        }
+        elsif (m/^Exists\s+\@(\w+)$/) {
+            my $key = $1;
+            push @program, [ 'Exists', $key ];
+        }
+        elsif (m/^End$/) {
+            push @program, [ 'End' ];
+        }
+        elsif (m/^JF\s+(\w+)$/) {
+            push @program, [ 'JF', $1 ];
+        }
+        elsif (m/^JT\s+(\w+)$/) {
+            push @program, [ 'JE', $1 ];
+        }
+        elsif (m/^(\w+):/) {
+            $labels{$1} = scalar @program;
+        }
+    }
+    return (\%labels, \@program);
+}
+
+sub create_machine {
+    my $filename = shift;
+
+    my %opcodes = (
+        Emit       => sub { print $_[1]; return $_[0]->{ip}+1 },
+        Emit_Field => sub { print $_[0]->{data}{$_[1]}; return $_[0]->{ip}+1 },
+        Exists     => sub { $_[0]->{jmp_flag} = exists $_[0]->{data}{$_[1]}; return $_[0]->{ip}+1 },
+        JF         => sub { return !$_[0]->{jmp_flag} ? $_[0]->{labels}{$_[1]} : $_[0]->{ip}+1; },
+        JT         => sub { return $_[0]->{jmp_flag}  ? $_[0]->{labels}{$_[1]} : $_[0]->{ip}+1; },
+        End        => sub { return -1; },
+    );
+
+    open my $fh, '<', $filename or die "Can't open $filename";
+    my ($labels, $program) = load_program($fh);
+
+    return sub {
+        my ($data) = @_;
+
+        my $machine = {
+            jmp_flag => 0,
+            ip       => 0,
+            data     => $data,
+            labels   => $labels,
+            program  => $program,
+        };
+
+        while ($machine->{ip} >= 0) {
+            my $instr = $program->[$machine->{ip}];
+            $machine->{ip} = $opcodes{ $instr->[0] }->($machine, $instr->[1]);
+        }
+    }
+}
+
+*output_html = create_machine($ARGV[0]);
+
+print <<"HEADER";
+<style>
+label {
+    font-weight:bold;
+}
+span.description {
+    color:#555;
+    font-size:9pt;
+}
+input {
+    display:block;
+}
+</style>
+HEADER
+
+my @description = (
+    {
+        id          => 'sku',
+        name        => 'sku',
+        description => 'Unieke code',
+        title       => 'SKU',
+    },
+    {
+        id          => 'barcode',
+        name        => 'barcode',
+        description => 'Niet verplicht',
+        title       => 'Streepjescode',
+    },
+    {
+        id          => 'name',
+        name        => 'name',
+        title       => 'Naam',
+        description => 'Naam van uw product',
+    },
+    {
+        id          => 'price',
+        name        => 'price',
+        title       => 'Prijs',
+        description => 'In euro cent incl. btw',
+    },
+);
+
+for (@description) {
+    output_html($_);
+}
+

examples/htmlgen/test.htmlgen

@@ -0,0 +1,12 @@
+p {
+    label id=@id { @title }
+    " "
+    ?@description { 
+        span class="description" {
+            "(" @description ")"
+        }
+        " "
+    }
+    input type="text" id=@id name=@name value=@value
+}
+"\n"

examples/lisp/lisp.mp

@@ -0,0 +1,12 @@
+
+String = /"([^"]+)"/
+Number = /(\d+)/
+Symbol = /([a-z]+)/
+
+Parser      ::= Expression+    {{ shift; return \@_; }}
+Expression  ::= $( List $)     {{ shift; return $_[1]; }}
+List        ::= Expression+    {{ shift; return \@_; }}
+Expression  ::= String         {{ shift; return { string => $_[0] }; }}
+Expression  ::= Number         {{ shift; return { number => $_[0] }; }}
+Expression  ::= Symbol         {{ shift; return { symbol => $_[0] }; }}
+

examples/lisp/test.lsp

@@ -0,0 +1 @@
+( add 10 10 1 9393 45 )

lib/Marp/App.pm

@@ -0,0 +1,42 @@
+package Marp::App;
+use 5.10.0;
+
+use strict;
+use warnings;
+
+use MarpaX::Parser::Marpa;
+
+sub new {
+    my ($klass) = @_;
+    my $self = bless {}, $klass;
+    return $self;
+}
+
+sub parse_args {
+    my ($self, @args) = @_;
+    $self->{infile} = $args[0];
+    $self->{codegen}  = $args[1];
+    $self->{package}  = $args[2];
+    return;
+}
+
+sub run {
+    my ($self) = @_;
+
+    my $infile = $self->{infile};
+
+    open my $fh, '<', $infile or die "Can't open '$infile'";
+
+    my $codegen_class = $self->{codegen} // 'MarpaX::CodeGen::Dumper';
+    eval "require $codegen_class";
+    my $codegen = $codegen_class->new({package => $self->{package}});
+
+    my $parser = MarpaX::Parser::Marpa->new();
+    my $parse_tree = $parser->parse($fh);
+
+    $codegen->generate_code($parse_tree);
+
+    return;
+}
+
+1;