diff --git a/Body.pm b/Body.pm index 7e44eab9..efd04c65 100644 --- a/Body.pm +++ b/Body.pm @@ -76,59 +76,4 @@ use CgOp (); no Moose; } -# Like a normal body, but creates a protoobject during preinit and run! -{ - package Body::Class; - use Moose; - extends 'Body'; - - has 'var' => (is => 'rw', isa => 'Str'); - has 'super' => (is => 'ro', isa => 'ArrayRef', default => sub { [] }); - has 'augmenting' => (is => 'ro', isa => 'Bool', default => 0); - - sub makeproto { - my ($self) = @_; - my @p; - push @p, CgOp::lextypes('!plist', 'List'); - push @p, CgOp::lexput(0, '!plist', - CgOp::rawnew('List')); - - for my $super (@{ $self->super }) { - push @p, CgOp::rawcall(CgOp::lexget(0, '!plist'), 'Add', - CgOp::getfield('klass', - CgOp::cast('DynObject', - CgOp::fetch(CgOp::scopedlex($super))))); - } - push @p, CgOp::lexput(1, $self->var, - CgOp::methodcall( - CgOp::lexget(1, $self->var . '!HOW'), 'create-protoobject', - CgOp::wrap(CgOp::callframe), - CgOp::wrap(CgOp::lexget(0, '!plist')))); - CgOp::prog(@p); - } - - around enter_code => sub { - my ($o, $self) = @_; - if ($self->mainline) { - $o->($self); - } else { - CgOp::prog( - CgOp::share_lex('!scopenum'), - $self->makeproto, - $o->($self)); - } - }; - - around preinit_code => sub { - my ($o, $self) = @_; - $self->lexical->{'!scopenum'} = 1; - CgOp::prog( - $o->($self), - $self->makeproto); - }; - - __PACKAGE__->meta->make_immutable; - no Moose; -} - 1; diff --git a/CodeGen.pm b/CodeGen.pm index f548e792..1522f786 100644 --- a/CodeGen.pm +++ b/CodeGen.pm @@ -15,25 +15,15 @@ use 5.010; slots => [f => 'Dictionary'] }, DynMetaObject => - { proto => [f => 'DynProtoMetaObject'], - BuildC3MRO => [m => 'Void'], + { BuildC3MRO => [m => 'Void'], typeObject => [f => 'IP6'], - outers => [f => 'List'] }, - - DynProtoMetaObject => - { how => [f => 'IP6'], - local => [f => 'Dictionary'], - def_outers => [f => 'List'], - superclasses => [f => 'List'], + how => [f => 'IP6'], + local => [f => 'Dictionary'], + superclasses => [f => 'List'], name => [f => 'String'] }, - 'List' => - { Add => [m => 'Void'], - Count => [p => 'System.Int32'] }, 'List' => { Add => [m => 'Void'] }, - 'List' => - { Add => [m => 'Void'] }, 'Double' => { ToString => [m => 'String'] }, 'Variable' => @@ -51,9 +41,7 @@ use 5.010; 'Kernel.NewCaptureVar' => [m => 'Variable'], 'Console.WriteLine' => [m => 'Void'], 'String.Concat' => [m => 'String'], - 'Kernel.SubPMO' => [f => 'DynProtoMetaObject'], 'Kernel.SubMO' => [f => 'DynMetaObject'], - 'Kernel.ScalarPMO' => [f => 'DynProtoMetaObject'], 'Kernel.ScalarMO' => [f => 'DynMetaObject'], 'Kernel.MainlineContinuation' => [f => 'DynBlockDelegate'], 'Kernel.MakeSub' => [m => 'IP6'], diff --git a/Decl.pm b/Decl.pm index a52cf801..da6227e4 100644 --- a/Decl.pm +++ b/Decl.pm @@ -192,11 +192,7 @@ use CgOp; has var => (is => 'ro', isa => 'Str', required => 1); has stub => (is => 'ro', isa => 'Bool', default => 0); has parents => (is => 'ro', isa => 'ArrayRef', default => sub { [] }); - - # the body is a very sublike thing; it has a preinit existance, and a - # lexical scope. but instead of just a Sub, it constructs a ClassHOW at - # preinit - has body => (is => 'ro', isa => 'Body::Class'); + has body => (is => 'ro', isa => 'Body'); sub used_slots { my ($self) = @_; @@ -217,7 +213,6 @@ use CgOp; } $self->body->outer($body); - $self->body->var($self->var); CgOp::with_aux("how", CgOp::methodcall(CgOp::scopedlex("ClassHOW"), "new", @@ -232,30 +227,25 @@ use CgOp; CgOp::proto_var($self->var . '!BODY', CgOp::newscalar( - CgOp::protosub($self->body, - CgOp::proto_var('!scopenum', - CgOp::methodcall(CgOp::aux('how'), - "push-scope", - CgOp::wrap(CgOp::callframe))))))); + CgOp::protosub($self->body))), + CgOp::scopedlex($self->var, + CgOp::methodcall(CgOp::aux("how"), "create-protoobject"))); } sub enter_code { my ($self, $body) = @_; CgOp::prog( CgOp::share_lex($self->var . '!HOW'), - ($self->stub ? - CgOp::share_lex($self->var) : + CgOp::share_lex($self->var), + ($self->stub ? () : ($body->mainline ? - CgOp::prog( - CgOp::share_lex($self->var . '!BODY'), - CgOp::share_lex($self->var)) : + CgOp::share_lex($self->var . '!BODY') : CgOp::clone_lex($self->var . '!BODY')))); } sub write { my ($self, $body) = @_; return unless $self->body; - $self->body->var($self->var); $self->body->outer($body); $self->body->write; } @@ -274,14 +264,13 @@ use CgOp; sub preinit_code { my ($self, $body) = @_; - if (!$body->isa('Body::Class')) { + if ($body->type ne 'class') { #TODO: Make this a sorry. die "Tried to set a method outside a class!"; } CgOp::sink( - CgOp::methodcall(CgOp::aux("how"), "add-scoped-method", + CgOp::methodcall(CgOp::aux("how"), "add-method", CgOp::wrap(CgOp::clr_string($self->name)), - CgOp::scopedlex('!scopenum'), CgOp::scopedlex($self->var))); } @@ -298,14 +287,10 @@ use CgOp; sub preinit_code { my ($self, $body) = @_; - if (!$body->isa('Body::Class')) { + if ($body->type ne 'class') { #TODO: Make this a sorry. - die "Tried to set a superclass outside a class!"; - } - if ($body->augmenting) { - die "Cannot add superclasses in an augment"; + die "Tried to set a superclass outside an initial class!"; } - push @{ $body->super }, $self->name; CgOp::sink( CgOp::methodcall(CgOp::aux('how'), "add-super", diff --git a/Kernel.cs b/Kernel.cs index 1e74661c..0a7d09b4 100644 --- a/Kernel.cs +++ b/Kernel.cs @@ -139,57 +139,40 @@ public class Frame: IP6 { // NOT IP6; these things should only be exposed through a ClassHOW-like // façade - public class DynProtoMetaObject { - public struct Method { - public Method(DynBlockDelegate code, Frame proto, int outer_index) { - this.code = code; - this.proto = proto; - this.outer_index = outer_index; - } - public DynBlockDelegate code; - public Frame proto; - public int outer_index; - } - + public class DynMetaObject { public IP6 how; + public IP6 typeObject; public string name; - public InvokeHandler OnInvoke; - public FetchHandler OnFetch; - public StoreHandler OnStore; - - public List superclasses - = new List(); - public Dictionary local - = new Dictionary(); - - public List def_outers = new List(); - public delegate Frame InvokeHandler(DynObject th, Frame c, LValue[] pos, Dictionary named); public delegate Frame FetchHandler(DynObject th, Frame c); public delegate Frame StoreHandler(DynObject th, Frame c, IP6 n); - } - public class DynMetaObject { - public DynProtoMetaObject proto; - public List outers = new List(); + public InvokeHandler OnInvoke; + public FetchHandler OnFetch; + public StoreHandler OnStore; + + public List superclasses + = new List(); + public Dictionary local + = new Dictionary(); + public List mro; - public IP6 typeObject; - public DynMetaObject(DynProtoMetaObject proto) { - this.proto = proto; + public DynMetaObject(string name) { + this.name = name; this.mro = new List(); mro.Add(this); } - public void BuildC3MRO(List supers) { + public void BuildC3MRO() { List> toMerge = new List>(); mro = new List(); toMerge.Add(new List()); toMerge[0].Add(this); - foreach (DynMetaObject dmo in supers) { + foreach (DynMetaObject dmo in superclasses) { toMerge[0].Add(dmo); toMerge.Add(new List(dmo.mro)); } @@ -242,24 +225,20 @@ public class DynObject: IP6 { = new Dictionary(); public DynMetaObject klass; + public DynObject(DynMetaObject klass) { + this.klass = klass; + } + private Frame Fail(Frame caller, string msg) { - return Kernel.Die(caller, msg + " in class " + klass.proto.name); + return Kernel.Die(caller, msg + " in class " + klass.name); } public Frame InvokeMethod(Frame caller, string name, LValue[] pos, Dictionary named) { - DynProtoMetaObject.Method m; - while (klass.outers.Count < klass.proto.def_outers.Count) { - klass.outers.Add(klass.proto.def_outers[klass.outers.Count]); - } + IP6 m; foreach (DynMetaObject k in klass.mro) { - if (k.proto.local.TryGetValue(name, out m)) { - Frame n = new Frame(caller, k.outers[m.outer_index], - m.code); - n.proto = m.proto; - n.pos = pos; - n.named = named; - return n; + if (k.local.TryGetValue(name, out m)) { + return m.Invoke(caller, pos, named); } } return Fail(caller, "Unable to resolve method " + name); @@ -275,29 +254,29 @@ public class DynObject: IP6 { } public Frame HOW(Frame caller) { - caller.resultSlot = klass.proto.how; + caller.resultSlot = klass.how; return caller; } public Frame Invoke(Frame c, LValue[] p, Dictionary n) { - if (klass.proto.OnInvoke != null) { - return klass.proto.OnInvoke(this, c, p, n); + if (klass.OnInvoke != null) { + return klass.OnInvoke(this, c, p, n); } else { return Fail(c, "No invoke handler set"); } } public Frame Fetch(Frame c) { - if (klass.proto.OnFetch != null) { - return klass.proto.OnFetch(this, c); + if (klass.OnFetch != null) { + return klass.OnFetch(this, c); } else { return Fail(c, "No fetch handler set"); } } public Frame Store(Frame c, IP6 o) { - if (klass.proto.OnStore != null) { - return klass.proto.OnStore(this, c, o); + if (klass.OnStore != null) { + return klass.OnStore(this, c, o); } else { return Fail(c, "No store handler set"); } @@ -370,8 +349,7 @@ public class Kernel { case 2: a = (DynObject) th.lex["s0"]; c = (Frame) th.resultSlot; - b = new DynObject(); - b.klass = a.klass; + b = new DynObject(a.klass); b.slots = new Dictionary(a.slots); b.slots["outer"] = c; th.caller.resultSlot = NewROScalar(b); @@ -464,16 +442,13 @@ public class Kernel { public static readonly DynMetaObject SubMO; public static readonly DynMetaObject ScalarMO; - public static readonly DynProtoMetaObject SubPMO; - public static readonly DynProtoMetaObject ScalarPMO; public static readonly IP6 DieSub; public static bool TraceCont; public static IP6 MakeSub(DynBlockDelegate code, Frame proto, Frame outer) { - DynObject n = new DynObject(); - n.klass = SubMO; + DynObject n = new DynObject(SubMO); n.slots["outer"] = outer; n.slots["code"] = code; n.slots["proto"] = proto; @@ -481,8 +456,7 @@ public class Kernel { } public static Variable BoxAny(object v, IP6 proto) { - DynObject n = new DynObject(); - n.klass = ((DynObject)proto).klass; + DynObject n = new DynObject(((DynObject)proto).klass); n.slots["value"] = v; return NewROScalar(n); } @@ -493,8 +467,7 @@ public class Kernel { } public static IP6 MakeSC(IP6 inside) { - DynObject n = new DynObject(); - n.klass = ScalarMO; + DynObject n = new DynObject(ScalarMO); n.slots["value"] = inside; return n; } @@ -631,22 +604,14 @@ public class Kernel { } static Kernel() { - SubPMO = new DynProtoMetaObject(); - SubPMO.name = "Sub"; - SubPMO.OnInvoke = new DynProtoMetaObject.InvokeHandler(SubInvoke); - SubPMO.local["clone"] = new DynProtoMetaObject.Method( - new DynBlockDelegate(SubCloneC), - null, 0); - SubPMO.def_outers.Add(null); - - SubMO = new DynMetaObject(SubPMO); - - ScalarPMO = new DynProtoMetaObject(); - ScalarPMO.name = "Scalar"; - ScalarPMO.OnFetch = new DynProtoMetaObject.FetchHandler(SCFetch); - ScalarPMO.OnStore = new DynProtoMetaObject.StoreHandler(SCStore); - - ScalarMO = new DynMetaObject(ScalarPMO); + SubMO = new DynMetaObject("Sub"); + SubMO.OnInvoke = new DynMetaObject.InvokeHandler(SubInvoke); + SubMO.local["clone"] = MakeSub(new DynBlockDelegate(SubCloneC), + null, null); + + ScalarMO = new DynMetaObject("Scalar"); + ScalarMO.OnFetch = new DynMetaObject.FetchHandler(SCFetch); + ScalarMO.OnStore = new DynMetaObject.StoreHandler(SCStore); DieSub = MakeSub(new DynBlockDelegate(ThrowC), null, null); } diff --git a/Niecza/Actions.pm b/Niecza/Actions.pm index 00d6c429..47bedd5d 100644 --- a/Niecza/Actions.pm +++ b/Niecza/Actions.pm @@ -852,14 +852,8 @@ sub package_def { my ($cl, $M) = @_; Decl::Super->new(name => 'Any'); } - $cl->blockcheck; - my $cbody = Body::Class->new( - name => $name, - type => 'class', - decls => ($::CURLEX->{'!decls'} // []), - enter => ($::CURLEX->{'!enter'} // []), - lexical => ($::CURLEX->{'!slots'} // {}), - do => $stmts->{_ast}); + my $cbody = $cl->sl_to_block('class', $stmts->{_ast}, + name => $name); my $cdecl = Decl::Class->new( name => $name, var => $outervar, diff --git a/notes.pod b/notes.pod index 3f4dce2d..729d9aab 100644 --- a/notes.pod +++ b/notes.pod @@ -231,6 +231,11 @@ place (using augment or supercede) will require more than one OUTER::; the main clone sets up the first OUTER, subsequent ones set up by the runtime manifestation of augments. +=head2 Death of NIL + +Due to persistant stack issues, NIL is no more. Instead, use CgOp, which is +a Lisp-like presentation of the low level optree. + =head1 Brief overview of the compiler User runs C. Entry point is in C, the driver. diff --git a/setting b/setting index da2b5864..7c32d2d0 100644 --- a/setting +++ b/setting @@ -7,20 +7,8 @@ my class CORE { ... } # We have to do this directly due to the circularity saw. Same # reason forces uncontainerized .NET values. # -# ClassHOW instances are shared between lexical instantiations of a class. -# # class ClassHOW { -# has Array[Frame] $.outers; -# -# # TODO -# has Array[Sub] $.scoped-parents; -# has Array[Sub] $.scoped-roles; -# -# # used to stage for composition - not yet -# has Dictionary[str,int] $.method-scopes; -# has Dictionary[str,Sub] $.methods; -# -# has DynProtoMetaObject $.meta-object; +# has DynMetaObject $.meta-object; # } # # Due to concerns of screwing up composition, adding new superclasses, roles, @@ -28,93 +16,65 @@ my class CORE { ... } # # to create a class: # BEGIN my $Foo_HOW ::= ClassHOW.new("Foo"); +# BEGIN my $Foo; # BEGIN { -# $Foo_HOW.push-scope(callframe); # $Foo_HOW.add-super(...); # $Foo_HOW.add-role(...); -# $Foo_HOW.add-scoped-method("bar", 0, sub { ... }); +# $Foo_HOW.add-method("bar", anon method bar { ... }); # $Foo_HOW.compose; +# $Foo ::= $Foo_HOW.create-protoobject; # } -# my ::Foo will begin { $Foo_HOW.create-protoobject(callframe) } -# will enter { $Foo_HOW.create-protoobject(callframe) }; # # to augment: -# BEGIN my $scopenum = $Foo_HOW.push-scope(callframe); -# BEGIN { $Foo_HOW.add-scoped-method("baz", $scopenum, sub { ... }); } -# Foo.^bind-outer($scopenum, callframe); +# BEGIN { $Foo_HOW.add-method("baz", anon method baz { ... }); } my class ClassHOW { ... } PRE-INIT { # ClassHOW.new($name) --> meta class instance sub new { Q:CgOp { (prog - (lextypes $pmo DynProtoMetaObject $self DynObject) - (l $pmo (rawnew DynProtoMetaObject)) - (l $self (rawnew DynObject)) - - (setfield how (l $pmo) (l $self)) - (setfield name (l $pmo) (unwrap String (@ (pos 1)))) + (lextypes $mo DynMetaObject $self DynObject) + (l $mo (rawnew DynMetaObject (unwrap String (@ (pos 1))))) + (l $self (rawnew DynObject (getfield klass + (cast DynObject (@ (pos 0)))))) + (setfield how (l $mo) (l $self)) (setindex meta-object (getfield slots (l $self)) - (nsw (rawnew CLRImportObject (l $pmo)))) - (setfield klass (l $self) (getfield klass - (cast DynObject (@ (pos 0))))) + (nsw (rawnew CLRImportObject (l $mo)))) (ns (l $self))) } } - # $how.push-scope($outer) - sub push-scope { Q:CgOp { - (prog (lextypes $df List) - (l $df (getfield def_outers (unwrap DynProtoMetaObject - (getattr meta-object (@ (pos 0)))))) - (rawcall (l $df) Add (unwrap Frame (@ (pos 1)))) - (w (- (int 1) (getfield Count (l $df))))) - } } - # $how.add-super($how) sub add-super { Q:CgOp { (prog (rawcall - (getfield superclasses (unwrap DynProtoMetaObject + (getfield superclasses (unwrap DynMetaObject (getattr meta-object (@ (pos 0))))) Add - (unwrap DynProtoMetaObject (getattr meta-object (@ (pos 1))))) + (unwrap DynMetaObject (getattr meta-object (@ (pos 1))))) (null Variable)) } } - # $how.add-scoped-method($name, $index, $sub) - sub add-scoped-method { Q:CgOp { + # $how.add-method($name, $sub) + sub add-method { Q:CgOp { (prog - (lextypes $name String $index Int32 $sub DynObject - $mo DynProtoMetaObject) - (l $mo (unwrap DynProtoMetaObject (getattr meta-object (@ (pos 0))))) - (l $name (unwrap String (@ (pos 1)))) - (l $index (unwrap Int32 (@ (pos 2)))) - (l $sub (cast DynObject (@ (pos 3)))) - - (lextypes $proto Frame $code DynBlockDelegate) - (l $code (cast DynBlockDelegate (getindex code - (getfield slots (l $sub))))) - (l $proto (cast Frame (getindex proto (getfield slots (l $sub))))) - - (setindex (l $name) (getfield local (l $mo)) - (rawnew DynProtoMetaObject.Method (l $code) (l $proto) (l $index))) + (setindex (unwrap String (@ (pos 1))) + (getfield local (unwrap DynMetaObject (getattr meta-object + (@ (pos 0))))) + (@ (pos 2))) (null Variable)) } } - # $how.create-protoobject($callframe, $superlist) + # $how.create-protoobject() sub create-protoobject { Q:CgOp { (prog - (lextypes $p DynObject $pmo DynProtoMetaObject $mo DynMetaObject) - (l $p (rawnew DynObject)) - (l $pmo (unwrap DynProtoMetaObject (getattr meta-object (@ (pos 0))))) - (l $mo (rawnew DynMetaObject (l $pmo))) + (lextypes $p DynObject $mo DynMetaObject) + (l $mo (unwrap DynMetaObject (getattr meta-object (@ (pos 0))))) + (l $p (rawnew DynObject (l $mo))) - (rawcall (getfield outers (l $mo)) Add (unwrap Frame (@ (pos 1)))) - (rawcall (l $mo) BuildC3MRO (unwrap List (@ (pos 2)))) + (rawcall (l $mo) BuildC3MRO) (setfield slots (l $p) (null Dictionary)) - (setfield klass (l $p) (l $mo)) (setfield typeObject (l $mo) (l $p)) (newscalar (l $p))) @@ -124,49 +84,33 @@ PRE-INIT { Q:CgOp { (prog - (lextypes $chpmo DynProtoMetaObject $ch DynObject) - (lexput 0 $chpmo (rawnew DynProtoMetaObject)) - (lexput 0 $ch (rawnew DynObject)) - - (setfield how (lexget 0 $chpmo) (lexget 0 $ch)) - (setfield name (lexget 0 $chpmo) (clr_string "ClassHOW")) - (setindex meta-object (getfield slots (lexget 0 '$ch')) - (wrap (lexget 0 '$chpmo'))) - - (sink (subcall (fetch (lexget 0 &push-scope)) - (newscalar (lexget 0 $ch)) (wrap (callframe)))) - (sink (subcall (fetch (lexget 0 &add-scoped-method)) - (newscalar (lexget 0 $ch)) (wrap (clr_string "new")) (wrap (int 0)) - (lexget 0 &new))) - (sink (subcall (fetch (lexget 0 &add-scoped-method)) - (newscalar (lexget 0 $ch)) (wrap (clr_string "push-scope")) (wrap (int 0)) - (lexget 0 &push-scope))) - (sink (subcall (fetch (lexget 0 &add-scoped-method)) - (newscalar (lexget 0 $ch)) (wrap (clr_string "add-scoped-method")) (wrap (int 0)) - (lexget 0 &add-scoped-method))) - (sink (subcall (fetch (lexget 0 &add-scoped-method)) - (newscalar (lexget 0 $ch)) (wrap (clr_string "add-super")) (wrap (int 0)) - (lexget 0 &add-super))) - (sink (subcall (fetch (lexget 0 &add-scoped-method)) - (newscalar (lexget 0 $ch)) (wrap (clr_string "compose")) (wrap (int 0)) - (lexget 0 &compose))) - (sink (subcall (fetch (lexget 0 &add-scoped-method)) - (newscalar (lexget 0 $ch)) (wrap (clr_string "create-protoobject")) (wrap (int 0)) - (lexget 0 &create-protoobject))) - - (lexput 1 ClassHOW (subcall (fetch (lexget 0 &create-protoobject)) - (newscalar (lexget 0 $ch)) (wrap (callframe)) - (wrap (rawnew List)))) - - (setfield klass (lexget 0 $ch) - (getfield klass (cast DynObject (fetch (lexget 1 ClassHOW))))) - (lexput 1 ClassHOW!HOW (newscalar (lexget 0 $ch))) + (lextypes $chmo DynMetaObject $chch Variable) + (l $chmo (rawnew DynMetaObject (clr_string "ClassHOW"))) + (l $chch (ns (rawnew DynObject (l $chmo)))) + + (setfield how (l $chmo) (@ (l $chch))) + (setindex meta-object (getfield slots (cast DynObject (@ (l $chch)))) + (w (l $chmo))) + + (sink (subcall (@ (l &add-method)) (l $chch) + (wrap (clr_string "new")) (l &new))) + (sink (subcall (@ (l &add-method)) (l $chch) + (wrap (clr_string "add-method")) (l &add-method))) + (sink (subcall (@ (l &add-method)) (l $chch) + (wrap (clr_string "add-super")) (l &add-super))) + (sink (subcall (@ (l &add-method)) (l $chch) + (wrap (clr_string "compose")) (l &compose))) + (sink (subcall (@ (l &add-method)) (l $chch) + (wrap (clr_string "create-protoobject")) (l &create-protoobject))) + + (l ClassHOW (subcall (@ (l &create-protoobject)) (l $chch))) + (l ClassHOW!HOW (l $chch)) (null Variable)) } } -# cannot be a normal class - it has no parents (and must not be cloned) +# cannot be a normal class - it has no parents my class Mu { ... } my class Any { ... } my class Cool { ... } @@ -174,39 +118,16 @@ my class Cool { ... } my class Scalar { ... } my class Sub { ... } PRE-INIT { - # (DynProtoMetaObject $dpmo, ClassHOW $super --> ClassHOW) + # (DynMetaObject $dmo, ClassHOW $super --> ClassHOW) sub wrap-dpmo { Q:CgOp { (prog - (lextypes $ch Variable $dp DynProtoMetaObject) - (lexput 0 $ch (methodcall (l ClassHOW) new - (wrap (clr_string "")))) - (lexput 0 $dp (unwrap DynProtoMetaObject (fetch (pos 0)))) - - (assign (varattr meta-object (fetch (lexget 0 $ch))) - (wrap (lexget 0 $dp))) - (sink (methodcall (lexget 0 $ch) add-super (pos 1))) - (lexget 0 $ch)) - } } - # (ClassHOW $me, DynMetaObject $use, DynMetaObject $p --> Variable) - sub wrapped-protoobj { Q:CgOp { - (prog - (lextypes $p DynObject $pmo DynProtoMetaObject $mo DynMetaObject - $s List) - (l $p (rawnew DynObject)) - (l $pmo (unwrap DynProtoMetaObject (getattr meta-object (@ (pos 0))))) - (l $mo (unwrap DynMetaObject (@ (pos 1)))) - - (l $s (rawnew List)) - (rawcall (l $s) Add (unwrap DynMetaObject (@ (pos 2)))) - (rawcall (l $mo) BuildC3MRO (l $s)) - - (setfield how (l $pmo) (@ (pos 0))) + (lextypes $ch Variable $dm DynMetaObject) + (l $ch (methodcall (l ClassHOW) new (w (clr_string "")))) + (l $dm (unwrap DynMetaObject (@ (pos 0)))) - (setfield slots (l $p) (null Dictionary)) - (setfield typeObject (l $mo) (l $p)) - (setfield klass (l $p) (l $mo)) - - (newscalar (l $p))) + (assign (varattr meta-object (@ (l $ch))) (w (l $dm))) + (sink (methodcall (l $ch) add-super (pos 1))) + (l $ch)) } } Q:CgOp { @@ -214,40 +135,26 @@ Q:CgOp { (lextypes !plist List) (l Mu!HOW (methodcall (l ClassHOW) new (w (clr_string Mu)))) - (l !plist (rawnew List)) - (l Mu (methodcall (l Mu!HOW) create-protoobject (w (callframe)) - (w (l !plist)))) + (l Mu (methodcall (l Mu!HOW) create-protoobject)) (l Any!HOW (methodcall (l ClassHOW) new (w (clr_string Any)))) (sink (methodcall (l Any!HOW) add-super (l Mu!HOW))) - (l !plist (rawnew List)) - (rawcall (l !plist) Add (getfield klass (cast DynObject (@ (l Mu))))) - (l Any (methodcall (l Any!HOW) create-protoobject (w (callframe)) - (w (l !plist)))) + (l Any (methodcall (l Any!HOW) create-protoobject)) (l Cool!HOW (methodcall (l ClassHOW) new (w (clr_string Cool)))) (sink (methodcall (l Cool!HOW) add-super (l Any!HOW))) - (l !plist (rawnew List)) - (rawcall (l !plist) Add (getfield klass (cast DynObject (@ (l Any))))) - (l Cool (methodcall (l Cool!HOW) create-protoobject (w (callframe)) - (w (l !plist)))) + (l Cool (methodcall (l Cool!HOW) create-protoobject)) - (l !plist (rawnew List)) - (rawcall (l !plist) Add (getfield klass (cast DynObject (@ (l Any))))) - (rawcall (getfield klass (cast DynObject (@ (l ClassHOW)))) - BuildC3MRO (l !plist)) + (sink (methodcall (l ClassHOW!HOW) add-super (l Any!HOW))) + (rawcall (getfield klass (cast DynObject (@ (l ClassHOW)))) BuildC3MRO) (l Sub!HOW (subcall (@ (l &wrap-dpmo)) - (w (rawsget Kernel.SubPMO)) (l Any!HOW))) - (l Sub (subcall (@ (l &wrapped-protoobj)) (l Sub!HOW) - (w (rawsget Kernel.SubMO)) - (w (getfield klass (cast DynObject (@ (l Any))))))) + (w (rawsget Kernel.SubMO)) (l Any!HOW))) + (l Sub (methodcall (l Sub!HOW) create-protoobject)) (l Scalar!HOW (subcall (@ (l &wrap-dpmo)) - (w (rawsget Kernel.ScalarPMO)) (l Any!HOW))) - (l Scalar (subcall (@ (l &wrapped-protoobj)) (l Scalar!HOW) - (w (rawsget Kernel.ScalarMO)) - (w (getfield klass (cast DynObject (@ (l Any))))))) + (w (rawsget Kernel.ScalarMO)) (l Any!HOW))) + (l Scalar (methodcall (l Scalar!HOW) create-protoobject)) (null Variable)) } } @@ -386,19 +293,18 @@ sub infix:<===>($l,$r) { Q:CgOp { # no MONKEY_TYPING. PRE-INIT { - my $i := Mu.HOW.push-scope(Q:CgOp { (wrap (callframe)) }); - Mu.HOW.add-scoped-method(Q:CgOp { (wrap (clr_string "defined")) }, $i, + Mu.HOW.add-method(Q:CgOp { (wrap (clr_string "defined")) }, anon method defined() { - Q:CgOp { (box Bool (compare != (null Dictionary) - (getfield slots (cast DynObject (fetch (scopedlex self)))))) } + Q:CgOp { (box Bool (!= (null Dictionary) + (getfield slots (cast DynObject (@ (l self)))))) } }); - Mu.HOW.add-scoped-method(Q:CgOp { (wrap (clr_string "Bool")) }, $i, + Mu.HOW.add-method(Q:CgOp { (w (clr_string "Bool")) }, anon method Bool() { self.defined }); - Mu.HOW.add-scoped-method(Q:CgOp { (wrap (clr_string "Str")) }, $i, + Mu.HOW.add-method(Q:CgOp { (w (clr_string "Str")) }, anon method Str() { my $tn := Q:CgOp { - (box Str (getfield name (getfield proto (getfield klass - (cast DynObject (fetch (scopedlex self))))))) + (box Str (getfield name (getfield klass + (cast DynObject (fetch (scopedlex self)))))) }; if self.defined { $tn ~ "()"