# $Id$ =head1 bas.pir -- shakespeare runtime =cut .namespace [] .sub 'onload' :anon :load :init $P0 = new 'ResizablePMCArray' set_global 'the_cast', $P0 $P0 = 0 set_global 'the_condition', $P0 $P0 = new 'String' set_global 'the_speaker', $P0 .end .sub 'say' .param pmc args :slurpy .local pmc iter iter = new 'Iterator', args iter_loop: unless iter goto iter_end $P0 = shift iter print $P0 goto iter_loop iter_end: print "\n" .return () .end .sub 'declare' .param string char $P0 = new 'Hash' $P0['name'] = char $P1 = new 'ResizableIntegerArray' $P0['value']= 0 $P0['list'] = $P1 $P0['onstage'] = 0 set_global char, $P0 get_global $P1 , 'the_cast' $P1.'push'($P0) .end .sub 'assign' .param int val .local pmc char char = 'find_other'() 'valset'(char,val) .end .sub 'find_other_name' $P0 = 'find_other'() $P1 = $P0['name'] .return ($P1) .end .sub 'get_speaker_name' get_global $P0, 'the_speaker' $S0 = $P0 .return ($S0) .end .sub 'dump' .param pmc char .local pmc val,ary .local int i, v, size, status .local string name ary= char['list'] name = char['name'] size = ary i=0 print "\ndump " print name print ": v=" v= char['value'] print v print " list=(" loop: if i == size goto end_loop val = ary[0] i += 1 print val print "," end_loop: print ")\n" .end .sub 'find_other' .local int i, size, status .local string name, speaker .local pmc person speaker = 'get_speaker_name'() get_global $P0, 'the_cast' size = $P0 i = 0 loop: if i == size goto end_loop person = $P0[i] i += 1 status = person['onstage'] unless status goto loop name = person['name'] if name == speaker goto loop end_loop: if status goto real_end die "there is only one person on stage!" real_end: .return (person) .end .sub 'valueof' .param string char get_global $P0, char $P2 = 'valget'($P0) .return ($P2) .end .sub 'enter' .param string char get_global $P0, char unless null $P0 goto fin die "no such character in the cast!" fin: $P0['onstage'] = 1 .end .sub 'exit' .param string char get_global $P0, char $P0['onstage'] = 0 .return () .end .sub 'exeunt_omnes' get_global $P0, 'the_cast' .local int i,size size = $P0 i=0 loop: $P1 = $P0[i] i = i + 1 if i == size goto end_loop $I0 = $P1['onstage'] unless $I0 goto loop $P1['onstage'] = 0 goto loop end_loop: .return () .end .namespace [] .sub 'tap' .param int val print "ok " print val print "\n" .return () .end .sub 'plan' .param int val print "1.." print val print "\n" .return () .end .sub 'dup' .param int b .local int c c = 2*b .return (c) .end .sub 'fact' .param int b .local int c c = fact b .return (c) .end .sub 'square' .param num b .local num c c = b*b .return (c) .end .sub 'cube' .param num b .local num c c = b*b c = c*b .return (c) .end .sub 'sqrt' .param num b .local num c c = sqrt b .return (c) .end .sub 'better' .param int a .param int b $I0 = a > b new $P0, 'Integer' set $P0, $I0 set_global 'the_condition', $P0 .end .sub 'worse' .param int a .param int b $I0 = a < b new $P0, 'Integer' set $P0, $I0 set_global 'the_condition', $P0 .end .sub 'equal' .param int a .param int b $I0 = a == b new $P0, 'Integer' set $P0, $I0 set_global 'the_condition', $P0 .end .sub 'push' .param int a $P0 = 'find_other'() $P1 = $P0['list'] push $P1, a .end .sub 'pop' $P0 = 'find_other'() $P1 = $P0['list'] $I1 = pop $P1 $P0['value']=$I1 .end .sub 'open_heart' $P0 = 'find_other'() $I1 = 'valget'($P0) print $I1 .end .sub 'valget' .param pmc char $I2 = char['value'] .return ($I2) .end .sub 'valset' .param pmc char .param int val char['value'] = val .end .sub 'listen_heart' $P0 = 'find_other'() $P1 = getstdin readline $S1, $P1 $I1 = $S1 'valset'($P0, $I1) .end .sub 'speak_mind' $P0 = 'find_other'() $I1 = 'valget'($P0) $S1 = chr $I1 print $S1 .end .sub 'open_mind' $P0 = 'find_other'() $P1 = getstdin read $S1, 1 if ''==$S1 goto empty $I1 = ord $S1 goto end empty: $I1 = -1 end: 'valset'($P0,$I1) .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: