Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Implement CLR:: psuedopackage
  • Loading branch information
@sorear
sorear committed Sep 10, 2011
1 parent e28d2ba commit acb2aad
Show file tree
Hide file tree
Showing 5 changed files with 159 additions and 3 deletions.
22 changes: 22 additions & 0 deletions lib/Kernel.cs
View file
Expand Up @@ -2583,6 +2583,7 @@ public struct StashCursor {
public const int LEX = 1; // p1(Frame) p2(int, depth)
public const int ROOT = 2; // p1(Frame) p2(int)
public const int DYNA = 3; // p1&p2
public const int CLR = 4; // p1(string)

int type;
object p1;
Expand Down Expand Up @@ -2706,6 +2707,15 @@ public struct StashCursor {
return true;
}

public static P6any MakeCLR_WHO(string name) {
StashCursor sc = default(StashCursor);
sc.type = CLR;
sc.p1 = name;
P6any who = Kernel.BoxRaw(sc, Kernel.PseudoStashMO);
who.SetSlot("name", Kernel.BoxAnyMO(name, Kernel.StrMO));
return who;
}

void Core(string key, bool final, out StashCursor sc, out Variable v,
Variable bind_to) {
v = null;
Expand All @@ -2722,6 +2732,14 @@ public struct StashCursor {
v = Kernel.AnyMO.typeVar;
goto have_v;
}
else if (type == CLR) {
if (Kernel.SaferMode)
throw new NieczaException("CLR objects may not be used directly in safe mode");
if (bind_to != null)
throw new NieczaException("Cannot bind interop namespaces");
v = CLRWrapperProvider.GetNamedWrapper((string)p1 + "." + key).typeVar;
goto have_v;
}
else if (type == WHO) {
// only special type is PARENT, maybe not even that?
P6any who = (P6any) p1;
Expand Down Expand Up @@ -2786,6 +2804,10 @@ public struct StashCursor {
} else if (key == "DYNAMIC") {
sc.type = DYNA;
goto have_sc;
} else if (key == "CLR") {
sc.type = CLR;
sc.p1 = "";
goto have_sc;
} else {
v = bind_to;
if (TryLexOut(key, bind_to != null, ref v)) {
Expand Down
25 changes: 24 additions & 1 deletion lib/NieczaCLR.cs
View file
Expand Up @@ -333,15 +333,37 @@ class OverloadDispatcher {
}

public class CLRWrapperProvider {
// wrapper_cache serves as the lock-bearer for both
static Dictionary<Type, STable> wrapper_cache
= new Dictionary<Type, STable>();
static Dictionary<string, STable> named_wrapper_cache
= new Dictionary<string, STable>();

public static STable GetWrapper(Type t) {
lock (wrapper_cache) {
STable r;
if (wrapper_cache.TryGetValue(t, out r))
return r;
return wrapper_cache[t] = NewWrapper(t);
wrapper_cache[t] = r = NewWrapper(t);
return r;
}
}

public static STable GetNamedWrapper(string nm) {
lock (wrapper_cache) {
STable r;
if (named_wrapper_cache.TryGetValue(nm, out r))
return r;
Type ty = Type.GetType(nm.Substring(1));
if (ty != null) {
wrapper_cache[ty] = r = NewWrapper(ty);
named_wrapper_cache[nm] = r;
} else {
named_wrapper_cache[nm] = r = StashCursor.MakePackage(
"CLR" + nm.Replace(".","::"),
StashCursor.MakeCLR_WHO(nm)).Fetch().mo;
}
return r;
}
}

Expand Down Expand Up @@ -384,6 +406,7 @@ public class CLRWrapperProvider {
if (CLROpts.Debug)
Console.WriteLine("Setting up wrapper for {0}", t.FullName);
STable m = new STable("CLR::" + t.FullName.Replace(".","::"));
m.who = StashCursor.MakeCLR_WHO("." + t.FullName);
STable pm = t.BaseType == null ? Kernel.AnyMO :
GetWrapper(t.BaseType);
STable[] mro = new STable[pm.mo.mro.Length + 1];
Expand Down
2 changes: 1 addition & 1 deletion src/Metamodel.pm6
View file
Expand Up @@ -593,7 +593,7 @@ class StaticSub is RefTarget {
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' {
} elsif $n0 eq any < COMPILING DYNAMIC CLR 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
Expand Down
2 changes: 1 addition & 1 deletion src/STD.pm6
View file
Expand Up @@ -5183,7 +5183,7 @@ method is_name($longname, $curlex = $*CURLEX) {
when 'CORE' { $sub = $curlex<!sub>.?true_setting; goto "lexy"; }
when 'SETTING' { $sub = $curlex<!sub>.?to_unit.?outer; goto "lexy"; }

when 'COMPILING' | 'DYNAMIC' | 'CALLER' { return True }
when 'COMPILING' | 'DYNAMIC' | 'CALLER' | 'CLR' { return True }

default {
my $lexical = self.lookup_lex(@parts[0], $curlex);
Expand Down
111 changes: 111 additions & 0 deletions src/niecza
View file
Expand Up @@ -24,6 +24,117 @@ use Sig;
use STD;

augment class NieczaActions {

method process_name($/, :$declaring, :$defer, :$clean) {
return () unless defined $/;

my @ns = @( $<name>.ast<names> );
my $ext = '';
my $trail = @ns && !defined @ns[*-1];
pop @ns if $trail;

if !$clean {
for @( $<colonpair> ) {
$ext ~= $_.ast<ext> // (
$_.CURSOR.sorry("Invalid colonpair for name extension");
"";
)
}
}

for $defer ?? () !! @ns.grep(Op) {
$_ = ~self.trivial_eval($/, $_);
# XXX should this always stringify?
if $_ ~~ Cool {
$_ = ~$_;
} else {
$_ = "XXX";
$/.CURSOR.sorry("Name components must evaluate to strings");
}
}

if $declaring {
# class :: is ... { } is a placeholder for a lack of name
return () if $trail && !@ns;
$/.CURSOR.sorry("Illegal explicit declaration of a symbol table")
if $trail;
die "Unimplemented" if $defer;
return () unless @ns;
my $head = pop(@ns) ~ $ext;
return Any, $head unless @ns;

# the remainder is assumed to name an existing or new package
my $pkg;
$/.CURSOR.trymop({
$pkg = $*CURLEX<!sub>.compile_get_pkg(@ns, :auto);
});
return $pkg, $head;
}
else {
if $defer {
# The stuff returned here is processed by the variable rule,
# and also by method call generation

goto "dyn" if $trail;
goto "dyn" if $_.^isa(Op) for @ns;
my $pkg;
my @tail = @ns;
my $head = pop(@tail) ~ $ext;
unless @tail {
goto "dyn" if $head eq any < MY OUR CORE DYNAMIC GLOBAL CALLER OUTER UNIT SETTING PROCESS COMPILING PARENT CLR >;
return { name => $head } unless @tail;
}
try { $pkg = $*CURLEX<!sub>.compile_get_pkg(@tail, :auto) };
goto "dyn" unless $pkg;

return { name => $head, pkg => $pkg };
dyn:
my @bits = map { $_, '::' }, @ns;
pop @bits if @bits;
push @bits, '::' if $trail;
return { iname => mkstringycat($/, @bits) };
}

$/.CURSOR.sorry("Class required, but symbol table name used instead")
if $trail;
return () unless @ns;
my $head = pop(@ns) ~ $ext;
my $pkg;
$/.CURSOR.trymop({
$pkg = $*CURLEX<!sub>.compile_get_pkg(@ns, $head);
});
return $pkg;
}
}
method term:identifier ($/) {
my $id = $<identifier>.ast;
my $sal = $<args> ?? ($<args>.ast // []) !! [];
# TODO: support zero-D slicels

if $sal > 1 {
$/.CURSOR.sorry("Slicel lists are NYI");
make ::Op::StatementList.new;
return;
}

if $id eq any < MY OUR CORE DYNAMIC GLOBAL CALLER OUTER UNIT SETTING PROCESS COMPILING PARENT CLR > {
make Op::IndirectVar.new(|node($/),
name => Op::StringLiteral.new(text => $id));
return;
}
my $is_name = $/.CURSOR.is_name(~$<identifier>);

if $is_name && $<args>.chars == 0 {
make mklex($/, $id);
return;
}

my $args = $sal[0] // [];

make ::Op::CallSub.new(|node($/),
invocant => mklex($/, $is_name ?? $id !! '&' ~ $id),
args => $args);
}
method process_nibble($/, @bits, $prefix?) {
my @acc;
for @bits -> $n {
Expand Down

0 comments on commit acb2aad

Please sign in to comment.