Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

[common] Much more filling out of NQPClassHOW, plus add a very basic …

…NQPAttribute. This gets classes with methods, attributes and doing single inheritance working.
  • Loading branch information...
commit 3c4309f33be37dcd19d06f79bdcaafa572c6a87d 1 parent 6d965f2
Jonathan Worthington authored October 31, 2010

Showing 1 changed file with 88 additions and 6 deletions. Show diff stats Hide diff stats

  1. 94  common/NQP/NQPSetting.pm
94  common/NQP/NQPSetting.pm
@@ -288,7 +288,7 @@ knowhow NQPClassHOW {
288 288
     has $!name;
289 289
 
290 290
     # Attributes, methods, parents and roles directly added.
291  
-    has %!attributes;
  291
+    has @!attributes;
292 292
     has %!methods;
293 293
     has @!parents;
294 294
     has @!roles;
@@ -315,9 +315,15 @@ knowhow NQPClassHOW {
315 315
         nqp::instance_of(self).BUILD()
316 316
     }
317 317
 
  318
+    method CREATE($obj) {
  319
+        nqp::instance_of($obj)
  320
+    }
  321
+
318 322
     method BUILD() {
319 323
         $!composed := 0;
320 324
         %!methods := NQPHash.new;
  325
+        @!attributes := NQPArray.new;
  326
+        @!parents := NQPArray.new;
321 327
         self;
322 328
     }
323 329
 
@@ -337,6 +343,34 @@ knowhow NQPClassHOW {
337 343
         %!methods{$name} := $code_obj;
338 344
     }
339 345
 
  346
+    method add_attribute($obj, $meta_attr) {
  347
+        if $!composed {
  348
+            die("NQPClassHOW does not support adding attributes after being composed.");
  349
+        }
  350
+        my $i := 0;
  351
+        while $i != +@!attributes {
  352
+            if @!attributes[$i].name eq $meta_attr.name {
  353
+                die("Already have an attribute named " ~ $meta_attr.name);
  354
+            }
  355
+            $i := $i + 1;
  356
+        }
  357
+        @!attributes[+@!attributes] := $meta_attr;
  358
+    }
  359
+
  360
+    method add_parent($obj, $parent) {
  361
+        if $!composed {
  362
+            pir::die("NQPClassHOW does not support adding parents after being composed.");
  363
+        }
  364
+        my $i := 0;
  365
+        while $i != +@!parents {
  366
+            if @!parents[$i] =:= $parent {
  367
+                die("Already have " ~ $parent ~ " as a parent class.");
  368
+            }
  369
+            $i := $i + 1;
  370
+        }
  371
+        @!parents[+@!parents] := $parent;
  372
+    }
  373
+
340 374
     method compose($obj) {
341 375
         # XXX TODO: Compose roles, compose attributes.
342 376
 
@@ -351,10 +385,27 @@ knowhow NQPClassHOW {
351 385
     }
352 386
 
353 387
     # XXX TODO: Get enough working to bring over the C3 implementation that
354  
-    # we run on 6model on Parrot.
  388
+    # we run on 6model on Parrot. For now, we only build it for single
  389
+    # inheritance since it's obvious how to do it.
355 390
     sub compute_c3_mro($obj) {
  391
+        # MRO starts with this object.
356 392
         my @mro;
357 393
         @mro[0] := $obj;
  394
+        
  395
+        # Now add all parents until we have none.
  396
+        my $cur_obj := $obj;
  397
+        my @parents := $cur_obj.HOW.parents($cur_obj, :local(1));
  398
+        while +@parents {
  399
+            if +@parents == 1 {
  400
+                @mro[+@mro] := $cur_obj := @parents[0];
  401
+                @parents := $cur_obj.HOW.parents($cur_obj, :local(1));
  402
+            }
  403
+            else {
  404
+                die("Sorry, multiple inheritance is not yet implemented.");
  405
+            }
  406
+        }
  407
+
  408
+        # Return MRO.
358 409
         @mro;
359 410
     }
360 411
 
@@ -362,10 +413,18 @@ knowhow NQPClassHOW {
362 413
     ## Introspecty
363 414
     ##
364 415
 
  416
+    method attributes($obj, :$local!) {
  417
+        @!attributes
  418
+    }
  419
+
365 420
     method method_table($obj) {
366 421
         %!methods
367 422
     }
368 423
 
  424
+    method parents($obj, :$local!) {
  425
+        @!parents
  426
+    }
  427
+
369 428
     method defined() {
370 429
         nqp::repr_defined(self)
371 430
     }
@@ -375,10 +434,33 @@ knowhow NQPClassHOW {
375 434
     ##
376 435
 
377 436
     method find_method($obj, $name) {
378  
-        # XXX TODO Epic cheat, replace with that's in the ClassHOW that we
379  
-        # run on Parrot. Needs auto-viv, .defined, return.
380  
-        my %meths := @!mro[0].HOW.method_table($obj);
381  
-        %meths{$name}
  437
+        my $i := 0;
  438
+        my $mro_length := +@!mro;
  439
+        while $i != $mro_length {
  440
+            my %meths := @!mro[$i].HOW.method_table($obj);
  441
+            my $found := %meths{$name};
  442
+            if $found.defined {
  443
+                return $found;
  444
+            }
  445
+            $i := $i + 1;
  446
+        }
  447
+        die("Could not find method " ~ $name);
  448
+    }
  449
+}
  450
+
  451
+# A simple attribute meta-object.
  452
+knowhow NQPAttribute {
  453
+    has $!name;
  454
+    method new(:$name) {
  455
+        my $obj := nqp::instance_of(self);
  456
+        $obj.BUILD(:name($name));
  457
+        $obj
  458
+    }
  459
+    method BUILD(:$name) {
  460
+        $!name := $name
  461
+    }
  462
+    method name() {
  463
+        $!name
382 464
     }
383 465
 }
384 466
 

0 notes on commit 3c4309f

Please sign in to comment.
Something went wrong with that request. Please try again.