Skip to content

@FROGGS /COBOL.pm secret

Embed URL

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
slangs, what are they?
class COBOL does Slangy {
has $.grammar = grammar {
token TOP { .* }
};
has $.actions = class {
method TOP($/) { say "method TOP($/)" }
}
}

I'd imagine that the following could be the nicest way to create your own slang:

# The `slang` keyword implicitly applies "does Slangy" which stubs `has $.grammar;`
# and `has $.actions;`. It also makes sure the slang will be available as `$~COBOL`
# and the grammar and actions will be put in `%*LANG`.
slang COBOL {
    has $.grammar = COBOL::Grammar.new;
    has $.actions = COBOL::Actions.new;

    # Optionally register our own module loader to support `use Foo:from<COBOL`
    # from within Perl 6.
    has $.module-loader = COBOL::ModuleLoader;
}

# Or register the ML later, by:
$~COBOL.module-loader = COBOL::ModuleLoader.new;
diff --git a/src/Perl6/Grammar.nqp b/src/Perl6/Grammar.nqp
index a37b6ec..69e0d3e 100644
--- a/src/Perl6/Grammar.nqp
+++ b/src/Perl6/Grammar.nqp
@@ -854,6 +854,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
# Quasis and unquotes
:my $*IN_QUASI := 0; # whether we're currently in a quasi block
+ :my $*MAIN := 'MAIN';
# Setting loading and symbol setup.
{
@@ -922,6 +923,9 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
%*LANG{$_.key} := $_.value;
}
}
+ if $have_outer && $*UNIT_OUTER.symbol('$*MAIN') {
+ $*MAIN := $*UNIT_OUTER.symbol('$*MAIN')<value>;
+ }
# Install unless we've no setting, in which case we've likely no
# static lexpad class yet either. Also, UNIT needs a code object.
@@ -944,7 +948,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
<.finishpad>
<.bom>?
- <statementlist>
+ <statementlist=.LANG($*MAIN, 'statementlist')>
<.install_doc_phaser>
@@ -1257,13 +1261,23 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
token statement_control:sym<use> {
:my $longname;
+ :my $module;
:my $*IN_DECL := 'use';
:my $*HAS_SELF := '';
:my $*SCOPE := 'use';
+ :my $OLD_MAIN := ~$*MAIN;
$<doc>=[ 'DOC' \h+ ]**0..1
<sym> <.ws>
[
- | <version>
+ | <version> [ <?{ ~$<version><vnum>[0] eq '5' }> {
+ $module := $*W.load_module($/, 'Perl5', {}, $*GLOBALish);
+ do_import($/, $module, 'Perl5');
+ $longname := 'Perl5';
+ $/.CURSOR.import_EXPORTHOW($module);
+ } ]?
+ [ <?{ ~$<version><vnum>[0] eq '6' }> {
+ $*MAIN := 'MAIN';
+ } ]?
| <module_name>
{
$longname := $<module_name><longname>;
@@ -1296,7 +1310,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
$<arglist><EXPR>.ast);
$arglist := nqp::getattr($arglist.list.eager,
$*W.find_symbol(['List']), '$!items');
- my $module := $*W.load_module($/, $name, %cp, $*GLOBALish);
+ $module := $*W.load_module($/, $name, %cp, $*GLOBALish);
do_import($/, $module, $name, $arglist);
$/.CURSOR.import_EXPORTHOW($module);
}
@@ -1306,7 +1320,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
my $lnd := $*W.dissect_longname($longname);
my $name := $lnd.name;
my %cp := $lnd.colonpairs_hash('use');
- my $module := $*W.load_module($/, $name, %cp, $*GLOBALish);
+ $module := $*W.load_module($/, $name, %cp, $*GLOBALish);
do_import($/, $module, $name);
$/.CURSOR.import_EXPORTHOW($module);
}
@@ -1314,6 +1328,17 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
}
]
]
+ [
+ || <?{ nqp::defined($module) && nqp::existskey($module, ~$longname)
+ && nqp::istype($module{~$longname}, $*W.find_symbol(['Slangy'])) }>
+ {
+ $*MAIN := ~$longname;
+ %*LANG<COBOL> := $module{~$longname}.new.grammar;
+ %*LANG<COBOL-actions> := $module{~$longname}.new.actions;
+ }
+ <statementlist=.LANG($*MAIN, 'TOP')>
+ || <?>
+ ]
<.ws>
}
diff --git a/src/core/Positional.pm b/src/core/Positional.pm
index ac73982..bd764fd 100644
--- a/src/core/Positional.pm
+++ b/src/core/Positional.pm
@@ -1,3 +1,7 @@
my role Positional[::T = Mu] {
method of() { T }
}
+
+my role Slangy[::T = Mu] {
+ method of() { T }
+}
diff --git a/src/core/core_prologue.pm b/src/core/core_prologue.pm
index e41cc40..3c24c95 100644
--- a/src/core/core_prologue.pm
+++ b/src/core/core_prologue.pm
@@ -4,6 +4,7 @@ use Perl6::BOOTSTRAP;
my class Pair { ... }
my class Whatever { ... }
my class WhateverCode { ... }
+my role Slangy { ... }
# Stub these or we can't use any sigil other than $.
my role Positional { ... }
$ perl6-p -I. -e 'use COBOL'
method TOP()
===SORRY!===
Can not get attribute '$!pos' declared in class 'NQPCursor' with this object
# Problem is that the Perl6 grammar is a NQP class, while our COBOL grammar is from Perl 6 land.
# We need to ross that boundary somehow...
$ perl6-p -I. -e 'use COBOL; hurz'
===SORRY!===
No such method 'substr' for invocant of type 'String'
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Something went wrong with that request. Please try again.