Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

[cardinal]

* Start of a class hierarchy
* Completely stolen from Rakudo


git-svn-id: https://svn.parrot.org/parrot/trunk/languages/cardinal@27506 d31e2699-5ff4-0310-a27c-f18f2fbe73fe
  • Loading branch information...
commit b8e8ee869414ce9b25e849cb68c30897d812a4b6 1 parent 9ebe999
@tene tene authored
View
3  cardinal.pir
@@ -55,6 +55,9 @@ object.
$P0 = new 'List'
set_hll_global ['cardinal';'Grammar';'Actions'], '@?BLOCK', $P0
+
+ $P1 = get_hll_global ['PAST::Compiler'], '%valflags'
+ $P1['CardinalString'] = 'e'
.end
=item main(args :slurpy) :main
View
4 config/makefiles/root.in
@@ -40,6 +40,10 @@ SOURCES = cardinal.pir \
BUILTINS_PIR = \
src/builtins/say.pir \
src/builtins/cmp.pir \
+ src/classes/Object.pir \
+ src/classes/String.pir \
+ src/classes/Integer.pir \
+ src/classes/Array.pir \
# PMCS = cardinal
# PMC_SOURCES = $(PMC_DIR)/cardinal.pmc
View
937 src/classes/Array.pir
@@ -0,0 +1,937 @@
+## $Id$
+
+=head1 NAME
+
+src/classes/CardinalArray.pir - Cardinal CardinalArray class and related functions
+Stolen from Rakudo
+
+=head1 Methods
+
+=over 4
+
+=cut
+
+.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')
+.end
+
+
+=item get_string() (vtable method)
+
+Return the elements of the list joined by spaces.
+
+=cut
+
+.sub 'get_string' :vtable :method
+ $S0 = join ' ', self
+ .return ($S0)
+.end
+
+
+=item clone() (vtable method)
+
+Clones the list.
+
+=cut
+
+.sub 'clone' :vtable :method
+ $P0 = 'list'(self)
+ .return ($P0)
+.end
+
+
+=item ACCEPTS(topic)
+
+=cut
+
+.sub 'ACCEPTS' :method
+ .param pmc topic
+ .local int i
+
+ .local string what
+ what = topic.'WHAT'()
+ if what == "CardinalArray" goto acc_list
+ goto no_match
+
+acc_list:
+ # Smartmatch against another list. Smartmatch each
+ # element.
+ .local int count_1, count_2
+ count_1 = elements self
+ count_2 = elements topic
+ if count_1 != count_2 goto no_match
+ i = 0
+list_cmp_loop:
+ if i >= count_1 goto list_cmp_loop_end
+ .local pmc elem_1, elem_2
+ elem_1 = self[i]
+ elem_2 = topic[i]
+ ($I0) = elem_1.ACCEPTS(elem_2)
+ unless $I0 goto no_match
+ inc i
+ goto list_cmp_loop
+list_cmp_loop_end:
+ goto match
+
+no_match:
+ $P0 = get_hll_global ['Bool'], 'False'
+ .return($P0)
+match:
+ $P0 = get_hll_global ['Bool'], 'True'
+ .return($P0)
+.end
+
+
+=item elems()
+
+Return the number of elements in the list.
+
+=cut
+
+.sub 'elems' :method
+ $I0 = elements self
+ .return ($I0)
+.end
+
+=item unshift(ELEMENTS)
+
+Prepends ELEMENTS to the front of the list.
+
+=cut
+
+.sub 'unshift' :method
+ .param pmc args :slurpy
+ .local int narg
+ .local int i
+
+ narg = args
+ i = 0
+
+ .local pmc tmp
+ loop:
+ if i == narg goto done
+ pop tmp, args
+ unshift self, tmp
+ inc i
+ goto loop
+ done:
+.end
+
+=item keys()
+
+Returns a CardinalArray containing the keys of the CardinalArray.
+
+=cut
+
+.sub 'keys' :method
+ .local pmc elem
+ .local pmc res
+ .local int len
+ .local int i
+
+ res = new 'CardinalArray'
+ len = elements self
+ i = 0
+
+ loop:
+ if i == len goto done
+
+ elem = new 'CardinalInteger'
+ elem = i
+ res.'push'(elem)
+
+ inc i
+ goto loop
+
+ done:
+ .return(res)
+.end
+
+=item values()
+
+Returns a CardinalArray containing the values of the CardinalArray.
+
+=cut
+
+.sub 'values' :method
+ .local pmc elem
+ .local pmc res
+ .local int len
+ .local int i
+
+ res = new 'CardinalArray'
+ len = elements self
+ i = 0
+
+ loop:
+ if i == len goto done
+
+ elem = new 'CardinalInteger'
+ elem = self[i]
+ res.'push'(elem)
+
+ inc i
+ goto loop
+
+ done:
+ .return(res)
+.end
+
+=item shift()
+
+Shifts the first item off the list and returns it.
+
+=cut
+
+.sub 'shift' :method
+ .local pmc x
+ x = shift self
+ .return (x)
+.end
+
+=item pop()
+
+Treats the list as a stack, popping the last item off the list and returning it.
+
+=cut
+
+.sub 'pop' :method
+ .local pmc x
+ .local int len
+
+ len = elements self
+
+ if len == 0 goto empty
+ pop x, self
+ goto done
+
+ empty:
+ x = undef()
+ goto done
+
+ done:
+ .return (x)
+.end
+
+=item push(ELEMENTS)
+
+Treats the list as a stack, pushing ELEMENTS onto the end of the list. Returns the new length of the list.
+
+=cut
+
+.sub 'push' :method
+ .param pmc args :slurpy
+ .local int len
+ .local pmc tmp
+ .local int i
+
+ len = args
+ i = 0
+
+ loop:
+ if i == len goto done
+ shift tmp, args
+ push self, tmp
+ inc i
+ goto loop
+ done:
+ len = elements self
+ .return (len)
+.end
+
+=item join(SEPARATOR)
+
+Returns a string comprised of all of the list, separated by the string SEPARATOR. Given an empty list, join returns the empty string.
+
+=cut
+
+.sub 'join' :method
+ .param string sep
+ .local string res
+ .local string tmp
+ .local int len
+ .local int i
+
+ res = ""
+
+ len = elements self
+ if len == 0 goto done
+
+ len = len - 1
+ i = 0
+
+ loop:
+ if i == len goto last
+
+ tmp = self[i]
+ concat res, tmp
+ concat res, sep
+
+ inc i
+ goto loop
+
+ last:
+ tmp = self[i]
+ concat res, tmp
+
+ done:
+ .return(res)
+.end
+
+=item reverse()
+
+Returns a list of the elements in revese order.
+
+=cut
+
+.sub 'reverse' :method
+ .local pmc res
+ .local int len
+ .local int i
+
+ res = new 'CardinalArray'
+
+ len = elements self
+ if len == 0 goto done
+ i = 0
+
+ .local pmc elem
+loop:
+ if len == 0 goto done
+
+ dec len
+ elem = self[len]
+ res[i] = elem
+ inc i
+
+ goto loop
+
+done:
+ .return(res)
+.end
+
+=item delete()
+
+Deletes the given elements from the CardinalArray, replacing them with Undef. Returns a CardinalArray of removed elements.
+
+=cut
+
+.sub delete :method
+ .param pmc indices :slurpy
+ .local pmc newelem
+ .local pmc elem
+ .local int last
+ .local pmc res
+ .local int ind
+ .local int len
+ .local int i
+
+ newelem = undef()
+ res = new 'CardinalArray'
+
+ # Index of the last element in the array
+ last = elements self
+ dec last
+
+ len = elements indices
+ i = 0
+
+ loop:
+ if i == len goto done
+
+ ind = indices[i]
+
+ if ind == -1 goto endofarray
+ if ind == last goto endofarray
+ goto restofarray
+
+ endofarray:
+ # If we're at the end of the array, remove the element entirely
+ elem = pop self
+ res.push(elem)
+ goto next
+
+ restofarray:
+ # Replace the element with undef.
+ elem = self[ind]
+ res.push(elem)
+
+ self[ind] = newelem
+
+ next:
+ inc i
+ goto loop
+ done:
+ .return(res)
+.end
+
+=item exists(INDEX)
+
+Checks to see if the specified index or indices have been assigned to. Returns a Bool value.
+
+=cut
+
+.sub exists :method
+ .param pmc indices :slurpy
+ .local int test
+ .local int len
+ .local pmc res
+ .local int ind
+ .local int i
+
+ test = 1
+ len = elements indices
+ i = 0
+
+ loop:
+ if i == len goto done
+
+ ind = indices[i]
+
+ test = exists self[ind]
+ if test == 0 goto done
+
+ inc i
+ goto loop
+
+ done:
+ .return 'prefix:?'(test)
+.end
+
+=item kv()
+
+=cut
+
+.sub kv :method
+ .local pmc elem
+ .local pmc res
+ .local int len
+ .local int i
+
+ res = new 'CardinalArray'
+ len = elements self
+ i = 0
+
+ loop:
+ if i == len goto done
+
+ elem = new 'CardinalInteger'
+ elem = i
+ res.'push'(elem)
+
+ elem = self[i]
+ res.'push'(elem)
+
+ inc i
+ goto loop
+
+ done:
+ .return(res)
+.end
+
+=item pairs()
+
+=cut
+
+.sub pairs :method
+ .local pmc pair
+ .local pmc key
+ .local pmc val
+ .local pmc res
+ .local int len
+ .local int i
+
+ res = new 'CardinalArray'
+ len = elements self
+ i = 0
+
+ loop:
+ if i == len goto done
+
+ key = new 'CardinalInteger'
+ key = i
+
+ val = self[i]
+
+ pair = new 'Pair'
+ pair[key] = val
+
+ res.'push'(pair)
+
+ inc i
+ goto loop
+
+ done:
+ .return(res)
+.end
+
+=item grep(...)
+
+=cut
+
+.sub grep :method
+ .param pmc test
+ .local pmc retv
+ .local pmc block
+ .local pmc block_res
+ .local pmc block_arg
+ .local int narg
+ .local int i
+
+ retv = new 'CardinalArray'
+ narg = elements self
+ i = 0
+
+ loop:
+ if i == narg goto done
+ block_arg = self[i]
+
+ newclosure block, test
+ block_res = block(block_arg)
+
+ if block_res goto grepped
+ goto next
+
+ grepped:
+ retv.'push'(block_arg)
+ goto next
+
+ next:
+ inc i
+ goto loop
+
+ done:
+ .return(retv)
+.end
+
+=item first(...)
+
+=cut
+
+.sub first :method
+ .param pmc test
+ .local pmc retv
+ .local pmc block
+ .local pmc block_res
+ .local pmc block_arg
+ .local int narg
+ .local int i
+
+ narg = elements self
+ i = 0
+
+ loop:
+ if i == narg goto nomatch
+ block_arg = self[i]
+
+ newclosure block, test
+ block_res = block(block_arg)
+
+ if block_res goto matched
+
+ inc i
+ goto loop
+
+ matched:
+ retv = block_arg
+ goto done
+
+ nomatch:
+ retv = new 'Undef'
+ goto done
+
+ done:
+ .return(retv)
+.end
+
+=back
+
+=head1 Functions
+
+=over 4
+
+=item C<list(...)>
+
+Build a CardinalArray from its arguments.
+
+=cut
+
+.namespace
+
+.sub 'list'
+ .param pmc args :slurpy
+ .local pmc list, item
+ list = new 'CardinalArray'
+ args_loop:
+ unless args goto args_end
+ item = shift args
+ $I0 = defined item
+ unless $I0 goto add_item
+ # $I0 = isa item, 'CardinalArray'
+ # if $I0 goto add_item
+ $I0 = does item, 'array'
+ unless $I0 goto add_item
+ splice args, item, 0, 0
+ goto args_loop
+ add_item:
+ push list, item
+ goto args_loop
+ args_end:
+ .return (list)
+.end
+
+
+=item C<infix:,(...)>
+
+Operator form for building a list from its arguments.
+
+=cut
+
+.sub 'infix:,'
+ .param pmc args :slurpy
+ .return 'list'(args :flat)
+.end
+
+
+=item C<infix:Z(...)>
+
+The zip operator.
+
+=cut
+
+.sub 'infix:Z'
+ .param pmc args :slurpy
+ .local int num_args
+ num_args = elements args
+
+ # Empty list of no arguments.
+ if num_args > 0 goto has_args
+ $P0 = new 'CardinalArray'
+ .return($P0)
+has_args:
+
+ # Get minimum element count - what we'll zip to.
+ .local int min_elem
+ .local int i
+ i = 0
+ $P0 = args[0]
+ min_elem = elements $P0
+min_elems_loop:
+ if i >= num_args goto min_elems_loop_end
+ $P0 = args[i]
+ $I0 = elements $P0
+ unless $I0 < min_elem goto not_min
+ min_elem = $I0
+not_min:
+ inc i
+ goto min_elems_loop
+min_elems_loop_end:
+
+ # Now build result list of lists.
+ .local pmc res
+ res = new 'CardinalArray'
+ i = 0
+zip_loop:
+ if i >= min_elem goto zip_loop_end
+ .local pmc cur_list
+ cur_list = new 'CardinalArray'
+ .local int j
+ j = 0
+zip_elem_loop:
+ if j >= num_args goto zip_elem_loop_end
+ $P0 = args[j]
+ $P0 = $P0[i]
+ cur_list[j] = $P0
+ inc j
+ goto zip_elem_loop
+zip_elem_loop_end:
+ res[i] = cur_list
+ inc i
+ goto zip_loop
+zip_loop_end:
+
+ .return(res)
+.end
+
+
+=item C<infix:X(...)>
+
+The non-hyper cross operator.
+
+=cut
+
+.sub 'infix:X'
+ .param pmc args :slurpy
+ .local pmc res
+ res = new 'CardinalArray'
+
+ # Algorithm: we'll maintain a list of counters for each list, incrementing
+ # the counter for the right-most list and, when it we reach its final
+ # element, roll over the counter to the next list to the left as we go.
+ .local pmc counters
+ .local pmc list_elements
+ .local int num_args
+ counters = new 'FixedIntegerCardinalArray'
+ list_elements = new 'FixedIntegerCardinalArray'
+ num_args = elements args
+ counters = num_args
+ list_elements = num_args
+
+ # Get element count for each list.
+ .local int i
+ .local pmc cur_list
+ i = 0
+elem_get_loop:
+ if i >= num_args goto elem_get_loop_end
+ cur_list = args[i]
+ $I0 = elements cur_list
+ list_elements[i] = $I0
+ inc i
+ goto elem_get_loop
+elem_get_loop_end:
+
+ # Now we'll start to produce them.
+ .local int res_count
+ res_count = 0
+produce_next:
+
+ # Start out by building list at current counters.
+ .local pmc new_list
+ new_list = new 'CardinalArray'
+ i = 0
+cur_perm_loop:
+ if i >= num_args goto cur_perm_loop_end
+ $I0 = counters[i]
+ $P0 = args[i]
+ $P1 = $P0[$I0]
+ new_list[i] = $P1
+ inc i
+ goto cur_perm_loop
+cur_perm_loop_end:
+ res[res_count] = new_list
+ inc res_count
+
+ # Now increment counters.
+ i = num_args - 1
+inc_counter_loop:
+ $I0 = counters[i]
+ $I1 = list_elements[i]
+ inc $I0
+ counters[i] = $I0
+
+ # In simple case, we just increment this and we're done.
+ if $I0 < $I1 goto inc_counter_loop_end
+
+ # Otherwise we have to carry.
+ counters[i] = 0
+
+ # If we're on the first element, all done.
+ if i == 0 goto all_done
+
+ # Otherwise, loop.
+ dec i
+ goto inc_counter_loop
+inc_counter_loop_end:
+ goto produce_next
+
+all_done:
+ .return(res)
+.end
+
+
+=item C<infix:min(...)>
+
+The min operator.
+
+=cut
+
+.sub 'infix:min'
+ .param pmc args :slurpy
+
+ # If we have no arguments, undefined.
+ .local int elems
+ elems = elements args
+ if elems > 0 goto have_args
+ $P0 = undef()
+ .return($P0)
+have_args:
+
+ # Find minimum.
+ .local pmc cur_min
+ .local int i
+ cur_min = args[0]
+ i = 1
+find_min_loop:
+ if i >= elems goto find_min_loop_end
+ $P0 = args[i]
+ $I0 = 'infix:cmp'($P0, cur_min)
+ if $I0 != -1 goto not_min
+ set cur_min, $P0
+not_min:
+ inc i
+ goto find_min_loop
+find_min_loop_end:
+
+ .return(cur_min)
+.end
+
+
+=item C<infix:max(...)>
+
+The max operator.
+
+=cut
+
+.sub 'infix:max'
+ .param pmc args :slurpy
+
+ # If we have no arguments, undefined.
+ .local int elems
+ elems = elements args
+ if elems > 0 goto have_args
+ $P0 = undef()
+ .return($P0)
+have_args:
+
+ # Find maximum.
+ .local pmc cur_max
+ .local int i
+ cur_max = args[0]
+ i = 1
+find_max_loop:
+ if i >= elems goto find_max_loop_end
+ $P0 = args[i]
+ $I0 = 'infix:cmp'($P0, cur_max)
+ if $I0 != 1 goto not_max
+ set cur_max, $P0
+not_max:
+ inc i
+ goto find_max_loop
+find_max_loop_end:
+
+ .return(cur_max)
+.end
+
+=item C<reverse(LIST)>
+
+Returns the elements of LIST in the opposite order.
+
+=cut
+
+.sub 'reverse'
+ .param pmc list :slurpy
+ .local string type
+ .local pmc retv
+ .local pmc elem
+ .local int len
+ .local int i
+
+ len = elements list
+
+ if len > 1 goto islist
+
+ # If we're not a list, check if we're a string.
+ elem = list[0]
+ typeof type, elem
+
+ # This is a bit of a work around - some operators (ie. ~) return
+ # a String object instead of a CardinalString.
+ eq type, 'String', parrotstring
+ eq type, 'CardinalString', perl6string
+ goto islist
+
+ parrotstring:
+ .local string tmps
+ tmps = elem
+ elem = new 'CardinalString'
+ elem = tmps
+
+ perl6string:
+ retv = elem.'reverse'()
+ goto done
+
+ islist:
+ retv = new 'CardinalArray'
+ i = 0
+
+ loop:
+ if i == len goto done
+ elem = list[i]
+ retv.'unshift'(elem)
+ inc i
+ goto loop
+
+ done:
+ .return(retv)
+.end
+
+.sub keys :multi('CardinalArray')
+ .param pmc list
+
+ .return list.'keys'()
+.end
+
+.sub values :multi('CardinalArray')
+ .param pmc list
+
+ .return list.'values'()
+.end
+
+.sub delete :multi('CardinalArray')
+ .param pmc list
+ .param pmc indices :slurpy
+
+ .return list.'delete'(indices :flat)
+.end
+
+.sub exists :multi('CardinalArray')
+ .param pmc list
+ .param pmc indices :slurpy
+
+ .return list.'exists'(indices :flat)
+.end
+
+.sub kv :multi('CardinalArray')
+ .param pmc list
+
+ .return list.'kv'()
+.end
+
+.sub pairs :multi('CardinalArray')
+ .param pmc list
+
+ .return list.'pairs'()
+.end
+
+.sub grep :multi(_,'CardinalArray')
+ .param pmc test
+ .param pmc list :slurpy
+
+ .return list.'grep'(test)
+.end
+
+.sub first :multi(_,'CardinalArray')
+ .param pmc test
+ .param pmc list :slurpy
+
+ .return list.'first'(test)
+.end
+
+## TODO: join map reduce sort zip
+
+=back
+
+=cut
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
View
74 src/classes/Integer.pir
@@ -0,0 +1,74 @@
+## $Id$
+
+=head1 TITLE
+
+CardinalInteger - Cardinal integers
+
+=cut
+
+.namespace [ 'CardinalInteger' ]
+
+
+=head1 SUBROUTINES
+
+=over 4
+
+=item onload
+
+=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')
+.end
+
+
+=item ACCEPTS()
+
+=cut
+
+.sub 'ACCEPTS' :method
+ .param num topic
+ .return 'infix:=='(topic, self)
+.end
+
+
+=item clone()
+
+=cut
+
+.sub 'clone' :method :vtable
+ .local pmc clone_type
+ clone_type = self.HOW()
+ $P0 = clone_type.'new'()
+ $P0 = self
+ .return($P0)
+.end
+
+
+=item perl()
+
+Returns a Perl representation of the CardinalInteger.
+
+=cut
+
+.sub 'perl' :method
+ $S0 = self
+ .return($S0)
+.end
+
+
+=back
+
+=cut
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
View
634 src/classes/Object.pir
@@ -0,0 +1,634 @@
+## $Id$
+
+=head1 TITLE
+
+Object - Cardinal Object class
+
+=head1 DESCRIPTION
+
+This file sets up the base classes and methods for Cardinal's
+object system. Differences (and conflicts) between Parrot's
+object model and the Cardinal model means we have to do a little
+name and method trickery here and there, and this file takes
+care of much of that.
+
+Still heavily based off of Perl 6's.
+
+=head2 Functions
+
+=over
+
+=item onload()
+
+Perform initializations and create the base classes.
+
+=cut
+
+.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)
+.end
+
+
+=item !keyword_class(name)
+
+Internal helper method to create a class.
+
+=cut
+
+.sub '!keyword_class' :method
+ .param string name
+ .local pmc class, resolve_list, methods, iter
+
+ # Create class.
+ class = newclass name
+
+ # Set resolve list to include all methods of the class.
+ methods = inspect class, 'methods'
+ iter = new 'Iterator', methods
+ resolve_list = new 'ResizableStringCardinalArray'
+resolve_loop:
+ unless iter goto resolve_loop_end
+ $P0 = shift iter
+ push resolve_list, $P0
+ goto resolve_loop
+resolve_loop_end:
+ class.resolve_method(resolve_list)
+
+ .return(class)
+.end
+
+=item !keyword_role(name)
+
+Internal helper method to create a role.
+
+=cut
+
+.sub '!keyword_role' :method
+ .param string name
+ .local pmc info, role
+
+ # Need to make sure it ends up attached to the right
+ # namespace.
+ info = new 'Hash'
+ info['name'] = name
+ $P0 = new 'ResizablePMCCardinalArray'
+ $P0[0] = name
+ info['namespace'] = $P0
+
+ # Create role.
+ role = new 'Role', info
+
+ # Stash in namespace.
+ $P0 = new 'ResizableStringCardinalArray'
+ set_hll_global $P0, name, role
+
+ .return(role)
+.end
+
+=item !keyword_does(class, role_name)
+
+Internal helper method to implement the functionality of the does keyword.
+
+=cut
+
+.sub '!keyword_does' :method
+ .param pmc class
+ .param string role_name
+ .local pmc role
+ role = get_hll_global role_name
+ addrole class, role
+.end
+
+=item !keyword_has(class, attr_name)
+
+Adds an attribute with the given name to the class.
+
+=cut
+
+.sub '!keyword_has' :method
+ .param pmc class
+ .param string attr_name
+ addattribute class, attr_name
+.end
+
+=back
+
+=head2 Object methods
+
+=over
+
+=item new()
+
+Create a new object having the same class as the invocant.
+
+=cut
+
+.sub 'new' :method
+ .param pmc init_parents :slurpy
+ .param pmc init_this :named :slurpy
+
+ # Instantiate.
+ $P0 = self.'HOW'()
+ $P1 = new $P0
+
+ # If this proto object has a WHENCE auto-vivification, we should use
+ # put any values it contains but that init_this does not into init_this.
+ .local pmc whence
+ whence = self.'WHENCE'()
+ unless whence goto no_whence
+ .local pmc this_whence_iter
+ this_whence_iter = new 'Iterator', whence
+ this_whence_iter_loop:
+ unless this_whence_iter goto no_whence
+ $S0 = shift this_whence_iter
+ $I0 = exists init_this[$S0]
+ if $I0 goto this_whence_iter_loop
+ $P2 = whence[$S0]
+ init_this[$S0] = $P2
+ goto this_whence_iter_loop
+ no_whence:
+
+ # Now we will initialize each attribute in the class itself and it's
+ # parents with an Undef or the specified initialization value. Note that
+ # the all_parents list includes ourself.
+ .local pmc all_parents, class_iter
+ all_parents = inspect $P0, "all_parents"
+ class_iter = new 'Iterator', all_parents
+ class_iter_loop:
+ unless class_iter goto class_iter_loop_end
+ .local pmc cur_class
+ cur_class = shift class_iter
+
+ # If this the current class?
+ .local pmc init_attribs
+ eq_addr cur_class, $P0, current_class
+
+ # If it's not the current class, need to see if we have any attributes.
+ # Go through the provided init_parents to see if we have anything that
+ # matches.
+ .local pmc ip_iter, cur_ip
+ ip_iter = new 'Iterator', init_parents
+ ip_iter_loop:
+ unless ip_iter goto ip_iter_loop_end
+ cur_ip = shift ip_iter
+
+ # We will check if their HOW matches.
+ $P2 = cur_ip.'HOW'()
+ eq_addr cur_class, $P2, found_parent_init
+
+ goto found_init_attribs
+ ip_iter_loop_end:
+
+ # If we get here, found nothing.
+ init_attribs = new 'Hash'
+ goto parent_init_search_done
+
+ # We found some parent init data, potentially.
+ found_parent_init:
+ init_attribs = cur_ip.WHENCE()
+ $I0 = 'defined'(init_attribs)
+ if $I0 goto parent_init_search_done
+ init_attribs = new 'Hash'
+ parent_init_search_done:
+ goto found_init_attribs
+
+ # If it's the current class, we will take the init_this hash.
+ current_class:
+ init_attribs = init_this
+ found_init_attribs:
+
+ # Now go through attributes of the current class and iternate over them.
+ .local pmc attribs, iter
+ attribs = inspect cur_class, "attributes"
+ iter = new 'Iterator', attribs
+ iter_loop:
+ unless iter goto iter_end
+ $S0 = shift iter
+ $S1 = substr $S0, 2
+ $I0 = exists init_attribs[$S1]
+ if $I0 goto have_init_value
+ $P2 = new 'Undef'
+ goto init_done
+ have_init_value:
+ $P2 = init_attribs[$S1]
+ delete init_attribs[$S1]
+ init_done:
+ push_eh set_attrib_eh
+ setattribute $P1, cur_class, $S0, $P2
+set_attrib_eh:
+ goto iter_loop
+ iter_end:
+
+ # Do we have anything left in the hash? If so, unknown.
+ $I0 = elements init_attribs
+ if $I0 == 0 goto init_attribs_ok
+ 'die'("You passed an initialization parameter that does not have a matching attribute.")
+ init_attribs_ok:
+
+ # Next class.
+ goto class_iter_loop
+ class_iter_loop_end:
+
+ .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.
+
+=cut
+
+.sub 'WHENCE' :method
+ $P0 = self.'WHAT'()
+ $P1 = $P0.'WHENCE'()
+ .return ($P1)
+.end
+
+=item REJECTS(topic)
+
+Define REJECTS methods for objects (this would normally
+be part of the Pattern role, but we put it here for now
+until we get roles).
+
+=cut
+
+.sub 'REJECTS' :method
+ .param pmc topic
+ $P0 = self.'ACCEPTS'(topic)
+ n_not $P0, $P0
+ .return ($P0)
+.end
+
+=item true()
+
+Defines the .true method on all objects via C<prefix:?>.
+
+=cut
+
+.sub 'true' :method
+ .return 'prefix:?'(self)
+.end
+
+=item print()
+
+=item say()
+
+Print the object
+
+=cut
+
+.sub 'print' :method
+ $P0 = get_hll_global 'print'
+ .return $P0(self)
+.end
+
+.sub 'puts' :method
+ $P0 = get_hll_global 'puts'
+ .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
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
View
520 src/classes/String.pir
@@ -0,0 +1,520 @@
+## $Id$
+
+=head1 TITLE
+
+CardinalString - Cardinal String class and related functions
+
+=head1 DESCRIPTION
+
+This file sets up the C<CardinalString> type.
+
+Stolen from Rakudo
+
+=head1 Methods
+
+=over 4
+
+=cut
+
+.namespace ['CardinalString']
+
+.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')
+.end
+
+
+.sub 'ACCEPTS' :method
+ .param string topic
+ .return 'infix:eq'(topic, self)
+.end
+
+.sub 'chars' :method
+ .local pmc retv
+
+ retv = new 'CardinalInteger'
+ $S0 = self
+ $I0 = length $S0
+ retv = $I0
+
+ .return (retv)
+.end
+
+.sub 'reverse' :method
+ .local pmc retv
+
+ retv = self.'split'('')
+ retv = retv.'reverse'()
+ retv = retv.join('')
+
+ .return(retv)
+.end
+
+.sub split :method :multi('CardinalString')
+ .param string delim
+ .local string objst
+ .local pmc pieces
+ .local pmc tmps
+ .local pmc retv
+ .local int len
+ .local int i
+
+ retv = new 'CardinalArray'
+
+ objst = self
+ split pieces, delim, objst
+
+ len = pieces
+ i = 0
+ loop:
+ if i == len goto done
+
+ tmps = new 'CardinalString'
+ tmps = pieces[i]
+
+ retv.'push'(tmps)
+
+ inc i
+ goto loop
+ done:
+ .return(retv)
+.end
+
+.sub lc :method
+ .local string tmps
+ .local pmc retv
+
+ tmps = self
+ downcase tmps
+
+ retv = new 'CardinalString'
+ retv = tmps
+
+ .return(retv)
+.end
+
+.sub uc :method
+ .local string tmps
+ .local pmc retv
+
+ tmps = self
+ upcase tmps
+
+ retv = new 'CardinalString'
+ retv = tmps
+
+ .return(retv)
+.end
+
+.sub lcfirst :method
+ .local string tmps
+ .local string fchr
+ .local pmc retv
+ .local int len
+
+ retv = new 'CardinalString'
+ tmps = self
+
+ len = length tmps
+ if len == 0 goto done
+
+ substr fchr, tmps, 0, 1
+ downcase fchr
+
+ concat retv, fchr
+ substr tmps, tmps, 1
+ concat retv, tmps
+
+ done:
+ .return(retv)
+.end
+
+.sub ucfirst :method
+ .local string tmps
+ .local string fchr
+ .local pmc retv
+ .local int len
+
+ retv = new 'CardinalString'
+ tmps = self
+
+ len = length tmps
+ if len == 0 goto done
+
+ substr fchr, tmps, 0, 1
+ upcase fchr
+
+ concat retv, fchr
+ substr tmps, tmps, 1
+ concat retv, tmps
+
+ done:
+ .return(retv)
+.end
+
+.sub capitalize :method
+ .local string tmps
+ .local string fchr
+ .local pmc retv
+ .local int len
+
+ retv = new 'CardinalString'
+ tmps = self
+
+ len = length tmps
+ if len == 0 goto done
+
+ downcase tmps
+
+ .local int pos, is_ws, is_lc
+ pos = 0
+ goto first_char
+ next_grapheme:
+ if pos == len goto done
+ is_ws = is_cclass .CCLASS_WHITESPACE, tmps, pos
+ if is_ws goto ws
+ advance:
+ pos += 1
+ goto next_grapheme
+ ws:
+ pos += 1
+ first_char:
+ is_lc = is_cclass .CCLASS_LOWERCASE, tmps, pos
+ unless is_lc goto advance
+ $S1 = substr tmps, pos, 1
+ upcase $S1
+ substr tmps, pos, 1, $S1
+ ## the length may have changed after replacement, so measure it again
+ len = length tmps
+ goto advance
+ done:
+ retv = tmps
+ .return (retv)
+.end
+
+.sub 'chop' :method
+ .local string tmps
+ .local pmc retv
+ .local int len
+
+ retv = new 'CardinalString'
+ tmps = self
+
+ len = length tmps
+ if len == 0 goto done
+ dec len
+ substr tmps,tmps, 0, len
+ done:
+ retv = tmps
+ .return(retv)
+.end
+
+
+=item perl()
+
+Returns a Perl representation of the Str.
+
+=cut
+
+.sub 'perl' :method
+ $S0 = "\""
+ $S1 = self
+ $S1 = escape $S1
+ concat $S0, $S1
+ concat $S0, "\""
+ .return ($S0)
+.end
+
+=back
+
+=head1 Functions
+
+=over 4
+
+=cut
+
+.namespace
+
+.include 'cclass.pasm'
+
+
+=item lc
+
+ our Str multi Str::lc ( Str $string )
+
+Returns the input string after converting each character to its lowercase
+form, if uppercase.
+
+=cut
+
+.sub 'lc'
+ .param string a
+ .local pmc s
+ s = new 'CardinalString'
+ s = a
+ .return s.'lc'()
+.end
+
+
+=item lcfirst
+
+ our Str multi Str::lcfirst ( Str $string )
+
+Like C<lc>, but only affects the first character.
+
+=cut
+
+.sub 'lcfirst'
+ .param string a
+ .local pmc s
+ s = new 'CardinalString'
+ s = a
+ .return s.'lcfirst'()
+.end
+
+
+=item uc
+
+ our Str multi Str::uc ( Str $string )
+
+Returns the input string after converting each character to its uppercase
+form, if lowercase. This is not a Unicode "titlecase" operation, but a
+full "uppercase".
+
+=cut
+
+.sub 'uc'
+ .param string a
+ .local pmc s
+ s = new 'CardinalString'
+ s = a
+ .return s.'uc'()
+.end
+
+
+=item ucfirst
+
+ our Str multi Str::ucfirst ( Str $string )
+
+Performs a Unicode "titlecase" operation on the first character of the string.
+
+=cut
+
+.sub 'ucfirst'
+ .param string a
+ .local pmc s
+ s = new 'CardinalString'
+ s = a
+ .return s.'ucfirst'()
+.end
+
+
+=item capitalize
+
+ our Str multi Str::capitalize ( Str $string )
+
+Has the effect of first doing an C<lc> on the entire string, then performing a
+C<s:g/(\w+)/{ucfirst $1}/> on it.
+
+=cut
+
+.sub 'capitalize'
+ .param string a
+ .local pmc s
+ s = new 'CardinalString'
+ s = a
+ .return s.'capitalize'()
+.end
+
+
+=item split
+
+ our CardinalArray multi Str::split ( Str $delimiter , Str $input = $+_, Int $limit = inf )
+ our CardinalArray multi Str::split ( Rule $delimiter = /\s+/, Str $input = $+_, Int $limit = inf )
+ our CardinalArray multi Str::split ( Str $input : Str $delimiter , Int $limit = inf )
+ our CardinalArray multi Str::split ( Str $input : Rule $delimiter , Int $limit = inf )
+
+String delimiters must not be treated as rules but as constants. The
+default is no longer S<' '> since that would be interpreted as a constant.
+P5's C<< split('S< >') >> will translate to C<.words> or some such. Null trailing fields
+are no longer trimmed by default. We might add some kind of :trim flag or
+introduce a trimlist function of some sort.
+
+B<Note:> partial implementation only
+
+=cut
+
+.sub 'split'
+ .param string sep
+ .param string target
+ .local pmc a, b
+
+ a = new 'CardinalString'
+ b = new 'CardinalString'
+
+ a = target
+ b = sep
+
+ .return a.'split'(b)
+.end
+
+
+=item join
+
+B<Note:> partial implementation only
+
+=cut
+
+.sub 'join'
+ .param pmc args :slurpy
+ .local pmc flatargs
+ .local string sep
+
+ flatargs = new 'CardinalArray'
+ sep = ''
+ unless args goto have_flatargs
+ $P0 = args[0]
+ $I0 = isa $P0, 'CardinalArray'
+ if $I0 goto have_sep
+ $P0 = shift args
+ sep = $P0
+ have_sep:
+ arg_loop:
+ unless args goto have_flatargs
+ $P0 = shift args
+ $I0 = isa $P0, 'CardinalArray'
+ if $I0 goto arg_array
+ push flatargs, $P0
+ goto arg_loop
+ arg_array:
+ $I0 = elements flatargs
+ splice flatargs, $P0, $I0, 0
+ goto arg_loop
+ have_flatargs:
+ $S0 = join sep, flatargs
+ .return ($S0)
+.end
+
+
+=item substr
+
+ multi substr (Str $s, StrPos $start : StrPos $end, $replace)
+ multi substr (Str $s, StrPos $start, StrLen $length : $replace)
+ multi substr (Str $s, StrLen $offset : StrLen $length, $replace)
+
+B<Note:> partial implementation only
+
+=cut
+
+.sub 'substr'
+ .param string x
+ .param int start
+ .param int len :optional
+ .param int has_len :opt_flag
+ .local pmc s
+
+ if has_len goto end
+ s = new 'CardinalString'
+ s = x
+ len = s.'chars'()
+
+ end:
+ $S0 = substr x, start, len
+ .return ($S0)
+.end
+
+=item chop
+
+ our Str method Str::chop ( Str $string: )
+
+Returns string with one Char removed from the end.
+
+=cut
+
+.sub 'chop'
+ .param string a
+ .local pmc s
+ s = new 'CardinalString'
+ s = a
+ .return s.'chop'()
+.end
+
+=back
+
+=head2 TODO Functions
+
+=over 4
+
+=item p5chop
+
+ our Char multi P5emul::Str::p5chop ( Str $string is rw )
+ our Char multi P5emul::Str::p5chop ( Str *@strings = ($+_) is rw )
+
+Trims the last character from C<$string>, and returns it. Called with a
+list, it chops each item in turn, and returns the last character
+chopped.
+
+=item p5chomp
+
+ our Int multi P5emul::Str::p5chomp ( Str $string is rw )
+ our Int multi P5emul::Str::p5chomp ( Str *@strings = ($+_) is rw )
+
+Related to C<p5chop>, only removes trailing chars that match C</\n/>. In
+either case, it returns the number of chars removed.
+
+=item chomp
+
+ our Str method Str::chomp ( Str $string: )
+
+Returns string with newline removed from the end. An arbitrary
+terminator can be removed if the input filehandle has marked the
+string for where the "newline" begins. (Presumably this is stored
+as a property of the string.) Otherwise a standard newline is removed.
+
+Note: Most users should just let their I/O handles autochomp instead.
+(Autochomping is the default.)
+
+=item length
+
+This word is banned in Cardinal. You must specify units.
+
+=item index
+
+Needs to be in terms of StrPos, not Int.
+
+=item pack
+
+=item pos
+
+=item quotemeta
+
+=item rindex
+
+Needs to be in terms of StrPos, not Int.
+
+=item sprintf
+
+=item unpack
+
+=item vec
+
+Should replace vec with declared arrays of bit, uint2, uint4, etc.
+
+=item words
+
+ our CardinalArray multi Str::words ( Rule $matcher = /\S+/, Str $input = $+_, Int $limit = inf )
+ our CardinalArray multi Str::words ( Str $input : Rule $matcher = /\S+/, Int $limit = inf )
+
+=back
+
+=cut
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
View
16 src/parser/actions.pm
@@ -366,7 +366,12 @@ method operation($/) {
}
method call_args($/) {
- make $( $<args> );
+ if ~$/ ne '()' {
+ make $( $<args> );
+ }
+ else {
+ make PAST::Op.new( :pasttype('call'), :node($/) );
+ }
}
method args($/) {
@@ -403,7 +408,8 @@ method scope_identifier($/) {
}
method literal($/, $key) {
- make $( $/{$key} );
+ my $past := $( $/{$key} );
+ make $past;
}
method pcomp_stmt($/) {
@@ -414,7 +420,7 @@ method array($/) {
my $past;
## XXX the "new" method should be invoked on the "Array" class (use get_class)
## but that doesn't work yet.
- my $getclass := PAST::Op.new( :inline(' %r = new "Array"'), :node($/) );
+ my $getclass := PAST::Op.new( :inline(' %r = new "CardinalArray"'), :node($/) );
if $<args> {
$past := $( $<args>[0] );
$past.unshift( $getclass );
@@ -451,11 +457,11 @@ method float($/) {
}
method integer($/) {
- make PAST::Val.new( :value( ~$/ ), :returns('Integer'), :node($/) );
+ make PAST::Val.new( :value( ~$/ ), :returns('CardinalInteger'), :node($/) );
}
method string($/) {
- make PAST::Val.new( :value( $($<string_literal>) ), :node($/) );
+ make PAST::Val.new( :value( ~$<string_literal> ), :returns('CardinalString'), :node($/) );
}
View
1  src/parser/grammar.pg
@@ -144,6 +144,7 @@ token operation {
}
token call_args {
+ | '()' {*}
| <args> {*}
| '(' <.ws> <args> <.ws> ')' {*}
}
Please sign in to comment.
Something went wrong with that request. Please try again.