Perhaps I don't understand how :multi works (and I would love to see more documentation and will even write tests, as I don't think the existing ones cover all of the cases).
I added a custom Cons class to Pheme, as that's what a Lisp/Scheme needs. This means that I also need some more logic for is_deeply() to compare two Cons objects appropriately. The attached patch is my first attempt. It doesn't work and I'm not sure why. I don't know if installing is() from Test::More (it's a multi sub) overrides the multi is() in Pheme::Test. I don't know if dispatch even *gets* to my custom is() either. I don't even know if what I'm trying to do should be possible, at least the way I'm doing it. I'm stumped and I appreciate any advice, especially from someone who knows how multi dispatch ought to work in Parrot and someone who knows how the current system does work. -- c
=== lib/PhemeSymbols.pir ================================================================== --- lib/PhemeSymbols.pir (revision 16710) +++ lib/PhemeSymbols.pir (local) @@ -15,14 +15,77 @@ .return() .end +.namespace [ 'Pheme::Cons' ] + +.sub _initialize :load + .local pmc cons_class + newclass cons_class, 'Pheme::Cons' + + addattribute cons_class, 'head' + addattribute cons_class, 'tail' +.end + +.sub 'head' :method + .param pmc new_head :optional + .param int have_head :opt_flag + + unless have_head goto return_head + setattribute self, 'head', new_head + .return( new_head ) + + return_head: + .local pmc head + head = getattribute self, 'head' + .return( head ) +.end + +.sub __get_integer :method + .local pmc elem + elem = self.'head'() + + .local int elem_defined + elem_defined = defined elem + + if elem_defined goto count_tail + .return( 0 ) + + count_tail: + .local int count + count = 0 + elem = self + + loop_start: + inc count + elem = elem.'tail'() + elem_defined = defined elem + if elem_defined goto loop_start + + loop_end: + .return( count ) +.end + +.sub 'tail' :method + .param pmc new_tail :optional + .param int have_tail :opt_flag + + unless have_tail goto return_tail + setattribute self, 'tail', new_tail + .return( new_tail ) + + return_tail: + .local pmc tail + tail = getattribute self, 'tail' + .return( tail ) +.end + .namespace [ 'Pheme' ] -.sub __resolve_at_runtime :multi( ResizablePMCArray ) - .param pmc args - .param pmc more_args :slurpy +.sub __resolve_at_runtime :multi( Pheme::Cons ) + .param pmc args :slurpy - unshift more_args, args - .return( more_args ) + .local pmc result + result = __list_to_cons( args :flat ) + .return( result ) .end .sub __resolve_at_runtime :multi( string ) @@ -40,48 +103,50 @@ .return( result ) return_list: - unshift args, symbol_name - .return( args ) + + result = __list_to_cons( symbol_name, args :flat ) + .return( result ) .end -.sub car - .param pmc list +.sub __list_to_cons + .param pmc args :slurpy - .local int count - count = list + .local int cons_type + cons_type = find_type 'Pheme::Cons' - if count > 0 goto really_car - .return( list ) + .local pmc result + result = new cons_type - really_car: - .local pmc first_item - first_item = list[0] + .local int args_count + .local pmc arg - .return( first_item ) + loop_start: + args_count = args + unless args_count goto loop_end + arg = pop args + result = cons( arg, result ) + goto loop_start + + loop_end: + .return( result ) .end -.sub cdr - .param pmc list +.sub car + .param pmc cons - .local pmc iter - iter = new .Iterator, list - iter = 0 + .local pmc head + head = cons.'head'() - .local pmc result - result = new .ResizablePMCArray + .return( head ) +.end - # skip the first element - .local pmc elem - elem = shift iter +.sub cdr + .param pmc cons - iter_loop: - unless iter goto iter_end - elem = shift iter - push result, elem - goto iter_loop + .local pmc tail + tail = cons.'tail'() - iter_end: - .return( result ) + .return( tail ) .end .sub include_file @@ -98,9 +163,16 @@ .param pmc l .param pmc r - unshift r, l + .local int cons_type + cons_type = find_type 'Pheme::Cons' - .return( r ) + .local pmc result + result = new cons_type + + result.'head'( l ) + result.'tail'( r ) + + .return( result ) .end .sub 'write' :multi() @@ -130,6 +202,11 @@ .sub __make_empty_cons .local pmc result - result = new .ResizablePMCArray + + .local int cons_type + cons_type = find_type 'Pheme::Cons' + + .local pmc result + result = new cons_type .return( result ) .end === lib/PhemeTest.pir ================================================================== --- lib/PhemeTest.pir (revision 16710) +++ lib/PhemeTest.pir (local) @@ -13,78 +13,20 @@ diag = find_global 'Test::More', 'diag' is_deeply = find_global 'Test::More', 'is_deeply' - store_global 'Pheme', 'plan', plan - store_global 'Pheme', 'is', is - store_global 'Pheme', 'ok', ok - store_global 'Pheme', 'diag', diag + store_global 'Pheme', 'plan', plan + store_global 'Pheme', 'is', is + store_global 'Pheme', 'ok', ok + store_global 'Pheme', 'diag', diag store_global 'Pheme', 'is_deeply', is_deeply .end -=cut - .namespace[ 'Pheme' ] -.sub _is :multi( ResizablePMCArray, ResizablePMCArray ) - .param pmc l_list - .param pmc r_list +.sub is :multi( Pheme::Cons, Pheme::Cons ) + .param pmc l_cons + .param pmc r_cons .param string diagnostic :optional - .local int l_count - .local int r_count - l_count = l_list - r_count = r_list - - .local string explanation - .local string num_to_s - - if l_count == r_count goto check_items - - explanation = 'Expected has ' - num_to_s = l_count - explanation .= num_to_s - explanation .= ' elements, Received has ' - num_to_s = r_count - explanation .= num_to_s - explanation .= ' elements' - - ok( 0, diagnostic ) - diag( explanation ) - .return() - - check_items: - .local int i - i = 0 - - .local pmc l_elem - .local pmc r_elem - - loop_start: - if i == l_count goto loop_end - l_elem = l_list[i] - r_elem = r_list[i] - eq l_elem, r_elem, pass_this_index - ok( 0, diagnostic ) - - explanation = 'Elements mismatched at index ' - num_to_s = i - explanation .= num_to_s - explanation .= ', (' - num_to_s = l_elem - explanation .= num_to_s - explanation .= '), (' - num_to_s = r_elem - explanation .= num_to_s - explanation .= ')' - diag( explanation ) - .return() - - pass_this_index: - inc i - goto loop_start - - loop_end: - ok( 1, diagnostic ) - .return() + print "Found correct is!\n" + .return( 0 ) .end - -=cut === lib/post2pir.tg ================================================================== --- lib/post2pir.tg (revision 16710) +++ lib/post2pir.tg (local) @@ -4,7 +4,7 @@ .namespace [ 'Pheme' ] .sub __onload :anon :load - load_bytecode 'lib/PhemeSymbols.pbc' +# load_bytecode 'lib/PhemeSymbols.pbc' main() .end