Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Rewrite stash handling

There are no more grafts, no more real concept of "stash paths", and
Foo::Bar really does define and use package Foo now.  As per jnthn's
design, non-packages can now replace packages in place, allowing
class Foo::Bar; class Foo to work again.  Things are generally
simpler; starting support for CORE:: and friends.
  • Loading branch information...
commit 2c21c29a06016cae8ed53ae4310fe645b27891f2 1 parent 365e216
@sorear authored
View
1  TODO
@@ -104,4 +104,3 @@ Other stuff to do after:
- jnthnian packages
- pm's = hack
- fix { my $x } crash
- + checking redeclaration of our symbols, methods, attributes...
View
17 lib/Builtins.cs
@@ -1213,6 +1213,23 @@ class SubstrLValue: Variable {
return File.Exists(path) || Directory.Exists(path);
}
+ static string[] split_on_colons(string path) {
+ List<string> l = new List<string>();
+ int ix = -2;
+ do {
+ int nix = path.IndexOf("::", ix+2);
+ l.Add(nix < 0 ? path.Substring(ix+2) :
+ path.Substring(ix+2, nix - (ix+2)));
+ ix = nix;
+ } while (ix >= 0);
+ return l.ToArray();
+ }
+
+ public static Variable dynamic_package_var(Frame th, string path) {
+ string[] toks = split_on_colons(path);
+ return null;
+ }
+
public static Variable BoxLoS(string[] los) {
VarDeque items = new VarDeque();
foreach (string i in los)
View
165 lib/CLRBackend.cs
@@ -159,8 +159,9 @@ class Reader {
// associated with either an Assembly or an AssemblyBuilder.
class Unit {
public readonly Xref mainline_ref;
+ public readonly Xref nsroot;
public readonly string name;
- public readonly object[] log;
+ public readonly object[] nslog;
public readonly Xref setting_ref;
public readonly Xref bottom_ref;
public readonly string filename;
@@ -168,7 +169,6 @@ class Unit {
public readonly object[] xref;
public readonly object[] tdeps;
- public readonly Dictionary<string, Package> exp_pkg;
public readonly Dictionary<string, int> tdep_to_id;
public readonly List<Unit> id_to_tdep;
@@ -200,15 +200,17 @@ class Unit {
List<object> alt_info_constants = new List<object>();
public Unit(object[] from, object[] code) {
- mainline_ref = Xref.from(from[0]);
- name = JScalar.S(from[1]);
- log = from[2] as object[];
+ name = JScalar.S(from[0]);
+ tdeps = from[1] as object[];
+ mainline_ref = Xref.from(from[2]);
setting_ref = Xref.from(from[3]);
bottom_ref = Xref.from(from[4]);
filename = JScalar.S(from[5]);
modtime = from[6] == null ? 0 : JScalar.N(from[6]);
- xref = from[7] as object[];
- exp_pkg = new Dictionary<string,Package>();
+ nsroot = Xref.from(from[7]);
+ nslog = from[8] as object[];
+ xref = from[9] as object[];
+
tdep_to_id = new Dictionary<string,int>();
id_to_tdep = new List<Unit>();
thaw_heap = new List<byte>();
@@ -225,10 +227,8 @@ class Unit {
Package p = Package.From(xr);
xref[i] = p;
p.own_xref = new Xref(name, i, p.name);
- p.NoteExports(exp_pkg);
}
}
- tdeps = from[8] as object[];
}
public void BindDepends(bool ismain) {
@@ -246,8 +246,6 @@ class Unit {
Unit o = CLRBackend.GetUnit(n);
id_to_tdep.Add(o);
o.BindDepends(false);
- foreach (KeyValuePair<string,Package> kv in o.exp_pkg)
- exp_pkg[kv.Key] = kv.Value;
}
if (ismain) return;
@@ -295,19 +293,6 @@ class Unit {
DoVisitSubsPreorder(z, cb);
}
- public Package GetPackage(string[] strs, int f, int l) {
- StringBuilder sb = new StringBuilder();
- for (int i = 0; i < l; i++) {
- string rxes = strs[i+f];
- sb.Append((char)(rxes.Length >> 16));
- sb.Append((char)(rxes.Length & 0xFFFF));
- sb.Append(rxes);
- }
- Package p;
- exp_pkg.TryGetValue(sb.ToString(), out p);
- return p;
- }
-
public Package GetCorePackage(string name) {
StaticSub r = (bottom_ref ?? mainline_ref).Resolve<StaticSub>();
while (r.unit.name != "CORE")
@@ -325,7 +310,7 @@ class Unit {
throw new ArgumentException();
}
LexStash lx = (LexStash)r.l_lexicals[name];
- return GetPackage(lx.path, 0, lx.path.Length);
+ return lx.GetPackage();
}
public static string SharedName(char type, int ix, string name) {
@@ -735,27 +720,13 @@ class Package {
public Xref own_xref;
public readonly string name;
public readonly string type;
- public readonly object[] exports;
+ public readonly string who;
public FieldInfo metaObject;
public Package(object[] p) {
type = ((JScalar)p[0]).str;
name = ((JScalar)p[1]).str;
- exports = (object[]) p[2];
- }
-
- internal void NoteExports(Dictionary<string,Package> dp) {
- foreach (object x in exports) {
- object[] rx = (object[]) x;
- StringBuilder sb = new StringBuilder();
- foreach (object rxe in rx) {
- string rxes = ((JScalar) rxe).str;
- sb.Append((char)(rxes.Length >> 16));
- sb.Append((char)(rxes.Length & 0xFFFF));
- sb.Append(rxes);
- }
- dp[sb.ToString()] = this;
- }
+ who = ((JScalar)p[2]).str;
}
public void BindFields(int ix, Func<string,Type,FieldInfo> binder) {
@@ -905,7 +876,6 @@ class StaticSub {
public readonly string[] cur_pkg;
public readonly string sclass;
public readonly object ltm;
- public readonly object[] exports;
public readonly object sig;
public readonly List<KeyValuePair<string,Lexical>> lexicals;
public readonly Dictionary<string,Lexical> l_lexicals;
@@ -923,10 +893,9 @@ class StaticSub {
zyg = JScalar.IA(0, s[4]);
sclass = JScalar.S(s[5]);
ltm = s[6];
- exports = (object[]) s[7];
- sig = s[8];
+ sig = s[7];
- object[] r_lexicals = s[9] as object[];
+ object[] r_lexicals = s[8] as object[];
if (c != null) {
parametric_role_hack = Xref.from(c[1]);
@@ -936,8 +905,7 @@ class StaticSub {
body_of = Xref.from(c[5]);
in_class = Xref.from(c[6]);
cur_pkg = JScalar.SA(0, c[7]);
- if (c[8] != null) r_lexicals = c[8] as object[];
- body = c[9];
+ body = c[8];
}
lexicals = new List<KeyValuePair<string,Lexical>>();
@@ -996,7 +964,9 @@ abstract class Lexical {
public virtual ClrOp SetCode(int up, ClrOp head) {
throw new Exception("Lexicals of type " + this + " cannot be bound");
}
+ public abstract void EmitInfo(Unit to);
public abstract ClrOp GetCode(int up);
+ /* names which are kept in the pad for quick runtime access */
public static bool IsDynamicName(string name) {
if (name == "$_") return true;
if (name.Length < 2) return false;
@@ -1006,7 +976,7 @@ abstract class Lexical {
}
}
- class LexVarish : Lexical {
+ abstract class LexVarish : Lexical {
public int index;
public FieldInfo stg;
@@ -1020,6 +990,14 @@ class LexVarish : Lexical {
: new ClrSetSField(stg, to);
}
+ public abstract byte TypeCode();
+ public override void EmitInfo(Unit to) {
+ to.EmitByte(TypeCode());
+ to.EmitInt(index);
+ if (index < 0)
+ to.EmitStr(stg.Name);
+ }
+
public override void BindFields(int six, int lix, StaticSub sub,
string name, Func<string,Type,FieldInfo> binder) {
if (IsDynamicName(name) || (sub.flags & StaticSub.RUN_ONCE) == 0) {
@@ -1039,6 +1017,7 @@ class LexSimple : LexVarish {
public readonly int flags;
public readonly Xref type;
+ public override byte TypeCode() { return 0; }
public LexSimple(object[] l) {
flags = JScalar.I(l[2]);
type = Xref.from(l[3]);
@@ -1047,9 +1026,20 @@ class LexSimple : LexVarish {
class LexLabel : LexVarish {
public LexLabel(object[] l) { }
+ public override byte TypeCode() { return 1; }
}
+
class LexDispatch : LexVarish {
public LexDispatch(object[] l) { }
+ public override byte TypeCode() { return 2; }
+ }
+
+ class LexSub : LexVarish {
+ public readonly Xref def;
+ public LexSub(object[] l) {
+ def = new Xref(l, 2);
+ }
+ public override byte TypeCode() { return 3; }
}
class LexHint : Lexical {
@@ -1063,13 +1053,18 @@ class LexHint : Lexical {
string name, Func<string,Type,FieldInfo> binder) {
stg = binder(Unit.SharedName('B', six, name), Tokens.BValue);
}
+ public override void EmitInfo(Unit to) {
+ to.EmitByte(4);
+ }
}
class LexCommon : Lexical {
- public readonly string[] path;
+ public readonly Xref package;
+ public readonly string name;
public FieldInfo stg;
public LexCommon(object[] l) {
- path = JScalar.SA(2, l);
+ package = Xref.from(l[2]);
+ name = JScalar.S(l[3]);
}
public override ClrOp GetCode(int up) {
return new ClrGetField(Tokens.BValue_v,
@@ -1079,45 +1074,45 @@ class LexCommon : Lexical {
return new ClrSetField(Tokens.BValue_v,
new ClrGetSField(stg), to);
}
+ public override void EmitInfo(Unit to) {
+ to.EmitByte(5);
+ to.EmitXref(package);
+ to.EmitStr(name);
+ }
public override void BindFields(int six, int lix, StaticSub sub,
string name, Func<string,Type,FieldInfo> binder) {
stg = binder(Unit.SharedName('B', six, name), Tokens.BValue);
}
}
- class LexSub : LexVarish {
- public readonly Xref def;
- public LexSub(object[] l) {
- def = new Xref(l, 2);
- }
- }
-
class LexAlias : Lexical {
public readonly string to;
public LexAlias(object[] l) {
to = JScalar.S(l[2]);
}
+ public override void EmitInfo(Unit to) {
+ to.EmitByte(6);
+ to.EmitStr(this.to);
+ }
public override ClrOp GetCode(int up) { throw new NotImplementedException(); }
}
class LexStash : Lexical {
public readonly Unit unit;
- public readonly string[] path;
- public Package GetPackage() {
- return unit.GetPackage(path, 0, path.Length);
+ public readonly Xref package;
+ public override void EmitInfo(Unit to) {
+ to.EmitByte(7);
+ to.EmitXref(package);
}
+ public Package GetPackage() { return package.Resolve<Package>(); }
public override ClrOp GetCode(int up) {
Package p = GetPackage();
- if (p == null) {
- return new ClrGetField(Tokens.DMO_typeVar,
- new ClrGetSField(Tokens.Kernel_AnyMO));
- }
return new ClrGetField(Tokens.DMO_typeVar,
- new ClrGetSField(p.metaObject));
+ new ClrGetSField(p.metaObject));
}
public LexStash(Unit u, object[] l) {
unit = u;
- path = JScalar.SA(2, l);
+ package = new Xref(l, 2);
}
}
@@ -1381,6 +1376,8 @@ sealed class Tokens {
typeof(Kernel).GetMethod("CreateArray");
public static readonly MethodInfo Kernel_CreateHash =
typeof(Kernel).GetMethod("CreateHash");
+ public static readonly MethodInfo Kernel_GetVar =
+ typeof(Kernel).GetMethod("GetVar");
public static readonly MethodInfo Kernel_Decontainerize =
typeof(Kernel).GetMethod("Decontainerize");
public static readonly MethodInfo Kernel_NewBoundVar =
@@ -1395,10 +1392,6 @@ sealed class Tokens {
typeof(Kernel).GetMethod("SetStatus");
public static readonly MethodInfo Kernel_SortHelper =
typeof(Kernel).GetMethod("SortHelper");
- public static readonly MethodInfo Kernel_GetVar =
- typeof(Kernel).GetMethod("GetVar");
- public static readonly MethodInfo Kernel_CreatePath =
- typeof(Kernel).GetMethod("CreatePath");
public static readonly MethodInfo Kernel_AddPhaser =
typeof(Kernel).GetMethod("AddPhaser");
public static readonly MethodInfo Kernel_FirePhasers =
@@ -4110,11 +4103,6 @@ class NamProcessor {
/*not used until sub3 time*/
EncodeSignature(sub);
sub.unit.EmitByte(sub.is_phaser >= 0 ? sub.is_phaser : 0xFF);
-
- object[] os = sub.exports ?? new object[0];
- sub.unit.EmitInt(os.Length);
- foreach (object o in os)
- sub.unit.EmitStrArray(JScalar.SA(0,o));
}
void EnterCode(List<object> frags) {
@@ -4403,6 +4391,7 @@ public class CLRBackend {
int b = unit.thaw_heap.Count;
unit.EmitInt(ix);
unit.EmitStr(pkg.name);
+ unit.EmitStr(pkg.who);
if (pkg is Role) {
unit.EmitByte(0);
@@ -4439,10 +4428,6 @@ public class CLRBackend {
unit.EmitByte(4);
}
- unit.EmitInt(pkg.exports.Length);
- foreach (object o in pkg.exports)
- unit.EmitStrArray(JScalar.SA(0,o));
-
if (pkg is Role || pkg is Class) {
Method[] methods = (pkg is Class) ? ((Class)pkg).methods :
((Role)pkg).methods;
@@ -4511,7 +4496,8 @@ public class CLRBackend {
LexCommon lx = (LexCommon)l.Value; /* XXX cname */
thaw.Add(CpsOp.SetSField(lx.stg,
CpsOp.MethodCall(Tokens.Kernel_GetVar,
- CpsOp.StringArray(false, lx.path))));
+ CpsOp.StringLiteral(lx.package.Resolve<Package>().who),
+ CpsOp.StringLiteral(lx.name))));
} else if (l.Value is LexHint) {
LexHint lx = (LexHint)l.Value;
thaw.Add(CpsOp.SetSField(lx.stg,
@@ -4544,18 +4530,15 @@ public class CLRBackend {
}
});
- foreach (object le in unit.log) {
+ int stash_base = unit.thaw_heap.Count;
+ unit.EmitInt(unit.nslog.Length);
+ foreach (object le in unit.nslog) {
object[] lea = (object[]) le;
- string t = ((JScalar)lea[0]).str;
- if (t == "pkg" || t == "var") {
- CpsOp sa = CpsOp.StringArray(false, JScalar.SA(0, lea[1]));
- if (t == "pkg") {
- thaw.Add(CpsOp.MethodCall(Tokens.Kernel_CreatePath, sa));
- } else {
- thaw.Add(CpsOp.Sink(CpsOp.MethodCall(Tokens.Kernel_GetVar, sa)));
- }
- }
+ unit.EmitStr(JScalar.S(lea[0])); //who
+ unit.EmitStr(JScalar.S(lea[1])); //name
+ unit.EmitXref(Xref.from(lea[2])); //what
}
+ thaw.Add(CpsOp.MethodCall(Tokens.RuntimeUnit.GetMethod("LoadStashes"), CpsOp.GetSField(unit.rtunit), CpsOp.IntLiteral(stash_base)));
thaw.Add(CpsOp.MethodCall(Tokens.SubInfo.GetMethod("SetStringHint"),
CpsOp.GetSField(unit.mainline_ref.Resolve<StaticSub>().subinfo),
@@ -4795,7 +4778,7 @@ public class DownCallAcceptor: CrossDomainReceiver {
} else if (args[0] == "replrun") {
string ret = "";
try {
- BValue b = Kernel.GetVar(new string[] { "PROCESS", "$OUTPUT_USED"});
+ BValue b = Kernel.PackageLookup(Kernel.ProcessO, "$OUTPUT_USED");
b.v = Kernel.FalseV;
Variable r = Kernel.RunInferior(
Kernel.GetInferiorRoot().MakeChild(null,
View
84 lib/Kernel.cs
@@ -441,6 +441,23 @@ public sealed class RuntimeUnit {
public const int SUB_IS_UNSAFE = 8;
public const int SUB_IS_PARAM_ROLE = 16;
+ public void LoadStashes(int from) {
+ int ct = ReadInt(ref from);
+ for (int i = 0; i < ct; i++) {
+ string who = ReadStr(ref from);
+ string name = ReadStr(ref from);
+ object what = ReadXref(ref from);
+
+ BValue slot = Kernel.GetVar(who, name);
+ if (what == null) continue;
+
+ Variable item = (what is SubInfo) ?
+ Kernel.NewROScalar(((SubInfo)what).protosub) :
+ ((STable)what).typeVar;
+ slot.v = Kernel.StashyMerge(slot.v, item, who, name);
+ }
+ }
+
public void LoadAllSubs(int from) {
int[] froms = ReadIntArray(ref from);
foreach (int f in froms)
@@ -523,6 +540,7 @@ public sealed class RuntimeUnit {
case 3: //module
break;
case 4: //package
+ mo.mo.isPackage = true;
break;
case 5: //subset
mo.mo.FillSubset((STable)ReadXref(ref from));
@@ -539,10 +557,6 @@ public sealed class RuntimeUnit {
mo.initObject = mo.typeObject;
}
- int nex = ReadInt(ref from);
- for (int j = 0; j < nex; j++)
- Kernel.GetVar(ReadStrArray(ref from)).v = mo.typeVar;
-
ReadClassMembers(mo, ref from);
if (mo.mo.isSubset)
mo.mo.subsetWhereThunk = ((SubInfo)ReadXref(ref from)).protosub;
@@ -562,12 +576,6 @@ public sealed class RuntimeUnit {
if (TraceLoad) Console.WriteLine("Sig loaded");
int ph = heap[from++];
if (ph != 0xFF) Kernel.AddPhaser(ph, si.protosub);
- int nex = ReadInt(ref from);
- if (TraceLoad) Console.WriteLine("loading exports...");
- for (int j = 0; j < nex; j++)
- Kernel.GetVar(ReadStrArray(ref from)).v =
- Kernel.NewROScalar(si.protosub);
- if (TraceLoad) Console.WriteLine("exports loaded");
}
}
@@ -575,12 +583,14 @@ public sealed class RuntimeUnit {
int _ifrom = from;
int ix = ReadInt(ref from);
string name = ReadStr(ref from);
+ string how = ReadStr(ref from);
if (TraceLoad)
Console.WriteLine("Installing package {0} \"{1}\" from {2:X}", ix, name, _ifrom);
STable mo = existing_mo != null ? existing_mo :
new STable(name);
xref[ix] = mo;
+ mo.how = Kernel.GetStash(how);
mo.typeObject = new P6opaque(mo, 0);
((P6opaque)mo.typeObject).slots = null;
mo.typeVar = Kernel.NewROScalar(mo.typeObject);
@@ -3157,21 +3167,6 @@ public class MMDCandidateLongname {
GetInferiorRoot(), "head", new Variable[] {lst}, null));
}
- // TODO: Runtime access to grafts
- public static void CreatePath(string[] path) {
- P6any cursor = RootO;
- foreach (string n in path)
- cursor = PackageLookup(cursor, n + "::").v.Fetch();
- }
-
- public static BValue GetVar(string[] path) {
- P6any cursor = RootO;
- for (int i = 0; i < path.Length - 1; i++) {
- cursor = PackageLookup(cursor, path[i] + "::").v.Fetch();
- }
- return PackageLookup(cursor, path[path.Length - 1]);
- }
-
public static Variable CreateArray() {
P6any v = new P6opaque(ArrayMO, 2);
v.SetSlot("items", new VarDeque());
@@ -3184,6 +3179,25 @@ public class MMDCandidateLongname {
return NewRWListVar(v);
}
+ public static Variable StashyMerge(Variable o, Variable n, string d1, string d2) {
+ if (n.rw || n.islist) return o;
+ if (o.rw || o.islist) return n;
+
+ P6any oo = o.Fetch();
+ P6any nn = n.Fetch();
+
+ if (!oo.IsDefined() && !nn.IsDefined() && oo.mo.how == nn.mo.how) {
+ if (oo.mo.mo.isPackage) return n;
+ if (nn.mo.mo.isPackage) return o;
+ }
+
+ throw new NieczaException("Funny merge failure " + d1 + "::" + d2);
+ }
+
+ public static BValue GetVar(string who, string name) {
+ return PackageLookup(GetStash(who), name);
+ }
+
public static BValue PackageLookup(P6any parent, string name) {
Dictionary<string,BValue> stash =
UnboxAny<Dictionary<string,BValue>>(parent);
@@ -3191,11 +3205,6 @@ public class MMDCandidateLongname {
if (stash.TryGetValue(name, out v)) {
return v;
- } else if (name.EndsWith("::")) {
- Dictionary<string,BValue> newstash =
- new Dictionary<string,BValue>();
- newstash["PARENT::"] = new BValue(NewROScalar(parent));
- return (stash[name] = new BValue(BoxAny<Dictionary<string,BValue>>(newstash, StashP)));
} else if (name.StartsWith("@")) {
return (stash[name] = new BValue(CreateArray()));
} else if (name.StartsWith("%")) {
@@ -3533,6 +3542,7 @@ class LastFrameNode {
}
}
+ static Dictionary<string, P6any> stashes;
public static P6any RootO;
// used as the fallbacks for $*FOO
public static P6any GlobalO;
@@ -3708,9 +3718,17 @@ class LastFrameNode {
ScalarMO = new STable("Scalar");
ScalarMO.FillProtoClass(new string[] { });
- RootO = BoxRaw(new Dictionary<string,BValue>(), StashMO);
- GlobalO = PackageLookup(RootO, "GLOBAL::").v.Fetch();
- ProcessO = PackageLookup(RootO, "PROCESS::").v.Fetch();
+ stashes = new Dictionary<string,P6any>();
+ RootO = GetStash("");
+ GlobalO = GetStash("::GLOBAL");
+ ProcessO = GetStash("::PROCESS");
+ }
+
+ public static P6any GetStash(string name) {
+ P6any o;
+ if (stashes.TryGetValue(name, out o))
+ return o;
+ return stashes[name] = BoxRaw(new Dictionary<string,BValue>(), StashMO);
}
public static Dictionary<string, int> usedNames = new Dictionary<string, int>();
View
2  lib/ObjModel.cs
@@ -116,7 +116,7 @@ public abstract class IndexHandler {
public class P6how {
public STable stable;
- public bool isRole, isSubset;
+ public bool isRole, isSubset, isPackage;
public P6any roleFactory;
public P6any subsetWhereThunk;
public Variable subsetFilter;
View
381 src/Metamodel.pm6
@@ -29,10 +29,10 @@ method locstr($fo, $lo, $fn, $ln) {
#
# This graph is a lot more random than the old trees were...
-# While manipulating metamodel bits, these contextuals are needed:
-# @*opensubs: stack of non-transparent subs, new lexicals go in [*-1]
+# While manipulating metamodel bits during BEGIN, these contextuals are needed:
# $*unit: current unit for new objects to attach to
# %*units: maps unit names to unit objects
+# $*CURSUB<!sub>: the top non-transparent sub
# Almost all longname and most identifier uses in Perl6 can be divided into
# two groups.
@@ -62,9 +62,8 @@ method locstr($fo, $lo, $fn, $ln) {
#
# immed_decl:
-# A stash is an object like Foo::. Foo and Foo:: are closely related, but
-# generally must be accessed separately due to constants (which have Foo but
-# not Foo::) and stub packages (vice versa).
+# A stash is an object like Foo::. Stashes are named to allow them to be
+# sensibly named across merges.
#
# 'my' stashes are really 'our' stashes with gensym mergable names. Because
# stashes have no identity beyond their contents and set of names, they don't
@@ -74,178 +73,101 @@ method locstr($fo, $lo, $fn, $ln) {
# keep the paths around, instead.
#
# This object holds the stash universe for a unit.
+# XXX forward decls are a little broken
+my $Package;
class Namespace {
- # root points to a graph of hashes each representing one package.
- # Each such hash has keys for each member; the values are arrayrefs:
- # ["graft", [@path]]: A graft
- # ["var", $meta, $sub]: A common variable and/or subpackage; either
- # field may be undef.
+ # all maps stash names to stashes. Stashes are represented as simple
+ # hashes here; the values are always arrays like [$xref, $file, $line].
+ # $xref may be undefined to indicate a stash entry with no compile-time
+ # value (our $x, my $x is export).
#
- # Paths do not start from GLOBAL; they start from an unnamed package
- # which contains GLOBAL, and also lexical namespaces (MAIN 15 etc).
- has $.root = {}; # is rw
+ # Stash names are keyed like "GLOBAL::Foo::Bar" or "MAIN:15". Stashes
+ # outside GLOBAL or PROCESS are anonymous packages, for my aliasing.
+ has %.all;
# Records *local* operations, so they may be stored and used to
# set up the runtime stashes. Read-only log access is part of the
# public API.
- has $.log = [];
-
- method !lookup_common($used, @path_) {
- my $cursor = $.root;
- my @path = @path_;
- while @path > 1 {
- my $k = shift @path;
- if ($cursor{$k} && $cursor{$k}[0] eq 'graft') {
- ($cursor, $used) = self!lookup_common([], [ @($cursor{$k}[1]), '' ]);
- next;
- }
+ #
+ # Each entry is an arrayref of the form [$who, $name, $xref, $file, $line].
+ has @.log;
- $cursor{$k} //= ['var',Any,Any];
- if !defined $cursor{$k}[2] {
- $.log.push(['pkg',[@$used, $k]]);
- $cursor{$k}[2] = {};
- }
- $cursor = $cursor{$k}[2];
- push @$used, $k;
- }
- @($cursor, $used, @path);
- }
+ # This is set up post-creation by NieczaGrammar. It points to a package
+ # with a who of ''.
+ has $.root is rw;
- method stash_cname(@path) {
- self!lookup_common([], @path)[1,2];
- }
+ method _merge_item($i1, $i2, $who, $name) {
+ # supress absent entries
+ return $i2 unless defined $i1;
+ return $i1 unless defined $i2;
- method stash_canon(@path) {
- my ($npath, $nhead) = self.stash_cname(@path);
- @$npath, $nhead;
- }
+ # suppress simple COMMONs if no absent
+ return $i2 unless defined $i1[0];
+ return $i1 unless defined $i2[0];
- method visit_stashes($cb) {
- sub visitor($node, @path) {
- $cb([@path]);
- for sort keys $node -> $k {
- if $node{$k}[0] eq 'var' && defined $node{$k}[2] {
- visitor($node{$k}[2], [ @path, $k ]);
- }
- }
- }
- visitor($.root, []);
- }
+ # ooh, we now know we have no COMMONs
+ my $item1 = $*unit.deref($i1[0]);
+ my $item2 = $*unit.deref($i2[0]);
- # Add a new unit set to the from-set and checks mergability
- method add_from($from) {
- $!root = _merge($!root, %*units{$from}.ns.root, []);
- }
+ return $i1 if $item1 === $item2;
- sub _dclone($tree) {
- return $tree unless defined $tree;
- my $rinto = { };
- for keys $tree -> $k {
- my $i = $tree{$k};
- if $i[0] eq 'var' {
- $i = ['var', $i[1], _dclone($i[2])];
- }
- $rinto{$k} = $i;
+ if $item1.^isa($Package) && $item2.^isa($Package) &&
+ $item1.who eq $item2.who &&
+ ($item1.WHAT === $Package || $item2.WHAT === $Package) {
+ return $i1;
}
- $rinto;
- }
- sub _merge_item($i1, $i2, *@path) {
- my $nn1 = $i1[0] && $i1[0][0];
- my $nn2 = $i2[0] && $i2[0][0];
- if $nn1 && $nn2 && ($i1[0][0] ne $i2[0][0] || $i1[0][1] != $i2[0][1]) {
- die "Two definitions found for package symbol [{@path}]\n\n" ~
+ die "Two definitions found for symbol {$who}::$name\n\n" ~
" first at $i1[1] line $i1[2]\n" ~
" second at $i2[1] line $i2[2]";
- }
-
- ($nn1 ?? $i1 !! $nn2 ?? $i2 !! ($i1 // $i2))
- }
-
- sub _merge($rinto_, $rfrom, @path) {
- my $rinto = _hash_constructor( %$rinto_ );
- for sort keys $rfrom -> $k {
- if !$rinto{$k} {
- $rinto{$k} = $rfrom{$k};
- if $rinto{$k}[0] eq 'var' {
- $rinto{$k} = ['var', $rinto{$k}[1], _dclone($rinto{$k}[2]) ];
- }
- next;
- }
- my $i1 = $rinto{$k};
- my $i2 = $rfrom{$k};
- if $i1[0] ne $i2[0] {
- die "Merge type conflict " ~ join(" ", $i1[0], $i2[0], @path, $k);
- }
- if $i1[0] eq 'graft' {
- die "Grafts cannot be merged " ~ join(" ", @path, $k)
- unless join("\0", @($i1[1])) eq join("\0", @($i2[1]));
- }
- if $i1[0] eq 'var' {
- $rinto{$k} = ['var',
- _merge_item($i1[1], $i2[1], @path, $k),
- ((defined($i1[2]) && defined($i2[2])) ??
- _merge($i1[2], $i2[2], [@path, $k]) !!
- _dclone($i1[2] // $i2[2]))];
- }
- }
- return $rinto;
}
- # Create or reuse a (stub) package for a given path
- method create_stash(@path) {
- self!lookup_common([], [@path, '']);
+ method exists($who, $item) {
+ return ?(%!all{$who}{$item});
}
- # Create or reuse a variable for a given path
- method create_var(@path) {
- my ($c,$u,$n) = self!lookup_common([], @path);
- my $i = $c{$n} //= ['var',Any,Any];
- if $i[0] ne 'var' {
- die "Collision with non-variable on @path";
- }
- if !$i[1] {
- $.log.push([ 'var', [ @$u,$n ] ]);
- $i[1] = [['',0],'',0];
- }
+ method get($who, $item) {
+ return %!all{$who}{$item}[0]
}
- # Lookup by name; returns undef if not found
- method get_item(@path) {
- my ($c,$u,$n) = self!lookup_common([], @path); #OK not used
- my $i = $c{$n} or return Any;
- if $i[0] eq 'graft' {
- self.get_item($i[1]);
- } elsif $i[0] eq 'var' {
- $i[1][0];
- }
+ method bind($who, $name, $item, :$file, :$line, :$pos) { #OK not used
+ my $slot := %!all{$who}{$name};
+ $slot = self._merge_item($slot, [ $item,
+ $file // '???', $line // '???' ], $who, $name);
+ push @!log, [ $who, $name, $item, $file, $line ];
}
- # Bind an unmergable thing (non-stub package) into a stash.
- method bind_item($path, $item, :$file = '???', :$line = '???', :$pos) {
- my ($c,$u,$n) = self!lookup_common([], $path); #OK not used
- my $i = $c{$n} //= ['var',Any,Any];
- if $i[0] ne 'var' {
- die "Installing item at $path, collide with graft";
+ method get_pkg($from is copy, *@names, :$auto) {
+ for @names {
+ my $sl = self.get($from.who, $_);
+ my $pkg;
+ if $sl && $sl[0] && ($pkg = $*unit.deref($sl)).^isa($Package) {
+ } elsif !$auto {
+ die "Name component $_ not found in $from.who()";
+ } else {
+ $pkg = $Package.new(name => $_, who => $from.who ~ '::' ~ $_);
+ self.bind($from.who, $_, $pkg.xref);
+ }
+ $from = $pkg;
}
- $i[1] = _merge_item($i[1], [$item,$file,$line], @$path);
+ $from;
}
- # Bind a graft into a stash
- method bind_graft($path1, $path2) {
- my ($c,$u,$n) = self!lookup_common([], $path1);
- if $c{$n} {
- die "Collision installing graft $path1 -> $path2";
+ # Add a new unit set to the from-set and checks mergability
+ method add_from($from) {
+ for %*units{$from}.ns.log -> $logent {
+ # not using bind since we don't want this in the log
+ my $slot := %!all{$logent[0]}{$logent[1]};
+ $slot = self._merge_item($slot, [ $logent[2], $logent[3],
+ $logent[4] ], $logent[0], $logent[1]);
}
- push $.log, [ 'graft', [ @$u, $n ], $path2 ];
- $c{$n} = ['graft', $path2];
}
- # List objects in a stash for use by the importer; returns tuples
- # of [name, var] etc
- method list_stash(@path) {
- my $c = self!lookup_common([], [@path, ''])[0];
- map { [ $_, @( $c{$_} ) ] }, sort keys $c;
+ # List objects in a stash for use by the importer; returns pairs
+ # of [name, xref]
+ method list_stash($who) {
+ my $h = %!all{$who};
+ map -> $a { $a => $h{$a}[0] }, sort keys $h;
}
}
@@ -268,11 +190,12 @@ class RefTarget {
}
class Package is RefTarget {
- has $.exports; # is rw
has $.closed;
+ has $.who;
method close() { $!closed = True; }
}
+$Package = Package;
class Module is Package {
}
@@ -381,8 +304,7 @@ class Class is Module {
if (($.name ne 'Mu' || !$*unit.is_true_setting)
&& !$.superclasses) {
- self.add_super($*unit.get_item(
- $*CURLEX<!sub>.true_setting.find_pkg(self._defsuper)));
+ self.add_super($*CURLEX<!sub>.compile_get_pkg(self._defsuper).xref);
}
my @merge;
@@ -399,7 +321,7 @@ class Class is Module {
nextsame;
}
- method _defsuper() { 'Any' }
+ method _defsuper() { 'CORE', 'Any' }
}
# roles come in two types; Role objects are used for simple roles, while roles
@@ -468,17 +390,17 @@ class ParametricRole is Module {
}
class Grammar is Class {
- method _defsuper() { 'Grammar' }
+ method _defsuper() { 'CORE', 'Grammar' }
}
# subsets are a bit simpler than roles/grammars/classes, as they have
# no body and so attributes &c cannot be added to them directly.
class Subset is Module {
# subset <longname>? <trait>* [where <EXPR>]?
- has $.basetype;
+ has $.basetype is rw;
# Xref to a sub which will be called once the first time the subset
# is used.
- has $.where;
+ has $.where is rw;
}
#####
@@ -513,7 +435,7 @@ class Lexical {
# our...
class Common is Lexical {
- has $.path = die "M:L:Common.path required"; # Array of Str
+ has $.pkg = die "M:L:Common.path required"; # Xref to Package
has $.name = die "M:L:Common.name required"; # Str
}
@@ -527,10 +449,10 @@ class Lexical {
has $.body; # Metamodel::StaticSub
}
- # my class Foo { } or our class Foo { }; either case, the true stash lives in
- # stashland
+ # my class Foo { } or our class Foo { }; either case, the true
+ # stash lives in stashland. Actually this points at a package now.
class Stash is Lexical {
- has $.path; # Array of Str
+ has $.pkg; # Xref
}
}
@@ -570,16 +492,15 @@ class StaticSub is RefTarget {
has $.hint_hack is rw;
has $.is_phaser is rw; # Int
- has Bool $.strong_used is rw = False; # Bool, is rw; prevents elision
- has $.body_of is rw; # Xref of Package
+ has Bool $.strong_used is rw = False; # prevents elision
+ has $.body_of is rw; # Xref of Package
has $.in_class is rw; # Xref of Package
- has $.cur_pkg is rw; # Array of Str
+ has $.cur_pkg is rw; # Xref of Package
has Bool $.returnable is rw = False; # catches &return
has Bool $.augmenting is rw = False; # traps add_attribute
has Bool $.unsafe is rw = False; # disallowed in safe mode
has Str $.class is rw = 'Sub';
has $.ltm is rw;
- has $.exports is rw;
has $.prec_info is rw;
# used during parse only
@@ -598,6 +519,16 @@ class StaticSub is RefTarget {
while $cursor && !$cursor.unit.is_true_setting {
$cursor = $cursor.outer;
}
+ $cursor || self;
+ }
+
+ method to_unit() {
+ my $cursor = self;
+ my $unit = self.unit;
+ my $outer;
+ while ($outer = $cursor.outer) && $outer.unit === $unit {
+ $cursor = $outer
+ }
$cursor;
}
@@ -625,35 +556,58 @@ class StaticSub is RefTarget {
$.signature && ?( grep { .slot && .slot eq '$_' }, @( $.signature.params ) )
}
- method find_lex_pkg($name) {
- my $toplex = self.find_lex($name) // return Array;
- if !$toplex.^isa(Metamodel::Lexical::Stash) {
- die "$name is declared as a non-package";
- }
- $toplex.path;
- }
-
- method find_pkg($names) {
- my @names = $names ~~ Str ?? ('MY', $names) !! @$names;
- for @names { $_ = substr($_, 0, chars($_)-2) if chars($_) >= 2 && substr($_, chars($_)-2, 2) eq '::' } # XXX
- my @tp;
- if @names[0] eq 'OUR' {
- @tp = @$.cur_pkg;
- shift @names;
- } elsif @names[0] eq 'PROCESS' or @names[0] eq 'GLOBAL' {
- @tp = shift @names;
- } elsif @names[0] eq 'MY' {
- @tp = @( self.find_lex_pkg(@names[1]) // die "{@names} doesn't seem to exist" );
- shift @names;
- shift @names;
- } elsif my $p = self.find_lex_pkg(@names[0]) {
- @tp = @$p;
- shift @names;
+ # helper for compile_get_pkg; handles stuff like SETTING::OUTER::Foo,
+ # recursively.
+ method _lexy_ref(*@names, :$auto) {
+ @names || die "Cannot use a lexical psuedopackage as a compile time package reference";
+ self // die "Passed top of lexical tree";
+ given shift @names {
+ when 'OUTER' { return self.outer._lexy_ref(@names, :$auto) }
+ when 'SETTING' { return self.to_unit.outer._lexy_ref(@names, :$auto) }
+ when 'UNIT' { return self.to_unit._lexy_ref(@names, :$auto) }
+ when 'CALLER' { die "Cannot use CALLER in a compile time name" }
+ default {
+ my $lex = self.find_lex($_);
+ $lex // die "No lexical found for $_";
+ $lex.^isa(Metamodel::Lexical::Stash) || die "Lexical $_ is not a package";
+ return $*unit.get_pkg($*unit.deref($lex.pkg), @names, :$auto);
+ }
+ }
+ }
+
+ # returns direct reference to package, or dies
+ method compile_get_pkg(*@names, :$auto) {
+ @names || die "Cannot make a compile time reference to the semantic root package";
+ my $n0 = shift(@names);
+ if $n0 eq 'OUR' {
+ return $*unit.get_pkg($*unit.deref($!cur_pkg), @names, :$auto);
+ } elsif $n0 eq 'PROCESS' or $n0 eq 'GLOBAL' {
+ return $*unit.abs_pkg($n0, @names, :$auto);
+ } elsif $n0 eq 'COMPILING' or $n0 eq 'DYNAMIC' or $n0 eq 'CALLER' {
+ # Yes, COMPILING is right here. Because COMPILING is only valid
+ # when recursively running code within the compiler, but this
+ # function is only called directly from the compiler. The closest
+ # it comes to making sense is if you use eval in a macro. Don't
+ # do that, okay?
+ die "Pseudo package $n0 may not be used in compile time reference";
+ } elsif $n0 eq 'MY' {
+ return self._lexy_ref(@names, :$auto);
+ } elsif $n0 eq 'CORE' {
+ return self.true_setting._lexy_ref(@names, :$auto);
+ } elsif $n0 eq 'OUTER' or $n0 eq 'SETTING' or $n0 eq 'UNIT' {
+ return self._lexy_ref($n0, @names, :$auto);
+ } elsif $n0 ne 'PARENT' && self.find_lex($n0) {
+ return self._lexy_ref($n0, @names, :$auto);
+ } elsif $n0 ~~ /^\W/ {
+ return $*unit.get_pkg($*unit.deref($!cur_pkg), $n0, @names, :$auto);
} else {
- @tp = 'GLOBAL';
+ return $*unit.abs_pkg('GLOBAL', $n0, @names, :$auto);
}
+ }
- [ @tp, @names ];
+ method bind_our_name($path, $name, $item, *%_) {
+ my $pkg = self.compile_get_pkg($path ?? @$path !! 'OUR', :auto);
+ $*unit.bind($pkg, $name, $item, |%_);
}
method find_lex($name) {
@@ -722,10 +676,10 @@ class StaticSub is RefTarget {
self.add_lex($slot, Metamodel::Lexical::Dispatch.new(|%params));
}
- method add_common_name($slot, $path, $name, :$file, :$line, :$pos) {
- $*unit.create_stash($path);
- $*unit.create_var([ @$path, $name ]);
- self.add_lex($slot, Metamodel::Lexical::Common.new(:$path, :$name,
+ method add_common_name($slot, $pkg, $name, :$file, :$line, :$pos) {
+ $*unit.bind($*unit.deref($pkg), $name, Any, :$file, :$line)
+ unless $*unit.ns.exists($*unit.deref($pkg).who, $name);
+ self.add_lex($slot, Metamodel::Lexical::Common.new(:$pkg, :$name,
:$file, :$line, :$pos));
}
@@ -736,29 +690,21 @@ class StaticSub is RefTarget {
if defined($slot) {
self.add_lex($slot, Metamodel::Lexical::Alias.new(to => $back,
|%param));
- }
+ }
}
- method add_my_stash($slot, $path, *%params) {
- self.add_lex($slot, Metamodel::Lexical::Stash.new(:$path, |%params));
+ method add_my_stash($slot, $pkg, *%params) {
+ self.add_lex($slot, Metamodel::Lexical::Stash.new(:$pkg, |%params));
}
method add_my_sub($slot, $body, *%params) {
self.add_lex($slot, Metamodel::Lexical::SubDef.new(:$body, |%params));
}
- method add_pkg_exports($unit, $name, $path2, $tags) {
+ method add_exports($name, $xref, $tags) {
for @$tags -> $tag {
- $unit.bind_graft([@$.cur_pkg, 'EXPORT', $tag, $name], $path2);
- }
- +$tags;
- }
-
- # NOTE: This only marks the variables as used. The code generator
- # still has to spit out assignments for these!
- method add_exports($unit, $name, $tags) {
- for @$tags -> $tag {
- $unit.create_var([ @$.cur_pkg, 'EXPORT', $tag, $name ]);
+ $*unit.bind($*unit.get_pkg($*unit.deref($!cur_pkg), 'EXPORT',
+ $tag, :auto), $name, $xref);
}
+$tags;
}
@@ -779,14 +725,15 @@ class Unit {
has Int $.next_anon_stash is rw = 0; # is rw, Int
has @.stubbed_stashes; # Pair[Stash,Cursor]
- method bind_item($path,$item,*%_) { $!ns.bind_item($path,$item,|%_) }
- method bind_graft($path1,$path2) { $!ns.bind_graft($path1,$path2) }
- method create_stash(@path) { $!ns.create_stash(@path) }
- method create_var(@path) { $!ns.create_var(@path) }
- method list_stash(@path) { $!ns.list_stash(@path) }
- method get_item(@path) { $!ns.get_item(@path) }
+ method bind($pkg,$name,$item,*%_) { $!ns.bind($pkg.who,$name,$item,|%_) }
+ method list_stash($pkg) { $!ns.list_stash($pkg.who) }
+ method get($pkg,$name) { $!ns.get($pkg.who,$name) }
+ method get_pkg($pkg,*@names,:$auto) { $!ns.get_pkg($pkg,@names,:$auto) }
+ method abs_pkg(*@names, :$auto) {
+ $!ns.get_pkg($*unit.deref($!ns.root),@names,:$auto)
+ }
- method is_true_setting() { $.name eq 'CORE' }
+ method is_true_setting() { $!name eq 'CORE' }
method get_unit($name) { %*units{$name} }
@@ -835,13 +782,17 @@ class Unit {
}
method need_unit($u2name) {
+ return $.tdeps{$u2name} if $.tdeps{$u2name};
my $u2 = %*units{$u2name} //= $*module_loader.($u2name);
$.tdeps{$u2name} = [ $u2.filename, $u2.modtime ];
+ my @new = $u2name;
for keys $u2.tdeps -> $k {
+ next if $.tdeps{$k};
+ push @new, $k;
%*units{$k} //= $*module_loader.($k);
- $.tdeps{$k} //= $u2.tdeps{$k};
+ $.tdeps{$k} = $u2.tdeps{$k};
}
- $.ns.add_from($u2name);
+ $!ns.add_from($_) for @new;
$u2;
}
}
View
83 src/NAMOutput.pm6
@@ -8,13 +8,6 @@ use MONKEY_TYPING;
method run($*unit) {
my @*subsnam;
- my %*keeplex;
- my $cursor = $*unit.deref($*unit.bottom_ref // $*unit.mainline.xref);
- while $cursor {
- %*keeplex{~$cursor.xref} = True;
- $cursor = $cursor.outer;
- }
-
$*unit.visit_local_subs_postorder(&nam_sub);
to-json($*unit.to_nam) ~ "\n" ~ to-json(@*subsnam);
}
@@ -45,9 +38,6 @@ sub nam_sub($s) {
$s.body_of,
$s.in_class,
$s.cur_pkg,
- (%*keeplex{~$s.xref} ?? Any !!
- [ map { [ $_, @( $s.lexicals{$_}.to_nam ) ] },
- sort keys $s.lexicals ]),
$code.cgop($s),
];
}
@@ -60,57 +50,34 @@ method load($text) {
augment class Metamodel::Unit { #OK exist
method to_nam() {
[
- $.mainline.xref,
$.name,
- $.ns.log,
+ [ map { [$_, @( $.tdeps{$_} )] }, sort keys $.tdeps ],
+ $.mainline.xref,
$.setting_ref,
$.bottom_ref,
$.filename,
$.modtime,
+ $.ns.root,
+ [ $.ns.log ],
[ map { $_ && $_.to_nam }, @$.xref ],
- [ map { [$_, @( $.tdeps{$_} )] }, sort keys $.tdeps ],
- stash_tonam($.ns.root),
]
}
}
-sub stash_tonam($hr) {
- my @out;
- for sort keys $hr -> $key {
- my $value = [ $key, @( $hr{$key} ) ];
- if $value[1] eq 'var' && $value[3] {
- $value[3] = stash_tonam($value[3]);
- }
- push @out, $value;
- }
- $( @out );
-}
-
-sub stash_fromnam(@block) {
- my %out;
- for @block -> $row {
- my ($key, @rest) = @$row;
- if @rest[0] eq 'var' && @rest[2] {
- @rest[2] = stash_fromnam(@rest[2]);
- }
- %out{$key} = @rest;
- }
- $( %out );
-}
-
sub unit_from_nam(@block) {
- my ($mlref, $name, $log, $setting, $bottom, $filename, $modtime, $xr,
- $td, $root) = @block;
+ my ($name, $td, $mlref, $setting, $bottom, $filename, $modtime,
+ $nsroot, $nslog, $xr) = @block;
my $*uname = $name;
my $*unit = ::Metamodel::Unit.new(
name => $name,
- ns => ::Metamodel::Namespace.new(log => $log,
- root => stash_fromnam($root)),
+ ns => ::Metamodel::Namespace.new(log => @$nslog,
+ root => $nsroot),
setting_ref => $setting,
bottom_ref => $bottom,
filename => $filename,
modtime => $modtime,
tdeps => _hash_constructor(map { (shift($_) => $_) }, @$td));
+
my $*xref = $*unit.xref;
my $*xid = 0;
while $*xid < @$xr {
@@ -122,7 +89,7 @@ sub unit_from_nam(@block) {
$*xid = 0;
while $*xid < @$xr {
if ($xr[$*xid] && $xr[$*xid][0] eq 'sub') {
- for @( $xr[$*xid][9] ) -> $row {
+ for @( $xr[$*xid][8] ) -> $row {
my ($k,$v) = lex_from_nam($row);
$*xref[$*xid].lexicals{$k} = $v;
}
@@ -156,11 +123,9 @@ augment class Metamodel::StaticSub { #OK exist
[ map { $_.xref[1] }, @$.zyg ],
$.class,
$.ltm,
- $.exports,
($.signature && [ map { $_.to_nam }, @( $.signature.params ) ]),
- (!%*keeplex{~self.xref} ?? [] !!
- [ map { [ $_, @( $.lexicals{$_}.to_nam ) ] },
- sort keys $.lexicals ]),
+ [ map { [ $_, @( $.lexicals{$_}.to_nam ) ] },
+ sort keys $.lexicals ],
$.prec_info,
]
}
@@ -168,7 +133,7 @@ augment class Metamodel::StaticSub { #OK exist
sub sub_from_nam(@block) {
my ($kind, $name, $outer, $flags, $zyg, #OK
- $cls, $ltm, $exp, $sig, $rlx, $prec) = @block; #OK
+ $cls, $ltm, $sig, $rlx, $prec) = @block; #OK
# Most of these are used only by code-gen. Lexicals are injected later.
::Metamodel::StaticSub.new(
@@ -204,21 +169,19 @@ augment class Metamodel::Package { #OK exist
[
%typecodes{self.typename},
$.name,
- $.exports,
+ $.who,
@more
]
}
}
sub packagely(@block) {
- my ($type, $name, $exports, $attr, $meth, $sup, $mro) = @block;
+ my ($type, $name, $who, $attr, $meth, $sup, $mro) = @block;
# these two are nonstandard
if $type eq 'subset' {
return ::Metamodel::Subset.new(
- :no_xref,
+ :no_xref, :$name, :$who,
xref => [ $*uname, $*xid, $name ],
- name => $name,
- exports => $exports,
basetype => $attr,
where => $meth,
);
@@ -226,10 +189,8 @@ sub packagely(@block) {
# this relies on .new ignoring unrecognized keys
%pkgtypes{$type}.new(
- :no_xref,
+ :no_xref, :$name, :$who,
xref => [ $*uname, $*xid, $name ],
- name => $name,
- exports => $exports,
attributes => $attr && [ map &attr_from_nam, @$attr ],
methods => $meth && [ map &method_from_nam, @$meth ],
superclasses => $sup,
@@ -348,7 +309,7 @@ augment class Metamodel::Lexical::Simple { #OK exist
$.typeconstraint] }
}
augment class Metamodel::Lexical::Common { #OK exist
- method to_nam() { ['common', @$.path, $.name ] }
+ method to_nam() { ['common', $.pkg, $.name ] }
}
augment class Metamodel::Lexical::Alias { #OK exist
method to_nam() { ['alias', $.to] }
@@ -366,15 +327,15 @@ augment class Metamodel::Lexical::SubDef { #OK exist
method to_nam() { ['sub', @( $.body.xref ) ] }
}
augment class Metamodel::Lexical::Stash { #OK exist
- method to_nam() { ['stash', @$.path ] }
+ method to_nam() { ['stash', @( $.pkg ) ] }
}
sub lex_from_nam(@block) {
my ($name, $type, @xtra) = @block;
return ($name, ::Metamodel::Lexical::Simple.new)
if $type eq 'simple';
- return ($name, ::Metamodel::Lexical::Common.new(name => pop(@xtra),
- path => @xtra)) if $type eq 'common';
+ return ($name, ::Metamodel::Lexical::Common.new(name => @xtra[1],
+ pkg => @xtra[0])) if $type eq 'common';
return ($name, ::Metamodel::Lexical::Alias.new(to => @xtra[0]))
if $type eq 'alias';
return ($name, ::Metamodel::Lexical::Hint.new)
@@ -385,7 +346,7 @@ sub lex_from_nam(@block) {
if $type eq 'dispatch';
return ($name, ::Metamodel::Lexical::SubDef.new(body => $*xref[@xtra[1]]))
if $type eq 'sub';
- return ($name, ::Metamodel::Lexical::Stash.new(path => @xtra))
+ return ($name, ::Metamodel::Lexical::Stash.new(pkg => @xtra))
if $type eq 'stash';
die "weird lex type $type";
}
View
6 src/NieczaActions.pm6
@@ -1322,7 +1322,11 @@ method PRE($/) {
method methodop($/) {
if $<longname> {
my $c = self.mangle_longname($<longname>);
- make ::Operator::Method.new(name => $c<name>, path => $c<path>);
+ my $package;
+ $/.CURSOR.trymop({
+ $package = $*CURLEX<!sub>.compile_get_pkg(@($c<path>)).xref;
+ });
+ make ::Operator::Method.new(name => $c<name>, :$package);
} elsif $<quote> {
make ::Operator::Method.new(name => $<quote>.ast);
} elsif $<variable> {
View
11 src/NieczaFrontendSTD.pm6
@@ -36,7 +36,7 @@ method function_O($name) {
my $sub;
if $lex ~~ ::Metamodel::Lexical::Common {
- $sub = $*unit.deref($*unit.get_item([ @($lex.path), $lex.name ]));
+ $sub = $*unit.deref($*unit.get($*unit.deref($lex.pkg), $lex.name));
} elsif $lex ~~ ::Metamodel::Lexical::SubDef {
$sub = $lex.body;
}
@@ -346,8 +346,13 @@ method parse(:$unitname, :$filename, :$modtime, :$source, :$outer) {
%*units{$unitname} = $*unit;
$*unit.tdeps{$unitname} = [$filename, $modtime];
- $*unit.create_stash(['GLOBAL']);
- $*unit.create_stash(['PROCESS']);
+ if $*unit.setting_ref {
+ $*unit.ns.root = $*unit.deref($*unit.setting_ref).unit.ns.root;
+ } else {
+ $*unit.ns.root = ::Metamodel::Package.new(name => 'ROOT', who => '').xref;
+ $*unit.abs_pkg('GLOBAL', :auto);
+ $*unit.abs_pkg('PROCESS', :auto);
+ }
my $ast = NieczaGrammar.parse($source, actions => NieczaActions).ast;
View
2  src/NieczaGrammar.pm6
@@ -35,7 +35,7 @@ grammar P6 is STD::P6 {
$*CURLEX{'!sub'} = ::Metamodel::StaticSub.new(
unit => $*unit,
outerx => $top,
- cur_pkg => ['GLOBAL'],
+ cur_pkg => $*unit.abs_pkg('GLOBAL').xref,
name => "mainline",
run_once => !$rtop || $rtop.run_once);
$*CURLEX{'!sub'}.add_my_name('$_') if !$top;
View
10 src/Operator.pm6
@@ -91,11 +91,11 @@ class Method is Operator {
has $.args = [];
has $.meta; # Bool
has $.private; # Bool
- has $.path; # Array of Str
+ has $.package; # Xref
method clone(*%_) {
self.new(name => $!name, args => $!args, meta => $!meta,
- private => $!private, path => $!path, |%_);
+ private => $!private, package => $!package, |%_);
}
method as_function($/) { self.wrap_in_function($/) }
@@ -111,14 +111,14 @@ class Method is Operator {
::Op::Interrogative.new(|node($/), receiver => @args[0],
name => $.name);
} else {
- if defined($.path) && !$.private {
+ if defined($.package) && !$.private {
$/.CURSOR.sorry("Qualified references to non-private methods NYI");
}
$*CURLEX<!sub>.noninlinable if $.name eq 'eval';
my $pclass;
if $.private {
- if $.path {
- $pclass = $*unit.get_item($*CURLEX<!sub>.find_pkg($.path));
+ if $.package {
+ $pclass = $.package;
} elsif $*CURLEX<!sub>.in_class -> $c {
$pclass = $c;
} else {
View
822 src/niecza
@@ -23,6 +23,122 @@ use RxOp;
use Sig;
use STD;
+augment grammar STD {
+my package DEBUG { our constant symtab = 3; }
+method trymop($f) { $f() }
+method explain_mystery() {
+ my %post_types;
+ my %unk_types;
+ my %unk_routines;
+ my $m = '';
+ for keys(%*MYSTERY) {
+ my $p = %*MYSTERY{$_}.<lex>;
+ if self.is_name($_, $p) {
+ # types may not be post-declared
+ %post_types{$_} = %*MYSTERY{$_};
+ next;
+ }
+
+ next if self.is_known($_, $p) or self.is_known('&' ~ $_, $p);
+
+ # just a guess, but good enough to improve error reporting
+ if $_ lt 'a' {
+ %unk_types{$_} = %*MYSTERY{$_};
+ }
+ else {
+ %unk_routines{$_} = %*MYSTERY{$_};
+ }
+ }
+ if %post_types {
+ my @tmp = sort keys(%post_types);
+ $m ~= "Illegally post-declared type" ~ ('s' x (@tmp != 1)) ~ ":\n";
+ for @tmp {
+ $m ~= "\t'$_' used at line " ~ %post_types{$_}.<line> ~ "\n";
+ }
+ }
+ if %unk_types {
+ my @tmp = sort keys(%unk_types);
+ $m ~= "Undeclared name" ~ ('s' x (@tmp != 1)) ~ ":\n";
+ for @tmp {
+ $m ~= "\t'$_' used at line " ~ %unk_types{$_}.<line> ~ "\n";
+ }
+ }
+ if %unk_routines {
+ my @tmp = sort keys(%unk_routines);
+ $m ~= "Undeclared routine" ~ ('s' x (@tmp != 1)) ~ ":\n";
+ for @tmp {
+ $m ~= "\t'$_' used at line " ~ %unk_routines{$_}.<line> ~ "\n";
+ }
+ }
+ self.sorry($m) if $m;
+
+ for $*unit.stubbed_stashes {
+ next if .key.closed || .key.WHAT === ::GLOBAL::Metamodel::Package;
+ .value.sorry("Package was stubbed but not defined");
+ }
+
+ self;
+}
+method is_name($longname, $curlex = $*CURLEX) {
+ my $deb = $*DEBUG +& DEBUG::symtab;
+ self.deb("is_name $longname") if $deb;
+ if defined($longname.index("::(")) {
+ self.deb("computed name gets a free pass") if $deb;
+ return True;
+ }
+ my @parts = $longname.split('::');
+ shift @parts if @parts[0] eq '';
+ pop @parts if @parts && @parts[*-1] eq ''; # doesn't change ref validity
+
+ @parts[*-1] = $/ ~ @parts[*-1] if @parts && @parts[0] ~~ s/^(\W\W?)//;
+
+ self.deb("reparsed: @parts.perl()") if $deb;
+ return False if !@parts;
+
+ my $pkg;
+
+ if @parts[0] eq 'OUR' {
+ $pkg = $*unit.deref($curlex<!sub>.cur_pkg);
+ shift @parts;
+ } elsif @parts[0] eq 'PROCESS' or @parts[0] eq 'GLOBAL' {
+ $pkg = $*unit.abs_pkg(shift @parts);
+ } elsif @parts[0] eq 'MY' {
+ return False if @parts == 1;
+ my $lexical = self.lookup_lex(@parts[1], $curlex);
+ unless defined $lexical {
+ self.deb("Lexical @parts[1] not found") if $deb;
+ return False;
+ }
+ if $lexical ~~ ::Metamodel::Lexical::Stash {
+ shift @parts; shift @parts;
+ $pkg = $*unit.deref($lexical.pkg);
+ }
+ else {
+ return @parts == 2;
+ }
+ } else {
+ my $lexical = self.lookup_lex(@parts[0], $curlex);
+ if !defined $lexical {
+ return False if @parts == 1; # $x doesn't mean GLOBAL
+ $pkg = $*unit.abs_pkg('GLOBAL');
+ } elsif $lexical ~~ ::Metamodel::Lexical::Stash {
+ $pkg = $*unit.deref($lexical.pkg);
+ shift @parts;
+ } else {
+ return @parts == 1;
+ }
+ }
+
+ for @parts {
+ return False if !$pkg || !$*unit.ns.exists($pkg.who, $_);
+ $pkg = $*unit.ns.get($pkg.who, $_);
+ $pkg = $pkg && $*unit.deref($pkg);
+ }
+
+ return True;
+}
+}
+
augment class NieczaActions {
method blast($/) {
if $<block> {
@@ -169,19 +285,148 @@ method install_sub($/, $sub, :$multiness is copy, :$scope is copy, :$class,
}
if $scope eq 'our' {
- $sub.exports = [[@($sub.outer.find_pkg($path // ['OUR'])), '&'~$name]];
- $*unit.bind_item($sub.exports.[0], $sub.xref, |mnode($/));
+ $sub.outer.bind_our_name($path, "&$name", $sub.xref);
+ }
+ });
+}
+
+method methodop($/) {
+ if $<longname> {
+ my $c = self.mangle_longname($<longname>);
+ my $package;
+ $/.CURSOR.trymop({
+ $package = $*CURLEX<!sub>.compile_get_pkg(@($c<path>)).xref;
+ }) if $c<path>;
+ make ::Operator::Method.new(name => $c<name>, :$package);
+ } elsif $<quote> {
+ make ::Operator::Method.new(name => $<quote>.ast);
+ } elsif $<variable> {
+ make ::Operator::Function.new(function =>
+ self.do_variable_reference($/, $<variable>.ast));
+ }
+
+ $/.ast.args = $<args>[0].ast[0] if $<args>[0];
+ $/.ast.args = $<arglist>[0].ast if $<arglist>[0];
+}
+method do_new_package($/, :$sub = $*CURLEX<!sub>, :$scope!, :$path!,
+ :$name!, :$class!, :$exports) {
+
+ $scope := $scope || 'our';
+ if $scope ne 'our' && $scope ne 'my' && $scope ne 'anon' {
+ $/.CURSOR.sorry("Invalid packageoid scope $scope");
+ $scope := 'anon';
+ }
+
+ if defined($path) && $scope ne 'our' {
+ $/.CURSOR.sorry("Pathed definitions require our scope");
+ $scope := 'our';
+ }
+
+ if !$name {
+ $scope := 'anon';
+ $name := 'ANON';
+ $path := Any;
+ }
+
+ my $npkg;
+ my $lexname;
+ $/.CURSOR.trymop({
+ my $old;
+ if $scope ne 'anon' && !$path && $sub.lexicals.{$name} -> $l {
+ die "Cannot resume definition - $name not a packageoid"
+ unless $l ~~ ::Metamodel::Lexical::Stash;
+ $old = $*unit.deref($l.pkg);
+ } elsif defined $path {
+ my $ppkg;
+ try $ppkg = $sub.compile_get_pkg(@$path);
+ my $xr = $ppkg && $*unit.get($ppkg, $name);
+ $old = $xr && $*unit.deref($xr);
}
+
+ my $lexed_already;
+
+ if $old && $old.WHAT === $class && !$old.closed {
+ $npkg = $old;
+ $lexed_already = True;
+ } elsif $scope eq 'our' {
+ my $ppkg = $sub.compile_get_pkg($path ?? @$path !! 'OUR', :auto);
+ $npkg = $class.new(:$name, who => $ppkg.who ~ '::' ~ $name);
+ $*unit.bind($ppkg, $name, $npkg.xref, |mnode($/));
+ } else {
+ my $id = $*unit.anon_stash;
+ $npkg = $class.new(:$name, who => "::$id");
+ $*unit.bind($*unit.abs_pkg(), $id, $npkg.xref, |mnode($/));
+ }
+
+ $lexname = (!$lexed_already && $scope ne 'anon' && !defined($path))
+ ?? $name !! self.gensym;
+
+ $sub.add_my_stash($lexname, $npkg.xref, |mnode($/));
+ $sub.add_exports($name, $npkg.xref, $exports) if $exports;
});
+
+ $lexname, $npkg
}
+method signature($/) {
+ if $<type_constraint> {
+ # ignore for now
+ }
+
+ if $<param_var> {
+ my $sig = Sig.new(params => [ ::Sig::Parameter.new(
+ name => ~$<param_var>, |$<param_var>.ast,
+ full_parcel => True) ]);
+ $*CURLEX<!sub>.signature = $sig if $*SIGNUM;
+ make $sig;
+ return;
+ }
+
+ my @p = map *.ast, @( $<parameter> );
+ my @ps = @( $<param_sep> );
+ my $ign = False;
+ loop (my $i = 0; $i < @p; $i++) {
+ @p[$i].multi_ignored = $ign;
+ if $i >= @ps {
+ } elsif defined @ps[$i].index(':') {
+ $/.CURSOR.sorry('Only the first parameter may be invocant') if $i;
+ $*CURLEX<!sub>.add_my_name('self', :noinit, |mnode($/));
+ @p[$i].invocant = True;
+ } elsif defined @ps[$i].index(';;') {
+ $ign = True;
+ } elsif !defined @ps[$i].index(',') {
+ $/.CURSOR.sorry("Parameter separator @ps[$i] NYI");
+ }
+ }
+
+ state %mlike = (:Method, :Submethod, :Regex);
+ if $*SIGNUM && %mlike{$*CURLEX<!sub>.class} && (!@p || !@p[0].invocant) {
+ $*CURLEX<!sub>.add_my_name('self', :noinit, |mnode($/));
+ unshift @p, ::Sig::Parameter.new(name => 'self', :invocant);
+ }
+
+ for @p {
+ if !defined(.tclass) && $*SIGNUM {
+ if .invocant && $*CURLEX<!sub>.methodof {
+ my $cl = $*unit.deref($*CURLEX<!sub>.methodof);
+ # XXX type checking against roles NYI
+ if $cl !~~ ::Metamodel::Role &&
+ $cl !~~ ::Metamodel::ParametricRole {
+ .tclass = $cl.xref;
+ }
+ } elsif !$*CURLEX<!sub>.returnable {
+ .tclass = $*CURLEX<!sub>.compile_get_pkg('Mu').xref;
+ }
+ }
+ }
+
+ my $sig = Sig.new(params => @p);
+ $*CURLEX<!sub>.signature = $sig if $*SIGNUM;
+ make $sig;
+}
method type_declarator:enum ($/) {
my $scope = $*SCOPE || 'our';
- if $scope && $scope ne 'our' && $scope ne 'my' && $scope ne 'anon' {
- $/.CURSOR.sorry("Invalid enum scope $scope");
- $scope = 'anon';
- }
my @exports;
for map *.ast, @$<trait> -> $t {
@@ -212,76 +457,55 @@ method type_declarator:enum ($/) {
}
my $basetype = $*OFTYPE ?? self.simple_longname($*OFTYPE<longname>) !!
- [ 'MY', $has_strs ?? 'Str' !! 'Int' ];
+ [$has_strs ?? 'Str' !! 'Int'];
+ my $kindtype = $has_strs ?? 'StrBasedEnum' !! 'IntBasedEnum';
- if $<name> && $<name>.reduced eq 'longname'&& ($scope ||= 'our') ne 'anon' {
+ if $<name> && $<name>.reduced eq 'longname' && $scope ne 'anon' {
# Longnamed enum is a kind of type definition
- my $ourpath = Array;
- my $lexvar = self.gensym;
- my $bindlex = False;
- my $r = self.mangle_longname($<longname>[0], True);
- my $name = $r<name>;
- if ($r<path>:exists) && $scope ne 'our' {
- $/.CURSOR.sorry("Enum name $<longname> requires our scope");
- $scope = 'our';
- }
-
- if $scope eq 'our' {
- $ourpath = ($r<path>:exists) ?? $r<path> !! ['OUR'];
- if !($r<path>:exists) {
- $lexvar = $name;
- $bindlex = True;
- }
- } elsif $scope eq 'my' {
- $lexvar = $name;
- $bindlex = True;
- }
+ my $r = self.mangle_longname($<name>, True);
+ my ($lexvar, $obj);
$/.CURSOR.trymop({
- my @ns = $ourpath ?? (@( $*CURLEX<!sub>.find_pkg($ourpath) ), $name) !!
- $*unit.anon_stash;
- $*unit.create_stash([@ns]);
- $*CURLEX<!sub>.add_my_stash($lexvar, [@ns], |mnode($/));
- my $obj = ::Metamodel::Class.new(:$name);
- $obj.exports = [ [@ns] ];
- $*unit.bind_item([@ns], $obj.xref, |mnode($/));
-
- $obj.add_super($*unit.get_item($*CURLEX<!sub>.find_pkg(
- ['MY', ($has_strs ?? 'Str' !! 'Int') ~ "BasedEnum"])));
- $obj.add_super($*unit.get_item($*CURLEX<!sub>.find_pkg($basetype)));
+ ($lexvar, $obj) = self.do_new_package($/, :$scope,
+ class => ::Metamodel::Class, name => $r<name>,
+ path => $r<path>, :@exports);
+
+ $obj.add_super($*CURLEX<!sub>.compile_get_pkg($kindtype).xref);
+ $obj.add_super($*CURLEX<!sub>.compile_get_pkg(@$basetype).xref);
my $nb = ::Metamodel::StaticSub.new(
transparent=> True,
unit => $*unit,
outerx => $*CURLEX<!sub>.xref,
outer_direct => $*CURLEX<!sub>,
- name => $name,
+ name => $r<name> ~ '.enums',
cur_pkg => $*CURLEX<!sub>.cur_pkg,
class => 'Method',
signature => Sig.simple('self'),
code => self.init_constant(
- self.make_constant($/, 'anon', Any, Any),
+ self.make_constant($/, 'anon', Any),
::Op::CallMethod.new(name => 'new',
receiver => mklex($/, 'EnumMap'), args => [$<term>.ast])));
+ my $nbvar = self.gensym;
$nb.add_my_name('self', noinit => True);
$*CURLEX<!sub>.create_static_pad;
$nb.strong_used = True;
$*CURLEX<!sub>.add_child($nb);
- $*CURLEX<!sub>.add_my_sub($lexvar ~ '!enums', $nb, |mnode($/));
- $obj.add_method('only', 'normal', 'enums', $lexvar ~ '!enums',
+ $*CURLEX<!sub>.add_my_sub($nbvar, $nb, |mnode($/));
+ $obj.add_method('only', 'normal', 'enums', $nbvar,
$nb.xref, |mnode($/));
$obj.close;
for @pairs {
- self.make_constant_into($/, @ns, .key, rhs =>
+ self.make_constant_into($/, $obj, .key, rhs =>
::Op::CallSub.new(invocant => mklex($/, $lexvar),
args => [ ::Op::StringLiteral.new(text => .key) ]));
}
for @pairs {
- self.init_constant(self.make_constant($/, $scope, .key, Any),
+ self.init_constant(self.make_constant($/, $scope, .key),
::Op::CallSub.new(invocant => mklex($/, $lexvar),
args => [ ::Op::StringLiteral.new(text => .key) ]));
}
@@ -290,15 +514,67 @@ method type_declarator:enum ($/) {
make mklex($/, $lexvar);
} else {
make self.init_constant(
- self.make_constant($/, $<name> ?? $scope !! 'anon', ~$<name>, Any),
+ self.make_constant($/, $<name> ?? $scope !! 'anon', ~$<name>),
::Op::CallMethod.new(|node($/), name => 'new',
receiver => mklex($/, 'EnumMap'),
args => [$<term>.ast])),
}
}
+method make_constant($/, $scope, $name) {
+ $scope := $scope || 'our';
+
+ my $slot = ($scope eq 'my' || $scope eq 'our') ?? $name !! self.gensym;
+
+ $/.CURSOR.trymop({
+ $/.CURSOR.check_categorical($slot);
+ if $scope eq 'our' {
+ $*CURLEX<!sub>.add_common_name($slot, $*CURLEX<!sub>.cur_pkg,
+ $name, |mnode($/));
+ } else {
+ $*CURLEX<!sub>.add_hint($slot, |mnode($/));
+ }
+ });
+
+ ::Op::ConstantDecl.new(|node($/), name => $slot, init => False);
+}
+
+method make_constant_into($/, $pkg, $name, $rhs) {
+ my $slot = self.gensym;
+ $/.CURSOR.trymop({
+ $*CURLEX<!sub>.add_common_name($slot, $pkg.xref, $name, |mnode($/));
+ });
+ self.init_constant(::Op::ConstantDecl.new(|node($/), name => $slot,
+ init => False), $rhs);
+}
+
+method type_declarator:constant ($/) {
+ if $*MULTINESS {
+ $/.CURSOR.sorry("Multi variables NYI");
+ }
+ my $name = ~($<identifier> // $<variable> // self.gensym);
+
+ make self.make_constant($/, $*SCOPE, $name);
+}
+
+method simple_longname($/) {
+ my $r = self.mangle_longname($/);
+ [ @( $r<path> // [] ), $r<name> ]
+}
+
+method package_var($/, $slot, $name, $path, :$list, :$hash) {
+ $/.CURSOR.trymop({
+ $/.CURSOR.check_categorical($slot);
+ $*CURLEX<!sub>.add_common_name($slot,
+ $*CURLEX<!sub>.compile_get_pkg(@$path, :auto).xref,
+ $name, |mnode($/));
+ $*CURLEX<!sub>.lexicals-used{$slot} = True;
+ });
+ ::Op::PackageVar.new(|node($/), :$slot, :$name, :$path, :$list, :$hash);
+}
+
method open_package_def($, $/ = $*cursor) {
- my %_decl2mclass = (
+ state %_decl2mclass = (
package => ::Metamodel::Package,
class => ::Metamodel::Class,
module => ::Metamodel::Module,
@@ -311,135 +587,162 @@ method open_package_def($, $/ = $*cursor) {
$/.CURSOR.sorry("Multi variables NYI");
}
- my $scope = $*SCOPE;
- if !$<longname> {
- $scope = 'anon';
- }
-
- if $scope eq 'supersede' {
- $/.CURSOR.sorry('Supercede is not yet supported');
- $scope = 'our';
- }
- if $scope eq 'has' || $scope eq 'state' {
- $/.CURSOR.sorry("Illogical scope $scope for package block");
- $scope = 'our';
- }
-
- if $scope eq 'augment' {
- my $r = self.mangle_longname($<longname>[0], True);
- my $name = $r<name>;
- my @augpkg = @( $r<path> // ['MY'] );
+ my $r = $<longname> && self.mangle_longname($<longname>[0], True);
- my $pkg = $sub.outer.find_pkg([ @augpkg, $name ]);
- my $so = $*unit.get_item($pkg);
- my $dso = $*unit.deref($so);
+ if $*SCOPE eq 'augment' && $r {
+ $/.CURSOR.trymop({
+ my $obj = $sub.outer.compile_get_pkg(@( $r<path> // [] ), $r<name>, :auto);
- if $dso.^isa(::Metamodel::Role) {
- $/.CURSOR.panic("Illegal augment of a role");
- }
+ if $obj.^isa(::Metamodel::Role) {
+ die "Illegal augment of a role";
+ }
- my @ah = $so;
- $sub.augment_hack = @ah;
- $sub.body_of = $sub.in_class = $so;
- $sub.cur_pkg = $pkg;
- $sub.augmenting = True;
- $sub.set_name("augment-$dso.name()");
+ $sub.augment_hack = [ $obj.xref ];
+ $sub.body_of = $sub.in_class = $sub.cur_pkg = $obj.xref;
+ $sub.augmenting = True;
+ $sub.set_name("augment-$obj.name()");
+ });
} else {
- my ($name, $ourpkg);
my $type = %_decl2mclass{$*PKGDECL};
if ($*PKGDECL//'role') eq 'role' && $<signature> {
$sub.signature = $<signature>.ast;
$type = ::Metamodel::ParametricRole;
}
- my @ns;
- if $<longname> {
- my $r = self.mangle_longname($<longname>[0], True);
- $name = $r<name>;
- if ($r<path>:exists) && $scope ne 'our' {
- $/.CURSOR.sorry("Block name $<longname> requires our scope");
- $scope = 'our';
- }
- if $scope eq 'our' {
- $ourpkg = ($r<path>:exists) ?? $r<path> !! ['OUR'];
- }
- if $r<path> {
- try @ns = @( $sub.outer.find_pkg([ @($r<path>), $r<name> ]) );
- } elsif $sub.outer.lexicals{$r<name>} {
- try @ns = @( $sub.outer.find_pkg([ 'MY', $r<name> ]) );
- }
- $sub.outervar = ($scope eq 'anon' || ($r<path>:exists))
- ?? self.gensym !! $name;
- } else {
- $sub.outervar = self.gensym;
- $name = 'ANON';
- }
- my $old = @ns ?? $*unit.get_item([@ns]) !! Any;
+ $/.CURSOR.trymop({
+ my ($lexvar, $obj) = self.do_new_package($/, sub => $sub.outer,
+ class => $type, name => $r<name>, path => $r<path>,
+ scope => $*SCOPE);
- if $old && ($old.[0] ne $*unit.name || $*unit.deref($old).closed) {
- $/.CURSOR.panic("Redefinition of class [@ns]");
- }
- my $obj;
- if $old {
- $obj = $*unit.deref($old);
- # we may need to make a new alias
- # XXX we might try looking for a reusable one, changing outervar?
- $/.CURSOR.trymop({
- $sub.outer.add_my_stash($sub.outervar, [@ns], |mnode($/));
- }) unless $sub.outer.lexicals{$sub.outervar};
- } else {
- @ns = $ourpkg ?? (@( $sub.outer.find_pkg($ourpkg) ), $name) !!
- $*unit.anon_stash;
+ $sub.outervar = $lexvar;
+ $sub.body_of = $sub.in_class = $sub.cur_pkg = $obj.xref;
- $*unit.create_stash([@ns]);
+ self.process_block_traits($/, $<trait>);
+ $sub.set_name($*PKGDECL ~ "-" ~ $obj.name);
+ });
+ }
+}
- $/.CURSOR.trymop({
- $sub.outer.add_my_stash($sub.outervar, [@ns], |mnode($/));
- $obj = $type.new(:$name);
- $obj.exports = [ [@ns] ];
- $*unit.bind_item([@ns], $obj.xref, |mnode($/));
- });
+method package_def ($/) {
+ my $sub = $*CURLEX<!sub>;
+
+ my $bodyvar = self.gensym;
+ $sub.outer.add_my_sub($bodyvar, $sub);
+ $sub.code = ($<blockoid> // $<statementlist>).ast;
+
+ if $sub.augmenting {
+ my $ah = $sub.augment_hack;
+ $sub.augment_hack = Any;
+
+ my $ph = ::Metamodel::StaticSub.new(
+ unit => $*unit,
+ outerx => $sub.xref,
+ outer_direct => $*CURLEX<!sub>,
+ cur_pkg => $sub.cur_pkg,
+ name => 'ANON',
+ is_phaser => 0,
+ augment_hack => $ah,
+ class => 'Code',
+ code => ::Op::StatementList.new(children => []),
+ run_once => $sub.run_once);
+ $sub.create_static_pad;
+ $sub.add_child($ph);
+
+ make ::Op::CallSub.new(|node($/), invocant => mklex($/, $bodyvar));
+ }
+ else {
+ my $obj = $*unit.deref($sub.body_of);
+
+ if $<stub> {
+ push $*unit.stubbed_stashes, ($obj => $/.CURSOR);
+
+ make mklex($/, $*CURLEX<!sub>.outervar);
}
+ else {
+ $/.CURSOR.trymop({ $obj.close; });
- $sub.body_of = $sub.in_class = $obj.xref;
- $sub.cur_pkg = [@ns];
+ if $obj ~~ ::Metamodel::ParametricRole {
+ $sub.parametric_role_hack = $obj.xref;
+ $sub.add_my_name('*params', :noinit);
+ $sub.create_static_pad;
- self.process_block_traits($/, $<trait>);
- $sub.set_name($*PKGDECL ~ "-" ~ $obj.name);
+ make mklex($/, $*CURLEX<!sub>.outervar);
+ } else {
+ make ::Op::StatementList.new(|node($/), children => [
+ ::Op::CallSub.new(invocant => mklex($/, $bodyvar)),
+ ::Op::Lexical.new(name => $*CURLEX<!sub>.outervar) ]);
+ }
+ }
}
}
-method type_declarator:subset ($/) {
- my $ourname = Array; my $lexvar = self.gensym; my $name;
- my $scope = $*SCOPE || 'our';
- if $scope && $scope ne 'our' && $scope ne 'my' && $scope ne 'anon' {
- $/.CURSOR.sorry("Invalid subset scope $scope");
- $scope = 'anon';
+
+method parameter($/) {
+ my $rw = False;
+ my $copy = False;
+ my $sorry;
+ my $slurpy = False;
+ my $slurpycap = False;
+ my $optional = False;
+ my $rwt = False;
+ my $type;
+
+ if $<type_constraint> {
+ my $t = self.simple_longname($<type_constraint>[0]<typename><longname>);
+ $type = $*CURLEX<!sub>.compile_get_pkg(@$t).xref;
}
- if $<longname> {
- $scope ||= 'my';
- my $r = self.mangle_longname($<longname>[0], True);
- $name = $r<name>;
- if ($r<path>:exists) && $scope ne 'our' {
- $/.CURSOR.sorry("Block name $<longname> requires our scope");
- $scope = 'our';
- }
- if $scope eq 'our' {
- $ourname = ($r<path>:exists) ?? $r<path> !! ['OUR'];
- $ourname = [ @$ourname, $name ];
- } elsif $scope eq 'my' {
- $lexvar = $name;
- }
- } else {
- if ($scope || 'anon') ne 'anon' {
- $/.CURSOR.sorry("Cannot have a non-anon subset with no name");
+
+ for @( $<trait> ) -> $trait {
+ if $trait.ast<rw> { $rw = True }
+ elsif $trait.ast<copy> { $copy = True }
+ elsif $trait.ast<parcel> { $rwt = True }
+ elsif $trait.ast<readonly> { $rw = False }
+ else {
+ $trait.CURSOR.sorry('Unhandled trait ' ~ $trait.ast.keys.[0]);
}
- $name = 'ANON';
}
+ if $<post_constraint> > 0 {
+ $/.sorry('Parameter post constraints NYI');
+ make ::Sig::Parameter.new;
+ return Nil;
+ }
+
+ my $default = $<default_value> ?? $<default_value>[0].ast !! Any;
+ $*unit.deref($default).set_name("$/ init") if $default;
+
+ my $tag = $<quant> ~ ':' ~ $<kind>;
+ if $tag eq '**:*' { $sorry = "Slice parameters NYI" }
+ elsif $tag eq '*:*' { $slurpy = True }
+ elsif $tag eq '|:*' { $slurpycap = True }
+ elsif $tag eq '\\:!' { $rwt = True }
+ elsif $tag eq '\\:?' { $rwt = True; $optional = True }
+ elsif $tag eq ':!' { }
+ elsif $tag eq ':*' { $optional = True }
+ elsif $tag eq ':?' { $optional = True }
+ elsif $tag eq '?:?' { $optional = True }
+ elsif $tag eq '!:!' { }
+ elsif $tag eq '!:?' { $optional = True }
+ elsif $tag eq '!:*' { }
+ else { $sorry = "Confusing parameters ($tag)" }
+ if $sorry { $/.CURSOR.sorry($sorry); }
+ my $p = $<param_var> // $<named_param>;
+
+ if defined $p.ast<slot> {
+ # TODO: type constraint here
+ }
+
+ make ::Sig::Parameter.new(name => ~$/, mdefault => $default,
+ :$optional, :$slurpy, :$rw, tclass => $type,
+ :$slurpycap, rwtrans => $rwt, is_copy => $copy, |$p.ast);
+}
+
+method type_declarator:subset ($/) {
+ my $r = $<longname> && self.mangle_longname($<longname>[0], True);
+
my $basetype = $*OFTYPE ?? self.simple_longname($*OFTYPE<longname>) !!
- ['MY', 'Any'];
+ ['Any'];
my @exports;
for map *.ast, @$<trait> -> $t {
@@ -454,20 +757,17 @@ method type_declarator:subset ($/) {
my $body = self.thunk_sub($<EXPR> ?? $<EXPR>[0].ast !! mklex($/, 'True'));
- my @ns = $ourname ?? @( $*CURLEX<!sub>.find_pkg($ourname) ) !!
- $*unit.anon_stash;
+ my ($lexvar, $obj) = "Any";
$/.CURSOR.trymop({
- $*unit.create_stash([@ns]);
- $*CURLEX<!sub>.add_my_stash($lexvar, [@ns], |mnode($/));
- $*CURLEX<!sub>.add_pkg_exports($*unit, $name, [@ns], @exports);
+ ($lexvar, $obj) = self.do_new_package($/, scope => $*SCOPE,
+ name => $r<name>, path => $r<path>, class => ::Metamodel::Subset,
+ :@exports);
+
$*CURLEX<!sub>.create_static_pad;
- $basetype = $*unit.get_item($*CURLEX<!sub>.find_pkg([@$basetype]));
- my $obj = ::Metamodel::Subset.new(:$name, where => $body.xref,
- :$basetype);
- $*unit.bind_item([@ns], $obj.xref, |mnode($/));
- $obj.exports = [ [@ns] ];
+ $obj.basetype = $*CURLEX<!sub>.compile_get_pkg(@$basetype).xref;
+ $obj.where = $body.xref;
});
make mklex($/, $lexvar);
@@ -521,6 +821,149 @@ method add_attribute($/, $name, $sigil, $accessor, $type) {
::Op::StatementList.new;
}
+method variable_declarator($/) {
+ if $*MULTINESS {
+ $/.CURSOR.sorry("Multi variables NYI");
+ }
+ for @$<trait> -> $t {
+ if $t.ast<rw> {
+ } else {
+ $/.CURSOR.sorry("Trait $t.ast.keys.[0] not available on variables");
+ }
+ }
+ if $<post_constraint> || $<postcircumfix> || $<semilist> {
+ $/.CURSOR.sorry("Postconstraints, and shapes on variable declarators NYI");
+ }
+
+ my $scope = $*SCOPE // 'my';
+
+ if $scope eq 'augment' || $scope eq 'supersede' {
+ $/.CURSOR.sorry("Illogical scope $scope for simple variable");
+ }
+
+ my $typeconstraint;
+ if $*OFTYPE {
+ $typeconstraint = self.simple_longname($*OFTYPE<longname>);
+ $/.CURSOR.sorry("Common variables are not unique definitions and may not have types") if $scope eq 'our';
+ }
+
+ my $v = $<variable>.ast;
+ my $t = $v<twigil>;
+ my $list = $v<sigil> eq '@';
+ my $hash = $v<sigil> eq '%';
+ if ($t && defined "?=~^:".index($t)) {
+ $/.CURSOR.sorry("Variables with the $t twigil cannot be declared " ~
+ "using $scope; they are created " ~
+ ($t eq '?' ?? "using 'constant'." !!
+ $t eq '=' ?? "by parsing POD blocks." !!
+ $t eq '~' ?? "by 'slang' definitions." !!
+ "automatically as parameters to the current block."));
+ }
+
+ if $scope ne 'has' && ($t eq '.' || $t eq '!') {
+ $/.CURSOR.sorry("Twigil $t is only valid on attribute definitions ('has').");
+ }
+
+ if defined $v<rest> {
+ $/.CURSOR.sorry(":: syntax is only valid when referencing variables, not when defining them.");
+ }
+
+ my $name = $v<sigil> ~ $v<twigil> ~ $v<name>;
+ # otherwise identical to my
+ my $slot = ($scope eq 'anon') ?? self.gensym !! $name;
+ my $res_tc = $typeconstraint ??
+ $*CURLEX<!sub>.compile_get_pkg(@$typeconstraint).xref !! Any;
+
+ if $scope eq 'has' {
+ make self.add_attribute($/, $v<name>, $v<sigil>, $t eq '.', $res_tc);
+ } elsif $scope eq 'state' {
+ $/.CURSOR.trymop({
+ $/.CURSOR.check_categorical($slot);
+ $*CURLEX<!sub>.add_state_name($slot, self.gensym, :$list,
+ :$hash, typeconstraint => $res_tc, |mnode($/));
+ });
+ make ::Op::Lexical.new(|node($/), name => $slot, :$list, :$hash,
+ :state_decl);
+ } elsif $scope eq 'our' {
+ make self.package_var($/, $slot, $slot, ['OUR'], :$list, :$hash);
+ } else {
+ $/.CURSOR.trymop({
+ $/.CURSOR.check_categorical($slot);
+ $*CURLEX<!sub>.add_my_name($slot, :$list, :$hash,
+ typeconstraint => $res_tc, |mnode($/));
+ });
+ make ::Op::Lexical.new(|node($/), name => $slot, :$list, :$hash);
+ }
+}
+
+method do_variable_reference($M, $v) {
+ if $v<term> {
+ return $v<term>;
+ }
+
+ my $tw = $v<twigil>;
+ my $sl = $v<sigil> ~ $tw ~ $v<name>;
+ my $list = $v<sigil> eq '@';
+ my $hash = $v<sigil> eq '%';
+
+ if defined($v<rest>) && $tw ~~ /<[*=~?^:]>/ {
+ $M.CURSOR.sorry("Twigil $tw cannot be used with qualified names");
+ return ::Op::StatementList.new;
+ }
+
+ if $tw eq '!' {
+ my $pclass;
+ if $v<rest> {
+ $pclass = $*CURLEX<!sub>.compile_get_pkg(@($v<rest>)).xref;
+ } elsif $*CURLEX<!sub>.in_class -> $c {
+ $pclass = $c;
+ } else {
+ $M.CURSOR.sorry("Cannot resolve class for private method");
+ }
+ self.docontext($M, $v<sigil>, ::Op::CallMethod.new(|node($M),
+ name => $v<name>, private => True, receiver => mklex($M, 'self'),
+ :$pclass));
+ }
+ elsif $tw eq '.' {
+ if defined $v<rest> {
+ $M.CURSOR.sorry('$.Foo::bar syntax NYI');
+ return ::Op::StatementList.new;
+ }
+
+ self.docontext($M, $v<sigil>, ::Op::CallMethod.new(|node($M),
+ name => $v<name>, receiver => mklex($M, 'self')));
+ }
+ # no twigil in lex name for these
+ elsif $tw eq '^' || $tw eq ':' {
+ mklex($M, $v<sigil> ~ $v<name>, :$hash, :$list);
+ }
+ elsif $tw eq '*' {
+ ::Op::ContextVar.new(|node($M), name => $sl);
+ }
+ elsif $tw eq '' || $tw eq '?' {
+ if defined($v<rest>) {
+ self.package_var($M, self.gensym, $sl, $v<rest>,
+ hash => ($v<sigil> eq '%'), list => ($v<sigil> eq '@'))
+ } elsif $tw eq '?' && $sl eq '$?POSITION' {
+ mkcall($M, '&infix:<..^>',
+ ::Op::Num.new(|node($M), value => [10, ~$M.from]),
+ ::Op::Num.new(|node($M), value => [10, ~$M.to]));
+ } elsif $tw eq '?' && $sl eq '$?LINE' {
+ ::Op::Num.new(|node($M), value => [10, ~$M.cursor.lineof($M.from)]);
+ } elsif $tw eq '?' && $sl eq '&?BLOCK' {
+ $*CURLEX<!sub>.noninlinable;
+ ::Op::GetBlock.new(|node($M))
+ } elsif $tw eq '?' && $sl eq '&?ROUTINE' {
+ $*CURLEX<!sub>.noninlinable;
+ ::Op::GetBlock.new(|node($M), :routine)
+ } else {
+ mklex($M, $sl, :$hash, :$list);
+ }
+ }
+ else {
+ $M.CURSOR.sorry("Unhandled reference twigil $tw");
+ }
+}
method process_block_traits($/, @tr) {
my $sub = $*CURLEX<!sub>;
@@ -538,27 +981,19 @@ method process_block_traits($/, @tr) {
next if !$*unit.deref($pack).^can('add_super');
$T.CURSOR.trymop({
- $*unit.deref($pack).add_super($*unit.get_item($sub.find_pkg(
- [ @($path // ['MY']), $name ])));
+ $*unit.deref($pack).add_super($sub.compile_get_pkg(
+ @($path // []), $name).xref);
});
} elsif $pack && $tr<export> {
my @exports = @( $tr<export> );
- $sub.outer.add_pkg_exports($*unit, $*unit.deref($pack).name,
- $sub.cur_pkg, @exports);
+ $sub.outer.add_exports($*unit.deref($pack).name, $pack, @exports);
} elsif !$pack && $tr<export> {
my @exports = @( $tr<export> );
- $sub.outer.add_exports($*unit, '&' ~ $sub.name, @exports);
+ $sub.outer.add_exports('&'~$sub.name, $sub.xref, @exports);
$sub.strong_used = True;
$sub.outer.create_static_pad;
$sub.outer.lexicals-used{$sub.outervar} = True
if defined $sub.outervar;
- $sub.exports //= [];
- for @exports {
- my $pkg = [ @($sub.outer.find_pkg(['OUR','EXPORT',$_])),
- '&' ~ $sub.name ];
- push $sub.exports, $pkg;
- $*unit.bind_item($pkg, $sub.xref, |mnode($T));
- }
} elsif !$pack && $tr<nobinder> {
$sub.signature = Any;
} elsif !$pack && grep { defined $tr{$_} }, <looser tighter equiv> {
@@ -639,32 +1074,29 @@ method statement_control:use ($/) {
my $u2 = $*unit.need_unit($name);
- my @can = @( $u2.mainline.find_pkg([$name.split('::')]) );
- my @exp = (@can, 'EXPORT', 'DEFAULT');
+ my $module = $u2.mainline.compile_get_pkg($name.split('::'));
+ my $exp;
+ try $exp = $*unit.get_pkg($module, 'EXPORT', 'DEFAULT');
- # XXX I am not sure how need binding should work in the :: case
+ # in the :: case, $module will usually be visible via GLOBAL