Browse files

[cardinal]

* Track object model changes in rakudo


git-svn-id: https://svn.parrot.org/parrot/trunk/languages/cardinal@27828 d31e2699-5ff4-0310-a27c-f18f2fbe73fe
  • Loading branch information...
1 parent 707379e commit c27492ce4bc147bbace155ab29d649ccb4747588 @tene tene committed May 26, 2008
Showing with 27 additions and 355 deletions.
  1. +5 −1 cardinal.pir
  2. +4 −6 src/classes/Array.pir
  3. +4 −7 src/classes/Integer.pir
  4. +10 −337 src/classes/Object.pir
  5. +4 −4 src/classes/String.pir
View
6 cardinal.pir
@@ -24,6 +24,8 @@ object.
.namespace
+.include 'src/gen_builtins.pir'
+
.sub 'onload' :anon :load :init
$P0 = subclass 'ResizablePMCArray', 'List'
.end
@@ -39,6 +41,9 @@ object.
.sub 'onload' :anon :load :init
load_bytecode 'PCT.pbc'
+ .local pmc cardinalmeta
+ cardinalmeta = get_hll_global ['CardinalObject'], '!CARDINALMETA'
+ cardinalmeta.'new_class'('cardinal::Compiler', 'parent'=>'PCT::HLLCompiler')
$P0 = get_hll_global ['PCT'], 'HLLCompiler'
$P1 = $P0.'new'()
@@ -98,7 +103,6 @@ to the cardinal compiler.
.end
-.include 'src/gen_builtins.pir'
.include 'src/gen_grammar.pir'
.include 'src/gen_actions.pir'
View
10 src/classes/Array.pir
@@ -14,12 +14,10 @@ Stolen from Rakudo
.namespace ['CardinalArray']
.sub 'onload' :anon :load :init
- $P0 = subclass 'ResizablePMCArray', 'CardinalArray'
- #$P1 = get_hll_global 'Any'
- #$P1 = $P1.HOW()
- #addparent $P0, $P1
- $P1 = get_hll_global ['CardinalObject'], 'make_proto'
- $P1($P0, 'CardinalArray')
+ .local pmc cardinalmeta, arrayproto
+ cardinalmeta = get_hll_global ['CardinalObject'], '!CARDINALMETA'
+ arrayproto = cardinalmeta.'new_class'('CardinalArray', 'parent'=>'ResizablePMCArray CardinalObject')
+ cardinalmeta.'register'('ResizablePMCArray', 'parent'=>'CardinalObject', 'protoobject'=>arrayproto)
.end
View
11 src/classes/Integer.pir
@@ -18,13 +18,10 @@ CardinalInteger - Cardinal integers
=cut
.sub 'onload' :anon :init :load
- $P0 = subclass 'Integer', 'CardinalInteger'
- #$P1 = get_hll_global 'Any'
- #$P1 = $P1.HOW()
- #addparent $P0, $P1
- $P1 = get_hll_global ['CardinalObject'], 'make_proto'
- $P1($P0, 'CardinalInteger')
- $P1('Integer', 'CardinalInteger')
+ .local pmc cardinalmeta, intproto
+ cardinalmeta = get_hll_global ['CardinalObject'], '!CARDINALMETA'
+ intproto = cardinalmeta.'new_class'('CardinalInteger', 'parent'=>'Integer CardinalObject')
+ cardinalmeta.'register'('Float', 'parent'=>'Object', 'protoobject'=>intproto)
.end
View
347 src/classes/Object.pir
@@ -27,116 +27,12 @@ Perform initializations and create the base classes.
.namespace ['CardinalObject']
.sub 'onload' :anon :init :load
- ## create a new 'Object' base class. We can't call it 'Object'
- ## because Parrot has already taken that classname (RT#43419).
- .local pmc objectclass
- objectclass = newclass 'CardinalObject'
-
- ## need a place to store variable type, if we have one; this is
- ## needed per value because we have no container that exists
- ## between assignments
- addattribute objectclass, '%!properties'
-
- ## create a CardinalProtoobject class. We don't call it 'Protoobject'
- ## to avoid conflicts with the Protoobject class used by PCT and PGE.
- .local pmc protoclass
- protoclass = subclass objectclass, 'CardinalProtoobject'
- addattribute protoclass, 'shortname'
- addattribute protoclass, 'HOW'
-
- ## create the protoobject for the new class, initialize its
- ## shortname, and set up the symbol/type mappings.
- .local pmc protoobject
- protoobject = new protoclass
- $P1 = new 'String'
- $P1 = 'Object'
- setattribute protoobject, 'shortname', $P1
- setattribute protoobject, 'HOW', objectclass
- set_hll_global 'Object', protoobject
- set_hll_global 'CardinalObject', protoobject
-.end
-
-
-=item make_proto(class [, 'name'=>name] )
-
-Create protoobjects and mappings for C<class>, using C<name>
-as the Cardinal name for the class. The C<class> argument can
-be a Parrot Class object, or anything that will obtain a
-Parrot class via the C<get_class> opcode.
-
-=cut
-
-.sub 'make_proto'
- .param pmc class
- .param string name :optional :named('name')
- .param int has_name :opt_flag
-
- ## get the Parrot class object if we don't already have it
- $I0 = isa class, 'Class'
- if $I0 goto have_class
- class = get_class class
- have_class:
-
- ## if the class is already a CardinalObject, we have methods already.
- ## if it's a PMCProxy, we have to add methods to the namespace.
- ## otherwise, we just add CardinalObject as a parent class
- $I0 = isa class, 'CardinalObject'
- if $I0 goto object_methods_done
- $I0 = isa class, 'PMCProxy'
- if $I0 goto object_methods_proxy
- $P0 = get_class 'CardinalObject'
- class.'add_parent'($P0)
- goto object_methods_done
- object_methods_proxy:
- ## for PMCProxy classes, we have to add CardinalObject's methods
- ## directly as subs into the class' namespace.
- ## get the class' namespace object
- .local pmc ns
- ns = class.'get_namespace'()
- ## iterate over CardinalObject's methods, adding them to the namespace
- .local pmc methods, iter
- $P0 = get_class 'CardinalObject'
- methods = $P0.'methods'()
- iter = new 'Iterator', methods
- iter_loop:
- unless iter goto iter_end
- $S0 = shift iter
- ## if the class/namespace already has the named sub, skip it
- $P0 = ns.find_sub($S0)
- unless null $P0 goto iter_loop
- $P0 = methods[$S0]
- ns.add_sub($S0, $P0)
- goto iter_loop
- iter_end:
- object_methods_done:
-
- ## get the associated namespace and shortname
- .local pmc shortname
- ns = split '::', name
- shortname = pop ns
-
- ## create a new class for the protoobject
- .local pmc protoclass, protoobject
- protoclass = new 'Class'
- $P0 = get_class 'CardinalProtoobject'
- protoclass.'add_parent'($P0)
- protoclass.'add_parent'(class)
-
- ## set up the protoobject and its attributes
- protoobject = new protoclass
- setattribute protoobject, 'shortname', shortname
- setattribute protoobject, 'HOW', class
-
- ## register the protoobject under its Parrot name and
- ## its Cardinal name.
- .local pmc sample
- sample = new class
- $S0 = typeof sample
- set_hll_global $S0, protoobject
- $S0 = shortname
- set_hll_global ns, $S0, protoobject
-
- .return (protoobject)
+ .local pmc cardinalmeta
+ load_bytecode 'P6object.pbc'
+ $P0 = get_hll_global 'P6metaclass'
+ $P0.'new_class'('CardinalObject', 'attr'=>'%!properties')
+ cardinalmeta = $P0.'HOW'()
+ set_hll_global ['CardinalObject'], '!CARDINALMETA', cardinalmeta
.end
@@ -239,7 +135,9 @@ Create a new object having the same class as the invocant.
.param pmc init_this :named :slurpy
# Instantiate.
- $P0 = self.'HOW'()
+ .local pmc cardinalmeta
+ cardinalmeta = get_hll_global ['CardinalObject'], '!CARDINALMETA'
+ $P0 = cardinalmeta.get_parrotclass(self)
$P1 = new $P0
# If this proto object has a WHENCE auto-vivification, we should use
@@ -284,7 +182,7 @@ Create a new object having the same class as the invocant.
cur_ip = shift ip_iter
# We will check if their HOW matches.
- $P2 = cur_ip.'HOW'()
+ $P2 = cardinalmeta.'get_parrotclass'(cur_ip)
eq_addr cur_class, $P2, found_parent_init
goto found_init_attribs
@@ -343,46 +241,6 @@ set_attrib_eh:
.return ($P1)
.end
-
-=item isa($class)
-
-Returns true if the invocant is of type $class.
-
-=cut
-
-.sub 'isa' :method
- .param string x
- $S0 = self.'WHAT'()
- $I0 = iseq $S0, x
- .return ($I0)
-.end
-
-
-=item WHAT()
-
-Return the invocant's protoobject.
-
-=cut
-
-.sub 'WHAT' :method
- $S0 = typeof self
- $P0 = get_hll_global $S0
- .return ($P0)
-.end
-
-=item HOW()
-
-Return the invocant's metaclass object (in Parrot, this is the
-class object for the invocant).
-
-=cut
-
-.sub 'HOW' :method
- $P0 = self.'WHAT'()
- $P1 = $P0.'HOW'()
- .return ($P1)
-.end
-
=item WHENCE()
Return the invocant's auto-vivification closure.
@@ -438,191 +296,6 @@ Print the object
.return $P0(self)
.end
-=item clone (vtable method)
-
-Actually just returns the object itself. This is used to get us working with
-the copy opcode, which clones things on assignment. However, objects by
-default have reference semantics, not value semantics. Those with value
-semantics override this.
-
-=cut
-
-.sub 'clone' :method :vtable
- .return(self)
-.end
-
-=back
-
-=head2 Protoobject methods
-
-Protoobjects are described in Synopsis 12, these are objects
-that are "empty" instances that differ in definedness and how
-they respond to certain methods.
-
-=over
-
-=item get_string() (vtable method)
-
-Returns the short name of the class (prototype objects stringify
-to the short name).
-
-=cut
-
-.namespace ['CardinalProtoobject']
-
-.sub 'get_string' :vtable :method
- $P0 = getattribute self, 'shortname'
- $S0 = $P0
- .return ($S0)
-.end
-
-=item defined() (vtable method)
-
-Returns false (prototype objects evaluate as undef).
-
-=cut
-
-.sub 'defined' :vtable :method
- .return (0)
-.end
-
-=item HOW()
-
-Returns the metaclass (Parrot class) of the protoobject.
-
-=cut
-
-.sub 'HOW' :method
- $P0 = getattribute self, 'HOW'
- .return ($P0)
-.end
-
-=item WHAT()
-
-Returns the invocant's protoobject, which in the case of a protoobject
-is just itself.
-
-=cut
-
-.sub 'WHAT' :method
- .return (self)
-.end
-
-=item WHENCE()
-
-Returns the invocant's autovivification closure.
-
-=cut
-
-.sub 'WHENCE' :method
- .local pmc props, whence
- props = getattribute self, '%!properties'
- if null props goto ret_undef
- whence = props['WHENCE']
- if null whence goto ret_undef
- .return (whence)
- ret_undef:
- whence = new 'Undef'
- .return (whence)
-.end
-
-=item ACCEPTS(topic)
-
-=cut
-
-.sub 'ACCEPTS' :method
- .param pmc topic
- .local pmc HOW
-
- # Do a does check against the topic.
- HOW = self.'HOW'()
- $I0 = does topic, HOW
- if $I0 goto do_return
-
- # If that didn't work, try invoking the ACCEPTS of the class itself.
- # XXX Once we get callsame-like stuff implemented, this logic should go away.
- try_class_accepts:
- .local pmc parents, found
- .local int i, count
- parents = inspect HOW, 'all_parents'
- count = elements parents
- i = 1 # skip protoclass
- find_next_loop:
- if i >= count goto find_next_loop_end
- $P0 = parents[i]
- $P0 = inspect $P0, 'methods'
- found = $P0['ACCEPTS']
- unless null found goto find_next_loop_end
- inc i
- goto find_next_loop
- find_next_loop_end:
-
- $I0 = 0
- if null found goto do_return
- $I0 = found(self, topic)
- do_return:
- .return 'prefix:?'($I0)
-.end
-
-=item get_pmc_keyed(key) (vtable method)
-
-Returns a proto-object with an autovivification closure attached to it.
-
-=cut
-
-.sub get_pmc_keyed :vtable :method
- .param pmc what
-
- # We'll build auto-vivification hash of values.
- .local pmc WHENCE, key, val
- WHENCE = new 'Hash'
-
- # What is it?
- $S0 = what.'WHAT'()
- if $S0 == 'Pair' goto from_pair
- if $S0 == 'CardinalArray' goto from_list
- 'die'("Auto-vivification closure did not contain a Pair")
-
- from_pair:
- # Just a pair.
- key = what.'key'()
- val = what.'value'()
- WHENCE[key] = val
- goto done_whence
-
- from_list:
- # CardinalArray.
- .local pmc list_iter, cur_pair
- list_iter = new 'Iterator', what
- list_iter_loop:
- unless list_iter goto done_whence
- cur_pair = shift list_iter
- key = cur_pair.'key'()
- val = cur_pair.'value'()
- WHENCE[key] = val
- goto list_iter_loop
- done_whence:
-
- # Now create a clone of the protoobject.
- .local pmc protoclass, res, props, tmp
- protoclass = class self
- res = new protoclass
- tmp = getattribute self, 'HOW'
- setattribute res, 'HOW', tmp
- tmp = getattribute self, 'shortname'
- setattribute res, 'shortname', tmp
-
- # Attach the WHENCE property.
- props = getattribute self, '%!properties'
- unless null props goto have_props
- props = new 'Hash'
- have_props:
- props['WHENCE'] = WHENCE
- setattribute res, '%!properties', props
-
- .return (res)
-.end
-
=back
=cut
View
8 src/classes/String.pir
@@ -21,10 +21,10 @@ Stolen from Rakudo
.include 'cclass.pasm'
.sub 'onload' :anon :init :load
- $P0 = subclass 'String', 'CardinalString'
- $P1 = get_hll_global ['CardinalObject'], 'make_proto'
- $P1('String', 'CardinalString')
- #$P1('CardinalString', 'Str')
+ .local pmc cardinalmeta, strproto
+ cardinalmeta = get_hll_global ['CardinalObject'], '!CARDINALMETA'
+ strproto = cardinalmeta.'new_class'('CardinalString', 'parent'=>'String CardinalObject')
+ cardinalmeta.'register'('CardinalString', 'parent'=>'CardinalObject', 'protoobject'=>strproto)
.end

0 comments on commit c27492c

Please sign in to comment.