From 4df5be18602ba48e0b299bf5f0df802381db0119 Mon Sep 17 00:00:00 2001 From: Carl Masak Date: Wed, 13 Feb 2019 07:57:10 +0100 Subject: [PATCH 1/8] Quarantine some of the tests These, incidentally, are the ones that require hygiene. Previously we provided that using the `identifier.frame` mechanism, but I'm about to remove that on this branch and put in another one. Before merge, these tests need to work again using the new mechanism. But for now, switching them off like this so that the rest of the test suite stays green. --- examples/format.007 | 59 ----------------- examples/name.007 | 18 ------ quarantined-tests.t.fixme | 129 ++++++++++++++++++++++++++++++++++++++ t/builtins/methods.t | 25 -------- t/examples/format.t | 38 ----------- t/examples/name.t | 11 ---- t/features/quasi.t | 53 ---------------- 7 files changed, 129 insertions(+), 204 deletions(-) delete mode 100644 examples/format.007 delete mode 100644 examples/name.007 create mode 100644 quarantined-tests.t.fixme delete mode 100644 t/examples/format.t delete mode 100644 t/examples/name.t diff --git a/examples/format.007 b/examples/format.007 deleted file mode 100644 index 2d9b1182..00000000 --- a/examples/format.007 +++ /dev/null @@ -1,59 +0,0 @@ -macro format(fmt, args) { - func replaceAll(input, transform) { - func helper(input, output) { - if !input.contains("{") { - return output ~ input; - } - my openBracePos = input.index("{"); - if !input.suffix(openBracePos).contains("}") { - return output ~ input; - } - my closeBracePos = input.suffix(openBracePos).index("}"); - return helper( - input.suffix(openBracePos + closeBracePos + 1), - output ~ input.prefix(openBracePos) ~ transform(input.substr(openBracePos + 1, closeBracePos - 1))); - } - - return helper(input, ""); - } - - func findHighestIndex(input) { - my openBracePos = input.index("{"); - if openBracePos == -1 { - return -1; - } - my closeBracePos = input.suffix(openBracePos).index("}"); - if closeBracePos == -1 { - return -1; - } - - my index = +input.substr(openBracePos + 1, closeBracePos - 1); - - my h = findHighestIndex(input.suffix(openBracePos + closeBracePos + 1)); - if h > index { - return h; - } - else { - return index; - } - } - - if fmt ~~ Q.Literal.Str && args ~~ Q.Term.Array { - my highestUsedIndex = findHighestIndex(fmt.value); - my argCount = args.elements.size(); - if argCount <= highestUsedIndex { - throw new Exception { message: "Highest index was " ~ highestUsedIndex - ~ " but got only " ~ argCount ~ " arguments." }; - } - } - - return quasi { - replaceAll({{{fmt}}}, func transform(arg) { - return {{{args}}}[+arg]; - }); - } -} - -say( format("{0}{1}{0}", ["abra", "cad"]) ); # abracadabra -say( format("foo{0}bar", ["{1}"]) ); # foo{1}bar ({} things can occur in the arguments) -# say( format("foo{1}bar", ["foo"]) ); # throws an exception at compile time diff --git a/examples/name.007 b/examples/name.007 deleted file mode 100644 index 50dc61b7..00000000 --- a/examples/name.007 +++ /dev/null @@ -1,18 +0,0 @@ -macro name(expr) { - if expr ~~ Q.Postfix.Property { - expr = expr.property; - } - assertType(expr, Q.Identifier); - return quasi { expr.name }; -} - -my info = { - foo: "Bond", - bar: { - baz: "James Bond" - }, -}; - -say(name(info)); # info -say(name(info.foo)); # foo -say(name(info.bar.baz)); # baz diff --git a/quarantined-tests.t.fixme b/quarantined-tests.t.fixme new file mode 100644 index 00000000..9f2abcfe --- /dev/null +++ b/quarantined-tests.t.fixme @@ -0,0 +1,129 @@ +use v6; +use Test; +use _007::Test; + +# --- from t/builtins/methods.t +{ + my $program = q:to/./; + macro so_hygienic() { + my x = "yay, clean!"; + return quasi { + say(x); + }; + } + + macro so_unhygienic() { + my x = "something is implemented wrong"; + return quasi { + say(x) + }.detach(); + } + + my x = "that's gross!"; + so_hygienic(); # yay, clean! + so_unhygienic(); # that's gross! + . + + outputs $program, "yay, clean!\nthat's gross!\n", + "detaching a qtree makes its identifiers unhygienic (#62)"; +} + +# --- from t/examples/format.t +constant MODIFIED_FORMAT_007_FILENAME = "format-$*PID.007"; +LEAVE unlink MODIFIED_FORMAT_007_FILENAME; +my $changed-line = False; + +given open(MODIFIED_FORMAT_007_FILENAME, :w) -> $fh { + for "examples/format.007".IO.lines -> $line { + if $line ~~ /^^ '# ' (.+) $$/ { + $changed-line = True; + $fh.say: ~$0; + } + else { + $fh.say: $line; + } + } + $fh.close; +} + +ok $changed-line, "found a line to un-comment from format.007"; + +{ + my @lines = run-and-collect-lines("examples/format.007"); + + is +@lines, 2, "correct number of lines"; + + is @lines[0], "abracadabra", "first line"; + is @lines[1], q[foo{1}bar], "second line"; +} + +{ + my $message = run-and-collect-error-message(MODIFIED_FORMAT_007_FILENAME); + + is $message, "Highest index was 1 but got only 1 arguments.", "got the right error"; +} + +# --- from t/examples/name.t +my @lines = run-and-collect-lines("examples/name.007"); + +is +@lines, 3, "correct number of lines of output"; +is @lines[0], "info", "line #1 correct"; +is @lines[1], "foo", "line #2 correct"; +is @lines[2], "baz", "line #3 correct"; + +# --- from t/features/quasi.t +{ + my $program = q:to/./; + macro foo() { + my x = 7; + return quasi { + say(x); + } + } + + foo(); + . + + outputs $program, "7\n", "a variable is looked up in the quasi's environment"; +} + +{ + my $program = q:to/./; + macro moo() { + func infix:<**>(l, r) { + return l ~ " to the " ~ r; + } + return quasi { + say("pedal" ** "metal"); + } + } + + moo(); + . + + outputs + $program, + "pedal to the metal\n", + "operator used in quasi block carries its original environement"; +} + +{ + my $program = q:to/./; + macro gah() { + return quasi { say(2 + 2) } + } + + { + func infix:<+>(l, r) { return "lol, pwnd!" } + gah() + } + . + + outputs + $program, + "4\n", + "operators in quasi aren't unhygienically overriden by mainline environment"; +} + +done-testing; + diff --git a/t/builtins/methods.t b/t/builtins/methods.t index 6248e9d9..fc74184a 100644 --- a/t/builtins/methods.t +++ b/t/builtins/methods.t @@ -222,31 +222,6 @@ use _007::Test; outputs $program, qq!["1", "2", "3"]\n[1, 2, 3]\n!, "flatMap() does nothing if there's no array to remove"; } -{ - my $program = q:to/./; - macro so_hygienic() { - my x = "yay, clean!"; - return quasi { - say(x); - }; - } - - macro so_unhygienic() { - my x = "something is implemented wrong"; - return quasi { - say(x) - }.detach(); - } - - my x = "that's gross!"; - so_hygienic(); # yay, clean! - so_unhygienic(); # that's gross! - . - - outputs $program, "yay, clean!\nthat's gross!\n", - "detaching a qtree makes its identifiers unhygienic (#62)"; -} - { my $program = q:to/./; my a = [1, 2]; diff --git a/t/examples/format.t b/t/examples/format.t deleted file mode 100644 index 66293a0c..00000000 --- a/t/examples/format.t +++ /dev/null @@ -1,38 +0,0 @@ -use Test; -use _007::Test; - -constant MODIFIED_FORMAT_007_FILENAME = "format-$*PID.007"; -LEAVE unlink MODIFIED_FORMAT_007_FILENAME; -my $changed-line = False; - -given open(MODIFIED_FORMAT_007_FILENAME, :w) -> $fh { - for "examples/format.007".IO.lines -> $line { - if $line ~~ /^^ '# ' (.+) $$/ { - $changed-line = True; - $fh.say: ~$0; - } - else { - $fh.say: $line; - } - } - $fh.close; -} - -ok $changed-line, "found a line to un-comment from format.007"; - -{ - my @lines = run-and-collect-lines("examples/format.007"); - - is +@lines, 2, "correct number of lines"; - - is @lines[0], "abracadabra", "first line"; - is @lines[1], q[foo{1}bar], "second line"; -} - -{ - my $message = run-and-collect-error-message(MODIFIED_FORMAT_007_FILENAME); - - is $message, "Highest index was 1 but got only 1 arguments.", "got the right error"; -} - -done-testing; diff --git a/t/examples/name.t b/t/examples/name.t deleted file mode 100644 index 3c25d4e5..00000000 --- a/t/examples/name.t +++ /dev/null @@ -1,11 +0,0 @@ -use Test; -use _007::Test; - -my @lines = run-and-collect-lines("examples/name.007"); - -is +@lines, 3, "correct number of lines of output"; -is @lines[0], "info", "line #1 correct"; -is @lines[1], "foo", "line #2 correct"; -is @lines[2], "baz", "line #3 correct"; - -done-testing; diff --git a/t/features/quasi.t b/t/features/quasi.t index 081334b1..72386ca3 100644 --- a/t/features/quasi.t +++ b/t/features/quasi.t @@ -29,59 +29,6 @@ use _007::Test; outputs $program, "none\n", "Empty quasiquote results in a none value"; } -{ - my $program = q:to/./; - macro foo() { - my x = 7; - return quasi { - say(x); - } - } - - foo(); - . - - outputs $program, "7\n", "a variable is looked up in the quasi's environment"; -} - -{ - my $program = q:to/./; - macro moo() { - func infix:<**>(l, r) { - return l ~ " to the " ~ r; - } - return quasi { - say("pedal" ** "metal"); - } - } - - moo(); - . - - outputs - $program, - "pedal to the metal\n", - "operator used in quasi block carries its original environement"; -} - -{ - my $program = q:to/./; - macro gah() { - return quasi { say(2 + 2) } - } - - { - func infix:<+>(l, r) { return "lol, pwnd!" } - gah() - } - . - - outputs - $program, - "4\n", - "operators in quasi aren't unhygienically overriden by mainline environment"; -} - { my $program = q:to/./; say(type(quasi { + })); From e194359cc7d1f11d9d9898c151d016e5f95aa385 Mon Sep 17 00:00:00 2001 From: Carl Masak Date: Wed, 13 Feb 2019 14:09:19 +0100 Subject: [PATCH 2/8] Remove .frame from identifiers --- lib/_007/Q.pm6 | 3 +-- lib/_007/Runtime.pm6 | 30 +++++++++--------------------- 2 files changed, 10 insertions(+), 23 deletions(-) diff --git a/lib/_007/Q.pm6 b/lib/_007/Q.pm6 index c27cd24b..f54768d3 100644 --- a/lib/_007/Q.pm6 +++ b/lib/_007/Q.pm6 @@ -170,12 +170,11 @@ class Q::Literal::Str does Q::Literal { ### class Q::Identifier does Q::Term { has Val::Str $.name; - has $.frame = NONE; method attribute-order { } method eval($runtime) { - return $runtime.get-var($.name.value, $.frame); + return $runtime.get-var($.name.value); } method put-value($value, $runtime) { diff --git a/lib/_007/Runtime.pm6 b/lib/_007/Runtime.pm6 index 5ec41fd1..23154245 100644 --- a/lib/_007/Runtime.pm6 +++ b/lib/_007/Runtime.pm6 @@ -4,9 +4,7 @@ use _007::Builtins; use _007::Equal; constant NO_OUTER = Val::Dict.new; -constant RETURN_TO = Q::Identifier.new( - :name(Val::Str.new(:value("--RETURN-TO--"))), - :frame(NONE)); +constant RETURN_TO = Q::Identifier.new(:name(Val::Str.new(:value("--RETURN-TO--")))); constant EXIT_SUCCESS = 0; class _007::Runtime { @@ -79,9 +77,7 @@ class _007::Runtime { my $frame = Val::Dict.new(:properties(:$outer-frame, :pad(Val::Dict.new))); @!frames.push($frame); for $static-lexpad.properties.kv -> $name, $value { - my $identifier = Q::Identifier.new( - :name(Val::Str.new(:value($name))), - :frame(NONE)); + my $identifier = Q::Identifier.new(:name(Val::Str.new(:value($name)))); self.declare-var($identifier, $value); } for $statementlist.statements.elements.kv -> $i, $_ { @@ -103,7 +99,7 @@ class _007::Runtime { } if $routine { my $name = $routine.name; - my $identifier = Q::Identifier.new(:$name, :$frame); + my $identifier = Q::Identifier.new(:$name); self.declare-var($identifier, $routine); } } @@ -142,15 +138,12 @@ class _007::Runtime { method put-var(Q::Identifier $identifier, $value) { my $name = $identifier.name.value; - my $frame = $identifier.frame ~~ Val::None - ?? self.current-frame - !! $identifier.frame; - my $pad = self!find-pad($name, $frame); + my $pad = self!find-pad($name, self.current-frame); $pad.properties{$name} = $value; } - method get-var(Str $name, $frame = self.current-frame) { - my $pad = self!find-pad($name, $frame); + method get-var(Str $name) { + my $pad = self!find-pad($name, self.current-frame); return $pad.properties{$name}; } @@ -162,10 +155,7 @@ class _007::Runtime { method declare-var(Q::Identifier $identifier, $value?) { my $name = $identifier.name.value; - my Val::Dict $frame = $identifier.frame ~~ Val::None - ?? self.current-frame - !! $identifier.frame; - $frame.properties.properties{$name} = $value // NONE; + self.current-frame.properties.properties{$name} = $value // NONE; } method declared($name) { @@ -173,9 +163,7 @@ class _007::Runtime { } method declared-locally($name) { - my $frame = self.current-frame; - return True - if $frame.properties.properties{$name} :exists; + return so (self.current-frame.properties.properties{$name} :exists); } method register-subhandler { @@ -263,7 +251,7 @@ class _007::Runtime { return $thing if $thing ~~ Val; - return $thing.new(:name($thing.name), :frame(NONE)) + return $thing.new(:name($thing.name)) if $thing ~~ Q::Identifier; return $thing From eaa61ed7807f6437de025787cc3c414ebf1c867b Mon Sep 17 00:00:00 2001 From: Carl Masak Date: Sat, 16 Feb 2019 17:35:42 +0100 Subject: [PATCH 3/8] Separate Q::Identifier and Q::Term::Identifier The former is the general form, when we have a name in code that shouldn't ever do any kind of value lookup, lexical or otherwise. Common examples include dictionary keys, property names, and all kind of definitions (`my`, `class`, `func`, etc.). The latter is a term in an expression. Basically anything that ought to look up a value at runtime should use this form. This change was harder than it looked. A few corners have been cut, and can hopefully be done better in the long term. --- lib/_007/Parser/Actions.pm6 | 31 ++++++++++++++++--------------- lib/_007/Parser/Syntax.pm6 | 19 ++++++++++++++----- lib/_007/Q.pm6 | 24 ++++++++++++++++-------- lib/_007/Runtime.pm6 | 3 +++ t/features/macros.t | 4 ++-- 5 files changed, 51 insertions(+), 30 deletions(-) diff --git a/lib/_007/Parser/Actions.pm6 b/lib/_007/Parser/Actions.pm6 index 14500e51..a0e73381 100644 --- a/lib/_007/Parser/Actions.pm6 +++ b/lib/_007/Parser/Actions.pm6 @@ -159,7 +159,7 @@ class _007::Parser::Actions { die "Unknown routine type $"; # XXX: Turn this into an X:: exception } - $identifier.put-value($val, $*runtime); + $*runtime.put-var($identifier, $val); $*parser.opscope.maybe-install($name, $); } @@ -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($/) { @@ -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{$op}.new(:$identifier, :operand(Val::None)); } @@ -530,7 +529,7 @@ class _007::Parser::Actions { } method regex-fragment:identifier ($/) { - make Q::Regex::Identifier.new(:identifier($.ast)); + make Q::Regex::Identifier.new(:identifier($.ast)); } method regex-fragment:call ($/) { @@ -546,7 +545,6 @@ class _007::Parser::Actions { } method term:identifier ($/) { - make $.ast; my $name = $.ast.name.value; if !$*runtime.declared($name) { my $frame = $*runtime.current-frame; @@ -558,6 +556,7 @@ class _007::Parser::Actions { unless $value ~~ Val::Func; }; } + make Q::Term::Identifier.new(:name($.ast.name)); } method term:block ($/) { @@ -618,7 +617,7 @@ class _007::Parser::Actions { my $outer-frame = $*runtime.current-frame.properties; my $static-lexpad = $*runtime.current-frame.properties; my $val = Val::Func.new(:$name, :$parameterlist, :$statementlist, :$outer-frame, :$static-lexpad); - $.ast.put-value($val, $*runtime); + $*runtime.put-var($.ast, $val); } finish-block($block); @@ -688,11 +687,12 @@ class _007::Parser::Actions { method term:my ($/) { my $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 ($/) { @@ -716,8 +716,10 @@ class _007::Parser::Actions { } method property:identifier ($/) { - my $key = $.ast.name; - make Q::Property.new(:$key, :value($.ast)); + self."term:identifier"($/); + my $value = $/.ast; + my $key = $value.name; + make Q::Property.new(:$key, :$value); } method property:method ($/) { @@ -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{$op}.new(:$identifier, :lhs(NONE), :rhs(NONE)); @@ -758,9 +760,8 @@ class _007::Parser::Actions { elsif $ { $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 diff --git a/lib/_007/Parser/Syntax.pm6 b/lib/_007/Parser/Syntax.pm6 index c778a3f7..0d42874d 100644 --- a/lib/_007/Parser/Syntax.pm6 +++ b/lib/_007/Parser/Syntax.pm6 @@ -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; } @@ -180,10 +180,12 @@ grammar _007::Parser::Syntax { } token regex-fragment:identifier { + # XXX: should be term:identifier } token regex-fragment:call { '<' ~ '>' + # XXX: should be term:identifier } rule regex-fragment:group { '' @@ -212,7 +214,7 @@ grammar _007::Parser::Syntax { || "<" <.ws> $=["Q.Prefix"] ">" <.ws> '{' <.ws> <.ws> '}' || "<" <.ws> $=["Q.Postfix"] ">" <.ws> '{' <.ws> <.ws> '}' || "<" <.ws> $=["Q.Expr"] ">" <.ws> '{' <.ws> <.ws> '}' - || "<" <.ws> $=["Q.Identifier"] ">" <.ws> '{' <.ws> <.ws> '}' + || "<" <.ws> $=["Q.Identifier"] ">" <.ws> '{' <.ws> <.ws> '}' || "<" <.ws> $=["Q.Block"] ">" <.ws> '{' <.ws> <.ws> '}' || "<" <.ws> $=["Q.CompUnit"] ">" <.ws> '{' <.ws> [ || ] <.ws> '}' || "<" <.ws> $=["Q.Literal"] ">" <.ws> '{' <.ws> [ | | ] <.ws> '}' @@ -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. + % [<.ws> "." <.ws>] .map(&prefix:<~>).map(-> $identifier { @@ -301,7 +308,9 @@ grammar _007::Parser::Syntax { :!s <.finishpad> } - token property:identifier { } + token property:identifier { + + } method infix { my @ops = $*parser.opscope.ops.keys; diff --git a/lib/_007/Q.pm6 b/lib/_007/Q.pm6 index f54768d3..58ac8d1a 100644 --- a/lib/_007/Q.pm6 +++ b/lib/_007/Q.pm6 @@ -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 { } +} + ### ### Q::Expr ### ### An expression; something that can be evaluated to a value. @@ -161,18 +171,16 @@ 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; - - method attribute-order { } - +class Q::Term::Identifier is Q::Identifier does Q::Term { method eval($runtime) { return $runtime.get-var($.name.value); } diff --git a/lib/_007/Runtime.pm6 b/lib/_007/Runtime.pm6 index 23154245..34fbc16b 100644 --- a/lib/_007/Runtime.pm6 +++ b/lib/_007/Runtime.pm6 @@ -606,6 +606,9 @@ class _007::Runtime { elsif $obj ~~ Val::Type && $obj.type === Q::Term && $propname eq "Array" { return Val::Type.of(Q::Term::Array); } + elsif $obj ~~ Val::Type && $obj.type === Q::Term && $propname eq "Identifier" { + return Val::Type.of(Q::Term::Identifier); + } else { if $obj ~~ Val::Type { die X::Property::NotFound.new(:$propname, :type("$type ({$obj.type.^name})")); diff --git a/t/features/macros.t b/t/features/macros.t index adc3b345..898066b2 100644 --- a/t/features/macros.t +++ b/t/features/macros.t @@ -31,8 +31,8 @@ use _007::Test; my $program = q:to/./; macro foo() { return new Q.Postfix.Call { - identifier: new Q.Identifier { name: "postfix:()" }, - operand: new Q.Identifier { name: "say" }, + identifier: new Q.Term.Identifier { name: "postfix:()" }, + operand: new Q.Term.Identifier { name: "say" }, argumentlist: new Q.ArgumentList { arguments: [new Q.Literal.Str { value: "OH HAI" }] } From ed1575bcf62ea8ab84d27b31594bf5e6ff64f761 Mon Sep 17 00:00:00 2001 From: Carl Masak Date: Sat, 16 Feb 2019 18:45:02 +0100 Subject: [PATCH 4/8] Introduce direct identifiers A _direct identifier_ is one where no lexical lookup is needed, because the frame and its lexical pad is already known/held. A quasi that's interpolated turns all of its identifiers direct. This makes some quarantined tests pass and so we bring them out of quarantine. However, there's a big piece missing: interpolation shouldn't turn the quasi's *own* variables direct -- those declared somewhere inside the quasi. Because we're not doing this correctly yet, some other tests also needed to move out into quarantine. --- examples/name.007 | 18 ++++++ lib/_007/Q.pm6 | 22 ++++++- lib/_007/Runtime.pm6 | 19 ++++++ quarantined-tests.t.fixme | 75 +++++++++++++++++++++--- t/examples/name.t | 11 ++++ t/features/hygiene.t | 23 ++++++++ t/features/quasi.t | 120 +++++++++++++++++--------------------- 7 files changed, 212 insertions(+), 76 deletions(-) create mode 100644 examples/name.007 create mode 100644 t/examples/name.t create mode 100644 t/features/hygiene.t diff --git a/examples/name.007 b/examples/name.007 new file mode 100644 index 00000000..50dc61b7 --- /dev/null +++ b/examples/name.007 @@ -0,0 +1,18 @@ +macro name(expr) { + if expr ~~ Q.Postfix.Property { + expr = expr.property; + } + assertType(expr, Q.Identifier); + return quasi { expr.name }; +} + +my info = { + foo: "Bond", + bar: { + baz: "James Bond" + }, +}; + +say(name(info)); # info +say(name(info.foo)); # foo +say(name(info.bar.baz)); # baz diff --git a/lib/_007/Q.pm6 b/lib/_007/Q.pm6 index 58ac8d1a..ad4f81ae 100644 --- a/lib/_007/Q.pm6 +++ b/lib/_007/Q.pm6 @@ -190,6 +190,23 @@ class Q::Term::Identifier is Q::Identifier does Q::Term { } } +### ### 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-direct($.frame, $.name.value); + } + + method put-value($value, $runtime) { + $runtime.put-direct($.frame, $.name.value, $value); + } +} + ### ### Q::Regex::Fragment ### ### The parent role to all regex fragment types. @@ -700,7 +717,10 @@ 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)) + return Q::Term::Identifier::Direct.new(:name($thing.name), :frame($runtime.lookup-frame($thing))) + if $thing ~~ Q::Term::Identifier; + + return $thing.new(:name($thing.name)) if $thing ~~ Q::Identifier; if $thing ~~ Q::Unquote::Prefix { diff --git a/lib/_007/Runtime.pm6 b/lib/_007/Runtime.pm6 index 34fbc16b..31bc4901 100644 --- a/lib/_007/Runtime.pm6 +++ b/lib/_007/Runtime.pm6 @@ -136,6 +136,17 @@ class _007::Runtime { if $symbol eq RETURN_TO; } + method lookup-frame(Q::Term::Identifier $identifier) { + my Str $name = $identifier.name.value; + my $frame = self.current-frame; + repeat until $frame === NO_OUTER { + return $frame + if $frame.properties.properties{$name} :exists; + $frame = $frame.properties; + } + die X::Undeclared.new(:symbol($name)); + } + method put-var(Q::Identifier $identifier, $value) { my $name = $identifier.name.value; my $pad = self!find-pad($name, self.current-frame); @@ -153,6 +164,14 @@ class _007::Runtime { } } + method get-direct(Val::Dict $frame, Str $name) { + return $frame.properties.properties{$name}; + } + + method put-direct(Val::Dict $frame, Str $name, $value) { + $frame.properties.properties{$name} = $value; + } + method declare-var(Q::Identifier $identifier, $value?) { my $name = $identifier.name.value; self.current-frame.properties.properties{$name} = $value // NONE; diff --git a/quarantined-tests.t.fixme b/quarantined-tests.t.fixme index 9f2abcfe..4e4ac304 100644 --- a/quarantined-tests.t.fixme +++ b/quarantined-tests.t.fixme @@ -63,14 +63,6 @@ ok $changed-line, "found a line to un-comment from format.007"; is $message, "Highest index was 1 but got only 1 arguments.", "got the right error"; } -# --- from t/examples/name.t -my @lines = run-and-collect-lines("examples/name.007"); - -is +@lines, 3, "correct number of lines of output"; -is @lines[0], "info", "line #1 correct"; -is @lines[1], "foo", "line #2 correct"; -is @lines[2], "baz", "line #3 correct"; - # --- from t/features/quasi.t { my $program = q:to/./; @@ -125,5 +117,72 @@ is @lines[2], "baz", "line #3 correct"; "operators in quasi aren't unhygienically overriden by mainline environment"; } +# --- more from t/features/quasi.t +{ + my $program = q:to/./; + my q1 = quasi { my x; }; + my q2 = quasi { my x; }; + say("alive"); + . + + outputs $program, "alive\n", "Q.Statement quasis don't leak (I)"; +} + +{ + my $program = q:to/./; + my q1 = quasi { my x; }; + say(x); + . + + parse-error $program, X::Undeclared, "Q.Statement quasis don't leak (II)"; +} + +{ + my $program = q:to/./; + macro moo() { + my y = "right"; + return quasi { + say(y); + { + my y = "wrong"; + } + say(y); + }; + }; + + moo(); + . + + outputs $program, "right\nright\n", "an injectile gets the quasi's outer scope"; +} + +{ + my $program = q:to/./; + macro moo() { + return quasi { + my x = 1; + } + } + + moo(); + . + + outputs $program, "", "a single declaration works in an injectile"; +} + +{ + my $program = q:to/./; + macro moo(x) { + return quasi { + (func() { my y = {{{x}}} })() + } + } + + say(moo(42)); + . + + outputs $program, "42\n", "a declaration works in a func term in an injectile"; +} + done-testing; diff --git a/t/examples/name.t b/t/examples/name.t new file mode 100644 index 00000000..3c25d4e5 --- /dev/null +++ b/t/examples/name.t @@ -0,0 +1,11 @@ +use Test; +use _007::Test; + +my @lines = run-and-collect-lines("examples/name.007"); + +is +@lines, 3, "correct number of lines of output"; +is @lines[0], "info", "line #1 correct"; +is @lines[1], "foo", "line #2 correct"; +is @lines[2], "baz", "line #3 correct"; + +done-testing; diff --git a/t/features/hygiene.t b/t/features/hygiene.t new file mode 100644 index 00000000..a2ec66ab --- /dev/null +++ b/t/features/hygiene.t @@ -0,0 +1,23 @@ +use v6; +use Test; +use _007::Test; + +{ + my $program = q:to/./; + macro moo() { + my x = "OH HAI"; + return quasi { + say(x); + } + } + + moo(); + . + + outputs + $program, + "OH HAI\n", + "quasis remember variables from their surrounding macro"; +} + +done-testing; diff --git a/t/features/quasi.t b/t/features/quasi.t index 72386ca3..71e2d459 100644 --- a/t/features/quasi.t +++ b/t/features/quasi.t @@ -29,6 +29,59 @@ use _007::Test; outputs $program, "none\n", "Empty quasiquote results in a none value"; } +{ + my $program = q:to/./; + macro foo() { + my x = 7; + return quasi { + say(x); + } + } + + foo(); + . + + outputs $program, "7\n", "a variable is looked up in the quasi's environment"; +} + +{ + my $program = q:to/./; + macro moo() { + func infix:<**>(l, r) { + return l ~ " to the " ~ r; + } + return quasi { + say("pedal" ** "metal"); + } + } + + moo(); + . + + outputs + $program, + "pedal to the metal\n", + "operator used in quasi block carries its original environement"; +} + +{ + my $program = q:to/./; + macro gah() { + return quasi { say(2 + 2) } + } + + { + func infix:<+>(l, r) { return "lol, pwnd!" } + gah() + } + . + + outputs + $program, + "4\n", + "operators in quasi aren't unhygienically overriden by mainline environment"; +} + { my $program = q:to/./; say(type(quasi { + })); @@ -259,26 +312,6 @@ use _007::Test; outputs $program, "\n", "quasi"; } - -{ - my $program = q:to/./; - my q1 = quasi { my x; }; - my q2 = quasi { my x; }; - say("alive"); - . - - outputs $program, "alive\n", "Q.Statement quasis don't leak (I)"; -} - -{ - my $program = q:to/./; - my q1 = quasi { my x; }; - say(x); - . - - parse-error $program, X::Undeclared, "Q.Statement quasis don't leak (II)"; -} - { my $program = q:to/./; macro moo() { @@ -323,51 +356,4 @@ use _007::Test; outputs $program, "", "a quasi doesn't have to return a value"; } -{ - my $program = q:to/./; - macro moo() { - my y = "right"; - return quasi { - say(y); - { - my y = "wrong"; - } - say(y); - }; - }; - - moo(); - . - - outputs $program, "right\nright\n", "an injectile gets the quasi's outer scope"; -} - -{ - my $program = q:to/./; - macro moo() { - return quasi { - my x = 1; - } - } - - moo(); - . - - outputs $program, "", "a single declaration works in an injectile"; -} - -{ - my $program = q:to/./; - macro moo(x) { - return quasi { - (func() { my y = {{{x}}} })() - } - } - - say(moo(42)); - . - - outputs $program, "42\n", "a declaration works in a func term in an injectile"; -} - done-testing; From 1fc4040bfb46512c035859145cba8bd6287396d3 Mon Sep 17 00:00:00 2001 From: Carl Masak Date: Sun, 17 Feb 2019 16:28:19 +0100 Subject: [PATCH 5/8] Exclude quasi variables from being made direct This is the wrong fix; it concludes that a variable was declared in the quasi iff lookup for it frame fails. The problem is that lookup might succeed (and find a variable outside of the quasi) but the variable might still have been declared inside the quasi. There's a better fix; it's probably a bit more complicated, and must involve actually declaring those variables inside the quasi block, including in nested blocks. I think the `interpolate` sub will end up looking a lot more like the `check` sub. Because this is the wrong fix, some things are still left in quarantine. However, quite a few things moved back, too. --- examples/format.007 | 59 +++++++++++++++++ lib/_007/Q.pm6 | 10 ++- lib/_007/Runtime.pm6 | 2 +- quarantined-tests.t.fixme | 136 -------------------------------------- t/examples/format.t | 38 +++++++++++ t/features/hygiene.t | 18 +++++ t/features/quasi.t | 48 ++++++++++++++ 7 files changed, 172 insertions(+), 139 deletions(-) create mode 100644 examples/format.007 create mode 100644 t/examples/format.t diff --git a/examples/format.007 b/examples/format.007 new file mode 100644 index 00000000..2d9b1182 --- /dev/null +++ b/examples/format.007 @@ -0,0 +1,59 @@ +macro format(fmt, args) { + func replaceAll(input, transform) { + func helper(input, output) { + if !input.contains("{") { + return output ~ input; + } + my openBracePos = input.index("{"); + if !input.suffix(openBracePos).contains("}") { + return output ~ input; + } + my closeBracePos = input.suffix(openBracePos).index("}"); + return helper( + input.suffix(openBracePos + closeBracePos + 1), + output ~ input.prefix(openBracePos) ~ transform(input.substr(openBracePos + 1, closeBracePos - 1))); + } + + return helper(input, ""); + } + + func findHighestIndex(input) { + my openBracePos = input.index("{"); + if openBracePos == -1 { + return -1; + } + my closeBracePos = input.suffix(openBracePos).index("}"); + if closeBracePos == -1 { + return -1; + } + + my index = +input.substr(openBracePos + 1, closeBracePos - 1); + + my h = findHighestIndex(input.suffix(openBracePos + closeBracePos + 1)); + if h > index { + return h; + } + else { + return index; + } + } + + if fmt ~~ Q.Literal.Str && args ~~ Q.Term.Array { + my highestUsedIndex = findHighestIndex(fmt.value); + my argCount = args.elements.size(); + if argCount <= highestUsedIndex { + throw new Exception { message: "Highest index was " ~ highestUsedIndex + ~ " but got only " ~ argCount ~ " arguments." }; + } + } + + return quasi { + replaceAll({{{fmt}}}, func transform(arg) { + return {{{args}}}[+arg]; + }); + } +} + +say( format("{0}{1}{0}", ["abra", "cad"]) ); # abracadabra +say( format("foo{0}bar", ["{1}"]) ); # foo{1}bar ({} things can occur in the arguments) +# say( format("foo{1}bar", ["foo"]) ); # throws an exception at compile time diff --git a/lib/_007/Q.pm6 b/lib/_007/Q.pm6 index ad4f81ae..a0602279 100644 --- a/lib/_007/Q.pm6 +++ b/lib/_007/Q.pm6 @@ -717,8 +717,14 @@ class Q::Term::Quasi does Q::Term { return $thing if $thing ~~ Val; - return Q::Term::Identifier::Direct.new(:name($thing.name), :frame($runtime.lookup-frame($thing))) - if $thing ~~ Q::Term::Identifier; + if $thing ~~ Q::Term::Identifier { + if $runtime.lookup-frame($thing) -> $frame { + return Q::Term::Identifier::Direct.new(:name($thing.name), :$frame); + } + else { + return $thing; + } + } return $thing.new(:name($thing.name)) if $thing ~~ Q::Identifier; diff --git a/lib/_007/Runtime.pm6 b/lib/_007/Runtime.pm6 index 31bc4901..2dd76e30 100644 --- a/lib/_007/Runtime.pm6 +++ b/lib/_007/Runtime.pm6 @@ -144,7 +144,7 @@ class _007::Runtime { if $frame.properties.properties{$name} :exists; $frame = $frame.properties; } - die X::Undeclared.new(:symbol($name)); + return; } method put-var(Q::Identifier $identifier, $value) { diff --git a/quarantined-tests.t.fixme b/quarantined-tests.t.fixme index 4e4ac304..ab582d53 100644 --- a/quarantined-tests.t.fixme +++ b/quarantined-tests.t.fixme @@ -28,115 +28,7 @@ use _007::Test; "detaching a qtree makes its identifiers unhygienic (#62)"; } -# --- from t/examples/format.t -constant MODIFIED_FORMAT_007_FILENAME = "format-$*PID.007"; -LEAVE unlink MODIFIED_FORMAT_007_FILENAME; -my $changed-line = False; - -given open(MODIFIED_FORMAT_007_FILENAME, :w) -> $fh { - for "examples/format.007".IO.lines -> $line { - if $line ~~ /^^ '# ' (.+) $$/ { - $changed-line = True; - $fh.say: ~$0; - } - else { - $fh.say: $line; - } - } - $fh.close; -} - -ok $changed-line, "found a line to un-comment from format.007"; - -{ - my @lines = run-and-collect-lines("examples/format.007"); - - is +@lines, 2, "correct number of lines"; - - is @lines[0], "abracadabra", "first line"; - is @lines[1], q[foo{1}bar], "second line"; -} - -{ - my $message = run-and-collect-error-message(MODIFIED_FORMAT_007_FILENAME); - - is $message, "Highest index was 1 but got only 1 arguments.", "got the right error"; -} - # --- from t/features/quasi.t -{ - my $program = q:to/./; - macro foo() { - my x = 7; - return quasi { - say(x); - } - } - - foo(); - . - - outputs $program, "7\n", "a variable is looked up in the quasi's environment"; -} - -{ - my $program = q:to/./; - macro moo() { - func infix:<**>(l, r) { - return l ~ " to the " ~ r; - } - return quasi { - say("pedal" ** "metal"); - } - } - - moo(); - . - - outputs - $program, - "pedal to the metal\n", - "operator used in quasi block carries its original environement"; -} - -{ - my $program = q:to/./; - macro gah() { - return quasi { say(2 + 2) } - } - - { - func infix:<+>(l, r) { return "lol, pwnd!" } - gah() - } - . - - outputs - $program, - "4\n", - "operators in quasi aren't unhygienically overriden by mainline environment"; -} - -# --- more from t/features/quasi.t -{ - my $program = q:to/./; - my q1 = quasi { my x; }; - my q2 = quasi { my x; }; - say("alive"); - . - - outputs $program, "alive\n", "Q.Statement quasis don't leak (I)"; -} - -{ - my $program = q:to/./; - my q1 = quasi { my x; }; - say(x); - . - - parse-error $program, X::Undeclared, "Q.Statement quasis don't leak (II)"; -} - { my $program = q:to/./; macro moo() { @@ -156,33 +48,5 @@ ok $changed-line, "found a line to un-comment from format.007"; outputs $program, "right\nright\n", "an injectile gets the quasi's outer scope"; } -{ - my $program = q:to/./; - macro moo() { - return quasi { - my x = 1; - } - } - - moo(); - . - - outputs $program, "", "a single declaration works in an injectile"; -} - -{ - my $program = q:to/./; - macro moo(x) { - return quasi { - (func() { my y = {{{x}}} })() - } - } - - say(moo(42)); - . - - outputs $program, "42\n", "a declaration works in a func term in an injectile"; -} - done-testing; diff --git a/t/examples/format.t b/t/examples/format.t new file mode 100644 index 00000000..66293a0c --- /dev/null +++ b/t/examples/format.t @@ -0,0 +1,38 @@ +use Test; +use _007::Test; + +constant MODIFIED_FORMAT_007_FILENAME = "format-$*PID.007"; +LEAVE unlink MODIFIED_FORMAT_007_FILENAME; +my $changed-line = False; + +given open(MODIFIED_FORMAT_007_FILENAME, :w) -> $fh { + for "examples/format.007".IO.lines -> $line { + if $line ~~ /^^ '# ' (.+) $$/ { + $changed-line = True; + $fh.say: ~$0; + } + else { + $fh.say: $line; + } + } + $fh.close; +} + +ok $changed-line, "found a line to un-comment from format.007"; + +{ + my @lines = run-and-collect-lines("examples/format.007"); + + is +@lines, 2, "correct number of lines"; + + is @lines[0], "abracadabra", "first line"; + is @lines[1], q[foo{1}bar], "second line"; +} + +{ + my $message = run-and-collect-error-message(MODIFIED_FORMAT_007_FILENAME); + + is $message, "Highest index was 1 but got only 1 arguments.", "got the right error"; +} + +done-testing; diff --git a/t/features/hygiene.t b/t/features/hygiene.t index a2ec66ab..33a82c95 100644 --- a/t/features/hygiene.t +++ b/t/features/hygiene.t @@ -20,4 +20,22 @@ use _007::Test; "quasis remember variables from their surrounding macro"; } +{ + my $program = q:to/./; + macro moo() { + return quasi { + my x = "OH HAI"; + say(x); + } + } + + moo(); + . + + outputs + $program, + "OH HAI\n", + "variables can be declared as usual inside of a quasi (and survive)"; +} + done-testing; diff --git a/t/features/quasi.t b/t/features/quasi.t index 71e2d459..434451a2 100644 --- a/t/features/quasi.t +++ b/t/features/quasi.t @@ -312,6 +312,26 @@ use _007::Test; outputs $program, "\n", "quasi"; } + +{ + my $program = q:to/./; + my q1 = quasi { my x; }; + my q2 = quasi { my x; }; + say("alive"); + . + + outputs $program, "alive\n", "Q.Statement quasis don't leak (I)"; +} + +{ + my $program = q:to/./; + my q1 = quasi { my x; }; + say(x); + . + + parse-error $program, X::Undeclared, "Q.Statement quasis don't leak (II)"; +} + { my $program = q:to/./; macro moo() { @@ -356,4 +376,32 @@ use _007::Test; outputs $program, "", "a quasi doesn't have to return a value"; } +{ + my $program = q:to/./; + macro moo() { + return quasi { + my x = 1; + } + } + + moo(); + . + + outputs $program, "", "a single declaration works in an injectile"; +} + +{ + my $program = q:to/./; + macro moo(x) { + return quasi { + (func() { my y = {{{x}}} })() + } + } + + say(moo(42)); + . + + outputs $program, "42\n", "a declaration works in a func term in an injectile"; +} + done-testing; From c7c082ce058a46174f8c150e439cd3688ffa0a5c Mon Sep 17 00:00:00 2001 From: Carl Masak Date: Sun, 17 Feb 2019 17:39:29 +0100 Subject: [PATCH 6/8] Add a (passing) test Adding these from #410; if nothing else, this one is an interesting regression test. --- t/features/hygiene.t | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/t/features/hygiene.t b/t/features/hygiene.t index 33a82c95..48b3c0be 100644 --- a/t/features/hygiene.t +++ b/t/features/hygiene.t @@ -38,4 +38,25 @@ use _007::Test; "variables can be declared as usual inside of a quasi (and survive)"; } +{ + my $program = q:to/./; + my a = "OH"; + + macro moo(x) { + my a = "macro"; + return quasi { + {{{x}}} + } + } + + a = a ~ " HAI"; + say(moo(a)); + . + + outputs + $program, + "OH HAI\n", + "mainline variable survive all the way through a macro/quasi expansion"; +} + done-testing; From 7cf209605ff583497084ccb00557baa57c577466 Mon Sep 17 00:00:00 2001 From: Carl Masak Date: Mon, 18 Feb 2019 16:58:05 +0100 Subject: [PATCH 7/8] Improve interpolate to start caring about blocks This is the right fix hinted at a couple of commits ago. It's probably not complete, but it does pass all the tests. This brings another test out of quarantine. --- lib/_007/Q.pm6 | 71 +++++++++++++++++++++------------- lib/_007/Runtime.pm6 | 13 +++++-- quarantined-tests.t.fixme | 20 ---------- t/api-documentation/comments.t | 2 + t/features/quasi.t | 19 +++++++++ 5 files changed, 75 insertions(+), 50 deletions(-) diff --git a/lib/_007/Q.pm6 b/lib/_007/Q.pm6 index a0602279..5db1beb9 100644 --- a/lib/_007/Q.pm6 +++ b/lib/_007/Q.pm6 @@ -429,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 { } } @@ -687,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 @@ -705,7 +723,7 @@ class Q::Term::Quasi does Q::Term { method attribute-order { } method eval($runtime) { - my $needs-displacement = $.contents !~~ Q::Block; + my $quasi-frame; sub interpolate($thing) { return $thing.new(:elements($thing.elements.map(&interpolate))) @@ -718,7 +736,7 @@ class Q::Term::Quasi does Q::Term { if $thing ~~ Val; if $thing ~~ Q::Term::Identifier { - if $runtime.lookup-frame($thing) -> $frame { + if $runtime.lookup-frame-outside($thing, $quasi-frame) -> $frame { return Q::Term::Identifier::Direct.new(:name($thing.name), :$frame); } else { @@ -749,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; } } @@ -801,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. @@ -1067,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; diff --git a/lib/_007/Runtime.pm6 b/lib/_007/Runtime.pm6 index 2dd76e30..23ca455b 100644 --- a/lib/_007/Runtime.pm6 +++ b/lib/_007/Runtime.pm6 @@ -136,15 +136,20 @@ class _007::Runtime { if $symbol eq RETURN_TO; } - method lookup-frame(Q::Term::Identifier $identifier) { + method lookup-frame-outside(Q::Term::Identifier $identifier, $quasi-frame) { my Str $name = $identifier.name.value; my $frame = self.current-frame; + my $seen-quasi-frame = False; repeat until $frame === NO_OUTER { - return $frame - if $frame.properties.properties{$name} :exists; + if $frame.properties.properties{$name} :exists { + return $seen-quasi-frame ?? $frame !! Nil; + } + if $frame === $quasi-frame { + $seen-quasi-frame = True; + } $frame = $frame.properties; } - return; + die "something is very off with lexical lookup ($name)"; # XXX: turn into X:: } method put-var(Q::Identifier $identifier, $value) { diff --git a/quarantined-tests.t.fixme b/quarantined-tests.t.fixme index ab582d53..e11ebbcb 100644 --- a/quarantined-tests.t.fixme +++ b/quarantined-tests.t.fixme @@ -28,25 +28,5 @@ use _007::Test; "detaching a qtree makes its identifiers unhygienic (#62)"; } -# --- from t/features/quasi.t -{ - my $program = q:to/./; - macro moo() { - my y = "right"; - return quasi { - say(y); - { - my y = "wrong"; - } - say(y); - }; - }; - - moo(); - . - - outputs $program, "right\nright\n", "an injectile gets the quasi's outer scope"; -} - done-testing; diff --git a/t/api-documentation/comments.t b/t/api-documentation/comments.t index 25f61f13..c48a07b4 100644 --- a/t/api-documentation/comments.t +++ b/t/api-documentation/comments.t @@ -7,6 +7,8 @@ for -> $file { my $state = Normal; for $file.IO.lines -> $line { + next if $line ~~ / \h '{ ... }' $/; + if $line ~~ /^ < class role > \h+ (Q | < Val:: Q:: > \S+)/ { ok $state == ApiComment, "$0 is documented"; } diff --git a/t/features/quasi.t b/t/features/quasi.t index 434451a2..081334b1 100644 --- a/t/features/quasi.t +++ b/t/features/quasi.t @@ -376,6 +376,25 @@ use _007::Test; outputs $program, "", "a quasi doesn't have to return a value"; } +{ + my $program = q:to/./; + macro moo() { + my y = "right"; + return quasi { + say(y); + { + my y = "wrong"; + } + say(y); + }; + }; + + moo(); + . + + outputs $program, "right\nright\n", "an injectile gets the quasi's outer scope"; +} + { my $program = q:to/./; macro moo() { From ab28ef489f9db3448f67c17e7f9ebf448873d25c Mon Sep 17 00:00:00 2001 From: Carl Masak Date: Tue, 19 Feb 2019 12:43:01 +0100 Subject: [PATCH 8/8] Restore .detach to working order I have a feeling this method will need its own mechanism once we get to actually remembering which block variables outside of a quasi come from. For now, this works. This empties out the quarantined tests file, and so we pass all the tests we used to, and then some. --- lib/_007/Runtime.pm6 | 4 ++-- quarantined-tests.t.fixme | 32 -------------------------------- t/builtins/methods.t | 25 +++++++++++++++++++++++++ 3 files changed, 27 insertions(+), 34 deletions(-) delete mode 100644 quarantined-tests.t.fixme diff --git a/lib/_007/Runtime.pm6 b/lib/_007/Runtime.pm6 index 23ca455b..149085a7 100644 --- a/lib/_007/Runtime.pm6 +++ b/lib/_007/Runtime.pm6 @@ -275,8 +275,8 @@ class _007::Runtime { return $thing if $thing ~~ Val; - return $thing.new(:name($thing.name)) - if $thing ~~ Q::Identifier; + return Q::Term::Identifier.new(:name($thing.name)) + if $thing ~~ Q::Term::Identifier; return $thing if $thing ~~ Q::Unquote; diff --git a/quarantined-tests.t.fixme b/quarantined-tests.t.fixme deleted file mode 100644 index e11ebbcb..00000000 --- a/quarantined-tests.t.fixme +++ /dev/null @@ -1,32 +0,0 @@ -use v6; -use Test; -use _007::Test; - -# --- from t/builtins/methods.t -{ - my $program = q:to/./; - macro so_hygienic() { - my x = "yay, clean!"; - return quasi { - say(x); - }; - } - - macro so_unhygienic() { - my x = "something is implemented wrong"; - return quasi { - say(x) - }.detach(); - } - - my x = "that's gross!"; - so_hygienic(); # yay, clean! - so_unhygienic(); # that's gross! - . - - outputs $program, "yay, clean!\nthat's gross!\n", - "detaching a qtree makes its identifiers unhygienic (#62)"; -} - -done-testing; - diff --git a/t/builtins/methods.t b/t/builtins/methods.t index fc74184a..6248e9d9 100644 --- a/t/builtins/methods.t +++ b/t/builtins/methods.t @@ -222,6 +222,31 @@ use _007::Test; outputs $program, qq!["1", "2", "3"]\n[1, 2, 3]\n!, "flatMap() does nothing if there's no array to remove"; } +{ + my $program = q:to/./; + macro so_hygienic() { + my x = "yay, clean!"; + return quasi { + say(x); + }; + } + + macro so_unhygienic() { + my x = "something is implemented wrong"; + return quasi { + say(x) + }.detach(); + } + + my x = "that's gross!"; + so_hygienic(); # yay, clean! + so_unhygienic(); # that's gross! + . + + outputs $program, "yay, clean!\nthat's gross!\n", + "detaching a qtree makes its identifiers unhygienic (#62)"; +} + { my $program = q:to/./; my a = [1, 2];