Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Lexical lookup from quasis, part Ⅰ #474

Merged
merged 8 commits into from
Feb 20, 2019
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
31 changes: 16 additions & 15 deletions lib/_007/Parser/Actions.pm6
Original file line number Diff line number Diff line change
Expand Up @@ -159,7 +159,7 @@ class _007::Parser::Actions {
die "Unknown routine type $<routine>"; # XXX: Turn this into an X:: exception
}

$identifier.put-value($val, $*runtime);
$*runtime.put-var($identifier, $val);

$*parser.opscope.maybe-install($name, $<traitlist><trait>);
}
Expand Down Expand Up @@ -205,7 +205,7 @@ class _007::Parser::Actions {
method attributes \{ () \}
method ^name(\$) \{ "{$identifier.name.value}" \}
\}]);
$identifier.put-value($val, $*runtime);
$*runtime.put-var($identifier, $val);
}

method traitlist($/) {
Expand Down Expand Up @@ -458,9 +458,8 @@ class _007::Parser::Actions {

method prefix($/) {
my $op = ~$/;
my $identifier = Q::Identifier.new(
my $identifier = Q::Term::Identifier.new(
:name(Val::Str.new(:value("prefix:$op"))),
:frame($*runtime.current-frame),
);
make $*parser.opscope.ops<prefix>{$op}.new(:$identifier, :operand(Val::None));
}
Expand Down Expand Up @@ -530,7 +529,7 @@ class _007::Parser::Actions {
}

method regex-fragment:identifier ($/) {
make Q::Regex::Identifier.new(:identifier($<identifier>.ast));
make Q::Regex::Identifier.new(:identifier($<term>.ast));
}

method regex-fragment:call ($/) {
Expand All @@ -546,7 +545,6 @@ class _007::Parser::Actions {
}

method term:identifier ($/) {
make $<identifier>.ast;
my $name = $<identifier>.ast.name.value;
if !$*runtime.declared($name) {
my $frame = $*runtime.current-frame;
Expand All @@ -558,6 +556,7 @@ class _007::Parser::Actions {
unless $value ~~ Val::Func;
};
}
make Q::Term::Identifier.new(:name($<identifier>.ast.name));
}

method term:block ($/) {
Expand Down Expand Up @@ -618,7 +617,7 @@ class _007::Parser::Actions {
my $outer-frame = $*runtime.current-frame.properties<outer-frame>;
my $static-lexpad = $*runtime.current-frame.properties<pad>;
my $val = Val::Func.new(:$name, :$parameterlist, :$statementlist, :$outer-frame, :$static-lexpad);
$<identifier>.ast.put-value($val, $*runtime);
$*runtime.put-var($<identifier>.ast, $val);
}
finish-block($block);

Expand Down Expand Up @@ -688,11 +687,12 @@ class _007::Parser::Actions {

method term:my ($/) {
my $identifier = $<identifier>.ast;
my $name = $identifier.name;

make Q::Term::My.new(:identifier($identifier));
make Q::Term::My.new(
:identifier(Q::Term::Identifier.new(:name($identifier.name)))
);

$*parser.opscope.maybe-install($name, []);
$*parser.opscope.maybe-install($identifier.name, []);
}

method propertylist ($/) {
Expand All @@ -716,8 +716,10 @@ class _007::Parser::Actions {
}

method property:identifier ($/) {
my $key = $<identifier>.ast.name;
make Q::Property.new(:$key, :value($<identifier>.ast));
self."term:identifier"($/);
my $value = $/.ast;
my $key = $value.name;
make Q::Property.new(:$key, :$value);
}

method property:method ($/) {
Expand All @@ -733,7 +735,7 @@ class _007::Parser::Actions {

method infix($/) {
my $op = ~$/;
my $identifier = Q::Identifier.new(
my $identifier = Q::Term::Identifier.new(
:name(Val::Str.new(:value("infix:$op"))),
);
make $*parser.opscope.ops<infix>{$op}.new(:$identifier, :lhs(NONE), :rhs(NONE));
Expand All @@ -758,9 +760,8 @@ class _007::Parser::Actions {
elsif $<prop> {
$op = ".";
}
my $identifier = Q::Identifier.new(
my $identifier = Q::Term::Identifier.new(
:name(Val::Str.new(:value("postfix:$op"))),
:frame($*runtime.current-frame),
);
# XXX: this can't stay hardcoded forever, but we don't have the machinery yet
# to do these right enough
Expand Down
19 changes: 14 additions & 5 deletions lib/_007/Parser/Syntax.pm6
Original file line number Diff line number Diff line change
Expand Up @@ -35,15 +35,15 @@ grammar _007::Parser::Syntax {
die X::Syntax::Missing.new(:$what);
}

our sub declare(Q::Declaration $decltype, $symbol) {
our sub declare(Q::Declaration $decltype, Str $symbol) {
die X::Redeclaration.new(:$symbol)
if $*runtime.declared-locally($symbol);
my $frame = $*runtime.current-frame();
die X::Redeclaration::Outer.new(:$symbol)
if %*assigned{$frame.WHICH ~ $symbol};
my $identifier = Q::Identifier.new(
:name(Val::Str.new(:value($symbol))),
:$frame);
:name(Val::Str.new(:value($symbol)))
);
$*runtime.declare-var($identifier);
@*declstack[*-1]{$symbol} = $decltype;
}
Expand Down Expand Up @@ -180,10 +180,12 @@ grammar _007::Parser::Syntax {
<str>
}
token regex-fragment:identifier {
# XXX: should be term:identifier
<identifier>
}
token regex-fragment:call {
'<' ~ '>'
# XXX: should be term:identifier
<identifier>
}
rule regex-fragment:group { ''
Expand Down Expand Up @@ -212,7 +214,7 @@ grammar _007::Parser::Syntax {
|| "<" <.ws> $<qtype>=["Q.Prefix"] ">" <.ws> '{' <.ws> <prefix> <.ws> '}'
|| "<" <.ws> $<qtype>=["Q.Postfix"] ">" <.ws> '{' <.ws> <postfix> <.ws> '}'
|| "<" <.ws> $<qtype>=["Q.Expr"] ">" <.ws> '{' <.ws> <EXPR> <.ws> '}'
|| "<" <.ws> $<qtype>=["Q.Identifier"] ">" <.ws> '{' <.ws> <term:identifier> <.ws> '}'
|| "<" <.ws> $<qtype>=["Q.Identifier"] ">" <.ws> '{' <.ws> <identifier> <.ws> '}'
|| "<" <.ws> $<qtype>=["Q.Block"] ">" <.ws> '{' <.ws> <block> <.ws> '}'
|| "<" <.ws> $<qtype>=["Q.CompUnit"] ">" <.ws> '{' <.ws> [<compunit=.unquote("Q.CompUnit")> || <compunit>] <.ws> '}'
|| "<" <.ws> $<qtype>=["Q.Literal"] ">" <.ws> '{' <.ws> [<term:int> | <term:none> | <term:str>] <.ws> '}'
Expand Down Expand Up @@ -240,6 +242,11 @@ grammar _007::Parser::Syntax {
}
token term:new-object {
new» <.ws>
# XXX: Deliberately introducing a bug here. Sorry!
# The first of the below identifiers should be a term:identifier, and the lookup
# should adapt to that fact. #250 would help sort this out. We're getting away
# with this because we're essentially missing a tricky-enough test, probably
# involving quasis and/or macros.
<identifier>+ % [<.ws> "." <.ws>] <?{
my $type;
[&&] $<identifier>.map(&prefix:<~>).map(-> $identifier {
Expand Down Expand Up @@ -301,7 +308,9 @@ grammar _007::Parser::Syntax {
<blockoid>:!s
<.finishpad>
}
token property:identifier { <identifier> }
token property:identifier {
<identifier>
}

method infix {
my @ops = $*parser.opscope.ops<infix>.keys;
Expand Down
122 changes: 87 additions & 35 deletions lib/_007/Q.pm6
Original file line number Diff line number Diff line change
Expand Up @@ -93,6 +93,16 @@ role Q {
}
}

### ### Q::Identifier
###
### An identifier; a name in code.
###
class Q::Identifier does Q {
has Val::Str $.name;

method attribute-order { <name> }
}

### ### Q::Expr
###
### An expression; something that can be evaluated to a value.
Expand Down Expand Up @@ -161,25 +171,39 @@ class Q::Literal::Str does Q::Literal {
method eval($) { $.value }
}

### ### Q::Identifier
### ### Q::Term::Identifier
###
### An identifier; a name which identifies a storage location in the program.
###
### Identifiers are subject to *scoping*: the same name can point to different
### storage locations because they belong to different scopes.
### Identifiers in expressions are subject to *scoping*: the same name can
### point to different storage locations because they belong to different scopes.
### The same name in the same scope might even point to different storage
### locations at different times when accessed from different call frames.
###
class Q::Identifier does Q::Term {
has Val::Str $.name;
has $.frame = NONE;
class Q::Term::Identifier is Q::Identifier does Q::Term {
method eval($runtime) {
return $runtime.get-var($.name.value);
}

method attribute-order { <name> }
method put-value($value, $runtime) {
$runtime.put-var(self, $value);
}
}

### ### Q::Term::Identifier::Direct
###
### A direct identifier; a name which directly identifies a storage location
### in the program.
###
class Q::Term::Identifier::Direct is Q::Term::Identifier {
has Val::Dict $.frame;

method eval($runtime) {
return $runtime.get-var($.name.value, $.frame);
return $runtime.get-direct($.frame, $.name.value);
}

method put-value($value, $runtime) {
$runtime.put-var(self, $value);
$runtime.put-direct($.frame, $.name.value, $value);
}
}

Expand Down Expand Up @@ -405,8 +429,6 @@ class Q::Block does Q {
has $.parameterlist;
has $.statementlist;
has Val::Dict $.static-lexpad is rw = Val::Dict.new;
# XXX
has $.frame is rw;

method attribute-order { <parameterlist statementlist> }
}
Expand Down Expand Up @@ -663,6 +685,26 @@ class Q::Unquote::Infix is Q::Unquote {
has $.rhs;
}

### ### Q::Term::My
###
### A `my` variable declaration.
###
class Q::Term::My does Q::Term does Q::Declaration {
has $.identifier;

method is-assignable { True }

method eval($runtime) {
return $.identifier.eval($runtime);
}

method put-value($value, $runtime) {
$.identifier.put-value($value, $runtime);
}
}

class Q::StatementList { ... }

### ### Q::Term::Quasi
###
### A quasi; a piece of 007 code which evaluates to that code's Qtree
Expand All @@ -681,7 +723,7 @@ class Q::Term::Quasi does Q::Term {
method attribute-order { <qtype contents> }

method eval($runtime) {
my $needs-displacement = $.contents !~~ Q::Block;
my $quasi-frame;

sub interpolate($thing) {
return $thing.new(:elements($thing.elements.map(&interpolate)))
Expand All @@ -693,7 +735,16 @@ class Q::Term::Quasi does Q::Term {
return $thing
if $thing ~~ Val;

return $thing.new(:name($thing.name), :frame($needs-displacement ?? $runtime.current-frame !! NONE))
if $thing ~~ Q::Term::Identifier {
if $runtime.lookup-frame-outside($thing, $quasi-frame) -> $frame {
return Q::Term::Identifier::Direct.new(:name($thing.name), :$frame);
}
else {
return $thing;
}
}

return $thing.new(:name($thing.name))
if $thing ~~ Q::Identifier;

if $thing ~~ Q::Unquote::Prefix {
Expand All @@ -716,20 +767,39 @@ class Q::Term::Quasi does Q::Term {
return $ast;
}

if $thing ~~ Q::Term::My {
$runtime.declare-var($thing.identifier);
}

if $thing ~~ Q::Term::Func {
$runtime.enter($runtime.current-frame, Val::Dict.new, Q::StatementList.new);
for $thing.block.parameterlist.parameters.elements.map(*.identifier) -> $identifier {
$runtime.declare-var($identifier);
}
}

if $thing ~~ Q::Block {
$runtime.enter($runtime.current-frame, Val::Dict.new, $thing.statementlist);
}

my %attributes = $thing.attributes.map: -> $attr {
aname($attr) => interpolate(avalue($attr, $thing))
};

if $thing ~~ Q::Term::Func || $thing ~~ Q::Block {
$runtime.leave();
}

$thing.new(|%attributes);
}

if $.qtype.value eq "Q.Unquote" && $.contents ~~ Q::Unquote {
return $.contents;
}
$runtime.enter($runtime.current-frame, Val::Dict.new, Q::StatementList.new);
$quasi-frame = $runtime.current-frame;
my $r = interpolate($.contents);
if $r ~~ Q::Block {
$r.frame = $runtime.current-frame;
}
$runtime.leave();
return $r;
}
}
Expand Down Expand Up @@ -768,24 +838,6 @@ class Q::ArgumentList does Q {
role Q::Statement does Q {
}

### ### Q::Term::My
###
### A `my` variable declaration.
###
class Q::Term::My does Q::Term does Q::Declaration {
has $.identifier;

method is-assignable { True }

method eval($runtime) {
return $.identifier.eval($runtime);
}

method put-value($value, $runtime) {
$.identifier.put-value($value, $runtime);
}
}

### ### Q::Statement::Expr
###
### A statement consisting of an expression.
Expand Down Expand Up @@ -1034,7 +1086,7 @@ class Q::Expr::BlockAdapter does Q::Expr {
has $.block;

method eval($runtime) {
$runtime.enter($.block.frame, $.block.static-lexpad, $.block.statementlist);
$runtime.enter($runtime.current-frame, $.block.static-lexpad, $.block.statementlist);
my $result = $.block.statementlist.run($runtime);
$runtime.leave;
return $result;
Expand Down
Loading