diff --git a/v6/Mildew-Setting-SMOP/DefinedBySMOP.setting b/v6/Mildew-Setting-SMOP/DefinedBySMOP.setting index a4d4d0444b..fe6aefb4b6 100644 --- a/v6/Mildew-Setting-SMOP/DefinedBySMOP.setting +++ b/v6/Mildew-Setting-SMOP/DefinedBySMOP.setting @@ -15,20 +15,20 @@ my $OUT; #HACK as we don't support $*OUT yet my $LexicalPrelude; #HACK my module PRIMITIVES { - sub int_add { } - sub int_equal { } - sub int_less { } - sub int_substract { } - sub idconst_concat { } - sub idconst_eq { } - sub get_interpreter { } - sub storage_name { } - sub ritest { } - sub pointer_equal { } - sub SMOP_RI { } - sub dump_print($obj,$template) {} + our sub int_add { } + our sub int_equal { } + our sub int_less { } + our sub int_substract { } + our sub idconst_concat { } + our sub idconst_eq { } + our sub get_interpreter { } + our sub storage_name { } + our sub ritest { } + our sub pointer_equal { } + our sub SMOP_RI { } + our sub dump_print($obj,$template) {} #OK not used } my module EXTERNAL { - sub eval_perl5($code) {} + sub eval_perl5($code) {} #OK not used } {YOU_ARE_HERE}; diff --git a/v6/Mildew-Setting-SMOP/MildewCORE.setting b/v6/Mildew-Setting-SMOP/MildewCORE.setting index 24e9da4160..2f28adc069 100644 --- a/v6/Mildew-Setting-SMOP/MildewCORE.setting +++ b/v6/Mildew-Setting-SMOP/MildewCORE.setting @@ -241,7 +241,7 @@ my role ReadonlyWrapper { method FETCH() { (|$!value); } - method STORE($value) { + method STORE($value) { #OK not used ::Exception.new.throw; } } @@ -402,7 +402,7 @@ my role ReadonlyParam { my role NamedReadonlyParam { NamedReadonlyParam.^compose_role(::Param); has $.name; - method BIND($scope,$capture,$i) { + method BIND($scope,$capture,$i) { #OK not used my $arg = $capture.named(self.name.FETCH); my $wrapper = ReadonlyWrapper.new; $wrapper.value = $arg; @@ -410,7 +410,7 @@ my role NamedReadonlyParam { $wrapper.FETCH; $scope{self.variable.FETCH} := (|$wrapper); } - method ACCEPTS_param($capture,$i is ref,$named is ref) { + method ACCEPTS_param($capture,$i is ref,$named is ref) { #OK not used if $capture.named($.name.FETCH) { $named = &infix:<+>:(int,int)($named.FETCH,1); } @@ -424,7 +424,7 @@ my role WholeCaptureParam { $i = $capture.elems; $named = $capture.named_count; } - method BIND($scope,$capture,$i) { + method BIND($scope,$capture,$i) { #OK not used $scope{self.variable.FETCH} = $capture; } } @@ -524,7 +524,6 @@ my role Multi { return } if $outer.exists((|$name)) { - my $i = 0; my $multi = $outer.lookup((|$name)); map(sub ($candidate) {self.candidates.push((|$candidate))},$multi.candidates); return; @@ -558,7 +557,7 @@ my role Failure { $.exception.throw; } # UNKNOWN_METHOD is a spec def - method UNKNOWN_METHOD($identifier) { + method UNKNOWN_METHOD($identifier) { #OK not used $.exception.throw; } } diff --git a/v6/Mildew/lib/Mildew/Frontend/STD.pm b/v6/Mildew/lib/Mildew/Frontend/STD.pm index 03b0cab6c7..4544e6aeb8 100644 --- a/v6/Mildew/lib/Mildew/Frontend/STD.pm +++ b/v6/Mildew/lib/Mildew/Frontend/STD.pm @@ -4,8 +4,72 @@ use MooseX::Declare; # STD needs to be important from the main package package main; use STD; + use STD::Actions; +} +{ + package + CursorBase; + no warnings 'redefine'; + BEGIN { *sys_real_load_modinfo = *sys_load_modinfo; } + sub sys_load_modinfo { + if ($_[1] eq 'adhoc-signatures') { return undef; } + goto &sys_real_load_modinfo; + } + + # Possibly worth folding back + sub STD::Actions::gen_class { + my $class = shift; + my $base = shift; + #say $class; + no strict 'refs'; + if ($STD::Actions::GENCLASS{$class}) { + return; + } + if (@{$class . '::ISA'} && join('|', @{$class . '::ISA'}) ne 'Moose::Object' ) { + $STD::Actions::GENCLASS{$class} = 1; + return; + } + if (!$base && $class =~ /(.*)__S_/) { + $base = $1; + STD::Actions::gen_class($base); + } elsif ($base) { + STD::Actions::gen_class($base); + } else { + $base = 'VAST::Base'; + } + #say "using $base"; + $STD::Actions::GENCLASS{$class} = $base; + @{$class . '::ISA'} = $base; + } + + { package VAST::Additive; } + { package VAST::Autoincrement; } + { package VAST::Base; } + { package VAST::Chaining; } + { package VAST::Comma; } + { package VAST::Concatenation; } + { package VAST::Conditional; } + { package VAST::Exponentiation; } + { package VAST::Item_assignment; } + { package VAST::Junctive_and; } + { package VAST::Junctive_or; } + { package VAST::List_assignment; } + { package VAST::List_infix; } + { package VAST::List_prefix; } + { package VAST::Loose_and; } + { package VAST::Loose_or; } + { package VAST::Loose_unary; } + { package VAST::Methodcall; } + { package VAST::Multiplicative; } + { package VAST::Named_unary; } + { package VAST::Replication; } + { package VAST::Sequencer; } + { package VAST::Structural_infix; } + { package VAST::Symbolic_unary; } + { package VAST::Term; } + { package VAST::Tight_and; } + { package VAST::Tight_or; } } -BEGIN {package main;require 'viv'}; class Mildew::Frontend::STD { use Getopt::Long qw(GetOptionsFromArray); use Digest::MD4 qw(md4_hex); diff --git a/v6/Mildew/lib/Mildew/Frontend/STD/Cached.pm b/v6/Mildew/lib/Mildew/Frontend/STD/Cached.pm index 0174f46e9f..f88039e762 100644 --- a/v6/Mildew/lib/Mildew/Frontend/STD/Cached.pm +++ b/v6/Mildew/lib/Mildew/Frontend/STD/Cached.pm @@ -12,8 +12,7 @@ class Mildew::Frontend::STD::Cached { if (my $parse = $self->cache->get($checksum)) { use Data::Dumper::Concise; { - local $INC{"STD.pm"} = "do-not-load"; - do 'viv'; + require STD::Actions; } warn "using cached ast"; diff --git a/v6/Mildew/lib/VAST.pm b/v6/Mildew/lib/VAST.pm index b6f6e97b17..24c8689953 100644 --- a/v6/Mildew/lib/VAST.pm +++ b/v6/Mildew/lib/VAST.pm @@ -8,6 +8,13 @@ use MooseX::Declare; VAST->subclasses; } class VAST::Base { + method Str { + my $b = $self->{BEG}; + my $e = $self->{END}; + return '' if $b > length($::ORIG); + substr($::ORIG, $b, $e - $b); + } + method emit_m0ld { use Mildew::AST::Helpers; if ($self->{infix}) {