[svn:languages] r66 - in cardinal: . branches tags trunk trunk/config trunk/config/makefiles trunk/src trunk/src/builtins trunk/src/classes trunk/src/parser trunk/t trunk/t/array trunk/t/classes trunk/t/file trunk/t/hash trunk/t/integer trunk/t/kernel trunk/t/math trunk/t/range trunk/t/string
fperrad at svn.parrot.org
fperrad at svn.parrot.org
Sun Apr 5 13:06:40 UTC 2009
Author: fperrad
Date: Sun Apr 5 13:06:34 2009
New Revision: 66
URL: https://trac.parrot.org/languages/changeset/66
Log:
import cardinal
Added:
cardinal/
cardinal/branches/
cardinal/tags/
cardinal/trunk/ (props changed)
cardinal/trunk/Configure.pl (contents, props changed)
cardinal/trunk/cardinal.pir (contents, props changed)
cardinal/trunk/config/
cardinal/trunk/config/makefiles/
cardinal/trunk/config/makefiles/root.in (contents, props changed)
cardinal/trunk/src/ (props changed)
cardinal/trunk/src/builtins/
cardinal/trunk/src/builtins/cmp.pir (contents, props changed)
cardinal/trunk/src/builtins/control.pir (contents, props changed)
cardinal/trunk/src/builtins/eval.pir (contents, props changed)
cardinal/trunk/src/builtins/globals.pir (contents, props changed)
cardinal/trunk/src/builtins/guts.pir (contents, props changed)
cardinal/trunk/src/builtins/op.pir (contents, props changed)
cardinal/trunk/src/builtins/say.pir (contents, props changed)
cardinal/trunk/src/classes/
cardinal/trunk/src/classes/Any.pir (contents, props changed)
cardinal/trunk/src/classes/Array.pir (contents, props changed)
cardinal/trunk/src/classes/Bool.pir (contents, props changed)
cardinal/trunk/src/classes/Continuation.pir (contents, props changed)
cardinal/trunk/src/classes/Dir.pir (contents, props changed)
cardinal/trunk/src/classes/Failure.pir (contents, props changed)
cardinal/trunk/src/classes/File.pir (contents, props changed)
cardinal/trunk/src/classes/FileStat.pir (contents, props changed)
cardinal/trunk/src/classes/GC.pir (contents, props changed)
cardinal/trunk/src/classes/Hash.pir (contents, props changed)
cardinal/trunk/src/classes/IO.pir (contents, props changed)
cardinal/trunk/src/classes/Integer.pir (contents, props changed)
cardinal/trunk/src/classes/Kernel.pir (contents, props changed)
cardinal/trunk/src/classes/Math.pir (contents, props changed)
cardinal/trunk/src/classes/NilClass.pir (contents, props changed)
cardinal/trunk/src/classes/Object.pir (contents, props changed)
cardinal/trunk/src/classes/Proc.pir (contents, props changed)
cardinal/trunk/src/classes/Queue.pir (contents, props changed)
cardinal/trunk/src/classes/Range.pir (contents, props changed)
cardinal/trunk/src/classes/String.pir (contents, props changed)
cardinal/trunk/src/classes/Time.pir (contents, props changed)
cardinal/trunk/src/parser/
cardinal/trunk/src/parser/actions.pm (contents, props changed)
cardinal/trunk/src/parser/grammar.pg (contents, props changed)
cardinal/trunk/src/parser/quote_expression.pir (contents, props changed)
cardinal/trunk/t/
cardinal/trunk/t/00-sanity.t (contents, props changed)
cardinal/trunk/t/01-stmts.t (contents, props changed)
cardinal/trunk/t/02-functions.t (contents, props changed)
cardinal/trunk/t/03-return.t (contents, props changed)
cardinal/trunk/t/04-indexed.t (contents, props changed)
cardinal/trunk/t/05-op-cmp.t (contents, props changed)
cardinal/trunk/t/07-loops.t (contents, props changed)
cardinal/trunk/t/08-class.t (contents, props changed)
cardinal/trunk/t/09-test.t (contents, props changed)
cardinal/trunk/t/10-regex.t (contents, props changed)
cardinal/trunk/t/11-slurpy.t (contents, props changed)
cardinal/trunk/t/12-gather.t (contents, props changed)
cardinal/trunk/t/99-other.t (contents, props changed)
cardinal/trunk/t/alias.t (contents, props changed)
cardinal/trunk/t/array/
cardinal/trunk/t/array/array.t (contents, props changed)
cardinal/trunk/t/array/at.t (contents, props changed)
cardinal/trunk/t/array/clear.t (contents, props changed)
cardinal/trunk/t/array/collect.t (contents, props changed)
cardinal/trunk/t/array/delete.t (contents, props changed)
cardinal/trunk/t/array/empty.t (contents, props changed)
cardinal/trunk/t/array/equals.t (contents, props changed)
cardinal/trunk/t/array/fill.t (contents, props changed)
cardinal/trunk/t/array/first.t (contents, props changed)
cardinal/trunk/t/array/flatten.t (contents, props changed)
cardinal/trunk/t/array/grep.t (contents, props changed)
cardinal/trunk/t/array/include.t (contents, props changed)
cardinal/trunk/t/array/intersection.t (contents, props changed)
cardinal/trunk/t/array/join.t (contents, props changed)
cardinal/trunk/t/array/mathop.t (contents, props changed)
cardinal/trunk/t/array/pop.t (contents, props changed)
cardinal/trunk/t/array/reverse.t (contents, props changed)
cardinal/trunk/t/array/shift.t (contents, props changed)
cardinal/trunk/t/array/slice.t (contents, props changed)
cardinal/trunk/t/array/sort.t (contents, props changed)
cardinal/trunk/t/array/to_s.t (contents, props changed)
cardinal/trunk/t/array/uniq.t (contents, props changed)
cardinal/trunk/t/array/warray.t (contents, props changed)
cardinal/trunk/t/assignment.t (contents, props changed)
cardinal/trunk/t/blocks.t (contents, props changed)
cardinal/trunk/t/classes/
cardinal/trunk/t/constants.t (contents, props changed)
cardinal/trunk/t/continuation.t (contents, props changed)
cardinal/trunk/t/file/
cardinal/trunk/t/file/dir.t (contents, props changed)
cardinal/trunk/t/file/file.t (contents, props changed)
cardinal/trunk/t/file/stat.t (contents, props changed)
cardinal/trunk/t/freeze.t (contents, props changed)
cardinal/trunk/t/gc.t (contents, props changed)
cardinal/trunk/t/harness (contents, props changed)
cardinal/trunk/t/hash/
cardinal/trunk/t/hash/hash.t (contents, props changed)
cardinal/trunk/t/integer/
cardinal/trunk/t/integer/integer.t (contents, props changed)
cardinal/trunk/t/integer/times.t (contents, props changed)
cardinal/trunk/t/kernel/
cardinal/trunk/t/kernel/exit.t (contents, props changed)
cardinal/trunk/t/kernel/open.t (contents, props changed)
cardinal/trunk/t/kernel/sprintf.t (contents, props changed)
cardinal/trunk/t/math/
cardinal/trunk/t/math/functions.t (contents, props changed)
cardinal/trunk/t/nil.t (contents, props changed)
cardinal/trunk/t/proc.t (contents, props changed)
cardinal/trunk/t/range/
cardinal/trunk/t/range.t (contents, props changed)
cardinal/trunk/t/range/each.t (contents, props changed)
cardinal/trunk/t/range/infix-exclusive.t (contents, props changed)
cardinal/trunk/t/range/infix-inclusive.t (contents, props changed)
cardinal/trunk/t/range/membership-variants.t (contents, props changed)
cardinal/trunk/t/range/new.t (contents, props changed)
cardinal/trunk/t/range/to_a.t (contents, props changed)
cardinal/trunk/t/range/to_s.t (contents, props changed)
cardinal/trunk/t/range/tofrom-variants.t (contents, props changed)
cardinal/trunk/t/splat.t (contents, props changed)
cardinal/trunk/t/string/
cardinal/trunk/t/string/add.t (contents, props changed)
cardinal/trunk/t/string/block.t (contents, props changed)
cardinal/trunk/t/string/capitalize.t (contents, props changed)
cardinal/trunk/t/string/chops.t (contents, props changed)
cardinal/trunk/t/string/cmp.t (contents, props changed)
cardinal/trunk/t/string/concat.t (contents, props changed)
cardinal/trunk/t/string/downcase.t (contents, props changed)
cardinal/trunk/t/string/eq.t (contents, props changed)
cardinal/trunk/t/string/mult.t (contents, props changed)
cardinal/trunk/t/string/new.t (contents, props changed)
cardinal/trunk/t/string/quote.t (contents, props changed)
cardinal/trunk/t/string/random_access.t (contents, props changed)
cardinal/trunk/t/string/reverse.t (contents, props changed)
cardinal/trunk/t/string/upcase.t (contents, props changed)
cardinal/trunk/t/time.t (contents, props changed)
cardinal/trunk/t/yield.t (contents, props changed)
cardinal/trunk/t/zip.t (contents, props changed)
cardinal/trunk/test.rb (contents, props changed)
Added: cardinal/trunk/Configure.pl
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/Configure.pl Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,66 @@
+# Copyright (C) 2009, Parrot Foundation.
+# $Id$
+
+use strict;
+use warnings;
+use 5.008;
+
+# Get a list of parrot-configs to invoke.
+my @parrot_config_exe = (
+ 'parrot/parrot_config',
+ '../../parrot_config',
+ 'parrot_config',
+);
+
+# Get configuration information from parrot_config
+my %config = read_parrot_config(@parrot_config_exe);
+unless (%config) {
+ die "Unable to locate parrot_config.";
+}
+
+# Create the Makefile using the information we just got
+create_makefiles(%config);
+
+sub read_parrot_config {
+ my @parrot_config_exe = @_;
+ my %config = ();
+ for my $exe (@parrot_config_exe) {
+ no warnings;
+ if (open my $PARROT_CONFIG, '-|', "$exe --dump") {
+ print "Reading configuration information from $exe\n";
+ while (<$PARROT_CONFIG>) {
+ $config{$1} = $2 if (/(\w+) => '(.*)'/);
+ }
+ close $PARROT_CONFIG;
+ last if %config;
+ }
+ }
+ %config;
+}
+
+
+# Generate Makefiles from a configuration
+sub create_makefiles {
+ my %config = @_;
+ my %makefiles = (
+ 'config/makefiles/root.in' => 'Makefile',
+# 'config/makefiles/pmc.in' => 'src/pmc/Makefile',
+# 'config/makefiles/ops.in' => 'src/ops/Makefile',
+ );
+ my $build_tool = $config{libdir} . $config{versiondir}
+ . '/tools/dev/gen_makefile.pl';
+
+ foreach my $template (keys %makefiles) {
+ my $makefile = $makefiles{$template};
+ print "Creating $makefile\n";
+ system($config{perl}, $build_tool, $template, $makefile);
+ }
+}
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
+
Added: cardinal/trunk/cardinal.pir
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/cardinal.pir Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,121 @@
+=head1 TITLE
+
+cardinal.pir - A cardinal compiler.
+
+=head2 Description
+
+This is the base file for the cardinal compiler.
+
+This file includes the parsing and grammar rules from
+the src/ directory, loads the relevant PGE libraries,
+and registers the compiler under the name 'cardinal'.
+
+=head2 Functions
+
+=over 4
+
+=item onload()
+
+Creates the cardinal compiler using a C<PCT::HLLCompiler>
+object.
+
+=cut
+
+
+.HLL 'cardinal'
+.namespace []
+
+.include 'src/gen_builtins.pir'
+
+.sub 'onload' :anon :load :init
+ load_bytecode 'PCT.pbc'
+ .local pmc parrotns, cardinalns, exports
+ parrotns = get_root_namespace ['parrot']
+ cardinalns = get_hll_namespace
+ exports = split ' ', 'PAST PCT PGE P6metaclass'
+ parrotns.'export_to'(cardinalns, exports)
+.end
+
+.include 'src/gen_grammar.pir'
+.include 'src/parser/quote_expression.pir'
+.include 'src/gen_actions.pir'
+.namespace [ 'cardinal';'Compiler' ]
+
+#no cardinal_group found on my machine
+#.loadlib 'cardinal_group'
+
+.sub 'onload' :anon :load :init
+ .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'()
+ $P1.'language'('cardinal')
+ $P0 = get_hll_namespace ['cardinal';'Grammar']
+ $P1.'parsegrammar'($P0)
+ $P0 = get_hll_namespace ['cardinal';'Grammar';'Actions']
+ $P1.'parseactions'($P0)
+
+ $P1.'commandline_banner'("Cardinal - Ruby for the Parrot VM\n\n")
+ $P1.'commandline_prompt'('crb(main):001:0>')
+
+ ## create a list of END blocks to be run
+ $P0 = new 'CardinalArray'
+ set_hll_global ['cardinal'], '@?END_BLOCKS', $P0
+
+ $P0 = new 'CardinalArray'
+ set_hll_global ['cardinal';'Grammar';'Actions'], '@?BLOCK', $P0
+
+ $P1 = get_hll_global ['PAST';'Compiler'], '%valflags'
+ $P1['CardinalString'] = 'e'
+.end
+
+=item main(args :slurpy) :main
+
+Start compilation by passing any command line C<args>
+to the cardinal compiler.
+
+=cut
+
+.sub 'main' :main
+ .param pmc args_str
+
+ ## create ARGS global.
+ .local pmc args, iter
+ args = new 'CardinalArray'
+ iter = new 'Iterator', args_str
+ $P0 = shift iter
+ args_loop:
+ unless iter goto args_end
+ $P0 = shift iter
+ push args, $P0
+ goto args_loop
+ args_end:
+ set_hll_global 'ARGS', args
+
+ $P0 = compreg 'cardinal'
+ $P1 = $P0.'command_line'(args_str)
+
+ .include 'iterator.pasm'
+ $P0 = get_hll_global ['cardinal'], '@?END_BLOCKS'
+ iter = new 'Iterator', $P0
+ iter = .ITERATE_FROM_END
+ iter_loop:
+ unless iter goto iter_end
+ $P0 = pop iter
+ $P0()
+ goto iter_loop
+ iter_end:
+.end
+
+=back
+
+=cut
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
+
Added: cardinal/trunk/config/makefiles/root.in
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/config/makefiles/root.in Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,201 @@
+# Copyright (C) 2008-2009, Parrot Foundation.
+## $Id$
+
+## arguments we want to run parrot with
+PARROT_ARGS :=
+
+## configuration settings
+VERSION := @versiondir@
+BIN_DIR := @bin_dir@
+LIB_DIR := @lib_dir@$(VERSION)
+DOC_DIR := @doc_dir@$(VERSION)
+MANDIR := @mandir@$(VERSION)
+
+# Set up extensions
+LOAD_EXT := @load_ext@
+O := @o@
+
+# Various paths
+PERL6GRAMMAR := $(LIB_DIR)/library/PGE/Perl6Grammar.pbc
+NQP := $(LIB_DIR)/languages/nqp/nqp.pbc
+PCT := $(LIB_DIR)/library/PCT.pbc
+
+## Setup some commands
+MAKE := @make_c@
+PERL := @perl@
+CAT := @cat@
+CHMOD := @chmod@
+CP := @cp@
+MKPATH := @mkpath@
+RM_F := @rm_f@
+RM_RF := @rm_rf@
+POD2MAN := pod2man
+#IF(parrot_is_shared and not(cygwin or win32)):export LD_RUN_PATH := @blib_dir@:$(LD_RUN_PATH)
+PARROT := $(BIN_DIR)/parrot at exe@
+PBC_TO_EXE := $(BIN_DIR)/pbc_to_exe at exe@
+#IF(darwin):
+#IF(darwin):# MACOSX_DEPLOYMENT_TARGET must be defined for OS X compilation/linking
+#IF(darwin):export MACOSX_DEPLOYMENT_TARGET := @osx_version@
+
+SOURCES := \
+ src/parser/quote_expression.pir \
+ src/gen_grammar.pir \
+ src/gen_actions.pir \
+ src/gen_builtins.pir \
+ cardinal.pir
+
+BUILTINS_PIR := \
+ src/builtins/guts.pir \
+ src/builtins/control.pir \
+ src/builtins/say.pir \
+ src/builtins/cmp.pir \
+ src/builtins/op.pir \
+ src/classes/Object.pir \
+ src/classes/NilClass.pir \
+ src/classes/String.pir \
+ src/classes/Integer.pir \
+ src/classes/Array.pir \
+ src/classes/Hash.pir \
+ src/classes/Any.pir \
+ src/classes/Range.pir \
+ src/classes/Bool.pir \
+ src/classes/Kernel.pir \
+ src/classes/Time.pir \
+ src/classes/Math.pir \
+ src/classes/GC.pir \
+ src/classes/IO.pir \
+ src/classes/Proc.pir \
+ src/classes/File.pir \
+ src/classes/FileStat.pir \
+ src/classes/Dir.pir \
+ src/builtins/globals.pir \
+ src/builtins/eval.pir \
+ src/classes/Continuation.pir
+
+
+DOCS := README
+
+BUILD_CLEANUPS := \
+ cardinal.pbc \
+ "src/gen_*.pir" \
+ "*.c" \
+ "*$(O)" \
+ cardinal at exe@ \
+#IF(win32): parrot-cardinal.exe \
+#IF(win32): parrot-cardinal.iss \
+#IF(win32): "setup-parrot-*.exe" \
+ installable_cardinal at exe@
+
+TEST_CLEANUPS :=
+
+# the default target
+build: cardinal.pbc
+
+all: build cardinal at exe@ installable
+
+cardinal.pbc: $(SOURCES)
+ $(PARROT) $(PARROT_ARGS) -o cardinal.pbc cardinal.pir
+
+cardinal at exe@: cardinal.pbc
+ $(PBC_TO_EXE) cardinal.pbc
+
+src/gen_grammar.pir: $(PERL6GRAMMAR) src/parser/grammar.pg
+ $(PARROT) $(PARROT_ARGS) $(PERL6GRAMMAR) \
+ --output=src/gen_grammar.pir \
+ src/parser/grammar.pg
+
+src/gen_actions.pir: $(NQP) src/parser/actions.pm
+ $(PARROT) $(PARROT_ARGS) $(NQP) --output=src/gen_actions.pir \
+ --target=pir src/parser/actions.pm
+
+src/gen_builtins.pir: $(BUILTINS_PIR)
+ $(CAT) $(BUILTINS_PIR) > src/gen_builtins.pir
+
+installable: installable_cardinal at exe@
+
+installable_cardinal at exe@: cardinal.pbc
+ $(PBC_TO_EXE) cardinal.pbc --install
+
+Makefile: config/makefiles/root.in
+ $(PERL) Configure.pl
+
+# This is a listing of all targets, that are meant to be called by users
+help:
+ @echo ""
+ @echo "Following targets are available for the user:"
+ @echo ""
+ @echo " build: cardinal.pbc"
+ @echo " This is the default."
+ @echo " cardinal at exe@ Self-hosting binary not to be installed."
+ @echo " all: cardinal.pbc cardinal at exe@ installable"
+ @echo " installable: Create libs and self-hosting binaries to be installed."
+ @echo " install: Install the installable targets and docs."
+ @echo ""
+ @echo "Testing:"
+ @echo " test: Run the test suite."
+ @echo " test-installable: Test self-hosting targets."
+ @echo " testclean: Clean up test results."
+ @echo ""
+ @echo "Cleaning:"
+ @echo " clean: Basic cleaning up."
+ @echo " realclean: Removes also files generated by 'Configure.pl'"
+ @echo " distclean: Removes also anything built, in theory"
+ @echo ""
+ @echo "Misc:"
+ @echo " help: Print this help message."
+ @echo ""
+
+test: build
+ $(PERL) -I$(LIB_DIR)/tools/lib t/harness
+
+arraytest: all
+ $(PERL) t/harness --tests-from-dir=array
+
+hashtest: all
+ $(PERL) t/harness --tests-from-dir=hash
+
+# basic run for missing libs
+test-installable: installable
+ echo "1" | ./installable_cardinal at exe@
+
+install: installable
+ $(CP) installable_cardinal at exe@ $(BIN_DIR)/parrot-cardinal at exe@
+ $(CHMOD) 0755 $(BIN_DIR)/parrot-cardinal at exe@
+ -$(MKPATH) $(LIB_DIR)/languages/cardinal
+ $(CP) cardinal.pbc $(LIB_DIR)/languages/cardinal/cardinal.pbc
+# -$(MKPATH) $(MANDIR)/man1
+# $(POD2MAN) doc/running.pod > $(MANDIR)/man1/parrot-cardinal.1
+# -$(MKPATH) $(DOC_DIR)/languages/cardinal
+# $(CP) $(DOCS) $(DOC_DIR)/languages/cardinal
+
+uninstall:
+ $(RM_F) $(BIN_DIR)/parrot-cardinal at exe@
+ $(RM_RF) $(LIB_DIR)/languages/cardinal
+# $(RM_F) $(MANDIR)/man1/parrot-cardinal.1
+# $(RM_RF) $(DOC_DIR)/languages/cardinal
+
+win32-inno-installer: installable
+# -$(MKPATH) man/man1
+# $(POD2MAN) doc/running.pod > man/man1/parrot-cardinal.1
+# -$(MKPATH) man/html
+# pod2html --infile doc/running.pod --outfile man/html/parrot-cardinal.html
+ $(CP) installable_cardinal at exe@ parrot-cardinal.exe
+ $(PERL) $(LIB_DIR)/tools/dev/mk_inno_language.pl cardinal
+ iscc parrot-cardinal.iss
+
+testclean:
+ $(RM_F) $(TEST_CLEANUPS)
+
+clean:
+ $(RM_F) $(TEST_CLEANUPS) $(BUILD_CLEANUPS)
+
+realclean:
+ $(RM_F) $(TEST_CLEANUPS) $(BUILD_CLEANUPS) Makefile
+
+distclean: realclean
+
+# Local variables:
+# mode: makefile
+# End:
+# vim: ft=make:
+
Added: cardinal/trunk/src/builtins/cmp.pir
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/src/builtins/cmp.pir Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,185 @@
+## $Id$
+
+=head1 NAME
+
+src/builtins/cmp.pir - Cardinal comparison builtins
+Swiped from Rakudo.
+
+=head1 Functions
+
+=over 4
+
+=cut
+
+.namespace []
+
+
+.sub 'prefix:?' :multi(_)
+ .param pmc a
+ if a goto a_true
+ $P0 = get_hll_global ['Bool'], 'False'
+ .return ($P0)
+ a_true:
+ $P0 = get_hll_global ['Bool'], 'True'
+ .return ($P0)
+.end
+
+.sub 'infix:==' :multi(_,_)
+ .param pmc a
+ .param pmc b
+ $I0 = iseq a, b
+ .tailcall 'prefix:?'($I0)
+.end
+
+.sub 'infix:==' :multi(Bool,Bool)
+ .param int a
+ .param int b
+ $I0 = a == b
+ $P0 = 'prefix:?'($I0)
+ .return ($P0)
+.end
+
+.sub 'infix:==' :multi(Integer,Integer)
+ .param pmc a
+ .param pmc b
+ $I0 = iseq a, b
+ .tailcall 'prefix:?'($I0)
+.end
+
+.sub 'infix:==' :multi(String,String)
+ .param pmc a
+ .param pmc b
+ $I0 = iseq a, b
+ .tailcall 'prefix:?'($I0)
+.end
+
+.sub 'infix:==' :multi(NilClass,_)
+ .param pmc a
+ .param pmc b
+ # mmd tells us they are different types, so return false
+ $I0 = 0
+ .tailcall 'prefix:?'($I0)
+.end
+
+.sub 'infix:==' :multi(_,NilClass)
+ .param pmc a
+ .param pmc b
+ # mmd tells us they are different types, so return false
+ $I0 = 0
+ .tailcall 'prefix:?'($I0)
+.end
+
+.sub 'infix:==' :multi(NilClass,NilClass)
+ .param pmc a
+ .param pmc b
+ # mmd tells us they are same types and both of type NilClass, so return true
+ $I0 = 1
+ .tailcall 'prefix:?'($I0)
+.end
+
+.sub 'infix:==' :multi(CardinalArray,CardinalArray)
+ .param pmc a
+ .param pmc b
+ .local int i
+ $I1 = a.'elems'()
+ $I2 = b.'elems'()
+ ne $I1, $I2, fail
+ i = 0
+ loop:
+ unless i < $I1 goto success
+ $P0 = a[i]
+ $P1 = b[i]
+ $I0 = 'infix:=='($P0,$P1)
+ inc i
+ if $I0 goto loop
+ fail:
+ .tailcall 'prefix:?'(0)
+ success:
+ .tailcall 'prefix:?'(1)
+.end
+
+
+.sub 'infix:!=' :multi(_,_)
+ .param pmc a
+ .param pmc b
+ $I0 = 'infix:=='(a, b)
+ $I0 = not $I0
+ .tailcall 'prefix:?'($I0)
+.end
+
+
+.sub 'infix:<' :multi(_,_)
+ .param pmc a
+ .param pmc b
+ $I0 = islt a, b
+ .tailcall 'prefix:?'($I0)
+.end
+
+.sub 'infix:<' :multi(Integer,Integer)
+ .param pmc a
+ .param pmc b
+ # creating a specific multi method
+ # where marshall into the correct register type
+ # gave a much needed boost in performance. Will investigate this later.
+ $I0 = a
+ $I1 = b
+ #$I0 = islt a, b
+ $I0 = islt $I0, $I1
+ .tailcall 'prefix:?'($I0)
+.end
+
+
+.sub 'infix:<=' :multi(_,_)
+ .param pmc a
+ .param pmc b
+ $I0 = isle a, b
+ .tailcall 'prefix:?'($I0)
+.end
+
+
+.sub 'infix:>' :multi(_,_)
+ .param pmc a
+ .param pmc b
+ $I0 = isgt a, b
+ .tailcall 'prefix:?'($I0)
+.end
+
+
+.sub 'infix:>=' :multi(_,_)
+ .param pmc a
+ .param pmc b
+ $I0 = isge a, b
+ .tailcall 'prefix:?'($I0)
+.end
+
+
+.sub 'infix:<=>'
+ .param pmc a
+ .param pmc b
+ $I0 = cmp_num a, b
+ .return ($I0)
+.end
+
+.sub 'infix:=~'
+ .param pmc topic
+ .param pmc x
+ .tailcall x(topic)
+.end
+
+.sub 'infix:!~'
+ .param pmc topic
+ .param pmc x
+ $P0 = x(topic)
+ $P0 = not $P0
+ .return ($P0)
+.end
+
+=back
+
+=cut
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
Added: cardinal/trunk/src/builtins/control.pir
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/src/builtins/control.pir Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,86 @@
+## $Id$
+
+=head1 NAME
+
+src/builtins/control.pir - Cardinal Control functions
+
+=head1 Functions
+
+=over 4
+
+=cut
+
+.namespace []
+
+.include 'except_types.pasm'
+.include 'except_severity.pasm'
+
+=item take
+
+=cut
+
+.sub 'take'
+ .param pmc value
+
+ $P0 = new 'Exception'
+ $P0['type'] = .CONTROL_TAKE
+ $P0['severity'] = .EXCEPT_NORMAL
+ setattribute $P0, 'payload', value
+ throw $P0
+ .return (value)
+.end
+
+.sub gather
+ .param pmc block
+ .local pmc list
+ .local pmc eh
+ list = 'list'()
+ eh = new 'ExceptionHandler'
+ eh.'handle_types'(.CONTROL_TAKE)
+ set_addr eh, handler
+ push_eh eh
+ block()
+ pop_eh
+ .return (list)
+ handler:
+ .local pmc exception, continuation
+ .local string message
+ .get_results(exception)
+ message = exception['message']
+ continuation = exception['resume']
+ $P0 = exception['payload']
+ list.'push'($P0)
+ continuation()
+.end
+
+.sub 'next'
+ .local pmc e
+ e = new 'Exception'
+ e['type'] = .CONTROL_LOOP_NEXT
+ e['severity'] = .EXCEPT_NORMAL
+ throw e
+.end
+
+=item sleep(num)
+Sleep for number of seconds.
+=cut
+.sub 'sleep'
+ .param num a
+ sleep a
+.end
+
+=item callcc(cc)
+
+=cut
+.sub 'callcc'
+ .param pmc block :named('!BLOCK')
+ $P0 = get_hll_global ['Kernel'], '!CARDINALMETA'
+ $P0.'callcc'(block :named('!BLOCK'))
+.end
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
+
Added: cardinal/trunk/src/builtins/eval.pir
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/src/builtins/eval.pir Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,133 @@
+## $Id$
+
+=head1 NAME
+
+src/builtins/eval.pir - Cardinal evaluators
+
+=head1 DESCRIPTION
+
+This file implements methods and functions that evaluate code,
+such as C<eval>, C<require>, and C<use>.
+
+=head1 Methods
+
+=over 4
+
+=cut
+
+.namespace []
+.sub 'onload' :anon :init :load
+ $P0 = get_hll_namespace ['Any']
+ '!EXPORT'('evalfile', 'from'=>$P0)
+.end
+
+
+.namespace ['Any']
+.sub 'evalfile' :method :multi(_)
+ .param pmc options :slurpy :named
+
+ .local string filename
+ filename = self
+
+ .local string lang
+ lang = options['lang']
+ if lang == 'Parrot' goto lang_parrot
+ if lang goto lang_compile
+ lang = 'cardinal'
+ lang_compile:
+ .local pmc compiler
+ compiler = compreg lang
+ .tailcall compiler.'evalfiles'(filename)
+
+ lang_parrot:
+ load_bytecode filename
+ .return (1)
+.end
+
+
+.namespace []
+.sub 'require' :multi(_)
+ .param string name
+ .param pmc options :named :slurpy
+
+ .local int isfile
+ .local pmc file
+ isfile = 0
+ file = options['file']
+ if null file goto have_name
+ isfile = istrue file
+
+ have_name:
+ ## see if we loaded this already
+ .local pmc inc_hash
+ inc_hash = get_hll_global '%INC'
+ $I0 = exists inc_hash[name]
+ unless $I0 goto require_name
+ $I0 = defined inc_hash[name]
+ .return ($I0)
+
+ require_name:
+ ## loop through $:
+ .local pmc inc_it
+ $P0 = get_hll_global '$:'
+ inc_it = iter $P0
+ inc_loop:
+ unless inc_it goto inc_end
+ .local string basename, realfilename
+ $S0 = shift inc_it
+ basename = concat $S0, '/'
+ basename .= name
+ unless isfile goto try_module
+ realfilename = basename
+ $I0 = stat realfilename, 0
+ if $I0 goto eval_ruby
+ goto inc_loop
+ try_module:
+ realfilename = concat basename, '.pbc'
+ $I0 = stat realfilename, 0
+ if $I0 goto eval_parrot
+ realfilename = concat basename, '.pir'
+ $I0 = stat realfilename, 0
+ if $I0 goto eval_parrot
+ realfilename = concat basename, '.rb'
+ $I0 = stat realfilename, 0
+ if $I0 goto eval_ruby
+ goto inc_loop
+ inc_end:
+ $S0 = concat "Can't find ", basename
+ concat $S0, ' in $:'
+ 'die'($S0)
+ .return (0)
+
+ eval_parrot:
+ .local pmc result
+ result = 'evalfile'(realfilename, 'lang'=>'Parrot')
+ goto done
+
+ eval_ruby:
+ result = 'evalfile'(realfilename, 'lang'=>'cardinal')
+
+ done:
+ inc_hash[name] = realfilename
+ .return (result)
+.end
+
+
+.sub 'load'
+ .param string file
+ .param pmc args :slurpy
+ .param pmc options :slurpy :named
+
+ $P0 = 'require'(file, 'file'=>1)
+.end
+
+=back
+
+=cut
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
+
Added: cardinal/trunk/src/builtins/globals.pir
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/src/builtins/globals.pir Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,80 @@
+## $Id$
+
+=head1 NAME
+
+src/builtins/globals.pir - initialize miscellaneous global variables
+
+=cut
+
+.namespace []
+
+.sub 'onload' :anon :load :init
+ .local pmc cardinalmeta
+ cardinalmeta = get_hll_global ['CardinalObject'], '!CARDINALMETA'
+
+ ## set up $ENV
+ $P0 = get_hll_global 'CardinalHash'
+ cardinalmeta.'register'('Env', 'parent'=>$P0, 'protoobject'=>$P0)
+ .local pmc env
+ env = new 'Env'
+ set_hll_global '$ENV', env
+
+ ## set up $:
+ $S0 = env['RUBYLIB']
+ $P0 = split ':', $S0
+ push $P0, '.'
+ $P0 = 'list'($P0)
+ set_hll_global '$:', $P0
+
+ ## set up %*INC
+ $P0 = new 'CardinalHash'
+ set_hll_global '%INC', $P0
+
+ #$P1 = new 'CardinalString'
+ #$P1 = "\n"
+ ## global input record separator
+ $P1 = get_hll_global ['NilClass'], '!CARDINALMETA'
+ set_hll_global '$/', $P1
+ ## global output record separator
+ $P4 = get_hll_global ['NilClass'], '!CARDINALMETA'
+ set_hll_global '$\', $P4
+
+ #getstdin $P5
+ #set_hll_global '$stdin', $P5
+ #set_hll_global '$>', $P5
+
+ getstdout $P6
+ set_hll_global '$stdout', $P6
+
+ #getstderr $P7
+ #set_hll_global 'stderr', $P7
+
+ $P2 = new 'CardinalString'
+ $P2 = "parrot"
+ set_hll_global 'RUBY_PLATFORM', $P2
+
+ $P3 = new 'CardinalString'
+ $P3 = "1.9"
+ set_hll_global 'RUBY_VERSION', $P3
+.end
+
+=over
+
+=item
+ Uses Parrot builtin Random type, doesnt seem to be working
+=cut
+.sub 'rand'
+ $P0 = new 'Random'
+ $I0 = $P0
+ .return ($I0)
+.end
+
+=back
+
+=cut
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
Added: cardinal/trunk/src/builtins/guts.pir
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/src/builtins/guts.pir Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,261 @@
+## $Id$
+
+=head1 NAME
+
+src/builtins/guts.pir - subs that are part of the internals, not for users
+
+=head1 SUBS
+
+=over 4
+
+=item !EXPORT(symbols, from :named('from') [, to :named('to')] )
+
+Export symbols in namespace C<from> to the namespace given by C<to>.
+If C<to> isn't given, then exports into the HLL global namespace.
+This function differs somewhat from Parrot's C<Exporter> PMC in that
+it understands how to properly merge C<MultiSub> PMCs.
+
+=cut
+
+.namespace []
+.sub '!EXPORT'
+ .param string symbols
+ .param pmc from :named('from')
+ .param pmc to :named('to') :optional
+ .param int has_to :opt_flag
+
+ if has_to goto have_to
+ to = get_hll_namespace
+ have_to:
+
+ .local pmc list
+ list = split ' ', symbols
+ list_loop:
+ unless list goto list_end
+ .local string symbol
+ .local pmc value
+ symbol = shift list
+ value = from[symbol]
+ $I0 = isa value, 'MultiSub'
+ unless $I0 goto store_value
+ $P0 = to[symbol]
+ if null $P0 goto store_value
+ $I0 = isa $P0, 'MultiSub'
+ unless $I0 goto err_type_conflict
+ $I0 = elements $P0
+ splice $P0, value, $I0, 0
+ goto list_loop
+ store_value:
+ to[symbol] = value
+ goto list_loop
+ list_end:
+ .return ()
+
+ err_type_conflict:
+ $S0 = concat "Unable to add Multisub '", symbol
+ $S0 .= "' to existing value"
+ die $S0
+.end
+
+
+=item !DOTYPECHECK
+
+Checks that the value and the assignee are type-compatible and does the
+assignment.
+
+=cut
+
+.sub '!DOTYPECHECK'
+ .param pmc type
+ .param pmc value
+ .param pmc result
+ $I0 = type.'ACCEPTS'(value)
+ result = $I0
+.end
+
+
+=item !TYPECHECKPARAM
+
+Checks the type of a parameter.
+
+=cut
+
+.sub '!TYPECHECKPARAM'
+ .param pmc type
+ .param pmc value
+ $P0 = getinterp
+ $P0 = $P0['lexpad';1]
+ if null $P0 goto no_match_to_copy
+ $P0 = $P0['$/']
+ .lex "$/", $P0
+ no_match_to_copy:
+
+ $I0 = type.'ACCEPTS'(value)
+ if $I0 goto ok
+ 'die'('Parameter type check failed')
+ok:
+.end
+
+
+=item !keyword_class(name)
+
+Internal helper method to create a class.
+
+=cut
+
+.sub '!keyword_class'
+ .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 'ResizableStringArray'
+ 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'
+ .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 'ResizablePMCArray'
+ $P0[0] = name
+ info['namespace'] = $P0
+
+ # Create role.
+ role = new 'Role', info
+
+ # Stash in namespace.
+ $P0 = new 'ResizableStringArray'
+ set_hll_global $P0, name, role
+
+ .return(role)
+.end
+
+=item !keyword_grammar(name)
+
+Internal helper method to create a grammar.
+
+=cut
+
+.sub '!keyword_grammar'
+ .param string name
+ .local pmc info, grammar
+
+ # Need to make sure it ends up attached to the right
+ # namespace.
+ info = new 'Hash'
+ info['name'] = name
+ $P0 = new 'ResizablePMCArray'
+ $P0[0] = name
+ info['namespace'] = $P0
+
+ # Create grammar class..
+ grammar = new 'Class', info
+
+ .return(grammar)
+.end
+
+=item !keyword_does(class, role_name)
+
+Internal helper method to implement the functionality of the does keyword.
+
+=cut
+
+.sub '!keyword_does'
+ .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'
+ .param pmc class
+ .param string attr_name
+ addattribute class, attr_name
+.end
+
+=back
+
+=cut
+
+.sub 'defined'
+ .param pmc x
+ $I0 = defined x
+ .return ($I0)
+.end
+
+.sub 'lex_lookup'
+ .param string name
+ $P0 = find_name name
+ .return($P0)
+.end
+
+.sub 'lookup_class'
+ .param pmc item
+ $P0 = class item
+ if_null $P0, null_class
+ .return($P0)
+ null_class:
+ $P0 = new 'Undef'
+ .return($P0)
+.end
+
+.sub 'die'
+ .param pmc list :slurpy
+ .local pmc iter
+ .local string message
+
+ message = ''
+ iter = new 'Iterator', list
+ iter_loop:
+ unless iter goto iter_end
+ $P0 = shift iter
+ $S0 = $P0
+ message .= $S0
+ goto iter_loop
+ iter_end:
+ if message > '' goto have_message
+ message = "Died\n"
+ have_message:
+ $P0 = new 'Exception'
+ $P0 = message
+ set_global '$!', $P0
+ throw $P0
+ .return ()
+.end
+
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
Added: cardinal/trunk/src/builtins/op.pir
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/src/builtins/op.pir Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,171 @@
+## $Id$
+
+=head1 NAME
+
+src/builtins/op.pir - Cardinal ops
+
+=head1 Functions
+
+=over 4
+
+=cut
+
+.namespace []
+
+.sub 'infix:+' :multi(_,_)
+ .param num a
+ .param num b
+ $P0 = new 'CardinalInteger'
+ $N0 = add a, b
+ $P0 = $N0
+ .return ($P0)
+.end
+
+.sub 'infix:-' :multi(_,_)
+ .param num a
+ .param num b
+ $P0 = new 'CardinalInteger'
+ $N0 = sub a, b
+ $P0 = $N0
+ .return ($P0)
+.end
+
+.sub 'infix:-' :multi(CardinalArray,CardinalArray)
+ .param pmc a
+ .param pmc b
+ $P0 = new 'CardinalArray'
+ .local pmc iter
+ iter = new 'Iterator', a
+ $P3 = get_hll_global['Bool'], 'False'
+ iter_loop:
+ unless iter goto done
+ $P1 = shift iter
+ $P2 = b.'include?'($P1)
+ $I0 = 'infix:=='($P2, $P3)
+ eq $I0, 1, appendit
+ #eq $P2, $P3, appendit
+ goto iter_loop
+ appendit:
+ $P0.'push'($P1)
+ goto iter_loop
+ done:
+ .return($P0)
+.end
+
+.sub 'infix:*' :multi(_,_)
+ .param num a
+ .param num b
+ $P0 = new 'CardinalInteger'
+ $N0 = mul a, b
+ $P0 = $N0
+ .return ($P0)
+.end
+
+.sub 'infix:/' :multi(_,_)
+ .param num a
+ .param num b
+ $P0 = new 'CardinalInteger'
+ $N0 = div a, b
+ $P0 = $N0
+ .return ($P0)
+.end
+
+.sub 'infix:+' :multi(CardinalString,_)
+ .param pmc a
+ .param pmc b
+ $P0 = new 'CardinalString'
+ $P0 = concat a, b
+ .return ($P0)
+.end
+
+.sub 'infix:+' :multi(CardinalArray,CardinalArray)
+ .param pmc a
+ .param pmc b
+ $P0 = new 'CardinalArray'
+ $P0 = 'list'(a :flat, b :flat)
+ .return ($P0)
+.end
+
+.sub 'infix:-=' :multi(_,_)
+ .param pmc a
+ .param pmc b
+ a -= b
+ .return (a)
+.end
+
+.sub 'infix:+=' :multi(_,_)
+ .param pmc a
+ .param pmc b
+ a += b
+ .return (a)
+.end
+
+.sub 'infix:+=' :multi(CardinalString,_)
+ .param pmc a
+ .param pmc b
+ $P0 = 'infix:+'(a,b)
+ assign a, $P0
+ .return (a)
+.end
+
+.sub 'infix:&' :multi(_,_)
+ .param int a
+ .param int b
+ $I0 = band a, b
+ .return ($I0)
+.end
+
+.sub 'infix:&' :multi(CardinalArray,CardinalArray)
+ .param pmc a
+ .param pmc b
+ .local pmc intersection
+ intersection = new 'CardinalArray'
+ .local pmc item
+ .local pmc it
+ it = iter a
+ loop:
+ unless it goto loop_end
+ item = shift it
+ $I0 = b.'include?'(item)
+ unless $I0, loop
+ intersection.'push'(item)
+ goto loop
+ loop_end:
+ .return (intersection)
+.end
+
+.sub 'infix:*' :multi(CardinalString,CardinalInteger)
+ .param pmc a
+ .param pmc b
+ $P0 = new 'CardinalString'
+ $P0 = repeat a, b
+ .return ($P0)
+.end
+
+
+## autoincrement
+.sub 'postfix:++' :multi(_)
+ .param pmc a
+ $P0 = clone a
+ inc a
+ .return ($P0)
+ #.return (a)
+.end
+
+.sub 'postfix:--' :multi(_)
+ .param pmc a
+ $P0 = clone a
+ dec a
+ .return ($P0)
+.end
+
+
+=back
+
+=cut
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
Added: cardinal/trunk/src/builtins/say.pir
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/src/builtins/say.pir Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,63 @@
+# $Id$
+
+=head1
+
+builtin functions for Ruby.
+
+=cut
+
+.namespace []
+
+.sub 'print'
+ .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:
+ .return ()
+.end
+
+.sub 'puts'
+ .param pmc args :slurpy
+ $S0 = join "\n", args
+ 'print'($S0, "\n")
+.end
+
+.sub 'p'
+ .param pmc args :slurpy
+ $S0 = join "\n", args
+ 'print'($S0, "\n")
+.end
+
+.sub 'readline'
+ #.param pmc sep :optional #record sep
+ $P0 = getstdin
+ $S0 = $P0.'readline'('')
+ .return($S0)
+.end
+
+.sub 'printf'
+ .param pmc fmt
+ .param pmc args :slurpy
+ $P0 = get_hll_global ['Kernel'], '!CARDINALMETA'
+ $P0.'printf'(fmt, args :flat)
+.end
+
+.sub 'sprintf'
+ .param pmc fmt
+ .param pmc args :slurpy
+ $P0 = get_hll_global ['Kernel'], '!CARDINALMETA'
+ $P1 = $P0.'sprintf'(fmt, args :flat)
+ .return ($P1)
+.end
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
+
Added: cardinal/trunk/src/classes/Any.pir
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/src/classes/Any.pir Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,54 @@
+## $Id$
+
+=head1 TITLE
+
+Any - Perl 6 Any class
+
+=head1 DESCRIPTION
+
+This file implements the Any class.
+
+=head2 Basic C<Any> methods
+
+=over 4
+
+=cut
+
+.namespace []
+.sub 'onload' :anon :init :load
+ .local pmc meta
+ meta = get_hll_global ['CardinalObject'], '!CARDINALMETA'
+ meta.'new_class'('CardinalAny', 'parent'=>'CardinalObject')
+.end
+
+
+=item can($x)
+
+=cut
+
+.namespace ['CardinalAny']
+.sub 'can' :method
+ .param pmc x
+ $P0 = self.'HOW'()
+ .tailcall $P0.'can'(self, x)
+.end
+
+=item isa($x)
+
+=cut
+
+.sub 'isa' :method
+ .param pmc x
+ $P0 = self.'HOW'()
+ .tailcall $P0.'isa'(self, x)
+.end
+
+=back
+
+=cut
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
Added: cardinal/trunk/src/classes/Array.pir
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/src/classes/Array.pir Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,1451 @@
+## $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
+ .local pmc cardinalmeta, arrayproto, interp, core_type, hll_type
+ cardinalmeta = get_hll_global ['CardinalObject'], '!CARDINALMETA'
+ arrayproto = cardinalmeta.'new_class'('CardinalArray', 'parent'=>'parrot;ResizablePMCArray CardinalObject')
+ #cardinalmeta.'register'('ResizablePMCArray', 'parent'=>'CardinalObject', 'protoobject'=>arrayproto)
+ core_type = get_class 'ResizablePMCArray'
+ hll_type = get_class 'CardinalArray'
+
+ interp = getinterp
+ interp.'hll_map'(core_type, hll_type)
+
+.end
+
+=item get_string() (vtable method)
+
+Return the elements of the list concatenated.
+
+=cut
+
+.sub 'get_string' :vtable :method
+ $S0 = join ', ', self
+ $S0 = concat '[', $S0
+ $S0 = concat $S0, ']'
+ .return ($S0)
+.end
+
+.sub 'initialize' :method :multi(_)
+ noop
+.end
+
+.include "hllmacros.pir"
+.sub 'initialize' :method :multi(_,CardinalInteger)
+ .param pmc size
+ .local pmc i
+ i = new 'CardinalInteger'
+ i = 0
+ $P0 = get_hll_global 'nil'
+ .DoWhile( {
+ self[i] = $P0
+ inc i
+ }, i < size)
+.end
+
+=item to_s() (method)
+
+Return a CardinalString representing the Array.
+
+=cut
+
+.sub 'to_s' :method
+ $S0 = join '', self
+ $P0 = new 'CardinalString'
+ $P0 = $S0
+ .return($P0)
+.end
+
+=item clone() (vtable method)
+
+Clones the list.
+
+=cut
+
+.sub 'clone' :vtable :method
+ $P0 = 'list'(self)
+ .return ($P0)
+.end
+
+=item clear() (method)
+
+Removes all elements from the array.
+
+=cut
+
+.sub 'clear' :method
+ self = 0
+.end
+
+=item fill(value)
+
+Fill C<self> with C<value>
+Doesnt work, but it should be close...
+
+=cut
+
+.sub 'fill' :method
+ .param pmc value
+ .param int offset :optional
+ .param int end_index :optional
+
+ unless end_index goto set_index
+ unless offset goto set_offset
+ goto do_fill
+
+ set_index:
+ end_index = self.'length'()
+ unless offset goto set_offset
+ goto do_fill
+ set_offset:
+ offset = 0
+ goto do_fill
+ do_fill:
+ $P0 = new 'CardinalString'
+ $P0 = value
+ splice self, value, offset, end_index
+ .return (self)
+.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
+
+Return the class name
+
+=cut
+
+.sub 'class' :method
+ .tailcall self.'WHAT'()
+.end
+
+=item sort()
+
+Return a sorted copy of the list
+
+=cut
+
+.sub 'sort' :method
+ .param pmc by :optional
+ .param int has_by :opt_flag
+ if has_by goto have_by
+ by = get_hll_global 'infix:cmp'
+ have_by:
+
+ .local pmc list, fpa
+ .local int elems
+
+ list = self
+ elems = list.'elems'()
+ fpa = new 'FixedPMCArray'
+ fpa = elems
+
+ .local int i
+ i = 0
+ fpa_loop:
+ unless i < elems goto fpa_end
+ $P0 = list[i]
+ fpa[i] = $P0
+ inc i
+ goto fpa_loop
+ fpa_end:
+ fpa.'sort'(by)
+ .tailcall 'list'(fpa :flat)
+.end
+
+.sub 'sort!' :method
+ .param pmc by :optional
+ .param int has_by :opt_flag
+ if has_by goto have_by
+ by = get_hll_global 'infix:cmp'
+ have_by:
+ $P0 = self.'sort'()
+ self = 0
+ self.'append'($P0)
+.end
+
+=item uniq(...)
+
+=cut
+
+# TODO Rewrite it. It's too naive.
+
+.sub uniq :method
+ .local pmc ulist
+ .local pmc key
+ .local pmc val
+ .local pmc uval
+ .local int len
+ .local int i
+ .local int ulen
+ .local int ui
+
+ ulist = new 'CardinalArray'
+ len = self.'elems'()
+ i = 0
+
+ loop:
+ if i == len goto done
+
+ val = self[i]
+
+ ui = 0
+ ulen = ulist.'elems'()
+ inner_loop:
+ if ui == ulen goto inner_loop_done
+
+ uval = ulist[ui]
+ if uval == val goto found
+
+ inc ui
+ goto inner_loop
+ inner_loop_done:
+
+ ulist.'push'(val)
+
+ found:
+
+ inc i
+ goto loop
+
+ done:
+ .return(ulist)
+.end
+
+.sub 'uniq!' :method
+ $P0 = self.'uniq'()
+ self = 0
+ self.'append'($P0)
+.end
+
+.sub 'max' :method
+ $P0 = 'infix:max'(self)
+ .return($P0)
+.end
+
+.sub 'min' :method
+ $P0 = 'infix:min'(self)
+ .return($P0)
+.end
+
+=item include?(ELEMENT)
+
+Return true if self contains ELEMENT
+
+=cut
+.sub 'include?' :method
+ .param pmc args
+ .local pmc iter
+ iter = new 'Iterator', self
+ iter_loop:
+ unless iter goto done_f
+ $P0 = shift iter
+ eq $P0, args, done_t
+ goto iter_loop
+ done_f:
+ $P0 = get_hll_global ['Bool'], 'False'
+ .return($P0)
+ done_t:
+ $P0 = get_hll_global ['Bool'], 'True'
+ .return($P0)
+.end
+
+=item
+Return true is C<self> is of size 0
+=cut
+.sub 'empty?' :method
+ .local int len
+ len = self.'length'()
+ if len == 0 goto empty
+ goto not_empty
+ empty:
+ $P0 = get_hll_global ['Bool'], 'True'
+ .return ($P0)
+ not_empty:
+ $P0 = get_hll_global ['Bool'], 'False'
+ .return ($P0)
+.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. SEPARATOR is an optional parameter
+
+=cut
+
+.sub 'join' :method
+ .param string sep :optional
+ .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:
+ $S0 = res
+ .return(res)
+.end
+
+=item reverse()
+
+Returns a list of the elements in reverse 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 reverse!()
+
+Reverses a list in place. Destructive update.
+Returns self.
+
+=cut
+
+.sub 'reverse!' :method
+ .local int pos
+ .local int len
+ .local pmc tmp1
+ .local pmc tmp2
+ pos = elements self
+ len = pos
+ dec len
+ pos = pos / 2
+ loop:
+ if pos == 0 goto done
+ dec pos
+ tmp1 = self[pos]
+ $I0 = len-pos
+ tmp2 = self[$I0]
+ self[pos] = tmp2
+ self[$I0] = tmp1
+ goto loop
+ done:
+ .return(self)
+.end
+
+=item delete()
+
+Deletes the given element from the CardinalArray, replacing them with Undef.
+Returns the item if found, otherwise returns the result of running the block
+if passed, otherwise returns nil.
+
+=cut
+
+.sub delete :method
+ .param pmc item
+ .param pmc block :optional :named('!BLOCK')
+ .param int block_flag :opt_flag
+ .local pmc nil
+ .local pmc elem
+ .local int len
+ .local int i
+ .local pmc return
+ .local pmc nil
+
+ nil = new 'NilClass'
+ return = nil
+
+ len = elements self
+ i = 0
+
+ loop:
+ if i == len goto done
+
+ elem = self[i]
+
+
+ $I0 = elem == item
+ if $I0, found
+ inc i
+
+ goto loop
+ found:
+ return = item
+ delete self[i]
+ dec len
+ goto loop
+ done:
+ $I0 = return == nil
+ if $I0, not_found
+ .return(return)
+ not_found:
+ if block_flag, have_block
+ .return(return)
+ have_block:
+ $P0 = block()
+ .return($P0)
+.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:
+ .tailcall '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
+ .param pmc block :named('!BLOCK')
+ .local pmc retv
+ .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]
+ $P0 = 'infix:=~'(block_arg, test)
+ unless $P0 goto next
+ block_res = block(block_arg)
+ if block_res goto grepped
+ goto next
+
+ grepped:
+ retv.'push'(block_res)
+ goto next
+
+ next:
+ inc i
+ goto loop
+
+ done:
+ .return(retv)
+.end
+
+=item first(...)
+
+=cut
+
+.sub first :method :multi(CardinalArray,_)
+ .param int count
+ .local pmc newlist
+ .local pmc item
+ .local int elems
+ .local int i
+
+ newlist = new 'CardinalArray'
+
+ elems = elements self
+ le count, elems, sufficient_elements
+ count = elems
+ sufficient_elements:
+
+ i = 0
+
+ loop:
+ if i == count goto done
+ item = self[i]
+ item = clone item
+
+ push newlist, item
+
+ inc i
+ goto loop
+ done:
+ .return(newlist)
+.end
+
+.sub first :method :multi(CardinalArray)
+ .local pmc item
+ $I0 = elements self
+ eq $I0, 0, empty
+ item = self[0]
+ .return (item)
+ empty:
+ item = new 'Undef'
+ .return (item)
+.end
+
+=item first(...)
+
+=cut
+
+.sub last :method :multi(CardinalArray,_)
+ .param int count
+ .local pmc newlist
+ .local pmc item
+ .local int elems
+ .local int i
+
+ newlist = new 'CardinalArray'
+
+ elems = elements self
+ count = elems - count
+ ge count, 0, sufficient_elements
+ count = 0
+ sufficient_elements:
+
+ i = elems - 1
+
+ loop:
+ lt i, count, done
+ item = self[i]
+ item = clone item
+
+ unshift newlist, item
+
+ dec i
+ goto loop
+ done:
+ .return(newlist)
+.end
+
+.sub last :method :multi(CardinalArray)
+ .local pmc item
+ $I0 = elements self
+ eq $I0, 0, empty
+ dec $I0
+ item = self[$I0]
+ .return (item)
+ empty:
+ item = new 'Undef'
+ .return (item)
+.end
+
+=item each(block)
+
+Run C<block> once for each item in C<self>, with the item passed as an arg.
+
+=cut
+
+.sub 'each' :method
+ .param pmc block :named('!BLOCK')
+ $P0 = new 'Iterator', self
+ each_loop:
+ unless $P0 goto each_loop_end
+ $P1 = shift $P0
+ block($P1)
+ goto each_loop
+ each_loop_end:
+.end
+
+.sub 'each_with_index' :method
+ .param pmc block :named('!BLOCK')
+ .local int len
+ len = elements self
+ $I0 = 0
+ each_loop:
+ if $I0 == len goto each_loop_end
+ $P0 = self[$I0]
+ block($P0,$I0)
+ inc $I0
+ goto each_loop
+ each_loop_end:
+.end
+
+=item collect(block)
+
+Run C<block> once for each item in C<self>, with the item passed as an arg.
+Creates a new Array containing the results and returns it.
+
+=cut
+
+.sub 'collect' :method
+ .param pmc block :named('!BLOCK')
+ .local pmc result
+ result = new 'CardinalArray'
+ $P0 = new 'Iterator', self
+ each_loop:
+ unless $P0 goto each_loop_end
+ $P1 = shift $P0
+ $P2 = block($P1)
+ result.'push'($P2)
+ goto each_loop
+ each_loop_end:
+ .return (result)
+.end
+
+=item flatten
+
+ recursively flatten any inner arrays into a single outer array
+
+=cut
+.sub 'flatten' :method
+ .local pmc returnMe
+ .local pmc iterator
+ returnMe = new 'CardinalArray'
+ iterator = new 'Iterator', self
+ each_loop:
+ unless iterator goto each_loop_end
+ $P1 = shift iterator
+ #if $P1 is an array call flatten
+ $I0 = isa $P1, 'CardinalArray'
+ if $I0 goto inner_flatten
+ push returnMe, $P1
+ goto each_loop
+ inner_flatten:
+ $P2 = $P1.'flatten'()
+ $P3 = new 'Iterator', $P2
+ inner_loop:
+ unless $P3 goto each_loop
+ $P4 = shift $P3
+ push returnMe, $P4
+ goto inner_loop
+ goto each_loop
+ each_loop_end:
+ .return(returnMe)
+.end
+
+=item size
+
+Retrieve the number of elements in C<self>
+
+=cut
+.sub 'size' :method
+ $I0 = self
+ .return($I0)
+.end
+
+=item length
+
+Retrieve the number of elements in C<self>
+
+=cut
+.sub 'length' :method
+ $I0 = self
+ .return($I0)
+.end
+
+=item at(index)
+
+ Retrieve element from position C<index>.
+
+=cut
+.sub 'at' :method
+ .param pmc i
+ $P0 = self[i]
+ .return($P0)
+.end
+
+.sub '[]' :method
+ .param pmc i
+ $P0 = self[i]
+ .return($P0)
+.end
+
+.sub '[]=' :method
+ .param pmc k
+ .param pmc v
+ self[k] = v
+ .return()
+.end
+
+
+=item slice
+
+Retrieve the number of elements in C<self>
+
+=cut
+.sub 'slice' :method
+ .param int start
+ .param int end
+ .local pmc returnMe
+ returnMe = new 'CardinalArray'
+ $I0 = start
+ each_loop:
+ unless $I0 <= end goto each_loop_end
+ $P0 = self[$I0]
+ inc $I0
+ push returnMe, $P0
+ goto each_loop
+ each_loop_end:
+ .return(returnMe)
+.end
+
+=item zip
+
+The zip operator.
+
+=cut
+
+.sub 'zip' :method
+ .param pmc args :slurpy
+ .local int num_args
+ .local pmc zipped
+ num_args = elements args
+
+ zipped = new 'CardinalArray'
+
+ # Get minimum element count - what we'll zip to.
+ .local pmc iterator, args_iter, arg, item
+ .local int i
+ iterator = new 'Iterator', self
+ i = 0
+
+ setup_loop:
+ unless iterator, setup_loop_done
+ args_iter = new 'Iterator', args
+ item = new 'CardinalArray'
+ $P0 = shift iterator
+ item.'push'($P0)
+ inner_loop:
+ unless args_iter, inner_loop_done
+ arg = shift args_iter
+ $P0 = arg[i]
+ unless null $P0 goto arg_not_null
+ $P0 = get_hll_global 'nil'
+ arg_not_null:
+ item.'push'($P0)
+ goto inner_loop
+ inner_loop_done:
+ inc i
+ zipped.'push'(item)
+ goto setup_loop
+ setup_loop_done:
+
+ .return (zipped)
+.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
+ .tailcall '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
+
+ # 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
+ .local pmc compare
+ compare = get_hll_global 'infix:<=>'
+find_min_loop:
+ if i >= elems goto find_min_loop_end
+ $P0 = args[i]
+ #$I0 = cur_min.'infix:cmp'($P0)
+ $I0 = cur_min.compare($P0)
+ 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
+
+ # 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
+ .local pmc compare
+ compare = get_hll_global 'infix:<=>'
+find_max_loop:
+ if i >= elems goto find_max_loop_end
+ $P0 = args[i]
+ #$I0 = 'infix:<=>'($P0, cur_max)
+ $I0 = cur_max.compare($P0)
+ 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
+
+ .tailcall list.'keys'()
+.end
+
+.sub values :multi('CardinalArray')
+ .param pmc list
+
+ .tailcall list.'values'()
+.end
+
+.sub delete :multi('CardinalArray')
+ .param pmc list
+ .param pmc indices :slurpy
+
+ .tailcall list.'delete'(indices :flat)
+.end
+
+.sub exists :multi('CardinalArray')
+ .param pmc list
+ .param pmc indices :slurpy
+
+ .tailcall list.'exists'(indices :flat)
+.end
+
+.sub kv :multi('CardinalArray')
+ .param pmc list
+
+ .tailcall list.'kv'()
+.end
+
+.sub pairs :multi('CardinalArray')
+ .param pmc list
+
+ .tailcall list.'pairs'()
+.end
+
+.sub grep :multi(_,'CardinalArray')
+ .param pmc test
+ .param pmc list :slurpy
+
+ .tailcall list.'grep'(test)
+.end
+
+.sub first :multi(_,'CardinalArray')
+ .param pmc test
+ .param pmc list :slurpy
+
+ .tailcall list.'first'(test)
+.end
+
+.sub 'infix:<<' :multi('CardinalArray',_)
+ .param pmc array
+ .param pmc item
+ push array, item
+ .return(array)
+.end
+
+## TODO: join map reduce sort zip
+
+=back
+
+=cut
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
Added: cardinal/trunk/src/classes/Bool.pir
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/src/classes/Bool.pir Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,61 @@
+## $Id$
+
+=head1 TITLE
+
+Bool - Cardinal boolean class
+Swiped from RAKUDO
+
+=head1 DESCRIPTION
+
+This file sets up the Cardinal C<Bool> class, and initializes
+symbols for C<Bool::True> and C<Bool::False>.
+
+=cut
+
+.namespace ['Bool']
+
+.sub 'onload' :anon :init :load
+ .local pmc cardinalmeta, boolproto
+ cardinalmeta = get_hll_global ['CardinalObject'], '!CARDINALMETA'
+ boolproto = cardinalmeta.'new_class'('Bool', 'parent'=>'parrot;Boolean')
+ cardinalmeta.'register'('Boolean', 'parent'=>boolproto, 'protoobject'=>boolproto)
+
+ $P0 = boolproto.'new'()
+ $P0 = 0
+ set_hll_global ['Bool'], 'False', $P0
+
+ $P0 = boolproto.'new'()
+ $P0 = 1
+ set_hll_global ['Bool'], 'True', $P0
+.end
+
+
+.sub 'ACCEPTS' :method
+ .param pmc topic
+ .return (self)
+.end
+
+
+.sub 'perl' :method
+ if self goto false
+ .return ('Bool::False')
+ false:
+ .return ('Bool::True')
+.end
+
+
+.sub 'succ' :method :vtable('increment')
+ self = 1
+.end
+
+
+.sub 'pred' :method :vtable('decrement')
+ self = 0
+.end
+
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
Added: cardinal/trunk/src/classes/Continuation.pir
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/src/classes/Continuation.pir Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,48 @@
+# Copyright (C) 2001-2008, Parrot Foundation.
+# $Id$
+
+=head1 TITLE
+
+Continuation - Cardinal Continuation class
+
+=head1 DESCRIPTION
+
+=head2 Functions
+
+=over
+
+=item onload()
+
+Perform initializations and create the Continuation class
+
+=cut
+
+.namespace ['CardinalContinuation']
+
+.sub 'onload' :anon :init :load
+ .local pmc cardinalmeta, contproto
+ cardinalmeta = get_hll_global ['CardinalObject'], '!CARDINALMETA'
+ contproto = cardinalmeta.'new_class'('CardinalContinuation', 'parent'=>'parrot;Continuation CardinalObject')
+ cardinalmeta.'register'('Continuation', 'parent'=>'CardinalObject', 'protoobject'=>contproto)
+
+.end
+
+.sub 'get_string' :vtable
+ $S0 = 'Continuation'
+ .return ($S0)
+.end
+
+.sub 'call' :method
+ #.param pmc args :optional
+ #.local pmc cont
+ #getattribute cont, self, '!block'
+ #$P0 = block(args :flat)
+ self()
+ #.return ($P0)
+.end
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
Added: cardinal/trunk/src/classes/Dir.pir
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/src/classes/Dir.pir Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,173 @@
+# Copyright (C) 2001-2008, Parrot Foundation.
+# $Id$
+
+=head1 TITLE
+
+Dir - Cardinal Dir class
+
+=head1 DESCRIPTION
+
+=head2 Functions
+
+=over
+
+=item onload()
+
+Perform initializations and create the Dir class
+
+=cut
+
+.namespace ['Dir']
+
+.sub 'onload' :anon :init :load
+ .local pmc cardinalmeta
+ $P0 = get_hll_global ['CardinalObject'], '!CARDINALMETA'
+ cardinalmeta = $P0.'new_class'('Dir', 'parent'=>'CardinalObject', 'attr'=>'!umask')
+.end
+
+#.sub 'new' :method
+# .param string dir
+# print "Dir.new"
+# print " param="
+# say dir
+ #opendir dir
+#.end
+
+.sub 'get_bool' :vtable
+ .return(1)
+.end
+
+#.sub 'get_string_keyed' :vtable
+# .return ('Dir')
+#.end
+
+.sub 'get_string' :vtable
+ $S0 = 'Dir'
+ .return ($S0)
+.end
+
+.sub 'chdir' :method
+ .param string new_dir
+ .param pmc block :named('!BLOCK') :optional
+ .param int has_block :opt_flag
+ .local pmc os
+ .local string old_dir
+
+ if has_block goto with_block
+ goto no_block
+
+ with_block:
+ os = new 'OS'
+ old_dir = os.'cwd'()
+ os.'chdir'(new_dir)
+ $P0 = block()
+ os.'chdir'(old_dir)
+ goto done
+ no_block:
+ $P0 = new 'CardinalInteger'
+ $P0 = 0
+ os = new 'OS'
+ os.'chdir'(new_dir)
+ goto done
+
+ done:
+ .return ($P0)
+.end
+
+.sub 'pwd' :method
+ .local pmc os
+ .local pmc pwd
+ pwd = new 'CardinalString'
+ os = new 'OS'
+ pwd = os.'cwd'()
+ .return (pwd)
+.end
+
+.sub 'getwd' :method
+ .tailcall self.'pwd'()
+.end
+
+.sub 'chroot' :method
+ .local pmc os
+ .local pmc status
+ status = new 'CardinalInteger'
+ os = new 'OS'
+ status = os.'cwd'()
+ .return (status)
+.end
+
+.sub 'mkdir' :method
+ .param string path
+ .param string mode :optional
+ .param int mode_flag :opt_flag
+ .local pmc os
+
+ os = new 'OS'
+ if mode_flag goto make
+ goto no_mode
+
+ no_mode:
+ mode = ''
+ goto make
+ make:
+ os.'mkdir'(path, mode)
+.end
+
+.sub 'unlink' :method
+ .tailcall self.'rmdir'()
+.end
+
+.sub 'delete' :method
+ .tailcall self.'rmdir'()
+.end
+
+.sub 'rmdir' :method
+ .param string path
+ .local pmc os
+ os = new 'OS'
+ os.'rm'(path)
+ $P0 = new 'CardinalInteger'
+ $P0 = 0
+ .return ($P0)
+.end
+
+.sub 'entries' :method
+ .param string path
+ .local pmc os
+ .local pmc list
+ os = new 'OS'
+ list = new 'CardinalArray'
+ $P0 = os.'readdir'(path)
+ $P1 = new 'Iterator', $P0
+ loop:
+ unless $P1 goto loop_end
+ $P2 = shift $P1
+ list.'push'($P2)
+ goto loop
+ loop_end:
+
+ .return (list)
+.end
+
+.sub 'foreach' :method
+ .param string path
+ .param pmc block :named('!BLOCK')
+ .local pmc names
+ names = self.'entries'(path)
+ $P0 = new 'Iterator', names
+ loop:
+ unless $P0 goto loop_end
+ $P1 = shift $P0
+ block($P1)
+ goto loop
+ loop_end:
+
+ $P2 = new 'NilClass'
+ .return ($P2)
+.end
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
Added: cardinal/trunk/src/classes/Failure.pir
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/src/classes/Failure.pir Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,101 @@
+.namespace ['CardinalFailure']
+
+.sub 'onload' :anon :init :load
+ .local pmc meta, failureproto, exceptionproto
+ meta = get_hll_global ['CardinalObject'], '!CARDINALMETA'
+ failureproto = meta.'new_class'('CardinalFailure', 'parent'=>'parrot;Undef CardinalAny', 'attr'=>'$!exception')
+ meta.'register'('Undef', 'parent'=>failureproto, 'protoobject'=>failureproto)
+ exceptionproto = meta.'new_class'('CardinalException', 'parent'=>'CardinalAny', 'attr'=>'$!exception')
+ meta.'register'('Exception', 'protoobject'=>exceptionproto)
+.end
+
+
+.sub '' :method :vtable('get_integer')
+ self.'!throw_unhandled'()
+ .return (0)
+.end
+
+.sub '' :method :vtable('get_number')
+ self.'!throw_unhandled'()
+ .return (0.0)
+.end
+
+.sub '' :method :vtable('get_string')
+ self.'!throw_unhandled'()
+ .return ('')
+.end
+
+
+.sub '!exception' :method
+ .local pmc exception
+ exception = getattribute self, '$!exception'
+ if null exception goto make_exception
+ $I0 = isa exception, 'Exception'
+ if $I0 goto have_exception
+ make_exception:
+ exception = new 'Exception'
+ exception['message'] = 'Use of uninitialized value'
+ setattribute self, '$!exception', exception
+ have_exception:
+ .return (exception)
+.end
+
+
+.sub '!throw_unhandled' :method
+ $I0 = self.'handled'()
+ if $I0 goto done
+ $P0 = self.'!exception'()
+ $S0 = $P0['message']
+ $S0 = concat $S0, "\n"
+ printerr $S0
+ done:
+.end
+
+.sub 'ACCEPTS' :method
+ .param pmc other
+ $I0 = defined other
+ if $I0 goto defined
+ .return(1)
+ defined:
+ .return(0)
+.end
+
+
+.sub 'defined' :method
+ $P0 = self.'!exception'()
+ $P0['handled'] = 1
+ $P1 = get_hll_global ['Bool'], 'False'
+ .return ($P1)
+.end
+
+
+.sub 'handled' :method
+ .local pmc exception
+ exception = self.'!exception'()
+ $I0 = exception['handled']
+ .return ($I0)
+.end
+
+
+.sub 'perl' :method
+ .return ('undef')
+.end
+
+
+.namespace []
+.sub 'undef'
+ .param pmc x :slurpy
+ ## 0-argument test, RT#56366
+ ## but see also C<< term:sym<undef> >> in STD.pm
+ unless x goto no_args
+ die "Obsolete use of undef; in Perl 6 please use undefine instead"
+ no_args:
+ $P0 = new 'Failure'
+ .return ($P0)
+.end
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
Added: cardinal/trunk/src/classes/File.pir
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/src/classes/File.pir Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,224 @@
+# Copyright (C) 2001-2008, Parrot Foundation.
+# $Id$
+
+=head1 TITLE
+
+File - Cardinal File class
+
+=head1 DESCRIPTION
+
+=head2 Functions
+
+=over
+
+=item onload()
+
+Perform initializations and create the File class
+
+=cut
+
+.namespace ['CardinalFile']
+
+.sub 'onload' :anon :init :load
+ .local pmc cardinalmeta
+ $P0 = get_hll_global ['CardinalObject'], '!CARDINALMETA'
+ cardinalmeta = $P0.'new_class'('CardinalFile', 'parent'=>'parrot;File IO CardinalObject', 'attr'=>'!path')
+ $P0.'register'('File', 'parent'=>'CardinalObject', 'protoobject'=>cardinalmeta)
+.end
+
+.sub 'get_bool' :vtable
+ .return (1)
+.end
+
+.sub 'ACCEPTS' :method
+ .param pmc topic
+ .local int i
+
+ .local string what
+ what = topic.'WHAT'()
+ if what == "CardinalFile" goto match
+ goto no_match
+ no_match:
+ $P0 = get_hll_global ['Bool'], 'False'
+ .return($P0)
+ match:
+ $P0 = get_hll_global ['Bool'], 'True'
+ .return($P0)
+.end
+
+#.sub 'get_string_keyed' :vtable
+# $S0 = 'File'
+# .return ($S0)
+#.end
+
+.namespace['File']
+
+.sub 'open' :method
+ .param pmc path
+ .param string mode :optional
+ .param pmc block :optional :named('!BLOCK')
+ .local pmc cardinalmeta, this
+ cardinalmeta = get_hll_global ['CardinalObject'], '!CARDINALMETA'
+ $P0 = cardinalmeta.'get_parrotclass'(self)
+ this = $P0.'new'()
+ $S0 = this.'!to_path'(path)
+ $P0 = this.'initialize'(path, mode)
+ $I0 = defined block
+ if $I0 == 1 goto exec_block
+ goto done
+ exec_block:
+ getattribute $P1, this, '!io'
+ block(this)
+ close $P1
+ $P2 = get_hll_global 'nil'
+ .return ($P2)
+ done:
+ .return (this)
+.end
+
+.sub 'initialize' :method
+ .param pmc path
+ .param string mode :optional
+ .local string parrot_io_mode
+ $S0 = self.'!to_path'(path)
+ bsr parse_mode
+ open $P1, $S0, parrot_io_mode
+ #setprop self, '!io', $P0
+ setattribute self, '!io', $P1
+ #setprop self, '!path', path
+
+ setattribute self, '!path', path
+ goto done
+ parse_mode:
+ unless mode goto default_mode
+ eq_str mode, "r", default_mode
+ eq_str mode, "w", write_mode
+ #eq_str mode, "r+", read_write_mode
+ #eq_str mode, "a", append_mode
+ goto done
+ default_mode:
+ parrot_io_mode = "<"
+ ret
+ append_mode:
+ parrot_io_mode = ">>"
+ ret
+ write_mode:
+ parrot_io_mode = ">"
+ ret
+ done:
+ .return (self)
+.end
+
+.sub '!to_path' :method
+ .param pmc path
+ $S0 = typeof path
+ cmp_str $I0, $S0, "CardinalString"
+ if $I0 == 0 goto have_path
+ goto get_path
+ get_path:
+ path = path.'to_path'()
+ goto have_path
+ have_path:
+ $S0 = path
+ .return ($S0)
+ no_path:
+ #TODO probably should throw an exception
+ $S0 = ""
+ .return ($S0)
+.end
+
+.include 'hllmacros.pir'
+.include 'cclass.pasm'
+.sub 'read' :method
+ .local pmc io
+ #getprop io, '!io', self
+ getattribute io, self, '!io'
+ #readline, read, peek
+ $P0 = new 'CardinalString'
+ readline $S0, io
+ .While( { $S0 != '' },
+ {
+ $P0 = $P0.'concat'($S0)
+ #$P0 = $P0.'concat'(.CCLASS_NEWLINE)
+ readline $S0, io
+ })
+ .return ($P0)
+.end
+
+.sub 'puts' :method
+ .param pmc args
+ .local pmc io
+ #getprop io, '!io', self
+ getattribute io, self, '!io'
+ print io, args
+.end
+
+.sub 'class' :method
+ $P0 = new 'CardinalString'
+ $S0 = "File"
+ $P0.'concat'($S0)
+ .return ($P0)
+.end
+
+.sub 'path' :method
+ .local pmc path
+ path = new 'CardinalString'
+ #getprop path, '!path', self
+ getattribute path, self, '!path'
+ .return (path)
+.end
+
+.sub 'stat' :method
+ .local pmc stat
+ stat = new 'FileStat'
+ $P0 = self.'path'()
+ stat.'initialize'($P0)
+ .return(stat)
+.end
+
+.sub 'exist?' :method
+ .param string path
+ $I0 = 0
+ $I1 = stat path, $I0
+ if $I1 == 1 goto yes
+ goto no
+ yes:
+ $P0 = get_hll_global ['Bool'], 'True'
+ .return ($P0)
+ no:
+ $P0 = get_hll_global ['Bool'], 'False'
+ .return ($P0)
+.end
+
+.sub 'exists?' :method
+ .param string path
+ .local pmc exists
+ exists = self.'exist?'(path)
+ .return (exists)
+.end
+
+.sub 'unlink' :method
+ .param pmc file_names :slurpy
+ .local pmc os
+ $P0 = new 'Iterator', file_names
+ os = new 'OS'
+ loop:
+ unless $P0 goto done
+ $S0 = shift $P0
+ os.'rm'($S0)
+ #unlink $S0 #does the unlink op code exist? should I use it?
+ goto loop
+ done:
+.end
+
+.sub 'delete' :method
+ .param pmc file_names :slurpy
+ self.'unlink'(file_names :flat)
+.end
+
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
Added: cardinal/trunk/src/classes/FileStat.pir
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/src/classes/FileStat.pir Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,292 @@
+# Copyright (C) 2001-2008, Parrot Foundation.
+# $Id$
+
+=head1 TITLE
+
+FileStat - Cardinal File Stat class
+
+=head1 DESCRIPTION
+
+=head2 Functions
+
+=over
+
+=item onload()
+
+Perform initializations and create the File Stat class
+
+=cut
+
+.namespace ['FileStat']
+#constants for the stat op code, not to be confused w/ the OS.stat method
+.include 'stat.pasm'
+
+.sub 'onload' :anon :init :load
+ .local pmc cardinalmeta
+ $P0 = get_hll_global ['CardinalObject'], '!CARDINALMETA'
+ cardinalmeta = $P0.'new_class'('FileStat', 'parent'=>'CardinalObject', 'attr'=>'!path')
+ #$P0.'register'('File', 'parent'=>'CardinalObject', 'protoobject'=>cardinalmeta)
+.end
+
+.sub 'get_bool' :vtable
+ .return (1)
+.end
+
+.sub 'ACCEPTS' :method
+ .param pmc topic
+ .local int i
+
+ .local string what
+ what = topic.'WHAT'()
+ if what == "FileStat" goto match
+ goto no_match
+ no_match:
+ $P0 = get_hll_global ['Bool'], 'False'
+ .return($P0)
+ match:
+ $P0 = get_hll_global ['Bool'], 'True'
+ .return($P0)
+.end
+
+.sub 'get_string' :vtable
+ $S0 = 'FileStat'
+ .return ($S0)
+.end
+
+.sub 'initialize' :method
+ .param pmc path
+ setattribute self, '!path', path
+.end
+
+.sub 'class' :method
+ $P0 = new 'CardinalString'
+ $S0 = "File::Stat"
+ $P0.'concat'($S0)
+ .return ($P0)
+.end
+
+.sub 'path' :method
+ .local pmc path
+ path = new 'CardinalString'
+ getattribute path, self, '!path'
+ .return (path)
+.end
+
+.sub 'directory?' :method
+ .local pmc dir
+ .local pmc path
+ path = self.'path'()
+ $S0 = path
+ $I0 = 2
+ $I1 = stat $S0, $I0
+ if $I1 == 1 goto yes
+ goto no
+ yes:
+ $P0 = get_hll_global ['Bool'], 'True'
+ .return ($P0)
+ no:
+ $P0 = get_hll_global ['Bool'], 'False'
+ .return ($P0)
+.end
+
+.sub 'file?' :method
+ .local pmc dir
+ .local pmc path
+ path = self.'path'()
+ $S0 = path
+ $I0 = 3
+ $I1 = stat $S0, $I0
+ if $I1 == 1 goto no
+ goto yes
+ yes:
+ $P0 = get_hll_global ['Bool'], 'True'
+ .return ($P0)
+ no:
+ $P0 = get_hll_global ['Bool'], 'False'
+ .return ($P0)
+.end
+
+.sub 'dev' :method
+ .local pmc dev
+ .local pmc os
+ .local pmc path
+ path = self.'path'()
+ os = new 'OS'
+ $P0 = os.'stat'(path)
+ $I0 = $P0[0]
+ dev = new 'CardinalInteger'
+ dev = $I0
+ .return (dev)
+.end
+
+.sub 'ino' :method
+ .local pmc mode
+ .local pmc os
+ .local pmc path
+ path = self.'path'()
+ os = new 'OS'
+ $P0 = os.'stat'(path)
+ $I0 = $P0[1]
+ mode = new 'CardinalInteger'
+ mode = $I0
+ .return (mode)
+.end
+
+.sub 'mode' :method
+ .local pmc mode
+ .local pmc os
+ .local pmc path
+ path = self.'path'()
+ os = new 'OS'
+ $P0 = os.'stat'(path)
+ $I0 = $P0[2]
+ mode = new 'CardinalInteger'
+ mode = $I0
+ .return (mode)
+.end
+
+.sub 'nlink' :method
+ .local pmc links
+ .local pmc os
+ .local pmc path
+ path = self.'path'()
+ os = new 'OS'
+ $P0 = os.'stat'(path)
+ $I0 = $P0[3]
+ links = new 'CardinalInteger'
+ links = $I0
+ .return (links)
+.end
+
+.sub 'uid' :method
+ .local pmc gid
+ .local pmc os
+ .local pmc path
+ path = self.'path'()
+ os = new 'OS'
+ $P0 = os.'stat'(path)
+ $I0 = $P0[4]
+ gid = new 'CardinalInteger'
+ gid = $I0
+ .return (gid)
+.end
+
+.sub 'gid' :method
+ .local pmc gid
+ .local pmc os
+ .local pmc path
+ path = self.'path'()
+ os = new 'OS'
+ $P0 = os.'stat'(path)
+ $I0 = $P0[5]
+ gid = new 'CardinalInteger'
+ gid = $I0
+ .return (gid)
+.end
+
+.sub 'rdev' :method
+ .local pmc rdev
+ .local pmc os
+ .local pmc path
+ path = self.'path'()
+ os = new 'OS'
+ $P0 = os.'stat'(path)
+ $I0 = $P0[6]
+ rdev = new 'CardinalInteger'
+ rdev = $I0
+ .return (rdev)
+.end
+
+.sub 'size?' :method
+ .local pmc mode
+ .local pmc os
+ .local pmc path
+ path = self.'path'()
+ os = new 'OS'
+ $P0 = os.'stat'(path)
+ $I0 = $P0[7]
+ mode = new 'CardinalInteger'
+ mode = $I0
+ .return (mode)
+.end
+
+.sub 'size' :method
+ $P0 = self.'size?'()
+ .return ($P0)
+.end
+
+.sub 'executable?' :method
+ $P0 = self.'mode'()
+ .return ($P0)
+.end
+
+.sub 'atime' :method
+ .local pmc atime
+ .local pmc os
+ .local pmc path
+ path = self.'path'()
+ os = new 'OS'
+ $P0 = os.'stat'(path)
+ #$I0 = $P0[.STAT_ACCESSTIME] Wrong stat constants, there doesnt seem to be any OS stat consts
+ $I0 = $P0[8]
+ atime = new 'Time'
+ atime.'initialize'($I0)
+ .return (atime)
+.end
+
+.sub 'mtime' :method
+ .local pmc mtime
+ .local pmc os
+ .local pmc path
+ path = self.'path'()
+ os = new 'OS'
+ $P0 = os.'stat'(path)
+ $I0 = $P0[9]
+ mtime = new 'Time'
+ mtime.'initialize'($I0)
+ .return (mtime)
+.end
+
+.sub 'ctime' :method
+ .local pmc ctime
+ .local pmc os
+ .local pmc path
+ path = self.'path'()
+ os = new 'OS'
+ $P0 = os.'stat'(path)
+ $I0 = $P0[10]
+ ctime = new 'Time'
+ ctime.'initialize'($I0)
+ .return (ctime)
+.end
+
+.sub 'blksize' :method
+ .local pmc blksize
+ .local pmc os
+ .local pmc path
+ path = self.'path'()
+ os = new 'OS'
+ $P0 = os.'stat'(path)
+ $I0 = $P0[11]
+ blksize = new 'CardinalInteger'
+ blksize = $I0
+ .return (blksize)
+.end
+
+.sub 'blocks' :method
+ .local pmc size
+ .local pmc os
+ .local pmc path
+ path = self.'path'()
+ os = new 'OS'
+ $P0 = os.'stat'(path)
+ $I0 = $P0[12]
+ size = new 'CardinalInteger'
+ size = $I0
+ .return (size)
+.end
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
Added: cardinal/trunk/src/classes/GC.pir
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/src/classes/GC.pir Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,127 @@
+## $Id$
+
+=head1 TITLE
+
+GC - Cardinal GC class
+
+=head1 DESCRIPTION
+
+=head2 Functions
+
+=over
+
+=item onload()
+
+Perform initializations and create the GC class
+
+=cut
+
+.namespace ['GC']
+
+.sub 'onload' :anon :init :load
+ .local pmc cardinalmeta
+ $P0 = get_hll_global ['CardinalObject'], '!CARDINALMETA'
+ cardinalmeta = $P0.'new_class'('GC', 'parent'=>'', 'attr'=>'$!disabled')
+ #$P2 = cardinalmeta.'HOW'()
+ #$P1 = new 'CardinalInteger'
+ #$P1 = 0
+ #setattribute $P2, '$!disabled', $P1
+ #set_hll_global ['GC'], '!CARDINALMETA', cardinalmeta
+.end
+
+.sub 'get_bool' :vtable
+ .return (1)
+.end
+
+#.sub 'get_string' :vtable
+# $S0 = 'GC'
+# .return ($S0)
+#.end
+
+.sub 'init' :vtable('init')
+ $P1 = new 'CardinalInteger'
+ $P1 = 0
+ setattribute self, '$!disabled', $P1
+.end
+
+.sub 'disable' :method
+ $P0 = getattribute self, "$!disabled"
+ #could have been null, need to make this class a singleton with these a class methods, not instance methods
+ if $P0 == 1 goto already_disabled
+ goto disable
+ disable:
+ $P1 = new 'CardinalInteger'
+ $P1 = 1
+ setattribute self, '$!disabled', $P1
+ collectoff
+ $P0 = new 'CardinalString'
+ $P0 = 'false'
+ .return ($P0)
+ already_disabled:
+ $P0 = new 'CardinalString'
+ $P0 = 'true'
+ .return ($P0)
+.end
+
+.sub 'enable' :method
+ $P0 = getattribute self, "$!disabled"
+ if $P0 == 1 goto enable
+ goto already_enabled
+ already_enabled:
+ $P0 = new 'CardinalString'
+ $P0 = 'false'
+ .return ($P0)
+ enable:
+ $P1 = new 'CardinalInteger'
+ $P1 = 0
+ setattribute self, '$!disabled', $P1
+ collecton
+ $P0 = new 'CardinalString'
+ $P0 = 'true'
+ .return ($P0)
+.end
+
+.sub 'start' :method
+ collect
+ $P0 = get_hll_global 'nil'
+ .return ($P0)
+.end
+
+.sub 'each_object' :method
+ .param pmc block :named('!BLOCK')
+ .local pmc addr_space, itr
+ .local pmc test
+ .return(1)
+ test = new 'CardinalString'
+ test = "yo"
+ # Nope AddrRegistry is not what I expected, we cant use it.
+ # We need to create Hash to store all the objects, Use WeakRefs to store the pmcs?
+ addr_space = new 'AddrRegistry'
+ $I0 = get_addr test
+ addr_space[$I0] = test
+ #$P0 = addr_space.'methods'()
+ #say $P0
+ itr = new 'Iterator', addr_space
+ print "created iterator: "
+ say itr
+ $S0 = typeof itr
+ print "itr type="
+ say $S0
+ itr_loop:
+ unless itr goto itr_end
+ $P0 = shift itr
+ $I0 = defined $P0
+ unless $I0 goto itr_loop
+ print "found: "
+ say $P0
+ goto itr_loop
+ itr_end:
+ say "done looping thru addr_space"
+ .return ()
+.end
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
Added: cardinal/trunk/src/classes/Hash.pir
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/src/classes/Hash.pir Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,315 @@
+## $Id$
+
+=head1 NAME
+
+src/classes/CardinalHash.pir - Cardinal hash class and related functions
+
+=head1 Methods
+
+=over 4
+
+=cut
+
+.namespace ['CardinalHash']
+
+.sub 'onload' :anon :load :init
+ .local pmc cardinalmeta, mappingproto
+ cardinalmeta = get_hll_global ['CardinalObject'], '!CARDINALMETA'
+ mappingproto = cardinalmeta.'new_class'('CardinalHash', 'parent'=>'parrot;Hash CardinalObject')
+ cardinalmeta.'register'('Hash', 'parent'=>'CardinalObject', 'protoobject'=>mappingproto)
+ $P0 = get_class 'CardinalHash'
+ addattribute $P0, 'default'
+.end
+
+
+.sub 'get_string' :vtable :method
+ $S0 = '{'
+ .local pmc iter
+ iter = new 'Iterator', self
+ goto loop_start
+ loop:
+ unless iter goto end
+ $S0 = concat $S0, ','
+ loop_start:
+ $S1 = shift iter
+ $S2 = iter[$S1]
+ $S0 = concat $S0, $S1
+ $S0 = concat $S0, '=>'
+ concat $S0, $S2
+ goto loop
+ end:
+ concat $S0, '}'
+ .return ($S0)
+.end
+
+=item to_s (method)
+
+Returns a string of keys and values appended together.
+
+=cut
+
+.sub 'to_s' :method
+ .local pmc iter
+ .local pmc rv
+ iter = new 'Iterator', self
+ rv = new 'CardinalString'
+ loop:
+ unless iter goto end
+ $S1 = shift iter
+ concat rv, $S1
+ $S1 = iter[$S1]
+ concat rv, $S1
+ goto loop
+ end:
+ .return (rv)
+.end
+
+
+
+=item kv (method)
+
+Returns elements of hash as array of C<Pair(key, value)>
+
+=cut
+
+.sub 'kv' :method
+ .local pmc iter
+ .local pmc rv
+ iter = new 'Iterator', self
+ rv = new 'CardinalArray'
+ loop:
+ unless iter goto end
+ $S1 = shift iter
+ push rv, $S1
+ $S1 = iter[$S1]
+ push rv, $S1
+ goto loop
+ end:
+ .return (rv)
+.end
+
+
+
+.sub 'keys' :method
+ .local pmc iter
+ .local pmc rv
+ iter = new 'Iterator', self
+ rv = new 'CardinalArray'
+ loop:
+ unless iter goto end
+ $S1 = shift iter
+ push rv, $S1
+ goto loop
+ end:
+ .return (rv)
+.end
+
+
+.sub 'values' :method
+ .local pmc iter
+ .local pmc rv
+ iter = new 'Iterator', self
+ rv = new 'CardinalArray'
+ loop:
+ unless iter goto end
+ $S1 = shift iter
+ $S1 = iter[$S1]
+ push rv, $S1
+ goto loop
+ end:
+ .return (rv)
+.end
+
+=item each(block)
+
+Run C<block> once for each item in C<self>, with the key and value passed as args.
+
+=cut
+
+.sub 'each' :method
+ .param pmc block
+ .local pmc iter
+ iter = new 'Iterator', self
+ each_loop:
+ unless iter goto each_loop_end
+ $P1 = shift iter
+ $P2 = iter[$P1]
+ block($P1,$P2)
+ goto each_loop
+ each_loop_end:
+.end
+
+.sub 'to_a' :method
+ .local pmc newlist
+ .local pmc item
+ .local pmc iter
+ newlist = new 'CardinalArray'
+ iter = new 'Iterator', self
+ each_loop:
+ unless iter goto each_loop_end
+ $P1 = shift iter
+ $P2 = iter[$P1]
+ item = new 'CardinalArray'
+ push item, $P1
+ push item, $P2
+ push newlist, item
+ goto each_loop
+ each_loop_end:
+ .return (newlist)
+.end
+
+
+## FIXME: Parrot currently requires us to write our own "clone" method.
+.sub 'clone' :vtable :method
+ $P0 = new 'CardinalHash'
+ .local pmc iter
+ iter = new 'Iterator', self
+ loop:
+ unless iter goto end
+ $P1 = shift iter
+ $P2 = iter[$P1]
+ $P0[$P1] = $P2
+ goto loop
+ end:
+ .return ($P0)
+.end
+
+.sub '[]' :method
+ .param pmc i
+ $P0 = self[i]
+ unless_null $P0, index_return
+ $P0 = getattribute self, 'default'
+ .local string type
+ type = typeof $P0
+ $I0 = iseq type, 'Closure'
+ unless $I0 goto index_return
+ $P1 = $P0(self,i)
+ $P0 = $P1
+ index_return:
+ .return($P0)
+.end
+
+.sub '[]=' :method
+ .param pmc k
+ .param pmc v
+ self[k] = v
+ .return(v)
+.end
+
+=back
+
+=head1 Functions
+
+=over 4
+
+=back
+
+=head1 TODO: Functions
+
+=over 4
+
+=cut
+
+.namespace []
+
+=item delete
+
+ our List multi method Hash::delete ( *@keys )
+ our Scalar multi method Hash::delete ( $key ) is default
+
+Deletes the elements specified by C<$key> or C<$keys> from the invocant.
+returns the value(s) that were associated to those keys.
+
+=item exists
+
+ our Bool multi method Hash::exists ( $key )
+
+True if invocant has an element whose key matches C<$key>, false
+otherwise.
+
+=item keys
+
+=item kv
+
+=cut
+
+.sub kv :multi('Hash')
+ .param pmc hash
+
+ .tailcall hash.'kv'()
+.end
+
+
+=item pairs
+
+=item values
+
+ multi Int|List Hash::keys ( %hash : MatchTest *@keytests )
+ multi Int|List Hash::kv ( %hash : MatchTest *@keytests )
+ multi Int|(List of Pair) Hash::pairs (%hash : MatchTest *@keytests )
+ multi Int|List Hash::values ( %hash : MatchTest *@keytests )
+
+Iterates the elements of C<%hash> in no apparent order, but the order
+will be the same between successive calls to these functions, as long as
+C<%hash> doesn't change.
+
+If C<@keytests> are provided, only elements whose keys evaluate
+C<$key ~~ any(@keytests)> as true are iterated.
+
+What is returned at each element of the iteration varies with function.
+C<keys> only returns the key; C<values> the value; C<kv> returns both as
+a 2 element list in (key, value) order, C<pairs> a C<Pair(key, value)>.
+
+Note that C<kv %hash> returns the same as C<zip(keys %hash; values %hash)>
+
+In Scalar context, they all return the count of elements that would have
+been iterated.
+
+The lvalue form of C<keys> is not longer supported. Use the C<.buckets>
+property instead.
+
+=back
+
+=cut
+
+.namespace []
+
+.sub 'infix:=>'
+ .param pmc key
+ .param pmc value
+ $P1 = new 'CardinalArray'
+ $P1.'push'(key)
+ $P1.'push'(value)
+ .return($P1)
+.end
+
+.sub 'hash'
+ .param pmc pairs :slurpy
+ .local pmc ahash
+ ahash = new 'CardinalHash'
+ .local pmc item
+ pairs_loop:
+ unless pairs goto pairs_loop_end
+ item = shift pairs
+ $P0 = shift item
+ $P1 = shift item
+ ahash[$P0] = $P1
+ goto pairs_loop
+ pairs_loop_end:
+ .return(ahash)
+.end
+
+.namespace ['Hash']
+
+.sub 'new' :method
+ .param pmc a :optional :named('!BLOCK')
+ $P0 = new 'CardinalHash'
+ setattribute $P0, 'default', a
+ .return($P0)
+.end
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
Added: cardinal/trunk/src/classes/IO.pir
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/src/classes/IO.pir Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,59 @@
+# Copyright (C) 2001-2008, Parrot Foundation.
+# $Id$
+
+=head1 TITLE
+
+IO - Cardinal IO class
+
+=head1 DESCRIPTION
+
+=head2 Functions
+
+=over
+
+=item onload()
+
+Perform initializations and create the IO class
+
+=cut
+
+.namespace ['IO']
+
+.const int DEFAULT_BLOCK_SIZE = 8129
+
+.sub 'onload' :anon :init :load
+ .local pmc cardinalmeta
+ $P0 = get_hll_global ['CardinalObject'], '!CARDINALMETA'
+ cardinalmeta = $P0.'new_class'('IO', 'parent'=>'CardinalObject', 'attr'=>'!io')
+.end
+
+.sub 'ACCEPTS' :method
+ .param pmc topic
+ .local int i
+
+ .local string what
+ what = topic.'WHAT'()
+ if what == "IO" goto match
+ goto no_match
+ match:
+ .return(1)
+ no_match:
+ .return(0)
+.end
+
+#.sub 'get_string' :vtable
+# $S0 = 'IO'
+# .return ($S0)
+#.end
+
+.sub 'read' :method
+ .param string path
+ .param pmc end_offset :optional
+ .param pmc start_offset :optional
+.end
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
Added: cardinal/trunk/src/classes/Integer.pir
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/src/classes/Integer.pir Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,222 @@
+## $Id$
+
+=head1 TITLE
+
+CardinalInteger - Cardinal integers
+
+=cut
+
+.namespace [ 'CardinalInteger' ]
+
+
+=head1 SUBROUTINES
+
+=over 4
+
+=item onload
+
+=cut
+
+.sub 'onload' :anon :init :load
+ .local pmc cardinalmeta, intproto
+ cardinalmeta = get_hll_global ['CardinalObject'], '!CARDINALMETA'
+ intproto = cardinalmeta.'new_class'('CardinalInteger', 'parent'=>'parrot;Integer CardinalObject')
+ cardinalmeta.'register'('Float', 'parent'=>'CardinalObject', 'protoobject'=>intproto)
+.end
+
+=item ACCEPTS()
+
+=cut
+
+.sub 'ACCEPTS' :method
+ .param num topic
+ .tailcall 'infix:=='(topic, self)
+.end
+
+=item perl()
+
+Returns a Perl representation of the CardinalInteger.
+
+=cut
+
+.sub 'perl' :method
+ $S0 = self
+ .return($S0)
+.end
+
+.sub 'integer?' :method
+ $P0 = get_hll_global['Bool'], 'True'
+ .return($P0)
+.end
+
+=item to_s()
+
+Returns a CardinalString representation of the CardinalInteger.
+
+=cut
+
+.sub 'to_s' :method
+ $P0 = new 'CardinalString'
+ $S0 = self
+ $P0 = $S0
+ .return($P0)
+.end
+
+=item
+to_i()
+to_int()
+floor()
+ceil()
+round()
+truncate()
+
+All return C<self>
+
+=cut
+
+.sub 'to_i' :method
+ .return(self)
+.end
+
+.sub 'to_int' :method
+ .return(self)
+.end
+
+.sub 'floor' :method
+ .return(self)
+.end
+
+.sub 'ceil' :method
+ .return(self)
+.end
+
+.sub 'round' :method
+ .return(self)
+.end
+
+.sub 'truncate' :method
+ .return(self)
+.end
+
+.sub 'numerator' :method
+ .return(self)
+.end
+
+=item
+
+Returns 1
+
+=cut
+
+.sub 'denominator' :method
+ $P0 = new 'CardinalInteger'
+ $P0 = 1
+ .return($P0)
+.end
+
+
+=item gcd(num)
+
+Return the greatest common divisor of C<self> and num
+
+=cut
+
+.sub 'gcd' :method
+ .param num other
+ $N0 = self
+ gcd $I0, $N0, other
+ .return($I0)
+.end
+
+=item downto(n, block)
+
+Runs C<block> for each integer from the current value of the Integer down to n.
+
+=cut
+
+.sub 'downto' :method
+ .param int n
+ .param pmc block :named('!BLOCK')
+ $I1 = self
+ downto_loop:
+ $I0 = $I1 < n
+ if $I0, downto_done
+ block($I1)
+ dec $I1
+ goto downto_loop
+ downto_done:
+.end
+
+
+=item upto(n, block)
+
+Runs C<block> for each integer from the current value of the Integer up to n.
+
+=cut
+
+.sub 'upto' :method
+ .param int n
+ .param pmc block :named('!BLOCK')
+ $I1 = self
+ upto_loop:
+ $I0 = $I1 > n
+ if $I0, upto_done
+ block($I1)
+ inc $I1
+ goto upto_loop
+ upto_done:
+.end
+
+=item
+
+Runs C<block> for integer from 0 to value of C<self>
+
+=cut
+
+.include "hllmacros.pir"
+.sub 'times' :method
+ .param pmc block
+ $I0 = 0
+ $I1 = self
+ .While($I0 < $I1, {
+ block($I0)
+ inc $I0
+ })
+.end
+
+=item succ()
+
+Return C<self> plus 1
+
+=cut
+
+.sub 'succ' :method
+ $P0 = new 'CardinalInteger'
+ $P0 = 1
+ $P1 = 'infix:+'($P0, self)
+ .return ($P1)
+.end
+
+=item next()
+
+Return C<self> plus 1
+
+=cut
+
+.sub 'next' :method
+ $P0 = new 'CardinalInteger'
+ $P0 = 1
+ $P1 = 'infix:+'($P0, self)
+ .return ($P1)
+.end
+
+
+=back
+
+=cut
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
Added: cardinal/trunk/src/classes/Kernel.pir
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/src/classes/Kernel.pir Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,166 @@
+## $Id$
+
+=head1 TITLE
+
+Kernel - Cardinal Kernel class
+
+=head1 DESCRIPTION
+
+=head2 Functions
+
+=over
+
+=item onload()
+
+Perform initializations and create the kernel class
+
+=cut
+
+.namespace ['Kernel']
+
+.sub 'onload' :anon :init :load
+ .local pmc cardinalmeta, kernelprototype
+ load_bytecode 'P6object.pbc'
+ $P0 = get_hll_global ['CardinalObject'], '!CARDINALMETA'
+ kernelprototype = $P0.'new_class'('Kernel', 'attr'=>'%!properties')
+ #cardinalmeta = $P0.'HOW'()
+ cardinalmeta = kernelprototype.'new'()
+ set_hll_global ['Kernel'], '!CARDINALMETA', cardinalmeta
+ #.local pmc cardinalmeta
+ #cardinalmeta = get_hll_global ['CardinalObject'], '!CARDINALMETA'
+ #cardinalmeta.'new_class'('CardinalKernel')
+ #$P0 = cardinalmeta.'HOW'()
+ #set_hll_global ['CardinalKernel'], '!CARDINALMETA', $P0
+.end
+
+
+=item WHENCE()
+
+Return the invocant's auto-vivification closure.
+
+=cut
+
+.sub 'WHENCE' :method
+ $P0 = self.'WHAT'()
+ $P1 = $P0.'WHENCE'()
+ .return ($P1)
+.end
+
+=item get_bool(vtable)
+
+Returns true if the object is defined, false otherwise
+
+=cut
+
+.sub '' :vtable('get_bool')
+ $I0 = 'defined'(self)
+ .return ($I0)
+.end
+
+=item print() prints to stdout
+
+=item puts() print to stdout
+
+=item readline() read from stdin
+
+=cut
+
+.sub 'print' :method
+ .param pmc args :slurpy
+ $P0 = get_hll_global 'print'
+ .tailcall $P0(self)
+.end
+
+.sub 'puts' :method
+ .param pmc args :slurpy
+ $P0 = get_hll_global 'puts'
+ .tailcall $P0(args :flat)
+.end
+
+.sub 'readline' :method
+ .param pmc args :slurpy
+ $P0 = get_hll_global 'readline'
+ .tailcall $P0(args)
+.end
+
+.sub 'printf' :method
+ .param pmc fmt
+ .param pmc args :slurpy
+ $P0 = get_hll_global 'print'
+ $P99 = get_hll_global ['Kernel'], '!CARDINALMETA'
+ $P1 = $P99.'sprintf'(fmt, args :flat)
+ .tailcall $P0($P1)
+.end
+
+.sub 'sprintf' :method
+ .param pmc fmt
+ .param pmc args :slurpy
+ $P0 = new 'CardinalString'
+ sprintf $P0, fmt, args
+ .return ($P0)
+.end
+
+=item `(cmd)
+Call the OS with C<cmd>, return the ouput.
+=cut
+.sub '`' :method
+ .param string cmd
+ .local pmc pipe
+ pipe = open cmd, "-|"
+ .local string buffer
+ .local pmc output
+ output = new 'CardinalString'
+ $S0 = pop pipe # pop buf layer
+ goto lp
+ lp:
+ buffer = read pipe, 256
+ output.'concat'(buffer)
+ if pipe goto lp
+ goto done
+ done:
+ .return(output)
+.end
+
+=item
+Call the OS, return C<true> if successful, otherwise C<false>
+=cut
+.sub 'system' :method
+ .param string syscall
+ spawnw $I0, syscall
+ if $I0 == 0 goto done_t
+ goto done_f
+ done_t:
+ $S0 = "true"
+ goto ret
+ done_f:
+ $S0 = "false"
+ goto ret
+ ret:
+ .return ($S0)
+.end
+
+.sub 'exit!' :method
+ .param int return
+ exit return
+.end
+
+.sub callcc :method
+ .param pmc block :named('!BLOCK')
+ .local pmc cont
+ cont = new 'CardinalContinuation'
+ set_addr cont, done
+ block(cont)
+ goto done
+
+ done:
+.end
+
+=back
+
+=cut
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
Added: cardinal/trunk/src/classes/Math.pir
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/src/classes/Math.pir Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,148 @@
+## $Id$
+
+=head1 TITLE
+
+Math - Cardinal Math class
+
+=head1 DESCRIPTION
+
+=head2 Functions
+
+=over
+
+=item onload()
+
+Perform initializations and create the Math class
+
+=cut
+
+.namespace ['Math']
+
+
+.const num PI = 3.14159265358979
+
+.sub 'onload' :anon :init :load
+ .local pmc cardinalmeta
+ $P0 = get_hll_global ['CardinalObject'], '!CARDINALMETA'
+ cardinalmeta = $P0.'new_class'('Math', 'parent'=>'', 'attr'=>'')
+ #cardinalmeta = $P0.'HOW'()
+ #set_hll_global ['Math'], '!CARDINALMETA', cardinalmeta
+
+ #.local pmc math_clazz, base_clazz
+ #base_clazz = class $P0
+ ###newclass math_clazz, 'Math'
+ ###math_clazz.'add_parent'(base_clazz)
+ #get_class $P0, "CardinalObject"
+ #subclass math_clazz, $P0, "Math"
+ #set_hll_global ['Math'], '!CARDINALMETA', math_clazz
+
+
+.end
+
+#=item WHENCE()
+#
+#Return the invocant's auto-vivification closure.
+#
+#=cut
+#.sub 'WHENCE' :method
+# $P0 = self.'WHAT'()
+# $P1 = $P0.'WHENCE'()
+# .return ($P1)
+#.end
+
+.sub 'get_bool' :vtable
+ .return (1)
+.end
+
+.sub 'initialize' :method
+ noop
+.end
+
+.sub 'get_string' :vtable
+ $S0 = 'Math'
+ .return ($S0)
+.end
+
+.sub 'cos' :method
+ .param num arg
+ cos $N0, arg
+ .return ($N0)
+.end
+
+.sub 'sin' :method
+ .param num arg
+ sin $N0, arg
+ .return ($N0)
+.end
+
+.sub 'acos' :method
+ .param num arg
+ acos $N0, arg
+ .return ($N0)
+.end
+
+.sub 'asin' :method
+ .param num arg
+ asin $N0, arg
+ .return ($N0)
+.end
+
+.sub 'asec' :method
+ .param num arg
+ asec $N0, arg
+ .return ($N0)
+.end
+
+.sub 'atan' :method
+ .param num arg
+ atan $N0, arg
+ .return ($N0)
+.end
+
+.sub 'cosh' :method
+ .param num arg
+ cosh $N0, arg
+ .return ($N0)
+.end
+
+.sub 'sinh' :method
+ .param num arg
+ sinh $N0, arg
+ .return ($N0)
+.end
+
+.sub 'sech' :method
+ .param num arg
+ sech $N0, arg
+ .return ($N0)
+.end
+
+.sub 'tanh' :method
+ .param num arg
+ tanh $N0, arg
+ .return ($N0)
+.end
+
+.sub 'log' :method
+ .param num arg
+ log2 $N0, arg
+ .return ($N0)
+.end
+
+.sub 'log10' :method
+ .param num arg
+ log10 $N0, arg
+ .return ($N0)
+.end
+
+.sub 'sqrt' :method
+ .param num arg
+ sqrt $N0, arg
+ .return ($N0)
+.end
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
Added: cardinal/trunk/src/classes/NilClass.pir
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/src/classes/NilClass.pir Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,59 @@
+.namespace []
+
+.namespace [ 'NilClass' ]
+
+.sub 'onload' :anon :load :init
+ .local pmc cardinalmeta, nilproto
+ cardinalmeta = get_hll_global ['CardinalObject'], '!CARDINALMETA'
+ nilproto = cardinalmeta.'new_class'('NilClass', 'parent'=>'parrot;Undef CardinalObject')
+ cardinalmeta.'register'('Undef', 'parent'=>nilproto, 'protoobject'=>nilproto)
+.end
+
+=over 4
+
+=item get_string() (vtable method)
+
+Return the elements of the list concatenated.
+
+=cut
+
+.sub 'get_string' :vtable :method
+ $P0 = new 'CardinalString'
+ $P0 = 'nil'
+ .return($P0)
+.end
+
+.sub 'to_i' :method
+ $P0 = new 'CardinalInteger'
+ $P0 = 0
+ .return ($P0)
+.end
+
+.sub 'to_a' :method
+ $P0 = new 'CardinalArray'
+ .return ($P0)
+.end
+
+.sub 'to_s' :method
+ $P0 = new 'CardinalString'
+ $P0 = ''
+ .return($P0)
+.end
+
+.sub 'nil?' :method
+ $P0 = get_hll_global ['Bool'], 'True'
+ .return ($P0)
+.end
+
+.namespace []
+.sub 'setup' :anon :load :init
+ $P0 = new 'NilClass'
+ set_hll_global 'nil', $P0
+.end
+
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
Added: cardinal/trunk/src/classes/Object.pir
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/src/classes/Object.pir Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,371 @@
+## $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
+ .local pmc cardinalmeta
+ load_bytecode 'P6object.pbc'
+ $P0 = get_root_global ['parrot'], 'P6metaclass'
+ $P0.'new_class'('CardinalObject', 'attr'=>'%!properties')
+ cardinalmeta = $P0.'HOW'()
+ set_hll_global ['CardinalObject'], '!CARDINALMETA', cardinalmeta
+.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 args :slurpy
+ .param pmc named_args :named :slurpy
+ # Instantiate.
+ .local pmc cardinalmeta
+ cardinalmeta = get_hll_global ['CardinalObject'], '!CARDINALMETA'
+ $P0 = cardinalmeta.'get_parrotclass'(self)
+ $P1 = $P0.'new'()
+#print 'constructing a new object w/ id'
+#$P98 = $P1.'object_id'()
+#say $P98
+ $P2 = $P1.'HOW'()
+ $I0 = $P2.'can'(self,'initialize')
+ unless $I0, no_initialize
+ $P2 = $P1.'initialize'(args :flat, named_args :named :flat)
+ no_initialize:
+
+ .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)
+ $P1 = not $P0
+ .return ($P1)
+.end
+
+=item true()
+
+Defines the .true method on all objects via C<prefix:?>.
+
+=cut
+
+.sub 'true' :method
+ .tailcall 'prefix:?'(self)
+.end
+
+.sub 'object_id' :method
+ get_addr $I0, self
+ .return ($I0)
+.end
+
+=item get_bool(vtable)
+
+Returns true if he object is defined, false otherwise
+
+=cut
+
+.sub '' :vtable('get_bool')
+ $I0 = 'defined'(self)
+ .return ($I0)
+.end
+
+=item print()
+
+=item say()
+
+Print the object
+
+=cut
+
+.sub 'print' :method
+ $P0 = get_hll_global 'print'
+ .tailcall $P0(self)
+.end
+
+.sub 'puts' :method
+ $P0 = get_hll_global 'puts'
+ .tailcall $P0(self)
+.end
+
+=item to_s()
+
+Return a CardinalString representation of the object.
+
+=cut
+
+.sub 'to_s' :method
+ $P0 = new 'CardinalString'
+ $P0 = self
+ .return ($P0)
+.end
+
+=item inspect()
+
+This is the same a to_s by default unless overriden
+
+=cut
+
+.sub 'inspect' :method
+ $P0 = self.'to_s'()
+.end
+
+.sub 'puts' :method
+ $P0 = get_hll_global 'puts'
+ .tailcall $P0(self)
+.end
+
+=item !cloneattr(attrlist)
+
+Create a clone of self, also cloning the attributes given by attrlist.
+
+=cut
+
+.sub '!cloneattr' :method
+ .param string attrlist
+ .local pmc result
+ .local pmc cardinalmeta
+ cardinalmeta = get_hll_global ['CardinalObject'], '!CARDINALMETA'
+ $P0 = cardinalmeta.'get_parrotclass'(self)
+ result = new $P0
+
+ .local pmc attr_it
+ attr_it = split ' ', attrlist
+ attr_loop:
+ unless attr_it goto attr_end
+ $S0 = shift attr_it
+ unless $S0 goto attr_loop
+ $P1 = getattribute self, $S0
+ unless $P1 goto set_default
+ $P1 = clone $P1
+ setattribute result, $S0, $P1
+ goto attr_loop
+ set_default:
+ $P2 = new 'CardinalInteger'
+ $P2 = 0
+ setattribute result, $S0, $P2
+ goto attr_loop
+ attr_end:
+ .return (result)
+.end
+
+=item methods()
+
+Get a list of all methods in the object.
+
+=cut
+
+.sub 'methods' :method
+ $P0 = class self
+ $P1 = $P0.'methods'()
+ .local pmc meth_iter
+ meth_iter = new 'Iterator', $P1
+ .local pmc method_list
+ method_list = new 'CardinalArray'
+ methods_loop:
+ unless meth_iter goto methods_loop_end
+ $P0 = shift meth_iter
+ method_list.'push'($P0)
+ goto methods_loop
+ methods_loop_end:
+ .return(method_list)
+.end
+
+.sub 'class' :method
+ $P0 = new 'CardinalString'
+ $S0 = self.'WHAT'()
+ $P0.'concat'($S0)
+ .return ($P0)
+.end
+
+.sub 'defined' :method
+ $P0 = get_hll_global ['Bool'], 'False'
+ .return ($P0)
+.end
+
+.sub 'nil?' :method
+ $P0 = get_hll_global 'nil'
+ if self == $P0 goto yes
+ goto no
+ yes:
+ $P0 = get_hll_global ['Bool'], 'True'
+ .return ($P0)
+ no:
+ $P0 = get_hll_global ['Bool'], 'False'
+ .return ($P0)
+.end
+
+.sub 'freeze' :method
+ #Parrots freeze seems to mean the same as Javas serialize
+ #Rubys freeze means to set the object as readonly. I think Perl6 gives their objects a role of Mutable, then checks for that role in infix:=
+ #freeze $S0, self
+ #.return (self)
+ #self = $S0
+ #.return ($S0)
+ #share_ro $P0, self
+ .return (self)
+.end
+
+.sub 'is_a?' :method
+ .param pmc test
+ .local pmc metaclass
+ .local int result
+ metaclass = self.'HOW'()
+ result = metaclass.'isa'(test)
+ if result goto yes
+ goto no
+ yes:
+ $P0 = get_hll_global ['Bool'], 'True'
+ .return ($P0)
+ no:
+ $P0 = get_hll_global ['Bool'], 'False'
+.end
+
+.sub 'kind_of?' :method
+ .param pmc test
+ $P0 = self.'is_a?'(test)
+ .return ($P0)
+.end
+
+=back
+
+=cut
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
Added: cardinal/trunk/src/classes/Proc.pir
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/src/classes/Proc.pir Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,74 @@
+# Copyright (C) 2001-2008, Parrot Foundation.
+# $Id$
+
+=head1 TITLE
+
+Proc - Cardinal Proc class
+
+=head1 DESCRIPTION
+
+=head2 Functions
+
+=over
+
+=item onload()
+
+Perform initializations and create the Proc class
+
+=cut
+
+.namespace ['Proc']
+
+.sub 'onload' :anon :init :load
+ .local pmc cardinalmeta
+ $P0 = get_hll_global ['CardinalObject'], '!CARDINALMETA'
+ cardinalmeta = $P0.'new_class'('Proc', 'parent'=>'CardinalObject', 'attr'=>'!block')
+.end
+
+.sub 'get_bool' :vtable
+ .return (1)
+.end
+
+.sub 'get_string' :vtable
+ $S0 = 'Proc'
+ .return ($S0)
+.end
+
+.sub 'initialize' :method
+ .param pmc block :named('!BLOCK')
+ setattribute self, '!block', block
+ #setprop self, '!block', block
+.end
+
+.sub 'call' :method
+ .param pmc args :slurpy
+ .local pmc block
+ getattribute block, self, '!block'
+ #getprop block, '!block', self
+ $P0 = block(args :flat)
+ .return ($P0)
+.end
+
+.sub 'arity' :method
+ .param pmc args :slurpy
+ .local pmc block
+ getattribute block, self, '!block'
+ #getprop block, '!block', self
+ $I0 = block.'arity'()
+ #$P2 = block.'inspect'()
+ #say $P2
+ $P0 = new 'CardinalInteger'
+ dec $I0
+ $P0 = $I0
+ .return ($P0)
+.end
+
+.sub 'to_proc' :method
+ .return (self)
+.end
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
Added: cardinal/trunk/src/classes/Queue.pir
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/src/classes/Queue.pir Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,101 @@
+# Copyright (C) 2001-2008, Parrot Foundation.
+# $Id$
+
+=head1 TITLE
+
+Queue - Cardinal Queue class
+
+=head1 DESCRIPTION
+
+=head2 Functions
+
+=over
+
+=item onload()
+
+Perform initializations and create the Queue class
+
+=cut
+
+.namespace ['Queue']
+
+.sub 'onload' :anon :init :load
+ .local pmc meta, qproto
+ meta = get_hll_global ['CardinalObject'], '!CARDINALMETA'
+ qproto = meta.'new_class'('Queue', 'parent'=>'parrot;TQueue CardinalObject', 'attr'=>'')
+ meta.'register'('TQueue', 'parent'=>'TQueue', 'protoobject'=>qproto)
+.end
+
+.sub 'get_bool' :vtable
+ .return (1)
+.end
+
+.sub 'get_string' :vtable
+ $S0 = 'Queue'
+ .return ($S0)
+.end
+
+.sub 'length' :method
+ $I0 = self
+ .return ($I0)
+.end
+
+.sub 'size' :method
+ $I0 = self
+ .return ($I0)
+.end
+
+.sub 'empty?' :method
+ $I0 = self.'size'()
+ if $I0 == 0 goto yes
+ goto no
+ yes:
+ $P0 = get_hll_global ['Bool'], 'True'
+ .return ($P0)
+ no:
+ $P0 = get_hll_global ['Bool'], 'False'
+ .return ($P0)
+.end
+
+.sub 'push' :method
+ .param pmc obj
+ push self, obj
+.end
+
+.sub 'infix:<<' :method
+ .param pmc obj
+ self.'push'(obj)
+.end
+
+.sub 'enq' :method
+ self.'push'(obj)
+.end
+
+.sub 'shift' :method
+ .param pmc blockt :optional
+ .param int has_blockt :opt_flag
+ .local pmc obj
+ if has_blockt goto shiftem
+ blockt = get_hll_global ['Bool'], 'False'
+ shiftem:
+ shift obj, self
+ .return (obj)
+.end
+
+.sub 'deq' :method
+ .param pmc blockt
+ $P0 = self.'shift'(blockt)
+ .return ($P0)
+.end
+
+.sub 'pop' :method
+ .param pmc blockt
+ $P0 = self.'shift'(blockt)
+ .return ($P0)
+.end
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
Added: cardinal/trunk/src/classes/Range.pir
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/src/classes/Range.pir Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,524 @@
+## $Id$
+
+=head1 NAME
+
+src/classes/CardinalRange.pir - methods for the CardinalRange class
+
+=head1 DESCRIPTION
+
+=head2 Methods
+
+=over 4
+
+=cut
+
+.namespace ['CardinalRange']
+
+.sub 'onload' :anon :load :init
+ .local pmc meta, proto
+ meta = get_hll_global ['CardinalObject'], '!CARDINALMETA'
+ proto = meta.'new_class'('CardinalRange', 'parent'=>'CardinalAny CardinalObject', 'attr'=>'$!from $!to $!from_exclusive $!to_exclusive')
+ #meta.'register'('CardinalRange', 'CardinalObject', 'protoobject'=>proto)
+.end
+
+=item VTABLE_get integer (vtable method)
+
+=item VTABLE_get_number (vtable method)
+
+=item VTABLE_get_string (vtable method)
+
+=cut
+
+.sub 'VTABLE_get_integer' :method :vtable('get_integer')
+ $P0 = self.'list'()
+ $I0 = $P0
+ .return ($I0)
+.end
+
+.sub 'VTABLE_get_number' :method :vtable('get_number')
+ $P0 = self.'list'()
+ $N0 = $P0
+ .return ($N0)
+.end
+
+.sub 'VTABLE_get_string' :method :vtable('get_string')
+ $P0 = self.'list'()
+ $S0 = $P0
+ .return ($S0)
+.end
+
+
+=item ACCEPTS(topic)
+
+Determines if topic is within the range or equal to the range.
+
+=cut
+
+.sub 'ACCEPTS' :method
+ .param pmc topic
+
+ $I0 = isa topic, 'CardinalRange'
+ unless $I0 goto value_in_range_check
+ $I0 = self.'from'()
+ $I1 = topic.'from'()
+ if $I0 != $I1 goto false
+ $I0 = self.'to'()
+ $I1 = topic.'to'()
+ if $I0 != $I1 goto false
+ $P0 = getattribute self, "$!from_exclusive"
+ $P1 = getattribute topic, "$!from_exclusive"
+ if $P0 != $P1 goto false
+ $P0 = getattribute self, "$!to_exclusive"
+ $P1 = getattribute topic, "$!to_exclusive"
+ if $P0 != $P1 goto false
+ goto true
+
+ value_in_range_check:
+ $I0 = self.'!from_test'(topic)
+ unless $I0 goto false
+ $I0 = self.'!to_test'(topic)
+ unless $I0 goto false
+
+ true:
+ $P0 = get_hll_global ['Bool'], 'True'
+ .return ($P0)
+ false:
+ $P0 = get_hll_global ['Bool'], 'False'
+ .return ($P0)
+.end
+
+
+=item clone() (vtable method)
+
+Create a clone of the CardinalRange.
+
+=cut
+
+.sub 'clone' :method :vtable
+ $P0 = self.'!cloneattr'('$!from $!to $!from_exclusive $!to_exclusive')
+ .return ($P0)
+.end
+
+
+=item from()
+
+=item to()
+
+Gets the beginning or end of the range.
+
+=cut
+
+.sub 'from' :method
+ $P0 = getattribute self, '$!from'
+ .return ($P0)
+.end
+
+=item
+
+=cut
+
+.sub 'to' :method
+ $P0 = getattribute self, '$!to'
+ .return ($P0)
+.end
+
+=item to_a
+
+ Generates and returns this range as an array. This will eventually be refactored w/ the other Enumerable methods This will eventually be refactored w/ the other Enumerable methods.
+
+=cut
+
+.sub 'to_a' :method
+ $P0 = self.'list'()
+ .return ($P0)
+.end
+
+.sub 'to_s' :method
+ $P0 = getattribute self, '$!from_exclusive'
+ $P1 = getattribute self, '$!to_exclusive'
+ $P2 = $P0 && $P1
+ if $P2 goto build_exclusive
+ goto build_inclusive
+ build_inclusive:
+ $S0 = '..'
+ goto build_return
+ build_exclusive:
+ $S0 = '...'
+ goto build_return
+ build_return:
+ $P0 = getattribute self, '$!from'
+ $P1 = getattribute self, '$!to'
+ $P3 = new 'CardinalString'
+ $P3.'concat'($P0)
+ $P3.'concat'($S0)
+ $P3.'concat'($P1)
+ .return ($P3)
+.end
+
+=item iterator() (vtable method)
+
+Return an iterator for the CardinalRange. Since CardinalRanges are already
+iterators, we can just return a clone.
+
+=cut
+
+.sub 'iterator' :method :vtable('get_iter')
+ $P0 = clone self
+ .return ($P0)
+.end
+
+
+=item list()
+
+Generate the CardinalRange in list context. Currently we generate all
+of the elements in the range; when we have lazy lists we can
+just return a clone of the CardinalRange.
+
+=cut
+
+.sub 'list' :method
+ .local pmc range_it, result
+ range_it = self.'iterator'()
+ result = new 'CardinalArray'
+ range_loop:
+ unless range_it goto range_end
+ $P0 = shift range_it
+ push result, $P0
+ goto range_loop
+ range_end:
+ .return (result)
+.end
+
+
+=item min()
+
+=item minmax()
+
+=item max()
+
+=cut
+
+.namespace ['CardinalRange']
+
+=item
+ Return first element in CardinalRange. Will later be refactored as part of the Enumerable module.
+=cut
+.sub 'min' :method
+ .tailcall self.'from'()
+.end
+
+=item
+ Return first element in CardinalRange.
+=cut
+.sub 'begin' :method
+ .tailcall self.'from'()
+.end
+
+=item
+ Return first element in CardinalRange.
+=cut
+.sub 'first' :method
+ .tailcall self.'from'()
+.end
+
+.sub 'minmax' :method
+ $P0 = self.'from'()
+ $P1 = self.'to'()
+ $P2 = get_hll_global 'list'
+ .tailcall $P2($P0, $P1)
+.end
+
+=item
+ Return last element in CardinalRange. Will later be refactored as part of the Enumerable module.
+=cut
+.sub 'max' :method
+ .tailcall self.'to'()
+.end
+
+=item
+ Return last element in CardinalRange.
+=cut
+.sub 'last' :method
+ .tailcall self.'to'()
+.end
+
+=item
+ Return last element in CardinalRange.
+=cut
+.sub 'end' :method
+ .tailcall self.'to'()
+.end
+
+=item
+Return true if the parameter is located with this CardinalRange
+=cut
+.sub 'covers?' :method
+ .param pmc test
+ $P0 = self.'include?'(test)
+ .return ($P0)
+.end
+
+=item
+Return true if the parameter is located with this CardinalRange
+1.9 does a succ on the last element if it isnt a integer, so this doesnt work
+=cut
+.sub 'include?' :method
+ .param pmc test
+ $P0 = self.'from'()
+ $P1 = self.'to'()
+
+ $I0 = self.'!from_test'(test)
+ if $I0 == 0 goto out_of_bounds
+ $I0 = self.'!to_test'(test)
+ if $I0 == 0 goto out_of_bounds
+ #if test <= $P0 goto out_of_bounds
+ #if test >= $P1 goto out_of_bounds
+ $P3 = get_hll_global ['Bool'], 'True'
+ .return ($P3)
+ out_of_bounds:
+ $P3 = get_hll_global ['Bool'], 'False'
+ say 'out of bounds'
+ #throw 'out of bounds!'
+ .return ($P3)
+.end
+
+=item
+
+Return C<True> if the parameter is a member of this CardinalRange
+
+=cut
+
+.sub 'member?' :method
+ .param pmc test
+ $P0 = self.'include?'(test)
+ .return ($P0)
+.end
+
+
+=item pop() (vtable_method)
+
+Generate the next element at the end of the CardinalRange.
+
+=cut
+
+.sub 'pop' :method :vtable('pop_pmc')
+ .local pmc to, toexc, value
+ to = getattribute self, '$!to'
+ toexc = getattribute self, '$!to_exclusive'
+ value = 'postfix:--'(to)
+ unless toexc goto have_value
+ value = clone to
+ have_value:
+ $I0 = self.'!from_test'(value)
+ if $I0 goto success
+ #value = '!FAIL'('Undefined value popped from empty range')
+ value = new 'Undef'
+ success:
+ .return (value)
+.end
+
+
+=item shift() (vtable_method)
+
+Generate the next element at the front of the CardinalRange.
+
+=cut
+
+.sub 'shift' :method :vtable('shift_pmc')
+ .local pmc from, fromexc, value
+ from = getattribute self, '$!from'
+ fromexc = getattribute self, '$!from_exclusive'
+ value = 'postfix:++'(from)
+ unless fromexc goto have_value
+ value = clone from
+ have_value:
+ $I0 = self.'!to_test'(value)
+ if $I0 goto success
+ #value = '!FAIL'('Undefined value shifted from empty range')
+ value = new 'Undef'
+ success:
+ .return (value)
+.end
+
+
+=item true()
+
+Return true if there are any more values to iterate over.
+
+=cut
+
+.sub 'true' :method :vtable('get_bool')
+ .local pmc from, fromexc
+ from = getattribute self, '$!from'
+ fromexc = getattribute self, '$!from_exclusive'
+ unless fromexc goto have_value
+ from = clone from
+ 'postfix:++'(from)
+ have_value:
+ $I0 = self.'!to_test'(from)
+ .return ($I0)
+.end
+
+
+.sub 'initialize' :method :multi(_)
+ .param pmc hash :named :slurpy
+ $P1 = hash["$!from_exclusive"]
+ defined $I0, $P1
+ $I0 = !$I0
+ if $I0 goto default
+ setattribute self, '$!from_exclusive', $P1
+ $P2 = hash["$!to_exclusive"]
+ setattribute self, '$!to_exclusive', $P2
+ goto finish
+ default:
+ $P0 = new 'CardinalInteger'
+ $P0 = 0
+ setattribute self, '$!from_exclusive', $P0
+ setattribute self, '$!to_exclusive', $P0
+ goto finish
+ finish:
+ $P3 = hash["$!from"]
+ setattribute self, '$!from', $P3
+ $P4 = hash["$!to"]
+ setattribute self, '$!to', $P4
+.end
+
+.sub 'initialize' :method :multi(_,_,_)
+ .param pmc from
+ .param pmc to
+ $P0 = new 'CardinalInteger'
+ $P0 = 0
+ setattribute self, '$!from_exclusive', $P0
+ setattribute self, '$!to_exclusive', $P0
+ setattribute self, '$!from', from
+ setattribute self, '$!to', to
+.end
+
+=item each(block)
+
+Run C<block> once for each item in C<self>, with the item passed as an arg.
+
+=cut
+
+.sub 'each' :method
+ .param pmc block :named ("!BLOCK")
+ $P0 = self.'first'()
+ $P1 = $P0.'HOW'()
+ $I0 = $P1.'can'(self,'succ')
+ if $I0 != 0 goto continuous_range
+ $P0 = self.'iterator'()
+ goto each_loop
+ continuous_range:
+ $P1 = new 'CardinalString'
+ $P1 = "Cant iterate from "
+ $P2 = $P0.'class'()
+ $P1.'concat'($P2)
+#say "continuous_range..."
+#say $P2
+ .return ($P2)
+ #throw $P2
+ each_loop:
+ unless $P0 goto each_loop_end
+ $P1 = shift $P0
+ block($P1)
+ goto each_loop
+ each_loop_end:
+.end
+
+=back
+
+=head2 Operators
+
+=over 4
+
+=item infix:<..>
+
+=item infix:<...>
+
+Construct a range from the endpoints.
+
+=cut
+
+.namespace []
+.sub 'infix:..'
+ .param pmc from
+ .param pmc to
+ .local pmc proto
+ proto = get_hll_global 'CardinalRange'
+ $P1 = proto.'new'('$!from'=>from, '$!to'=>to)
+ .return ($P1)
+.end
+
+.sub 'infix:...'
+ .param pmc from
+ .param pmc to
+ .local pmc proto, true, false
+ proto = get_hll_global 'CardinalRange'
+ true = get_hll_global ['Bool'], 'True'
+ false = get_hll_global ['Bool'], 'False'
+ $P0 = proto.'new'('$!from'=>from, '$!to'=>to, '$!from_exclusive'=>false, '$!to_exclusive'=>true)
+ .return ($P0)
+.end
+
+=back
+
+=head2 Private methods
+
+=over 4
+
+=item !from_test(topic)
+
+=item !to_test(topic)
+
+Returns true if C<topic> is greater than C<.from> / less than C<.to>,
+honoring exclusive flags.
+
+=cut
+
+.namespace ['CardinalRange']
+.sub '!from_test' :method
+ .param pmc topic
+ .local pmc from, fromexc
+ from = getattribute self, '$!from'
+ fromexc = getattribute self, '$!from_exclusive'
+ if fromexc goto exclusive_test
+ $I0 = isge topic, from
+ .return ($I0)
+ exclusive_test:
+ $I0 = isgt topic, from
+ .return ($I0)
+.end
+
+.sub '!to_test' :method
+ .param pmc topic
+ .local pmc to, toexc
+ to = getattribute self, '$!to'
+ $I0 = isa to, 'String'
+ unless $I0 goto test_value
+ $S0 = topic
+ $I0 = length $S0
+ $S1 = to
+ $I1 = length $S1
+ eq $I0, $I1, test_value
+ $I0 = islt $I0, $I1
+ .return ($I0)
+ test_value:
+ toexc = getattribute self, '$!to_exclusive'
+ if toexc goto exclusive_test
+ $I0 = isle topic, to
+ .return ($I0)
+ exclusive_test:
+ $I0 = islt topic, to
+ .return ($I0)
+.end
+
+=back
+
+=cut
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
+
Added: cardinal/trunk/src/classes/String.pir
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/src/classes/String.pir Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,803 @@
+## $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
+ .local pmc cardinalmeta, strproto
+ cardinalmeta = get_hll_global ['CardinalObject'], '!CARDINALMETA'
+ strproto = cardinalmeta.'new_class'('CardinalString', 'parent'=>'parrot;String CardinalObject')
+ cardinalmeta.'register'('String', 'parent'=>'CardinalObject', 'protoobject'=>strproto)
+.end
+
+.sub 'new' :method :multi(_)
+ $P0 = new 'CardinalString'
+ .return ($P0)
+.end
+
+.sub 'new' :method :multi(_,_)
+ .param pmc a
+ $P0 = new 'CardinalString'
+ $P0 = a
+ .return ($P0)
+.end
+
+.sub 'ACCEPTS' :method
+ .param string topic
+ .tailcall 'infix:eq'(topic, self)
+.end
+
+=item chars()
+
+Returns the number of characters in C<self>
+
+=cut
+
+.sub 'chars' :method
+ .local pmc retv
+
+ retv = new 'CardinalInteger'
+ $S0 = self
+ $I0 = length $S0
+ retv = $I0
+
+ .return (retv)
+.end
+
+
+=item size()
+
+=cut
+
+.sub 'size' :method
+ .local pmc retv
+
+ retv = new 'CardinalInteger'
+ $S0 = self
+ $I0 = length $S0
+ retv = $I0
+
+ .return (retv)
+.end
+
+
+=item concat()
+
+Adds given object to C<self>. Returns self
+
+=cut
+
+.sub 'concat' :method
+ .param pmc item
+ concat self, item
+ .return(self)
+.end
+
+=item reverse()
+
+Returns a new CardinalString with the characters of C<self> in reverse order.
+
+=cut
+
+.sub 'reverse' :method
+ .local pmc res
+ .local int i
+
+ res = new 'CardinalString'
+
+ .local pmc iterator, item
+ iterator = new 'Iterator', self
+ each_loop:
+ unless iterator goto each_loop_done
+ item = shift iterator
+ res = concat item, res
+ goto each_loop
+ each_loop_done:
+ .return(res)
+.end
+
+=item reverse!()
+
+Returns the characters in C<self> in reverse order. Destructive update.
+
+=cut
+
+.sub 'reverse!' :method
+ $S0 = self.'reverse'()
+ self = $S0
+ .return(self)
+.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 'each' :method :multi('CardinalString',_)
+ .param pmc delim
+ .param pmc block :named('!BLOCK')
+ .local pmc list
+ list = self.'split'(delim)
+ list.'each'(block)
+.end
+
+.sub lc :method
+ .local string tmps
+ .local pmc retv
+
+ tmps = self
+ downcase tmps
+
+ retv = new 'CardinalString'
+ retv = tmps
+
+ .return(retv)
+.end
+
+=item downcase()
+
+Returns a copy of C<self> with all upper case letters converted to lower case
+
+=cut
+
+.sub downcase :method
+ .local pmc s
+ s = new 'CardinalString'
+ s = self
+ .tailcall s.'lc'()
+.end
+
+=item upcase()
+
+Returns a copy of C<self> with all lower case letters converted to upper case
+
+=cut
+
+.sub upcase :method
+ .local pmc s
+ s = new 'CardinalString'
+ s = self
+ .tailcall s.'uc'()
+.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
+
+=item capitalize()
+
+ Returns a copy of C<self> with the first character converted to uppercase and the remainder to lowercase.
+
+=cut
+
+.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
+ unless is_lc goto done
+ $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
+
+=item
+ TODO: Read from the global record separator
+=cut
+.sub 'chomp' :method
+ .param string splitby :optional
+ .param int custom_split :opt_flag
+ .local string tmps
+ .local pmc retv
+ if custom_split goto have_split
+ splitby = "\n"
+ have_split:
+
+ retv = new 'CardinalString'
+ $I0 = self.'chars'()
+ if $I0 == 0 goto done
+ $I1 = length splitby
+ $I0 = $I0 - $I1
+ $S0 = substr self, $I0, $I1
+ if $S0 == splitby goto chop
+ tmps = self
+ goto done
+ chop:
+ tmps = substr self, 0, $I0
+ goto done
+ done:
+ retv = tmps
+ .return(retv)
+.end
+
+=item
+ TODO: Read from the global record separator
+=cut
+.sub 'chomp!' :method
+ .param string splitby :optional
+ .param int custom_split :opt_flag
+ .local string tmps
+ if custom_split goto have_split
+ splitby = "\n"
+ have_split:
+
+ $I0 = self.'chars'()
+ if $I0 == 0 goto done
+ $I1 = length splitby
+ $I0 = $I0 - $I1
+ $S0 = substr self, $I0, $I1
+ if $S0 == splitby goto chop
+ tmps = self
+ goto done
+ chop:
+ tmps = substr self, 0, $I0
+ goto done
+ done:
+ self = tmps
+ .return(self)
+.end
+
+.sub 'chop' :method
+ .local string tmps
+ .local pmc retv
+ .local int len
+
+ retv = new 'CardinalString'
+ tmps = self
+ chopn tmps, 1
+ retv = tmps
+ .return(retv)
+.end
+
+.sub 'chop!' :method
+ .local string tmps
+ .local int len
+
+ tmps = self
+ chopn tmps, 1
+ self = tmps
+ .return(self)
+.end
+
+=item length()
+
+ Return the number of characters in C<self>
+
+=cut
+
+.sub 'length' :method
+ $I0 = self.'chars'()
+ .return($I0)
+.end
+
+=item '[]'
+
+ subscript operator. Accepts [(-)? int], [(-)?int, (-)?int]
+
+=cut
+
+.sub '[]' :method :vtable('get_pmc_keyed')
+ .param int start
+ .param int stop :optional
+ .local string tmp
+ .local int len
+
+ if stop <= 0 goto init_stop
+ process:
+ tmp = self
+ len = length tmp
+ if start >= len goto oob
+ if start >= 0 goto pos_access
+ if start < 0 goto neg_access
+ goto oob
+ neg_access:
+ substr $S0, tmp, start, stop
+ .return($S0)
+ pos_access:
+ substr $S0, tmp, start, stop
+ .return($S0)
+ oob:
+ # out of bounds, return nil
+ $P0 = new 'NilClass'
+ .return($P0)
+ init_stop:
+ stop = 1
+ goto process
+.end
+
+=item '[]='
+
+Warning: Partial implementation. Look for TODO
+
+=cut
+
+.sub '[]=' :method :vtable('set_pmc_keyed')
+ .param int start
+ .param string replace_with
+ .local string tmp
+ .local int len
+ .local int stop
+
+ tmp = self
+ len = length tmp
+ stop = length replace_with
+
+ if start > len goto oob
+ if start >= len goto oob
+ if start >= 0 goto pos_access
+ if start < 0 goto neg_access
+ goto oob
+ neg_access:
+ substr $S0, tmp, start, stop, replace_with
+ self = tmp
+ .return()
+ pos_access:
+ substr $S0, tmp, start, stop, replace_with
+ self = tmp
+ .return()
+ oob:
+ say "oob, IndexException"
+ # TODO out of bounds, throw IndexException
+ .return()
+.end
+
+.sub 'each_byte' :method
+ .param pmc block :named('!BLOCK')
+ .local pmc iterator, item
+ iterator = new 'Iterator', self
+ each_loop:
+ unless iterator goto each_loop_done
+ item = shift iterator
+ block(item)
+ goto each_loop
+ each_loop_done:
+.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
+
+=item to_s()
+
+Returns self
+
+=cut
+
+.sub 'to_s' :method
+ $P0 = new 'CardinalString'
+ $P0 = self
+ .return ($P0)
+.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
+ .tailcall 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
+ .tailcall 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
+ .tailcall 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
+ .tailcall 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
+ .tailcall 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
+
+ .tailcall 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
+ .tailcall 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 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 )
+
+=cut
+
+.sub 'infix:<<' :multi('CardinalString',_)
+ .param pmc s
+ .param pmc item
+ concat s, item
+ .return(s)
+.end
+
+=back
+
+=cut
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
Added: cardinal/trunk/src/classes/Time.pir
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/src/classes/Time.pir Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,217 @@
+## $Id$
+
+=head1 TITLE
+
+Time - Cardinal Time class
+
+=head1 DESCRIPTION
+
+=head2 Functions
+
+=over
+
+=item onload()
+
+Perform initializations and create the Time class
+
+=cut
+
+
+.namespace ['Time']
+
+.include "tm.pasm"
+
+.sub 'onload' :anon :init :load
+ .local pmc cardinalmeta
+ $P0 = get_hll_global ['CardinalObject'], '!CARDINALMETA'
+ cardinalmeta = $P0.'new_class'('Time', 'parent'=>'CardinalObject', 'attr'=>'$!time_in_millis $!gmt')
+ cardinalmeta = $P0.'HOW'()
+ set_hll_global ['Time'], '!CARDINALMETA', cardinalmeta
+.end
+
+
+=item WHENCE()
+
+Return the invocant's auto-vivification closure.
+
+=cut
+
+.sub 'WHENCE' :method
+ $P0 = self.'WHAT'()
+ $P1 = $P0.'WHENCE'()
+ .return ($P1)
+.end
+
+=item get_bool(vtable)
+
+Returns true if he object is defined, false otherwise
+
+=cut
+
+.sub '' :vtable('get_bool')
+ $I0 = 'defined'(self)
+ .return ($I0)
+.end
+
+.sub 'initialize' :method :multi(_,_)
+ .param pmc t
+ $P0 = new 'CardinalInteger'
+ $P0 = t
+ setattribute self, '$!time_in_millis', $P0
+ $P1 = get_hll_global['Bool'], 'False'
+ # TODO fix this, check gmt then set to appropriate value
+ setattribute self, '$!gmt', $P1
+.end
+
+.sub 'initialize' :method :multi(_)
+ time $I0
+ $P0 = new 'CardinalInteger'
+ $P0 = $I0
+ setattribute self, '$!time_in_millis', $P0
+ $P1 = get_hll_global['Bool'], 'False'
+ # TODO fix this, check gmt then set to appropriate value
+ setattribute self, '$!gmt', $P1
+.end
+
+#.sub 'now'
+ #call CardinalObject super .new
+ #return the object returned by super
+#.end
+
+.sub 'to_s' :method :vtable('get_string')
+ .local pmc is_gmt, to_s
+ to_s = new 'CardinalString'
+ $P0 = getattribute self, '$!time_in_millis'
+ $I0 = $P0
+ is_gmt = getattribute self, '$!gmt'
+ if is_gmt goto g_time
+ goto l_time
+ g_time:
+ $S0 = gmtime $I0
+ to_s = $S0
+ goto done
+ l_time:
+ $S0 = localtime $I0
+ to_s = $S0
+ goto done
+ done:
+ .return (to_s)
+.end
+
+.sub 'to_i' :method
+ .local int epoch_sec
+ $P0 = getattribute self, '$!time_in_millis'
+ epoch_sec = $P0
+ .return (epoch_sec)
+.end
+
+.sub 'to_f' :method
+ .local pmc epoch_sec
+ $P0 = getattribute self, '$!time_in_millis'
+ epoch_sec = new 'Float'
+ epoch_sec = $P0
+ .return (epoch_sec)
+.end
+
+.sub 'gmt?' :method
+ $P0 = getattribute self, '$!gmt'
+ .return ($P0)
+.end
+
+.sub 'gmtime' :method
+ .local pmc is_gmt
+
+ is_gmt = getattribute self, '$!gmt'
+ if is_gmt goto done
+
+ $P1 = get_hll_global['Bool'], 'True'
+ setattribute self, '$!gmt', $P1
+ goto done
+
+ done:
+ .return (self)
+.end
+
+.sub '#!parse_time_array' :method
+ .param int offset
+ .local pmc is_gmt
+ .local pmc return_value
+ return_value = new 'CardinalInteger'
+ $P0 = getattribute self, '$!time_in_millis'
+ $I0 = $P0
+ is_gmt = getattribute self, '$!gmt'
+
+ if is_gmt goto decodegmt
+ goto decodelocal
+
+ decodegmt:
+ decodetime $P1, $I0
+ $I0 = $P1[offset]
+ return_value = $I0
+ goto done
+ decodelocal:
+ decodelocaltime $P1, $I0
+ $I0 = $P1[offset]
+ return_value = $I0
+ goto done
+ done:
+ .return (return_value)
+
+ #print out all values in the time array
+ #$P2 = new 'Iterator', $P0
+ #each_loop:
+ # unless $P2 goto done
+ # $P3 = shift $P2
+ # say $P3
+ # goto each_loop
+.end
+
+.sub 'sec' :method
+ $P0 = self.'#!parse_time_array'(.TM_SEC)
+ .return ($P0)
+.end
+
+.sub 'min' :method
+ $I0 = self.'#!parse_time_array'(.TM_MIN)
+ .return ($I0)
+.end
+
+.sub 'hour' :method
+ $I0 = self.'#!parse_time_array'(.TM_HOUR)
+ .return ($I0)
+.end
+
+.sub 'day' :method
+ .tailcall self.'mday'()
+.end
+
+.sub 'mday' :method
+ $I0 = self.'#!parse_time_array'(.TM_MDAY)
+ .return ($I0)
+.end
+
+.sub 'yday' :method
+ $I0 = self.'#!parse_time_array'(.TM_YDAY)
+ .return ($I0)
+.end
+
+.sub 'wday' :method
+ $I0 = self.'#!parse_time_array'(.TM_WDAY)
+ .return ($I0)
+.end
+
+.sub 'month' :method
+ $I0 = self.'#!parse_time_array'(.TM_MON)
+ .return ($I0)
+.end
+
+.sub 'year' :method
+ $I0 = self.'#!parse_time_array'(.TM_YEAR)
+ .return ($I0)
+.end
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
Added: cardinal/trunk/src/parser/actions.pm
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/src/parser/actions.pm Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,906 @@
+# Copyright (C) 2008, Parrot Foundation.
+# $Id$
+
+=begin comments
+
+cardinal::Grammar::Actions - ast transformations for cardinal
+
+This file contains the methods that are used by the parse grammar
+to build the PAST representation of an cardinal program.
+Each method below corresponds to a rule in F<src/parser/grammar.pg>,
+and is invoked at the point where C<{*}> appears in the rule,
+with the current match object as the first argument. If the
+line containing C<{*}> also has a C<#= key> comment, then the
+value of the comment is passed as the second argument to the method.
+
+=end comments
+
+class cardinal::Grammar::Actions;
+
+method TOP($/) {
+ my $past := $( $<comp_stmt> );
+ $past.blocktype('declaration');
+ $past.pirflags(':load');
+ $past.hll('cardinal');
+
+ our $?INIT;
+ if defined( $?INIT ) {
+ $?INIT.unshift(
+ PAST::Var.new(
+ :name('$def'),
+ :scope('lexical'),
+ :isdecl(1)
+ )
+ );
+ $?INIT.blocktype('declaration');
+ $?INIT.pirflags(':init :load');
+ $past.unshift( $?INIT );
+ $?INIT := PAST::Block.new(); # For the next eval.
+ }
+
+ make $past;
+}
+
+method comp_stmt($/,$key) {
+ our $?BLOCK;
+ our @?BLOCK;
+ our $?BLOCK_SIGNATURED;
+ if $key eq 'open' {
+ if $?BLOCK_SIGNATURED {
+ $?BLOCK := $?BLOCK_SIGNATURED;
+ $?BLOCK_SIGNATURED := 0;
+ }
+ else {
+ $?BLOCK := PAST::Block.new( PAST::Stmts.new(), :node($/));
+ my $block := PAST::Var.new(:scope('parameter'), :named('!BLOCK'), :name('!BLOCK'), :viviself('Undef'));
+ $?BLOCK.symbol($block.name(), :scope('lexical'));
+ $?BLOCK[0].push($block);
+ }
+ @?BLOCK.unshift($?BLOCK);
+ }
+ if $key eq 'close' {
+ my $past := @?BLOCK.shift();
+ $?BLOCK := @?BLOCK[0];
+ $past.push( $( $<stmts> ) );
+ make $past;
+ }
+}
+
+method stmts($/) {
+ my $past := PAST::Stmts.new( :node($/) );
+ for $<stmt> {
+ $past.push($($_));
+ }
+ make $past;
+}
+
+method basic_stmt($/, $key) {
+ make $( $/{$key} );
+}
+
+method stmt($/) {
+ my $past := $( $<basic_stmt> );
+ for $<stmt_mod> {
+ my $modifier := $( $_ );
+ $modifier.push($past);
+ $past := $modifier;
+ }
+ make $past;
+}
+
+method stmt_mod($/) {
+ my $op;
+ if $<sym> eq 'until' {
+ ## there is no :pasttype('until'); this is called repeat_until
+ $op := 'repeat_until';
+ }
+ else {
+ ## if, while and unless are valid :pasttypes.
+ $op := ~$<sym>;
+ }
+ make PAST::Op.new( $( $<expr> ), :pasttype($op), :node($/) );
+
+}
+
+method expr($/) {
+ my $past := $( $<arg> );
+ if +$<not> {
+ $past := PAST::Op.new( $past, :pirop('not'), :node($/) );
+ }
+ if $<expr> {
+ my $op;
+ if ~$<op>[0] eq 'and' { $op := 'if'; }
+ else { $op := 'unless'; }
+ $past := PAST::Op.new( $past, $( $<expr>[0] ), :pasttype($op), :node($/) );
+ }
+ make $past;
+}
+
+method return_stmt($/) {
+ my $past := $($<call_args>);
+ $past.pasttype('inline');
+ $past.inline(' .return(%0)');
+ make $past;
+}
+
+## not entirely sure what alias does, but this is a guess...
+method alias($/) {
+ my $fname := $<fname>[0];
+ my $alias := $<fname>[1];
+ make PAST::Op.new( $alias, $fname, :pasttype('bind'), :node($/) );
+}
+
+method begin($/) {
+ my $past := $( $<comp_stmt> );
+ my $sub := PAST::Compiler.compile( $past );
+ $sub();
+ ## XXX what to do here? empty block? stolen from rakudo.
+ make PAST::Block.new( :node($/) );
+}
+
+method end($/) {
+ my $past := PAST::Block.new( $( $<comp_stmt> ), :node($/) );
+ $past.blocktype('declaration');
+ my $sub := PAST::Compiler.compile( $past );
+ PIR q< $P0 = get_hll_global ['cardinal'], '@?END_BLOCKS' >;
+ PIR q< $P1 = find_lex '$sub' >;
+ PIR q< push $P0, $P1 >;
+ make $past;
+}
+
+method indexed_assignment($/) {
+ my $key := $( $<key> );
+ my $rhs := $( $<rhs> );
+ my $primary := $( $<basic_primary> );
+
+ my $past := PAST::Op.new( :name('[]='), :pasttype('callmethod'), :node($/) );
+
+ $past.push( $primary );
+ $past.push( $key );
+ $past.push( $rhs );
+
+ make $past;
+}
+method member_assignment($/) {
+ my $rhs := $( $<rhs> );
+ my $primary := $( $<basic_primary> );
+
+ my $past := PAST::Op.new( :name(~$<key><ident> ~ '='), :pasttype('callmethod'), :node($/) );
+
+ $past.push( $primary );
+ $past.push( $rhs );
+
+ make $past;
+}
+method assignment($/) {
+ my $lhs := $( $<mlhs> );
+ our $?BLOCK;
+ my $name := $lhs.name();
+ unless $?BLOCK.symbol(~$name) {
+ our @?BLOCK;
+ my $exists := 0;
+ my $scope;
+ for @?BLOCK {
+ if $_ {
+ my $sym_table := $_.symbol(~$name);
+ if $sym_table {
+ $exists := 1;
+ $scope := '' ~ $sym_table<scope>;
+ }
+ }
+ }
+ our $?CLASS;
+ if $exists == 0 && defined($?CLASS) {
+ my $block := $?CLASS[0];
+ my $sym_table := $block.symbol(~$name);
+ if $sym_table {
+ $exists := 1;
+ $scope := '' ~ $sym_table<scope>;
+ }
+ }
+ if $exists == 0 {
+ $lhs.isdecl(1);
+ $scope := 'lexical';
+ }
+ $?BLOCK.symbol(~$name, :scope($scope));
+ $lhs.scope($scope);
+ }
+
+ my $rhs := $( $<mrhs> );
+ make PAST::Op.new( $lhs, $rhs, :pasttype('bind'), :lvalue(1), :node($/) );
+}
+
+method mlhs($/, $key) {
+ make $( $/{$key} );
+}
+
+method lhs($/, $key) {
+ make $( $/{$key} );
+}
+
+method member_variable($/) {
+ make $( $<primary> );
+ # XXX fix field.
+}
+
+method indexed($/) {
+ my $args;
+ if $<args> {
+ $args := $( $<args>[0] );
+ }
+
+ my $past := PAST::Op.new( :name('[]'), :pasttype('callmethod'), :node($/) );
+ while $args[0] {
+ $past.push( $args.shift() );
+ }
+
+ make $past;
+}
+
+method variable($/, $key) {
+ my $past;
+ if $key eq 'varname' {
+ $past := $( $/<varname> );
+ }
+ elsif $key eq 'self' {
+ $past := PAST::Op.new(:inline('%r = self'));
+ }
+ elsif $key eq 'nil' {
+ $past := PAST::Var.new(:scope('package'), :name('nil'));
+ }
+ make $past;
+}
+
+method varname($/, $key) {
+ my $past := $( $/{$key} );
+ if is_a_sub(~$/) { # unary sub
+ $past := PAST::Op.new( :pasttype('call'), :node($/), $past );
+ }
+ make $past;
+}
+
+method global($/) {
+ my @namespace;
+ our @?BLOCK;
+ my $toplevel := @?BLOCK[0];
+ $toplevel.symbol(~$/, :scope('package'), :namespace(@namespace));
+ make PAST::Var.new( :name(~$/), :scope('package'), :namespace(@namespace), :viviself('Undef'), :node($/) );
+}
+
+method instance_variable($/) {
+ our $?CLASS;
+ our $?BLOCK;
+ my $name := ~$/;
+ my $past := PAST::Var.new( :name($name), :scope('attribute'), :viviself('Undef'), :node($/) );
+ my $block := $?CLASS[0];
+ unless $block.symbol(~$/) {
+ $?CLASS.push(
+ PAST::Op.new(
+ :pasttype('call'),
+ :name('!keyword_has'),
+ PAST::Var.new(
+ :name('$def'),
+ :scope('lexical')
+ ),
+ PAST::Val.new( :value($name) )
+ )
+ );
+
+ $block.symbol(~$name, :scope('attribute'));
+ $?BLOCK.symbol(~$name, :scope('attribute'));
+ }
+ make $past;
+}
+
+method class_variable($/) {
+ our $?CLASS;
+ our $?BLOCK;
+ my $name := ~$/;
+ my $past := PAST::Var.new( :name($name), :scope('package'), :viviself('Undef'), :node($/) );
+ my $block := $?CLASS[0];
+ unless $block.symbol(~$/) {
+ $block.symbol(~$name, :scope('package'));
+ $?BLOCK.symbol(~$name, :scope('package'));
+ }
+ make $past;
+}
+
+method local_variable($/) {
+ our $?BLOCK;
+ my $past := PAST::Var.new( :name(~$<ident>), :node($/), :viviself('Undef') );
+ if +$<ns> {
+ $past.scope('package');
+ $past.namespace(~$<ns>[0]);
+ }
+ elsif $?BLOCK.symbol($<ident>) {
+ my $scope := '' ~ $?BLOCK.symbol($<ident>)<scope>;
+ $past.scope(~$scope);
+ }
+ else {
+ our @?BLOCK;
+ my $exists := 0;
+ my $scope;
+ for @?BLOCK {
+ if $_ {
+ my $sym_table := $_.symbol(~$<ident>);
+ if $sym_table {
+ $exists := 1;
+ $scope := '' ~ $sym_table<scope>;
+ }
+ }
+ }
+ if $exists == 0 {
+ $past.scope('package');
+ my @a;
+ $past.namespace(@a);
+ }
+ else {
+ $past.scope($scope);
+ }
+ }
+ make $past;
+}
+
+method funcall($/) {
+ my $past := $( $<local_variable> );
+ make $past;
+}
+
+method constant_variable($/) {
+ my @a;
+ my $name := ~$/;
+ if $name eq 'Integer' { $name := "CardinalInteger"; }
+ elsif $name eq 'String' { $name := "CardinalString"; }
+ elsif $name eq 'Array' { $name := "CardinalArray"; }
+ elsif $name eq 'Hash' { $name := "CardinalHash"; }
+ elsif $name eq 'Range' { $name := "CardinalRange"; }
+ elsif $name eq 'File' { $name := "CardinalFile"; }
+ my $past := PAST::Var.new( :name($name), :scope('package'), :node($/), :viviself('Undef'), :namespace( @a ) );
+ make $past;
+}
+
+
+method if_stmt($/) {
+ my $cond := +$<expr> - 1;
+ my $comp := $( $<comp_stmt>[$cond] );
+ $comp.blocktype('immediate');
+ my $past := PAST::Op.new( $( $<expr>[$cond] ),
+ $comp,
+ :pasttype('if'),
+ :node( $/ )
+ );
+ if ( $<else> ) {
+ my $else := $( $<else>[0] ) ;
+ $else.blocktype('immediate');
+ $past.push( $else );
+ }
+ while ($cond != 0) {
+ $cond := $cond - 1;
+ $comp := $( $<comp_stmt>[$cond] );
+ $comp.blocktype('immediate');
+ $past := PAST::Op.new( $( $<expr>[$cond] ),
+ $comp,
+ $past,
+ :pasttype('if'),
+ :node( $/ )
+ );
+ }
+ make $past;
+}
+
+method unless_stmt($/) {
+ my $cond := $( $<expr> );
+ my $body := $( $<comp_stmt> );
+ $body.blocktype('immediate');
+ my $past := PAST::Op.new( $cond, $body, :pasttype('unless'), :node($/) );
+ if $<else> {
+ $past.push( $( $<else>[0] ) );
+ }
+ make $past;
+}
+
+method else($/) {
+ make $( $<comp_stmt> );
+}
+
+method ensure($/) {
+ make $( $<comp_stmt> );
+}
+
+method while_stmt($/) {
+ my $cond := $( $<expr> );
+ my $body := $( $<comp_stmt> );
+ $body.blocktype('immediate');
+ make PAST::Op.new( $cond, $body, :pasttype(~$<sym>), :node($/) );
+}
+
+method for_stmt($/) {
+ my $list := $( $<expr> );
+ my $body := $( $<comp_stmt> );
+ my $var := $( $<variable> );
+ $body.blocktype('declaration');
+ $var.scope('parameter');
+ $var.isdecl(0);
+ $body[0].push($var);
+ make PAST::Op.new( $list, $body, :pasttype('for'), :node($/) );
+}
+
+method control_command($/,$key) {
+ make PAST::Op.new(
+ :pasttype('call'),
+ :name(~$/),
+ );
+}
+
+method yield($/) {
+ our $?BLOCK;
+ our @?BLOCK;
+ my $blockname;
+ if $?BLOCK.symbol('!BLOCK') {
+ if defined($?BLOCK.symbol('!BLOCK')<name>) {
+ $blockname := $?BLOCK.symbol('!BLOCK')<name>;
+ }
+ else {
+ $blockname := '!BLOCK';
+ }
+ }
+ my $call := $( $<call_args> );
+ $call.unshift( PAST::Var.new(:scope('lexical'), :name(~$blockname)));
+ $call.node($/);
+ make $call;
+}
+
+method module($/) {
+ my $past := $( $<comp_stmt> );
+ my $name := $( $<module_identifier> );
+ $past.namespace( $name.name() );
+ $past.blocktype('declaration');
+ $past.pirflags(':load :init');
+ make $past;
+}
+
+method begin_end($/) {
+ my $past := $( $<comp_stmt> );
+ # XXX handle resque and ensure clauses
+ make $past;
+}
+
+method classdef($/,$key) {
+ our $?CLASS;
+ our @?CLASS;
+ our $?INIT;
+
+ my $name := ~$<module_identifier><ident>;
+ if $key eq 'open' {
+ my $decl := PAST::Stmts.new();
+ $decl.push(
+ PAST::Op.new(
+ :pasttype('bind'),
+ PAST::Var.new(
+ :name('$def'),
+ :scope('lexical')
+ ),
+ PAST::Op.new(
+ :pasttype('call'),
+ :name('!keyword_class'),
+ PAST::Val.new( :value($name) )
+ )
+ )
+ );
+ @?CLASS.unshift( $?CLASS );
+ $?CLASS := $decl;
+ $?CLASS.unshift( PAST::Block.new() );
+ }
+ else {
+ my $block := $( $<comp_stmt> );
+ $block.namespace($name);
+ $block.blocktype('declaration');
+ $block.pirflags(':init :load');
+
+ $?CLASS.push(
+ PAST::Op.new(
+ :pasttype('callmethod'),
+ :name('register'),
+ PAST::Var.new(
+ :scope('package'),
+ :name('!CARDINALMETA'),
+ :namespace('CardinalObject')
+ ),
+ PAST::Var.new(
+ :scope('lexical'),
+ :name('$def')
+ ),
+ PAST::Val.new(
+ :value('CardinalObject'),
+ :named( PAST::Val.new( :value('parent') ) )
+ )
+ )
+ );
+
+ unless defined( $?INIT ) {
+ $?INIT := PAST::Block.new();
+ }
+ for @( $?CLASS ) {
+ if $_.WHAT() eq 'Block' {
+ $block.push( $_ );
+ }
+ else {
+ $?INIT.push( $_ );
+ }
+ }
+
+ # Restore outer class.
+ if +@?CLASS {
+ $?CLASS := @?CLASS.shift();
+ }
+ else {
+ $?CLASS := @?CLASS[0];
+ }
+
+
+ make $block;
+ }
+}
+
+method functiondef($/) {
+ my $past := $( $<comp_stmt> );
+ my $name := $<fname>;
+ my $arity := +$past[0]<arity>;
+ #my $args := $( $<argdecl> );
+ #$past.push($args);
+ $past.name(~$name);
+ our $?BLOCK;
+ our $?CLASS;
+ $?BLOCK.symbol(~$name, :scope('package'), :arity($arity));
+ if defined($?CLASS) {
+ $past.pirflags(':method');
+ }
+ make $past;
+}
+
+method sig_identifier($/) {
+ my $past := $($<identifier>);
+ if +$<default> == 1 {
+ $past.viviself( $( $<default>[0] ) );
+ }
+ make $past;
+}
+
+method block_signature($/) {
+ my $params := PAST::Stmts.new( :node($/) );
+ my $past := PAST::Block.new($params, :blocktype('declaration'));
+ for $<sig_identifier> {
+ my $parameter := $( $_ );
+ $past.symbol($parameter.name(), :scope('lexical'));
+ $parameter.scope('parameter');
+ $params.push($parameter);
+ }
+ if $<slurpy_param> {
+ my $slurp := $( $<slurpy_param>[0] || $<slurpy_param> );
+ $past.symbol($slurp.name(), :scope('lexical'));
+ $params.push( $slurp );
+ }
+
+ if $<block_param> {
+ my $block := $( $<block_param>[0] );
+ $block.named('!BLOCK');
+ $past.symbol($block.name(), :scope('lexical'));
+ $past.symbol('!BLOCK', :name(~$block.name()));
+ $params.push($block);
+ }
+ else {
+ my $block := PAST::Var.new(:scope('parameter'), :named('!BLOCK'), :name('!BLOCK'), :viviself('Undef'));
+ $past.symbol($block.name(), :scope('lexical'));
+ $params.push($block);
+ }
+ $params.arity( +$<sig_identifier> + +$<block_param> );
+ our $?BLOCK_SIGNATURED := $past;
+ make $past;
+}
+
+method slurpy_param($/) {
+ my $past := $( $<identifier> );
+ $past.slurpy(1);
+ $past.scope('parameter');
+ make $past;
+}
+
+method block_param($/) {
+ my $past := $( $<identifier> );
+ $past.scope('parameter');
+ make $past;
+}
+
+method identifier($/) {
+ make PAST::Var.new( :name(~$<ident>), :node($/) );
+}
+
+method module_identifier($/) {
+ make PAST::Var.new( :name(~$/), :scope('package'), :node($/) );
+}
+
+method mrhs($/) {
+ make $( $<args> );
+}
+
+method methodcall($/) {
+ my $op := $<operation>;
+ my $past;
+ if $<call_args> {
+ $past := $( $<call_args>[0] );
+ }
+ else {
+ $past := PAST::Op.new();
+ }
+
+ $past.pasttype('callmethod');
+
+ if $<do_block> {
+ $past.push( $( $<do_block>[0] ) );
+ }
+
+ $past.name(~$op);
+ make $past;
+}
+
+method do_block($/) {
+ my $past := $( $<comp_stmt> );
+ make $past;
+}
+
+method super_call($/) {
+ my $past := $( $<call_args> );
+ ## how to invoke super.xxx ?
+ make $past;
+}
+
+method operation($/) {
+ make $( $<identifier> );
+}
+
+method call_args($/) {
+ my $past;
+ if $<args> {
+ $past := $( $<args> );
+ }
+ else {
+ $past := PAST::Op.new( :pasttype('call'), :node($/) );
+ }
+ if $<do_block> {
+ my $do := $( $<do_block>[0] );
+ $do.named(PAST::Val.new(:value('!BLOCK')));
+ $past.push($do);
+ }
+ make $past;
+}
+
+method args($/) {
+ my $past := PAST::Op.new( :pasttype('call'), :node($/) );
+ for $<arg> {
+ $past.push( $($_) );
+ }
+ make $past;
+}
+
+method basic_primary($/, $key) {
+ make $( $/{$key} );
+}
+
+method primary($/) {
+ my $past := $( $<basic_primary> );
+
+ # XXX check this out:
+ for $<post_primary_expr> {
+ my $postexpr := $( $_ );
+ $postexpr.unshift($past);
+ $past := $postexpr;
+ }
+ make $past;
+}
+
+method post_primary_expr($/, $key) {
+ make $( $/{$key} );
+}
+
+method scope_identifier($/) {
+ make $( $<identifier> );
+ # XXX handle :: operator.
+}
+
+method literal($/, $key) {
+ my $past := $( $/{$key} );
+ make $past;
+}
+
+method pcomp_stmt($/) {
+ make $( $<comp_stmt> );
+}
+
+method quote_string($/) {
+ make $( $<quote_expression> );
+}
+
+method warray($/) {
+ make $( $<quote_expression> );
+}
+
+method array($/) {
+ my $list;
+ if $<args> {
+ $list := $( $<args>[0] );
+ $list.name('list');
+ }
+ else {
+ $list := PAST::Op.new( :name('list'), :node($/) );
+ }
+
+ make $list;
+}
+
+method ahash($/) {
+ my $hash := PAST::Op.new( :name('hash'), :node($/) );
+ if $<assocs> {
+ my $items := $( $<assocs>[0] );
+ for @($items) {
+ $hash.push( $_ );
+ }
+ }
+ make $hash;
+}
+
+method assocs($/) {
+ my $assoc := PAST::Stmts.new(:node($/));
+ for $<assoc> {
+ my $item := $( $_ );
+ $assoc.push($item);
+ }
+ make $assoc;
+}
+
+method assoc($/) {
+ my $past := PAST::Op.new(:name('list'), :node($/));
+ $past.push( $( $<arg>[0] ) );
+ $past.push( $( $<arg>[1] ) );
+ make $past;
+}
+
+method float($/) {
+ make PAST::Val.new( :value( ~$/ ), :returns('Float'), :node($/) );
+}
+
+method integer($/) {
+ make PAST::Val.new( :value( ~$/ ), :returns('CardinalInteger'), :node($/) );
+}
+
+method string($/) {
+ make PAST::Val.new( :value( ~$<string_literal> ), :returns('CardinalString'), :node($/) );
+}
+
+method regex($/) {
+ make $($<quote_expression>);
+}
+
+method quote_expression($/, $key) {
+ my $past;
+ if $key eq 'quote_regex' {
+ our $?NS;
+ $past := PAST::Block.new(
+ $<quote_regex>,
+ :compiler('PGE::Perl6Regex'),
+ :namespace($?NS),
+ :blocktype('declaration'),
+ :node( $/ )
+ );
+ }
+ elsif $key eq 'quote_concat' {
+ if +$<quote_concat> == 1 {
+ $past := $( $<quote_concat>[0] );
+ }
+ else {
+ $past := PAST::Op.new(
+ :name('list'),
+ :pasttype('call'),
+ :node( $/ )
+ );
+ for $<quote_concat> {
+ $past.push( $($_) );
+ }
+ }
+ }
+ make $past;
+}
+
+
+method quote_concat($/) {
+ my $terms := +$<quote_term>;
+ my $count := 1;
+ my $past := $( $<quote_term>[0] );
+ while ($count != $terms) {
+ $past := PAST::Op.new(
+ $past,
+ $( $<quote_term>[$count] ),
+ :pirop('concat'),
+ :pasttype('pirop')
+ );
+ $count := $count + 1;
+ }
+ make $past;
+}
+
+
+method quote_term($/, $key) {
+ my $past;
+ if ($key eq 'literal') {
+ $past := PAST::Val.new(
+ :value( ~$<quote_literal> ),
+ :returns('CardinalString'), :node($/)
+ );
+ }
+ elsif ($key eq 'variable') {
+ $past := $( $<variable> );
+ }
+ elsif ($key eq 'circumfix') {
+ $past := $( $<circumfix> );
+ if $past.WHAT() eq 'Block' {
+ $past.blocktype('immediate');
+ }
+ }
+ make $past;
+}
+
+method arg($/, $key) {
+ ## Handle the operator table
+ ##
+ if ($key eq 'end') {
+ make $($<expr>);
+ }
+ else {
+ my $past := PAST::Op.new( :name($<type>),
+ :pasttype($<top><pasttype>),
+ :pirop($<top><pirop>),
+ :lvalue($<top><lvalue>),
+ :node($/)
+ );
+ for @($/) {
+ $past.push( $($_) );
+ }
+ make $past;
+ }
+}
+
+sub is_a_sub($name) {
+ our $?BLOCK;
+ our @?BLOCK;
+ if $?BLOCK.symbol(~$name) {
+ if defined($?BLOCK.symbol(~$name)<arity>) {
+ return(1);
+ }
+ else {
+ return(0);
+ }
+ }
+ for @?BLOCK {
+ if $_ {
+ my $sym_table := $_.symbol(~$name);
+ if $sym_table {
+ if defined($sym_table<arity>) {
+ return(1);
+ }
+ else {
+ return(0);
+ }
+ }
+ }
+ }
+ my $lex := lex_lookup($name);
+ if $lex && ~lookup_class($lex) eq 'Sub' { return(1); }
+ return(0);
+}
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
+
Added: cardinal/trunk/src/parser/grammar.pg
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/src/parser/grammar.pg Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,567 @@
+# $Id$
+
+=begin overview
+
+This is the grammar for cardinal written as a sequence of Perl 6 rules.
+
+Originally taken (partly) from:
+http://www.math.hokudai.ac.jp/~gotoken/ruby/man/yacc.html
+
+and parse.y from the ruby source
+
+=end overview
+
+grammar cardinal::Grammar is PCT::Grammar;
+
+token TOP {
+ <comp_stmt>
+ [ $ || <panic: Syntax error> ]
+ {*}
+}
+
+token comp_stmt {
+ {*} #= open
+ <stmts>
+ {*} #= close
+}
+
+rule stmts {
+ <.term>?[ <stmt> [<.term>+ | <.before <end_block>> | $ | <panic: unterminated statement>] ]* {*}
+}
+
+token term { \n | ';' }
+token end_block { <.ws> [ 'end' | '}' ] }
+
+token basic_stmt {
+ | <alias> {*} #= alias
+ | <classdef> {*} #= classdef
+ | <functiondef> {*} #= functiondef
+ | <if_stmt> {*} #= if_stmt
+ | <while_stmt> {*} #= while_stmt
+ | <for_stmt> {*} #= for_stmt
+ | <unless_stmt> {*} #= unless_stmt
+ | <module> {*} #= module
+ | <begin_end> {*} #= begin_end
+ | <indexed_assignment> {*} #= indexed_assignment
+ | <member_assignment> {*} #= member_assignment
+ | <assignment> {*} #= assignment
+ | <return_stmt> {*} #= return_stmt
+ | <expr> {*} #= expr
+ | <begin> {*} #= begin
+ | <end> {*} #= end
+}
+
+token return_stmt {
+ 'return' <.ws> <call_args> {*}
+}
+
+rule alias {
+ 'alias' <fname> <fname>
+ {*}
+}
+
+token stmt {
+ <basic_stmt> <.ws> <stmt_mod>*
+ {*}
+}
+
+token stmt_mod {
+ $<sym>=[if|while|unless|until] <.ws> <expr>
+ {*}
+}
+
+rule expr {
+ [$<not>=['!'|'not']]? <arg> [$<op>=['and'|'or'] <expr>]?
+ {*}
+}
+
+rule begin {
+ 'BEGIN' '{' <comp_stmt> '}'
+ {*}
+}
+
+rule end {
+ 'END' '{' <comp_stmt> '}'
+ {*}
+}
+
+token indexed_assignment {
+ <basic_primary> '[' <key=arg> ']' <.ws> '=' <.ws> <rhs=arg>
+ {*}
+}
+
+token member_assignment {
+ <basic_primary> '.' <key=identifier> <.ws> '=' <.ws> <rhs=arg>
+ {*}
+}
+
+rule assignment {
+ <mlhs=lhs> '=' <mrhs=arg> #XXX need to figure out multiple assignment
+ {*}
+}
+
+rule mlhs {
+ | <lhs> {*} #= lhs
+ | '(' <mlhs> ')' {*} #= mlhs
+}
+
+token lhs {
+ | <basic_primary> {*} #= basic_primary
+}
+
+token indexed {
+ '[' <args>? ']'
+ {*}
+}
+
+token member_variable {
+ <primary> '.' <identifier>
+ {*}
+}
+
+token methodcall {
+ $<dot>='.'
+ <operation> <call_args>? <do_block>?
+ {*}
+}
+
+rule do_block {
+ | 'do' <do_args>? <.term>? <.before <stmt>><comp_stmt> 'end' {*}
+ | '{' <do_args>? <.term>? <.before <stmt>><comp_stmt> '}' {*}
+}
+
+rule super_call {
+ 'super' <call_args>
+ {*}
+}
+
+token operation {
+ 'class'|
+ 'nil?' |
+ 'next' |
+ 'begin'|
+ 'end' |
+ '`' |
+ <.identifier> ('!'|'?')?
+}
+
+#XXX UGLY! Refactor into <args> maybe?
+token call_args {
+ | '()' [<.ws> <do_block>]? {*}
+ | [ <.after \s|\)> | <.before \s> ] <args> [<.ws> <do_block>]? {*}
+ | '(' <.ws> <args> <.ws> ')' [<.ws> <do_block>]? {*}
+}
+
+rule do_args {
+ '|' <block_signature> '|'
+}
+
+rule sig_identifier {
+ #XXX Should this be basic_primary or expr or what?
+ <identifier>[ '=' <default=basic_primary>]? {*}
+}
+
+rule block_signature {
+ [
+ | <sig_identifier> [',' <sig_identifier>]* [',' <slurpy_param>]? [',' <block_param>]?
+ | <slurpy_param> [',' <block_param>]?
+ | <block_param>?
+ ] {*}
+}
+
+token variable {
+ | <varname> {*} #= varname
+ | 'nil' {*} #= nil
+ | 'self' {*} #= self
+}
+
+token varname {
+ <!reserved_word>
+ [ <global> {*} #= global
+ | <class_variable> {*} #= class_variable
+ | <instance_variable> {*} #= instance_variable
+ | <local_variable> {*} #= local_variable
+ | <constant_variable> {*} #= constant_variable
+ ]
+}
+
+token funcall {
+ <!reserved_word> <local_variable> <.before \s|'('> <.before <call_args>> {*}
+}
+
+token mrhs {
+ <args> {*}
+}
+
+rule args {
+ <arg> [',' <arg>]*
+ {*}
+}
+
+rule 'arg' is optable { ... }
+
+proto 'infix:=' is precedence('1') is pasttype('copy') is lvalue(1) { ... }
+
+
+
+token basic_primary {
+ | <literal> {*} #= literal
+ | <funcall> {*} #= funcall
+ | <variable> {*} #= variable
+ | <ahash> {*} #= ahash
+ | <regex> {*} #= regex
+ | <do_block> {*} #= do_block
+ | <quote_string> {*} #= quote_string
+ | <warray> {*} #= warray
+ | <array> {*} #= array
+ | <pcomp_stmt> {*} #= pcomp_stmt
+ | <yield> {*} #= yield
+ | <control_command> {*} #= control_command
+}
+
+token primary {
+ <basic_primary> <post_primary_expr>*
+ {*}
+}
+
+token post_primary_expr {
+ | <indexed> {*} #= indexed
+ | <call_args> {*} #= call_args
+ | <methodcall> {*} #= methodcall
+ | '[' <args>? ']' {*} #= args
+}
+
+token pcomp_stmt {
+ '(' <comp_stmt> ')'
+ {*}
+}
+
+
+rule if_stmt {
+ 'if' <expr> <.then>
+ [<comp_stmt>
+ ['elsif' <expr> <.then>
+ <comp_stmt>]*
+ <else>?
+ 'end'
+ |<panic: syntax error in if statement>]
+ {*}
+}
+
+token then { ':' | 'then' | <term> ['then']? }
+
+rule while_stmt {
+ $<sym>=['while'|'until'] <expr> <.do>
+ <comp_stmt>
+ 'end'
+ {*}
+}
+
+rule for_stmt {
+ 'for' <variable> 'in' <expr> <.do>
+ <comp_stmt>
+ 'end'
+ {*}
+}
+
+token do { ':' | 'do' | <term> ['do']? }
+
+rule unless_stmt {
+ 'unless' <expr> <.then> <comp_stmt>
+ <else>?
+ 'end'
+ {*}
+}
+
+token else {
+ 'else' <.ws> <comp_stmt>
+ {*}
+}
+
+token ensure {
+ 'ensure' <.ws> <comp_stmt>
+ {*}
+}
+
+rule rescue {
+ # XXX check <args>
+ ['rescue' <args> <.then> <comp_stmt>]+
+ {*}
+}
+
+token control_command {
+ | 'next' {*} #= next
+ | 'break' {*} #= break
+ | 'redo' {*} #= redo
+}
+
+token yield {
+ 'yield' <call_args> {*}
+}
+
+rule module {
+ 'module' <module_identifier>
+ <comp_stmt>
+ 'end'
+ {*}
+}
+
+rule classdef {
+ 'class' <module_identifier> {*} #= open
+ <comp_stmt>
+ 'end' {*} #= block
+}
+
+rule functiondef {
+ 'def' <fname> <argdecl>
+ <comp_stmt>
+ 'end'
+ {*}
+}
+
+rule bodystmt {
+ <comp_stmt>
+ <rescue>?
+ <else>?
+ <ensure>?
+}
+
+rule argdecl {
+ ['('
+ <block_signature>
+ ')']?
+}
+
+token slurpy_param {
+ '*' <identifier>
+ {*}
+}
+
+token block_param {
+ '&' <identifier>
+ {*}
+}
+
+rule begin_end {
+ 'begin'
+ <comp_stmt>
+ ['rescue' <args>? <.do> <comp_stmt>]+
+ ['else' <comp_stmt>]?
+ ['ensure' <comp_stmt>]?
+ 'end'
+ {*}
+}
+
+token fname {
+ <.identifier> <[=!?]>?
+}
+
+token quote_string {
+ ['%q'|'%Q'] <.before <[<[_|({]>> <quote_expression: :qq>
+ {*}
+}
+
+token warray {
+ '%w' <.before <[<[({]>> <quote_expression: :w :q>
+ {*}
+}
+
+rule array {
+ '[' [ <args> [',']? ]? ']'
+ {*}
+}
+
+rule ahash {
+ '{' [ <assocs> [',']? ]? '}'
+ {*}
+}
+
+rule assocs {
+ <assoc> [',' <assoc>]*
+ {*}
+}
+
+rule assoc {
+ <arg> '=>' <arg>
+ {*}
+}
+
+token identifier {
+ <!reserved_word> <ident> {*}
+}
+
+token module_identifier {
+ <.before <[A..Z]>> <ident>
+ {*}
+}
+
+token global {
+ '$' <ident>
+ {*}
+}
+
+token instance_variable {
+ '@' <ident>
+ {*}
+}
+
+token class_variable {
+ '@@' <ident>
+ {*}
+}
+
+token local_variable {
+ [<ns=ident> '::']* [ <before <[a..z_]>> | <after '::'> ] <ident>
+ {*}
+}
+
+token constant_variable {
+ <.before <[A..Z]>> <.ident>
+ {*}
+}
+
+token literal {
+ | <float> {*} #= float
+ | <integer> {*} #= integer
+ | <string> {*} #= string
+}
+
+token float {
+ '-'? \d* '.' \d+
+ {*}
+}
+
+token integer {
+ '-'? \d+
+ {*}
+}
+
+token string {
+ [ \' <string_literal: "'"> \' | \" <string_literal: '"'> \" ]
+ {*}
+}
+
+token regex {
+ <.before '/'> [<quote_expression: :regex> $<modifiers>=[<alpha>]*
+ |<panic: problem parsing regex>]
+ {*}
+}
+
+token reserved_word {
+ [alias|and|BEGIN|begin|break|case
+ |class|def|defined|do|else|elsif
+ |END|end|ensure|false|for|if
+ |in|module|next|nil|not|or
+ |redo|rescue|retry|return|self|super
+ |then|true|undef|unless|until|when
+ |while|yield|__FILE__|__LINE__]>>
+}
+
+token ws {
+ | '\\' \n ## a backslash at end of line
+ | <after [','|'='|'+']> \n ## a newline after a comma or operator is ignored
+ | \h* ['#' \N* \n* <ws>]?
+}
+
+
+proto 'infix:=' is precedence('1') is pasttype('copy') is lvalue(1) { ... }
+
+proto 'prefix:defined?' is looser('infix:=') { ... }
+
+proto 'infix:+=' is equiv('infix:=')
+ { ... }
+
+proto 'infix:-=' is equiv('infix:=')
+ { ... }
+
+proto 'infix:/=' is equiv('infix:=')
+ is pirop('div') { ... }
+
+proto 'infix:*=' is equiv('infix:=')
+ is pirop('mul') { ... }
+
+proto 'infix:%=' is equiv('infix:=')
+ is pirop('mul') { ... }
+
+proto 'infix:|=' is equiv('infix:=') { ... }
+
+proto 'infix:&=' is equiv('infix:=') { ... }
+
+proto 'infix:~=' is equiv('infix:=') { ... }
+
+proto infix:«>>=» is equiv('infix:=')
+ is pirop('rsh') { ... }
+
+proto infix:«<<=» is equiv('infix:=')
+ is pirop('lsh') { ... }
+
+proto 'infix:&&=' is equiv('infix:=')
+ is pirop('and') { ... }
+
+proto 'infix:**=' is equiv('infix:=')
+ is pirop('pow') { ... }
+
+proto 'ternary:? :' is tighter('infix:=')
+ is pirop('if') { ... }
+
+proto 'infix:..' is tighter('ternary:? :') { ... }
+ #is parsed(&primary) { ... }
+ #is pirop('add') { ... }
+
+proto 'infix:...' is equiv('infix:..') { ... }
+
+proto 'infix:||' is tighter('infix:..')
+ is pasttype('unless') { ... }
+
+proto 'infix:&&' is tighter('infix:||')
+ is pasttype('if') { ... }
+
+
+proto 'infix:==' is tighter('infix:&&') { ... }
+proto 'infix:!=' is equiv('infix:==') { ... }
+proto 'infix:=~' is equiv('infix:==') { ... }
+proto 'infix:!~' is equiv('infix:==') { ... }
+proto 'infix:===' is equiv('infix:==') { ... }
+proto infix:«<=>» is equiv('infix:==') { ... }
+
+
+proto infix:«>» is tighter('infix:===') { ... }
+proto infix:«<» is tighter('infix:===') { ... }
+proto infix:«<=» is tighter('infix:===') { ... }
+proto infix:«>=» is tighter('infix:===') { ... }
+
+proto 'infix:|' is tighter('infix:<=') { ... }
+proto 'infix:^' is equiv('infix:|') { ... }
+
+proto 'infix:&' is tighter('infix:|') { ... }
+
+proto infix:«<<» is tighter('infix:&') { ... }
+proto infix:«>>» is equiv(infix:«<<») { ... }
+
+proto 'infix:+' is tighter(infix:«<<») { ... }
+
+proto 'infix:-' is equiv('infix:+') { ... }
+ #is pirop('sub') { ... }
+
+proto 'infix:*' is tighter('infix:+') { ... }
+ #is pirop('mul') { ... }
+
+proto 'infix:/' is equiv('infix:*') { ... }
+ #is pirop('div') { ... }
+
+proto 'infix:%' is equiv('infix:*')
+ is pirop('mod') { ... }
+
+proto 'postfix:++' is tighter('infix:*')
+ is pirop('n_add') { ... }
+
+proto 'postfix:--' is tighter('infix:*')
+ is pirop('n_sub') { ... }
+#
+#proto 'prefix:+' is tighter('infix:*') { ... }
+#proto 'prefix:-' is equiv('prefix:+') { ... }
+#proto 'prefix:!' is equiv('prefix:+') { ... }
+#proto 'prefix:~' is equiv('prefix:+') { ... }
+
+proto 'term:' is tighter('infix:*')
+ is parsed(&primary) { ... }
Added: cardinal/trunk/src/parser/quote_expression.pir
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/src/parser/quote_expression.pir Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,454 @@
+# Copyright (C) 2007-2008, Parrot Foundation.
+# $Id$
+
+.include 'cclass.pasm'
+
+.namespace ['cardinal';'Grammar']
+
+.sub 'peek_brackets' :method
+ .param string target
+ .param int pos
+ .local string brackets, start, stop
+ brackets = unicode:"<>[](){}\xab\xbb"
+ start = substr target, pos, 1
+ stop = start
+ $I0 = index brackets, start
+ if $I0 < 0 goto end
+ $I1 = $I0 % 2
+ unless $I1 goto bracket_valid
+ self.'panic'("Using a closing delimiter for an opener is reserved")
+ goto end
+ bracket_valid:
+ inc $I0
+ stop = substr brackets, $I0, 1
+ end:
+ .return (start, stop)
+.end
+
+
+.sub 'quote_expression' :method
+ .param string flags
+ .param pmc options :slurpy :named
+
+ ## create a new match object
+ .local pmc mob
+ .local int pos
+ .local string target
+ (mob, pos, target) = self.'new'(self)
+
+ ## get action object
+ .local pmc action
+ action = options['action']
+
+ ## set up options based on flags
+ .local pmc flagarray, iter
+ flagarray = split ' ', flags
+ iter = new 'Iterator', flagarray
+ iter_loop:
+ unless iter goto iter_end
+ .local string oname
+ oname = shift iter
+ oname = substr oname, 1
+ options[oname] = 1
+ if oname == 'ww' goto opt_ww
+ if oname == 'w' goto opt_w
+ if oname == 'qq' goto opt_qq
+ if oname == 'b' goto opt_b
+ goto iter_loop
+ opt_ww:
+ opt_w:
+ options['wsstop'] = 1
+ goto iter_loop
+ opt_qq:
+ options['s'] = 1
+ options['a'] = 1
+ options['h'] = 1
+ options['f'] = 1
+ options['c'] = 1
+ options['b'] = 1
+ opt_b:
+ options['q'] = 1
+ goto iter_loop
+ iter_end:
+
+ .local string start, stop
+ (start, stop) = self.'peek_brackets'(target, pos)
+
+ ## determine pos, lastpos
+ $I0 = length start
+ pos += $I0
+ .local int stoplen, lastpos, wsstop
+ stoplen = length stop
+ wsstop = options['wsstop']
+ lastpos = length target
+ lastpos -= stoplen
+ options['stop'] = stop
+
+ ## handle :regex parsing
+ .local pmc p6regex, quote_regex
+ $I0 = options['regex']
+ unless $I0 goto word_start
+ regex_start:
+ p6regex = get_root_global ['parrot';'PGE';'Perl6Regex'], 'regex'
+ mob.'to'(pos)
+ quote_regex = p6regex(mob, options :flat :named)
+ unless quote_regex goto fail
+ pos = quote_regex.'to'()
+ .local string key
+ key = 'quote_regex'
+ mob[key] = quote_regex
+ goto succeed
+
+ ## handle word parsing
+ word_start:
+ ## set up escapes based on flags
+ .local string escapes
+ escapes = ''
+ $I0 = options['s']
+ unless $I0 goto escape_s_done
+ escapes = '$'
+ escape_s_done:
+ $I0 = options['c']
+ unless $I0 goto escape_c_done
+ escapes .= '{'
+ escape_c_done:
+ have_escapes:
+ options['escapes'] = escapes
+
+ .local int optww
+ optww = options['ww']
+ unless optww goto have_wwopts
+ .local pmc wwsingleopts, wwdoubleopts
+ wwsingleopts = new 'Hash'
+ wwsingleopts['q'] = 1
+ wwsingleopts['stop'] = "'"
+ wwsingleopts['action'] = action
+ ## FIXME: RT#48112 -- currently 'clone' on a Hash can't
+ ## handle null entries (and does a deepcopy), so we're
+ ## using an iterator to do it.
+ ## wwdoubleopts = clone options
+ wwdoubleopts = new 'Hash'
+ .local pmc iter2
+ iter2 = new 'Iterator', options
+ iter2_loop:
+ unless iter2 goto iter2_end
+ $S0 = shift iter2
+ $P0 = options[$S0]
+ wwdoubleopts[$S0] = $P0
+ goto iter2_loop
+ iter2_end:
+ wwdoubleopts['stop'] = '"'
+ wwdoubleopts['wsstop'] = 0
+ have_wwopts:
+
+ .local pmc quote_concat
+ quote_concat = new 'ResizablePMCArray'
+
+ unless wsstop goto word_plain
+ word_loop:
+ pos = find_not_cclass .CCLASS_WHITESPACE, target, pos, lastpos
+ if pos > lastpos goto fail
+ $S0 = substr target, pos, stoplen
+ if $S0 == stop goto word_succeed
+ if pos >= lastpos goto fail
+ unless optww goto word_plain
+ word_shell:
+ $S0 = substr target, pos, 1
+ if $S0 == '"' goto word_shell_double
+ if $S0 != "'" goto word_plain
+ word_shell_single:
+ inc pos
+ mob.'to'(pos)
+ $P0 = mob.'quote_concat'(wwsingleopts)
+ unless $P0 goto fail
+ push quote_concat, $P0
+ pos = $P0.'to'()
+ inc pos
+ goto word_loop
+ word_shell_double:
+ inc pos
+ mob.'to'(pos)
+ $P0 = mob.'quote_concat'(wwdoubleopts)
+ unless $P0 goto fail
+ push quote_concat, $P0
+ pos = $P0.'to'()
+ inc pos
+ goto word_loop
+ word_plain:
+ mob.'to'(pos)
+ $P0 = mob.'quote_concat'(options)
+ unless $P0 goto fail
+ push quote_concat, $P0
+ pos = $P0.'to'()
+ goto word_loop
+ word_succeed:
+ key = 'quote_concat'
+ mob[key] = quote_concat
+
+ succeed:
+ pos += stoplen
+ mob.'to'(pos)
+ if null action goto succeed_done
+ $I0 = can action, 'quote_expression'
+ unless $I0 goto succeed_done
+ action.'quote_expression'(mob, key)
+ succeed_done:
+ .return (mob)
+ fail:
+ mob.'to'(-1)
+ .return (mob)
+.end
+
+
+.sub 'quote_concat' :method
+ .param pmc options
+
+ ## create a new match object
+ .local pmc mob
+ .local int pos
+ .local string target
+ (mob, pos, target) = self.'new'(self)
+
+ ## determine pos, lastpos
+ .local string stop
+ .local int stoplen, lastpos, wsstop
+ stop = options['stop']
+ wsstop = options['wsstop']
+ stoplen = length stop
+ lastpos = length target
+ lastpos -= stoplen
+
+ .local string escapes
+ escapes = options['escapes']
+
+ .local pmc quote_term
+ quote_term = new 'ResizablePMCArray'
+
+ term_loop:
+ mob.'to'(pos)
+ $P0 = mob.'quote_term'(options)
+ unless $P0 goto fail
+ push quote_term, $P0
+ pos = $P0.'to'()
+ if pos > lastpos goto fail
+ $S0 = substr target, pos, stoplen
+ if $S0 == stop goto succeed
+ unless wsstop goto term_loop
+ $I0 = is_cclass .CCLASS_WHITESPACE, target, pos
+ unless $I0 goto term_loop
+ succeed:
+ ## save the array of captured terms
+ mob['quote_term'] = quote_term
+ mob.'to'(pos)
+ ## call any related {*} actions
+ .local pmc action
+ action = options['action']
+ if null action goto succeed_done
+ $I0 = can action, 'quote_concat'
+ unless $I0 goto succeed_done
+ action.'quote_concat'(mob)
+ succeed_done:
+ .return (mob)
+ fail:
+ mob.'to'(-1)
+ .return (mob)
+.end
+
+
+.sub 'quote_term' :method
+ .param pmc options
+
+ .local pmc action
+ action = options['action']
+
+ .local pmc mob
+ .local int pos
+ .local string target
+ (mob, pos, target) = self.'new'(self)
+
+ .local string leadchar, escapes
+ escapes = options['escapes']
+ leadchar = substr target, pos, 1
+ $I0 = index escapes, leadchar
+ if $I0 < 0 goto term_literal
+ if leadchar == '$' goto term_scalar
+ if leadchar == '{' goto term_closure
+ term_literal:
+ mob.'to'(pos)
+ $P0 = mob.'quote_literal'(options)
+ unless $P0 goto fail
+ pos = $P0.'to'()
+ mob['quote_literal'] = $P0
+ .local string key
+ key = 'literal'
+ goto succeed
+
+ term_scalar:
+ mob.'to'(pos)
+ $P0 = mob.'variable'('action'=>action)
+ unless $P0 goto err_scalar
+ pos = $P0.'to'()
+ key = 'variable'
+ mob[key] = $P0
+ goto succeed
+
+ term_closure:
+ mob.'to'(pos)
+ $P0 = mob.'circumfix'('action'=>action)
+ unless $P0 goto fail
+ pos = $P0.'to'()
+ key = 'circumfix'
+ mob[key] = $P0
+ goto succeed
+
+ succeed:
+ mob.'to'(pos)
+ if null action goto succeed_done
+ $I0 = can action, 'quote_term'
+ unless $I0 goto succeed_done
+ action.'quote_term'(mob, key)
+ succeed_done:
+ .return (mob)
+
+ fail:
+ mob.'to'(-1)
+ .return (mob)
+
+ err_scalar:
+ mob.'to'(pos)
+ mob.'panic'("Can't use $ as non-variable in interpolated string")
+ .return (mob)
+.end
+
+
+.sub 'quote_literal' :method
+ .param pmc options
+
+ .local pmc mob
+ .local int pos
+ .local string target
+ (mob, pos, target) = self.'new'(self)
+
+ .local string stop, stop1
+ .local int stoplen, lastpos, wsstop
+ stop = options['stop']
+ wsstop = options['wsstop']
+ stop1 = substr stop, 0, 1
+ stoplen = length stop
+ lastpos = length target
+ lastpos -= stoplen
+
+ .local string escapes
+ .local int optq, optb
+ escapes = options['escapes']
+ optq = options['q']
+ optb = options['b']
+
+ .local string literal
+ literal = ''
+
+ scan_loop:
+ if pos > lastpos goto fail
+ $S0 = substr target, pos, stoplen
+ if $S0 == stop goto succeed
+ unless wsstop goto scan_loop_1
+ $I0 = is_cclass .CCLASS_WHITESPACE, target, pos
+ if $I0 goto succeed
+ scan_loop_1:
+ if pos >= lastpos goto fail
+
+ scan_char:
+ .local string litchar
+ litchar = substr target, pos, 1
+ ## if we've reached an escape char, we're done
+ $I0 = index escapes, litchar
+ if $I0 >= 0 goto succeed
+ ## if this isn't an interpolation, add the char
+ unless optq goto add_litchar
+ if litchar != "\\" goto add_litchar
+ ## okay, we have a backslash, let's process it
+ .local string backchar
+ $I0 = pos + 1
+ backchar = substr target, $I0, 1
+ ## handle :q options, \\ and \+stop
+ if backchar == "\\" goto add_backchar
+ if backchar == stop1 goto add_backchar
+ unless optb goto add_litchar
+ ## handle :b options
+ $I0 = index "0abefnrtxdo123456789", backchar
+ if $I0 < 0 goto add_backchar
+ if $I0 >= 11 goto fail_backchar_digit
+ if $I0 >= 8 goto scan_xdo
+ litchar = substr "\0\a\b\e\f\n\r\t", $I0, 1
+ if $I0 >= 1 goto add_litchar2
+ ## peek ahead for octal digits after \0
+ $I0 = pos + 2
+ $S0 = substr target, $I0, 1
+ $I0 = index "01234567", $S0
+ if $I0 >= 0 goto fail_backchar_digit
+ add_litchar2:
+ pos += 2
+ literal .= litchar
+ goto scan_loop
+ add_backchar:
+ literal .= backchar
+ pos += 2
+ goto scan_loop
+ add_litchar:
+ literal .= litchar
+ inc pos
+ goto scan_loop
+
+ scan_xdo:
+ ## handle \x, \d, and \o escapes. start by converting
+ ## the backchar into 8, 10, or 16 (yes, it's a hack
+ ## but it works). Then loop through the characters
+ ## that follow to compute the decimal value of codepoints,
+ ## and add the codepoints to our literal.
+ .local int base, decnum, isbracketed
+ base = index ' o d x', backchar
+ decnum = 0
+ pos += 2
+ $S0 = substr target, pos, 1
+ isbracketed = iseq $S0, '['
+ pos += isbracketed
+ scan_xdo_char_loop:
+ $S0 = substr target, pos, 1
+ $I0 = index '0123456789abcdef0123456789ABCDEF', $S0
+ if $I0 < 0 goto scan_xdo_char_end
+ $I0 %= 16
+ if $I0 >= base goto scan_xdo_char_end
+ decnum *= base
+ decnum += $I0
+ inc pos
+ goto scan_xdo_char_loop
+ scan_xdo_char_end:
+ $S1 = chr decnum
+ concat literal, $S1
+ unless isbracketed goto scan_xdo_end
+ if $S0 == ']' goto scan_xdo_end
+ if $S0 != ',' goto fail
+ inc pos
+ decnum = 0
+ goto scan_xdo_char_loop
+ scan_xdo_end:
+ pos += isbracketed
+ goto scan_loop
+
+ succeed:
+ mob.'result_object'(literal)
+ mob.'to'(pos)
+ .return (mob)
+ fail_backchar_digit:
+ self.'panic'('\123 form deprecated, use \o123 instead')
+ fail:
+ mob.'to'(-1)
+ .return (mob)
+.end
+
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
Added: cardinal/trunk/t/00-sanity.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/00-sanity.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,17 @@
+puts "1..6" if 1
+
+# comments work!
+#
+puts "ok 1"
+
+puts "ok \
+ 2"
+
+puts "ok 3" ; puts "ok 4"
+
+print "ok "; print 1 + 4; print "\n"
+
+print "ok "; puts 2 * 3
+
+
+
Added: cardinal/trunk/t/01-stmts.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/01-stmts.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,13 @@
+puts "1..2"
+
+if 1 then
+ puts "ok 1"
+else
+ puts "nok 1"
+end
+
+unless 0
+ puts "ok 2"
+end
+
+
Added: cardinal/trunk/t/02-functions.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/02-functions.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,41 @@
+require 'test'
+
+plan 7
+
+def first
+ ok 1, 'simple function'
+end
+
+def second(n)
+ is n%3, 2, 'function 1 parameter'
+end
+
+def third(a,b)
+ ok a == 3, 'function 2 parameters'
+ is b, 4, 'function 2 parameters'
+end
+
+def fib(n)
+ if n<2
+ n
+ else
+ fib(n - 2)+fib(n - 1)
+ end
+end
+
+def blocks(n,&f)
+ f(n)
+end
+
+def defaults(n=7)
+ is n, 7, 'function w/ default parameter'
+end
+
+first
+second(2)
+third(3,4)
+second fib(6) - 3;
+blocks('foo') do |i|
+ is i, 'foo', 'invoke function 2 params, 1 value, 1 block'
+end
+defaults()
Added: cardinal/trunk/t/03-return.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/03-return.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,13 @@
+puts "1..2"
+
+def noargs
+ return 1
+end
+
+puts "ok ", noargs()
+
+def onearg(a)
+ return a
+end
+
+puts onearg("ok "), onearg(2)
Added: cardinal/trunk/t/04-indexed.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/04-indexed.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,12 @@
+puts "1..4"
+
+a = [ 'ok ', 1 ]
+
+puts a[0], a[1]
+
+a = [ 'ok ', 2, 3, 4 ]
+b = 1
+
+puts a[0], a[b]
+puts a[0], a[a[1]]
+puts a[0], a[a[a[1]]]
Added: cardinal/trunk/t/05-op-cmp.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/05-op-cmp.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,24 @@
+require 'test'
+plan 12
+
+ok 1 < 2, '<';
+nok 1 > 2, '>';
+ok 1 <= 2, '<=';
+ok 2 >= 1, '>=';
+ok 1 == 1, '==';
+nok 1 == 2, '==';
+ok 1 != 2, '!=';
+nok 1 != 1, '!=';
+
+#math ops
+num = 3 - 2
+ok num == 1, '-'
+num = 2 + 1
+ok num == 3, '+'
+num = 1 * 2
+ok num == 2, '*'
+num = 4 % 2
+ok num == 0, '%'
+# something is up with the /
+#num = 4 / 2
+#ok num == 2, 'div'
Added: cardinal/trunk/t/07-loops.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/07-loops.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,22 @@
+require 'test'
+plan 12
+
+i = 1
+while i < 5
+ ok(i < 5, 'while loop')
+ i = i + 1
+end
+
+a = [ 5, 6, 7, 8 ]
+
+for i in a
+ ok(i < 9, 'for loop')
+end
+
+a = [1,2,3,4,5,6,7,8]
+
+for i in a
+ next if i % 2
+ nok(i % 2, 'next in for loop')
+end
+
Added: cardinal/trunk/t/08-class.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/08-class.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,64 @@
+puts '1..7'
+
+class OkayOnCreate
+ def initialize(a)
+ puts 'ok ', a
+ end
+end
+
+a = OkayOnCreate.new(1)
+
+class OkaySayer
+ def speak
+ puts 'ok ', @num
+ end
+
+ def setnum(n)
+ @num = n
+ end
+
+ def initialize(n)
+ @num = n
+ end
+
+ def inc
+ @num = @num + 1
+ end
+
+ def num()
+ @num
+ end
+
+ def num=(val)
+ @num = val
+ end
+end
+
+b = OkaySayer.new(2)
+
+b.speak
+b.setnum(3)
+b.speak
+b.inc
+b.speak
+b.num = b.num + 1
+puts "ok ", b.num
+
+class StaticTester
+ def num()
+ @@num
+ end
+ def num=(var)
+ @@num = var
+ end
+ def speak()
+ puts "ok ", @@num
+ end
+end
+
+x = StaticTester.new
+x.num = 6
+y = StaticTester.new
+y.speak
+y.num = y.num + 1
+x.speak
Added: cardinal/trunk/t/09-test.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/09-test.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,7 @@
+require 'test'
+
+plan 3
+
+ok(1)
+is 1+1, 2
+is "foo", ['f','o','o'].to_s
Added: cardinal/trunk/t/10-regex.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/10-regex.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,11 @@
+require 'test'
+plan 3
+
+ok "foo" =~ /oo/, 'basic regex matching'
+
+a = /a+/
+ok "bar" =~ a, 'save a regex in a variable'
+
+# We only have Perl 6 Rules right now. No pcre.
+b = /^ <[abc]>+ $/
+ok "abacabba" =~ b, 'slightly more complex regex'
Added: cardinal/trunk/t/11-slurpy.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/11-slurpy.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,13 @@
+require 'test'
+plan 4
+
+def foo(*n)
+ is n.WHAT, Array, "slurpy param is an array"
+ i = 0
+ n.each do |a|
+ is a, i, "slurpy item"
+ i += 1
+ end
+end
+
+foo(0,1,2)
Added: cardinal/trunk/t/12-gather.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/12-gather.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,14 @@
+require 'test'
+plan 4
+
+items = gather do
+ take 0
+ take 1
+ take 2
+end
+
+is items.elems, 3, "basic gather"
+
+items.each do |i|
+ ok i < 3, "basic gather"
+end
Added: cardinal/trunk/t/99-other.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/99-other.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,25 @@
+require 'test'
+plan 8
+
+n = 5
+
+a = 1
+n.downto(1) do |i|
+ is 6-i, a, "downto"
+ a += 1
+end
+
+def foo
+ return [ 9, 6, 7 ]
+end
+
+foo[1].upto(7) { |i| is i, a, "method on array access of the result of calling a function"
+ a += 1}
+
+a = do |a,&f|
+ f(a)
+end
+
+a(8) do |i|
+ pass "do block that accepts a block parameter"
+end
Added: cardinal/trunk/t/alias.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/alias.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,21 @@
+require 'test'
+plan 2
+
+class NumberHolder
+ def initialize(n)
+ @num = n
+ end
+
+ def inc
+ @num = @num + 1
+ end
+ alias increment inc
+
+ def num
+ @num
+ end
+end
+
+obj = NumberHolder.new(0)
+is obj.inc, 1, '.alias method'
+is obj.increment, 2, '.alias method'
Added: cardinal/trunk/t/array/array.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/array/array.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,27 @@
+require 'test'
+plan 10
+
+a = [ 1, 2, 3, 4 ]
+
+is a.first, 1
+is a.first(2).last, 2
+is a.last(2).first, 3
+is a.elems, 4
+
+a = [ 5, 6 ]
+
+n = 5
+
+a.each() do |i|
+ is i, n
+ n += 1
+end
+
+b = [ [ 7, 8 ], [ 9, 10 ] ]
+
+b.each() do |x|
+ x.each() do |y|
+ is y, n
+ n += 1
+ end
+end
Added: cardinal/trunk/t/array/at.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/array/at.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,7 @@
+puts "1..4"
+
+a = [ 1, 2 ]
+puts 'ok ', a[-2]
+puts 'ok ', a.at(-1)
+puts 'ok ', a.at(1) + 1
+puts 'ok ', a.at(1) * 2
Added: cardinal/trunk/t/array/clear.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/array/clear.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,24 @@
+require 'test'
+plan 8
+
+a = Array.new()
+a << 1
+a << 2
+a << 3
+
+n = 1
+a.each() do |i|
+ is i, n, '<< on Array'
+ n += 1
+end
+
+a.clear
+4.upto(8){ |i|
+ a << i
+}
+
+n = 4
+a.each() do |i|
+ is i, n, '.clear on Array'
+ n += 1
+end
Added: cardinal/trunk/t/array/collect.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/array/collect.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,9 @@
+require 'test'
+plan 2
+
+a = [ "a", "b", "c", "d" ]
+b = a.collect {|x| x + "!" }
+
+is a, [ "a", "b", "c", "d" ], ".collect on Array returns new array"
+is b, [ "a!", "b!", "c!", "d!" ], ".collect on Array returns new array"
+
Added: cardinal/trunk/t/array/delete.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/array/delete.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,7 @@
+puts "1..3"
+
+a = [ "a", "b", "c", "d" ]
+
+puts "ok 1" if a.delete("d") == "d"
+puts "ok 2" if a.delete("z") == nil
+puts "ok 3" if a.delete("zZ"){ "no such element" } == "no such element"
Added: cardinal/trunk/t/array/empty.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/array/empty.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,7 @@
+require 'test'
+plan 2
+
+a = [ 1, 2 ]
+nothing = []
+proclaim nothing.empty?, ".empty? on Array"
+proclaim !a.empty?, ".empty? on Array"
Added: cardinal/trunk/t/array/equals.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/array/equals.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,7 @@
+require 'test'
+plan 2
+
+a = [ 1, 2, 3 ]
+
+is a,[ 1, 2, 3 ]
+isnt a, [ 1, 2, 4 ]
Added: cardinal/trunk/t/array/fill.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/array/fill.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,15 @@
+require 'test'
+plan 4
+
+a = Array.new(2)
+
+is a, [ nil, nil ], '.new on Array'
+
+a = a.fill('-')
+is a, [ '-', '-' ], '.fill on Array'
+
+a = a.fill(':-)', 1)
+is a, ['-', ':-)'], '.fill with start index'
+
+a = a.fill(':-o', 0, 1)
+is a, [':-o', ':-)'], '.fill with start and end index'
Added: cardinal/trunk/t/array/first.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/array/first.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,9 @@
+puts "1..4"
+
+a = [ 1, 2, 3, 4, 5, 6 ]
+
+puts "ok 1" if a.first == 1
+puts "ok 2" if a.first(1) == [1]
+b = a.first(3)
+puts "ok 3" if b.size == 3
+puts "ok 4" if b == [1,2,3]
Added: cardinal/trunk/t/array/flatten.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/array/flatten.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,18 @@
+puts "1..8"
+
+a = [ 1, 2 ]
+
+b = [ [ 3, 4 ], [ 5, 6 ] ]
+
+c = [ a, b, 7, 8]
+
+
+c = c.flatten
+
+if c.length == 8
+ c.each() do |x|
+ puts 'ok ', x
+ end
+else
+ puts "nok 1..8"
+end
Added: cardinal/trunk/t/array/grep.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/array/grep.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,8 @@
+require 'test'
+plan 1
+
+
+langs = [ "ruby", "perl", "java", "c++", "python" ].grep(/r/) do |ele|
+ ele.capitalize
+end
+is langs, [ "Ruby", "Perl" ], '.grep on Array'
Added: cardinal/trunk/t/array/include.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/array/include.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,17 @@
+require 'test'
+plan 6
+
+a = [ 1, 2 ]
+
+x = 1
+a.each() do |i|
+ ok i == x, 'Array#each'
+ x += 1
+end
+
+b = [ [ 3, 4 ], [ 5, 6 ] ]
+
+ok b[0].include?(3), 'Array#include'
+nok b[0].include?(400), 'Array#include'
+nok b[1].include?(500), 'Array#include'
+ok b[1].include?(6), 'Array#include'
Added: cardinal/trunk/t/array/intersection.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/array/intersection.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,12 @@
+require 'test'
+plan 6
+
+a = [ 0, 1, 2, 3, 4, 5, 6 ]
+b = [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ]
+
+c = a & b
+if c.size == 6
+ c.each() do |i|
+ pass 'intersection'
+ end
+end
Added: cardinal/trunk/t/array/join.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/array/join.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,7 @@
+puts "1..2"
+
+a = [ 1, 2, 3 ]
+b = a.join("-")
+puts "ok 1" if b == "1-2-3"
+b = a.join
+puts "ok 2" if b == "123"
Added: cardinal/trunk/t/array/mathop.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/array/mathop.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,32 @@
+require 'test'
+plan 10
+
+a = [ 1, 2 ]
+b = [ 3, 4]
+
+c = a + b
+
+index = 1
+c.each() do |i|
+ is i, index, "Array Addition"
+ index += 1
+end
+
+c = b + a
+c = c.collect{ |x| x + 4 }
+c = c.sort
+index = 5
+c.each() do |i|
+ is i, index, "collect"
+ index += 1
+end
+
+a = [ 25, 50, 75, 100, 125 ]
+b = [ 25, 50 ]
+c = a - b
+is c, [ 75, 100, 125 ], 'Array subtraction'
+langs = [ "parrot", "perl", "erlang", "java" ]
+minus = [ "java", "perl", "erlang" ]
+langs = langs - minus
+is langs, ["parrot"], 'Array subtraction'
+
Added: cardinal/trunk/t/array/pop.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/array/pop.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,17 @@
+puts "1..6"
+
+a = [6, 5, 4]
+a.push(3)
+a.push(2, 1)
+cur = a.pop
+puts "ok 1" if cur == 1
+cur = a.pop
+puts "ok 2" if cur == 2
+cur = a.pop
+puts "ok 3" if cur == 3
+cur = a.pop
+puts "ok 4" if cur == 4
+cur = a.pop
+puts "ok 5" if cur == 5
+cur = a.pop
+puts "ok 6" if cur == 6
Added: cardinal/trunk/t/array/reverse.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/array/reverse.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,24 @@
+puts "1..12"
+
+a = Array.new()
+a << 6
+a << 5
+a << 4
+a << 3
+a << 2
+a << 1
+
+a = a.reverse
+unless a[0] != 1
+ a.each() do |i|
+ puts 'ok ', i
+ end
+end
+
+a = a.reverse
+unless a[0] != 6
+ a.reverse!
+ a.each() do |i|
+ puts 'ok ', i + 6
+ end
+end
Added: cardinal/trunk/t/array/shift.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/array/shift.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,18 @@
+puts "1..6"
+
+a = [4, 5, 6]
+
+a.unshift(3)
+a.unshift(1, 2)
+cur = a.shift
+puts "ok 1" if cur == 1
+cur = a.shift
+puts "ok 2" if cur == 2
+cur = a.shift
+puts "ok 3" if cur == 3
+cur = a.shift
+puts "ok 4" if cur == 4
+cur = a.shift
+puts "ok 5" if cur == 5
+cur = a.shift
+puts "ok 6" if cur == 6
Added: cardinal/trunk/t/array/slice.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/array/slice.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,12 @@
+puts "1..4"
+
+a = [ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9 ]
+b = a.slice(1, 4)
+if b.size == 4
+ puts "ok 1" if b[0] == 1
+ puts "ok 2" if b[1] == 2
+ puts "ok 3" if b[2] == 3
+ puts "ok 4" if b[3] == 4
+end
+
+#puts "todo 5" if a.slice(100) == nil
Added: cardinal/trunk/t/array/sort.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/array/sort.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,17 @@
+require 'test'
+plan 8
+
+a = [ 2, 1, 3 ]
+a = a.sort
+a.each_with_index() do |x, i|
+ is i, x - 1, 'sort'
+end
+b = [ 6, 4, 5 ]
+b.sort!
+b.each_with_index() do |x, i|
+ is i, x - 4, 'sort!'
+end
+c = [ 10, 9, 7, 5, 4, 3, 6, 2, 1, 8]
+c = c.sort { |x, y| x <=> y }
+is c[-4], 7, 'custom sort function'
+is c[-3], 8, 'custom sort function'
Added: cardinal/trunk/t/array/to_s.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/array/to_s.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,6 @@
+require 'test'
+plan 1
+
+a = [ 1, 2 ]
+
+is a.to_s, "12"
Added: cardinal/trunk/t/array/uniq.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/array/uniq.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,18 @@
+require 'test'
+plan 6
+
+a = [ 1, 1, 2, 2, 3, 3, 1, 2, 3, 1, 2, 3]
+a = a.uniq
+
+counter = 1
+a.each() do |i|
+ is i, counter, 'uniq'
+ counter += 1
+end
+
+b = [ 4, 4, 5, 5, 5, 6, 4, 5, 6]
+b.uniq!
+b.each() do |y|
+ is y, counter, 'uniq!'
+ counter += 1
+end
Added: cardinal/trunk/t/array/warray.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/array/warray.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,7 @@
+require 'test'
+plan 3
+
+a = %w{ fe fi fo }
+is a[0], "fe"
+is a[1], "fi"
+is a[2], "fo"
Added: cardinal/trunk/t/assignment.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/assignment.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,28 @@
+require 'test'
+plan 4
+
+a = 1
+is a, 1, 'single assignment per line'
+a = 2
+is a, 2, 'single assignment per line'
+
+x, y, z = 3, 4, 5
+is x, 3, 'multiple assignment per line'
+is y, 4, 'multiple assignment per line'
+is z, 5, 'multiple assignment per line'
+
+
+x, y = y, x
+x = x + 2
+y = y + 4
+is x, 6, 'single line swap'
+is y, 7, 'single line swap'
+
+
+contra = "u", "u", "d", "d"
+is contra, ["u", "u", "d", "d"], 'single lvalue multiple rvalue'
+
+#uno, dos = "one", *["two", "deux"]
+#is uno, "one", 'single line lvalue splat'
+#puts dos
+#is dos, ["two", "duex"], 'single line lvalue splat'
Added: cardinal/trunk/t/blocks.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/blocks.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,8 @@
+require 'test'
+plan 4
+
+1.upto(2) { |x| is x, x, 'curly brace block' }
+1.upto(2) do |x|
+ is x, x, 'do block'
+end
+
Added: cardinal/trunk/t/constants.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/constants.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,7 @@
+require 'test'
+plan 2
+
+is RUBY_PLATFORM, 'parrot', 'RUBY_PLATORM'
+is RUBY_VERSION, '1.9', 'RUBY_VERSION'
+#p ENV
+#p $\
Added: cardinal/trunk/t/continuation.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/continuation.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,17 @@
+require 'test'
+plan 4
+
+k = 0
+callcc {|cont|
+ outer = [ 0, 1, 2, 3, 4 ]
+ outer.each(){ |i|
+ ok i < 1, 'callcc for continuation'
+ inner = 1...10
+ inner.each(){ |j|
+ cont.call() if j == 3
+ ok j < 3, 'callcc for continuation'
+ k = k + 1
+ }
+ }
+}
+ok k < 3, '.call on continuation'
Added: cardinal/trunk/t/file/dir.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/file/dir.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,26 @@
+require 'test'
+plan 4
+
+d = Dir.new('.')
+
+files = Dir.entries('.')
+if files.include?('tmp')
+ pass '.entries on Dir'
+ skip ".mkdir on Dir, tmp dir already exists"
+else
+ Dir.mkdir('./tmp')
+ pass '.mkdir on Dir'
+ files = Dir.entries('.')
+ if files.include?('tmp')
+ Dir.rmdir('./tmp')
+ files = Dir.entries('.')
+ pass '.entries on Dir'
+ is files.include?('tmp'), 'true', '.rmdir on Dir'
+ end
+end
+
+pwd = Dir.pwd
+curdir = Dir.entries(pwd)
+Dir.chdir('../')
+parentdir = Dir.entries(Dir.getwd)
+isnt curdir, parentdir, '.pwd,.chdir, and getwd on Dir'
Added: cardinal/trunk/t/file/file.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/file/file.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,47 @@
+require 'test'
+plan 12
+
+
+def cleanup(name)
+ if File.exist?(name)
+ File.delete(name)
+ if File.exist?(name)
+ fail '.exist? on File'
+ else
+ pass '.exist? on File'
+ end
+ end
+end
+f1_name = "file-new-tmp.txt"
+cleanup(f1_name)
+File.open(f1_name, "w") do |fd|
+ is fd.class.to_s, 'File', ".open for File"
+ fd.puts("ok 2 - .open w/ mode and block for File")
+end
+f1 = File.open("file-new-tmp.txt", "r") do |fd|
+ line = fd.read()
+ print line
+ print "\n"
+end
+$testnum += 1
+is f1, nil, '.open w/ block for File'
+
+f2 = File.open(f1_name, "r")
+cleanup(f1_name)
+is f2.class.to_s, 'File', '.open w/ mode and no block for File'
+is f2.path, f1_name, '.path for File'
+f2_name = "file-new-tmp2.txt"
+f3 = File.open(f2_name, "w")
+f3_name = "file-new-tmp3.txt"
+f4 = File.new(f3_name, "r+")
+f5 = File.new(f1_name, "r")
+is f4.class.to_s, 'File', '.new w/ mode on File'
+is f4.path, 'file-new-tmp3.txt', '.path for File'
+is f3.path, 'file-new-tmp2.txt', '.path for File'
+is f2.path, 'file-new-tmp.txt', '.path for File'
+is f5.path, 'file-new-tmp.txt', '.path for File'
+
+
+cleanup(f1_name)
+cleanup(f2_name)
+cleanup(f3_name)
Added: cardinal/trunk/t/file/stat.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/file/stat.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,35 @@
+require 'test'
+plan 20
+
+# need a better test for these things. this shows that we at least can parse and execute these commands
+name = "file-stat-tmp.txt"
+f = File.new(name, "w")
+stat = f.stat
+isnt stat, nil, '.stat on File'
+isnt stat.class, nil, '.class on FileStat'
+isnt stat.blksize, nil, '.blksize on FileStat'
+isnt stat.directory?, nil, '.directory? on FileStat'
+isnt stat.executable?, nil, '.executable? on FileStat'
+isnt stat.file?, nil, '.file? on FileStat'
+isnt stat.dev, nil, '.dev on FileStat'
+isnt stat.ino, nil, '.ino on FileStat'
+isnt stat.mode, nil, '.mode on FileStat'
+isnt stat.nlink, nil, '.nlink on FileStat'
+isnt stat.uid, nil, '.uid on FileStat'
+isnt stat.gid, nil, '.gid on FileStat'
+isnt stat.rdev, nil, '.rdev on FileStat'
+isnt stat.size, nil, '.size on FileStat'
+isnt stat.size?, nil, '.size? on FileStat'
+isnt stat.atime, nil, '.atime on FileStat'
+isnt stat.mtime, nil, '.mtime on FileStat'
+isnt stat.ctime, nil, '.ctime on FileStat'
+isnt stat.blocks, nil, '.blocks on FileStat'
+
+if File.exist?(name)
+ File.delete(name)
+ if File.exist?(name)
+ fail '.exist? on File'
+ else
+ pass '.exist? on File'
+ end
+end
Added: cardinal/trunk/t/freeze.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/freeze.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,22 @@
+require 'test'
+plan 1
+
+class NumberHolder
+ def initialize(n)
+ @num = n
+ end
+
+ def inc
+ @num = @num + 1
+ end
+
+ def num
+ @num
+ end
+end
+
+obj = NumberHolder.new(0)
+obj.inc
+obj.freeze
+#p obj
+isnt obj.inc, 2, '.freeze method'
Added: cardinal/trunk/t/gc.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/gc.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,16 @@
+require 'test'
+plan 4
+
+
+todo 'rework this test after we can loop thru all the object in the system, then we can verify they were destroyed'
+status = GC.disable
+is status, 'false', '.disable on GC'
+
+status = GC.enable
+is status, 'true', '.enable on GC'
+
+status = GC.disable
+is status, 'false', '.disable on GC'
+
+GC.start
+pass '.start on GC'
Added: cardinal/trunk/t/harness
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/harness Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,27 @@
+#! perl
+
+# $Id$
+
+use FindBin;
+use lib qw( . lib ../lib ../../lib );
+use File::Spec;
+use Getopt::Long qw(:config pass_through);
+use Data::Dumper;
+
+my %harness_args = (
+ language => 'cardinal',
+ compiler => 'cardinal.pbc',
+);
+
+GetOptions(
+ 'tests-from-dir=s' => \my $test_dir,
+ );
+if ($test_dir) {
+my @files = grep m/^[^-]/, @ARGV;
+push @files, "t/$test_dir/*.t";
+
+$harness_args{files} = \@files;
+}
+
+eval 'use Parrot::Test::Harness %harness_args';
+
Added: cardinal/trunk/t/hash/hash.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/hash/hash.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,20 @@
+require 'test'
+plan 5
+
+a = { "a" => "ok", "b" => 1}
+
+is a["a"], "ok", "basic hash access"
+
+b = { }
+b['foo'] = 2
+a['a'] = 'foo'
+
+is b[a['a']], 2, "basic hash access"
+
+c = Hash.new('ok')
+
+is c['a'], 'ok', "hash static default"
+
+d = Hash.new() { |hash, key| pass "hash block default"; hash[key] = 5 }
+
+is d['foo'], 5, "hash block default"
Added: cardinal/trunk/t/integer/integer.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/integer/integer.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,93 @@
+require 'test'
+plan 51
+
+# add a test against the expected class type when we get .class worked out better
+# our class hierarchy needs some work
+def test_by_int(pos, neg, desc)
+ isnt pos, '300', desc
+ isnt neg, '-300', desc
+ is pos, 300, desc
+ is neg, -300, desc
+end
+
+def test_by_str(pos, neg, desc)
+ isnt pos, 300, desc
+ isnt neg, -300, desc
+ is pos, '300', desc
+ is neg, '-300', desc
+end
+
+#int1 = Integer.new(300)
+#int2 = Integer.new(-300)
+
+int1 = 300
+int2 = -300
+test_by_int int1, int2, 'assignment of an Integer'
+
+str1 = int1.to_s
+str2 = int2.to_s
+test_by_str str1, str2, '.to_s on Integer'
+
+test1 = int1.to_i
+test2 = int2.to_i
+test_by_int test1, test2, '.to_i on Integer'
+
+test1 = int1.to_int
+test2 = int2.to_int
+test_by_int test1, test2, '.to_int on Integer'
+
+test1 = int1.floor
+test2 = int2.floor
+test_by_int test1, test2, '.floor on Integer'
+
+test1 = int1.ceil
+test2 = int2.ceil
+test_by_int test1, test2, '.ceil on Integer'
+
+test1 = int1.round
+test2 = int2.round
+test_by_int test1, test2, '.round on Integer'
+
+test1 = int1.truncate
+test2 = int2.truncate
+test_by_int test1, test2, '.truncate on Integer'
+
+test1 = int1.succ
+test2 = int2.succ
+is test1, 301, '.succ on Integer'
+is test2, -299, '.succ on Integer'
+
+test1 = int1.next
+test2 = int2.next
+is test1, 301, '.next on Integer'
+is test2, -299, '.next on Integer'
+
+
+is int1.numerator, int1, '.numerator on Integer'
+is int2.numerator, int2, '.numerator on Integer'
+
+is int1.denominator, 1, '.denominator on Integer'
+is int2.denominator, 1, '.denominator on Integer'
+
+test1 = int1.integer?
+test2 = int2.integer?
+proclaim test1, '.integer? on Integer'
+proclaim test2, '.integer? on Integer'
+
+test1 = 72.gcd 168
+test2 = 19.gcd 36
+is test1, 24, '.gcd on Integer'
+is test2, 1, '.gcd on Integer'
+
+one = 1
+four = 4
+j = 4
+four.downto(1) do |i|
+ is i, j, ".downto on Integer"
+ j -= 1
+end
+j = 1
+one.upto(3) do |i|
+ is i, j, ".upto on Integer"
+ j += 1
+end
Added: cardinal/trunk/t/integer/times.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/integer/times.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,7 @@
+require 'test'
+plan 5
+j = 0
+5.times do |i|
+ is i, j, '.times on Integer'
+ j += 1
+end
Added: cardinal/trunk/t/kernel/exit.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/kernel/exit.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,10 @@
+require 'test'
+plan 1
+
+pass '.exit! on Kernel'
+
+
+Kernel.exit! 1
+
+#should never get here
+fail '.exit! on Kernel'
Added: cardinal/trunk/t/kernel/open.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/kernel/open.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,8 @@
+require 'test'
+plan 2
+
+pipe = open("| echo *.t")
+p pipe.class
+files = pipe.readline
+p files
+pipe.close
Added: cardinal/trunk/t/kernel/sprintf.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/kernel/sprintf.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,34 @@
+require 'test'
+plan 11
+
+Kernel.printf("%s %d %s\n", 'ok', 1, '- .printf() on Kernel')
+printf("%s %d %s\n", 'ok', 2, '- .printf()')
+
+$testnum = 3
+str = sprintf("%s %d %s", 'ok', 999, '- .sprintf()')
+is str, 'ok 999 - .sprintf()', '.sprintf()'
+
+str = Kernel.sprintf("%d little bears in the bed.", 4)
+is str, '4 little bears in the bed.', '.sprintf w/ %d on Kernel'
+
+str = Kernel.sprintf("%.3f little bears in the bed.", 4.25)
+is str, '4.250 little bears in the bed.', '.sprintf w/ %f on Kernel'
+
+str = Kernel.sprintf("%d little %s in the bed.", 9 + 1, "bears")
+is str, '10 little bears in the bed.', '.sprintf multiple params on Kernel'
+
+str = Kernel.sprintf("%x %x %x %x %x %x", 10, 11, 12, 13, 14, 15)
+is str, 'a b c d e f', '.sprintf w/ %x on Kernel'
+
+str = Kernel.sprintf("%X %X %X %X %X %X", 10, 11, 12, 13, 14, 15)
+is str, 'A B C D E F', '.sprintf w/ %X on Kernel'
+
+str = Kernel.sprintf(":%5s:", '---')
+is str, ': ---:', '.sprintf %s /w right pad on Kernel'
+
+str = Kernel.sprintf(":%-5s:", '---')
+is str, ':--- :', '.sprintf %s /w left pad on Kernel'
+
+str = Kernel.sprintf(":%05d:", '123')
+is str, ':00123:', '.sprintf w/ %s on Kernel'
+
Added: cardinal/trunk/t/math/functions.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/math/functions.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,15 @@
+require 'test'
+plan 3
+
+
+n = Math.cos(0)
+p n
+is n, 1, '.cos on Math'
+
+n = Math.sin(0)
+p n
+is n, 0, '.sin on Math'
+
+n = Math.sqrt(25.0)
+p n
+is n, 5.0, '.sqrt on Math'
Added: cardinal/trunk/t/nil.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/nil.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,24 @@
+require 'test'
+plan 8
+
+ele = nil
+is ele, nil, 'nil == nil'
+
+ele2 = 100
+isnt nil, ele2, 'nil == against a number'
+
+ele3 = 'squaak!'
+isnt ele3, nil, 'nil == against a string'
+
+is nil.to_s, '', '.to_s on nil'
+
+if ele.nil?
+ pass '.nil? on nil'
+else
+ fail '.nil? on nil'
+end
+
+is nil.to_i, 0, '.to_i on nil'
+
+isnt nil, 0, 'nil cmp against 0'
+isnt nil, '', 'nil cmp against a empty str'
Added: cardinal/trunk/t/proc.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/proc.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,25 @@
+require 'test'
+plan 8
+
+proc = Proc.new{ |n|
+ is n, 1, '.call on Proc'
+}
+pass '.new on Proc'
+is proc.class.to_s, 'Proc', '.class on Proc'
+is proc.arity, 1, '.arity on Proc'
+proc.call(1)
+myself = proc.to_proc
+is myself.class.to_s, 'Proc', '.to_proc on Proc'
+
+
+
+def gen_times(factor)
+ return Proc.new {|n| n*factor }
+end
+
+times3 = gen_times(3)
+times5 = gen_times(5)
+
+is times3.call(12), 36, '.call on Proc'
+is times5.call(5), 25, '.class on Proc'
+is times3.call(times5.call(4)), 60, '.call on Proc'
Added: cardinal/trunk/t/range.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/range.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,38 @@
+require 'test'
+plan 7
+
+discrete = 1..4
+is discrete.class.to_s, 'Range', 'simple discrete Range creation'
+
+r = (5..6)
+proclaim r.include?(5), '.include? for Range'
+proclaim !r.include?(100), '.include? for Range'
+proclaim r.member?(6), '.member? for Range'
+
+arr = (7..9).to_a
+is arr, [7, 8, 9], 'to_a for Range'
+
+prev = 1
+(2...4).each do |cur|
+ if(cur == (prev + 1))
+ pass 'range .each'
+ end
+ prev = cur
+end
+
+find_me = 1337
+rule = case find_me
+ when 0..400
+ '1st rule'
+ when 401..800
+ '2nd rule'
+ when 801..1200
+ '3rd rule'
+ when 1201..1600
+ 'THE Cardinal rule'
+ when 1601..2000
+ 'THE Golden rule'
+ else
+ 'default rule'
+ end
+is rule, 'THE Cardinal rule', 'case when and range'
Added: cardinal/trunk/t/range/each.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/range/each.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,33 @@
+require 'test'
+plan 3
+
+
+discrete_range = Range.new(-3, -1)
+n = -3
+discrete_range.each() do |i|
+ is i, n, '.each on Range'
+ n += 1
+end
+
+
+todo "test range over ascii chars"
+#discrete_range = Range.new('a','c')
+#discrete_range.each() do |c|
+# p c
+#end
+
+todo "test range over floats"
+#def test_case()
+ #continuous_range = Range.new(0.1, 0.3)
+ #n = 0.1
+ #continuous_range.each() do |i|
+ # nok i, n, '.each on Range'
+ # n += 0.1
+ #end
+ #rescue => type_err
+ # pass 'continuous_range type error'
+ # print "rescued error=", type_err, "\n"
+#end
+#test_case()
+
+todo "test range over custom objects"
Added: cardinal/trunk/t/range/infix-exclusive.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/range/infix-exclusive.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,10 @@
+require 'test'
+plan 3
+
+r = 100...103
+n = 100
+r.each do |i|
+p i
+ is i, n, 'infix:... for Range'
+ n += 1
+end
Added: cardinal/trunk/t/range/infix-inclusive.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/range/infix-inclusive.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,9 @@
+require 'test'
+plan 3
+
+r = 1..3
+n = 1
+r.each() do |i|
+ is i, n, 'infix:.. for Range'
+ n += 1
+end
Added: cardinal/trunk/t/range/membership-variants.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/range/membership-variants.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,8 @@
+require 'test'
+plan 3
+
+r = Range.new(1,10)
+proclaim r.include?(5), '.include? for Range'
+#proclaim !r.include?(100), '.include? for Range' # !<variable.include?> parsing seems to be broken
+proclaim r.member?(6), '.member? for Range'
+proclaim r.covers?(9), '.covers? for Range'
Added: cardinal/trunk/t/range/new.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/range/new.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,6 @@
+require 'test'
+plan 1
+
+r = Range.new(1,10)
+pass '.new on Range'
+todo 'fix parsing for all syntax of a new Range, to include discrete and continuous ranges, (<to>..<from>), <to>..<from>, <from_exclusive>...<to_exclusive', 2
Added: cardinal/trunk/t/range/to_a.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/range/to_a.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,7 @@
+require 'test'
+plan 1
+
+r = Range.new(1,10)
+range_arr = r.to_a
+test_arr = [1,2,3,4,5,6,7,8,9,10]
+is range_arr, test_arr, '.to_a on Range'
Added: cardinal/trunk/t/range/to_s.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/range/to_s.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,6 @@
+require 'test'
+plan 1
+
+r = Range.new(1,10)
+range_str = r.to_s
+is range_str, '1..10', '.to_s on Range'
Added: cardinal/trunk/t/range/tofrom-variants.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/range/tofrom-variants.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,11 @@
+require 'test'
+plan 6
+
+r = Range.new(1,10)
+is r.min, 1, '.min on Range'
+is r.first, 1, '.first on Range'
+todo 'test .min/.max on exclusive range tests, fix parse for exclusive syntax first'
+is r.begin, 1, '.begin on Range'
+is r.max, 10, '.max on Range'
+is r.last, 10, '.last on Range'
+is r.end, 10, '.end on Range'
Added: cardinal/trunk/t/splat.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/splat.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,45 @@
+require 'test'
+plan 15
+# 1.8 syntax does not test more elaborate 1.9 splat syntax
+
+def nosplat(first, rest)
+ rest.each() do |x|
+ is x, x, 'splat'
+ end
+ first
+end
+
+def splat(first, *rest)
+ rest.each() do |x|
+ is x, x, 'splat'
+ end
+ first
+end
+
+a = [ 1, 2, 3 ]
+returned = nosplat(4, a)
+is returned, 4, 'splat'
+
+returned = splat(7, 5, 6)
+is returned, 7, 'splat'
+returned = splat(8)
+is returned , 8, 'splat'
+
+b = [11, 10, 9]
+returned = splat(*b)
+is returned, 11, 'splat'
+
+returned = splat(b)
+is returned, [11, 10, 9], 'splat'
+
+def dec_three_ary(start)
+ a = []
+ a << start
+ a << start - 1
+ a << start - 2
+ a
+end
+
+returned = splat(*dec_three_ary(15))
+is returned, 15, 'splat'
+
Added: cardinal/trunk/t/string/add.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/string/add.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,11 @@
+require 'test'
+plan 2
+
+speak = 'squaak'
+bird = 'parrot'
+
+action = speak + ' of a ' + bird
+is action, 'squaak of a parrot', 'chained + operator on new String'
+again = String.new()
+again = bird + " wanna" + ' cracker, ' + speak + '!'
+is again, 'parrot wanna cracker, squaak!', 'chained + operator on existing String'
Added: cardinal/trunk/t/string/block.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/string/block.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,30 @@
+require 'test'
+plan 6
+
+s = String.new("ruby")
+isnt s, nil, '.new for String'
+is s.size, 4, '.size for String'
+s = 'ruby'
+ruby = "____"
+i = 0
+s.each_byte() do |c|
+ ruby[i] = c
+ i = i + 1
+end
+is ruby, 'ruby', '.each_byte for String'
+parrot = 'parrot'
+i = 0
+parrot.each('r') do |split|
+ if i == 0
+ is split, 'par', '.each(char) for String'
+ end
+ if i == 1
+ is split, 'r', '.each(char) for String'
+ end
+ if i == 2
+ is split, 'ot', '.each(char) for String'
+ end
+ i = i + 1
+end
+
+
Added: cardinal/trunk/t/string/capitalize.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/string/capitalize.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,10 @@
+require 'test'
+plan 2
+
+str = "a long long time ago..."
+str = str.capitalize
+is str, "A long long time ago...", '.capitalize on String'
+
+str = "a LONG LONG TIME AGO..."
+str = str.capitalize
+is str, "A long long time ago...", '.capitalize on String'
Added: cardinal/trunk/t/string/chops.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/string/chops.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,19 @@
+require 'test'
+plan 7
+
+dynamic_languages = "If it walks like a parrot\nand if it squaaks like a parrot\nit probably is the elite vm!\n"
+dynamic_languages = dynamic_languages.chomp()
+is dynamic_languages, "If it walks like a parrot\nand if it squaaks like a parrot\nit probably is the elite vm!", '1st .chomp()'
+is dynamic_languages.chomp, "If it walks like a parrot\nand if it squaaks like a parrot\nit probably is the elite vm!", '2nd .chomp()'
+dl = dynamic_languages.chomp("elite vm!")
+is dl, "If it walks like a parrot\nand if it squaaks like a parrot\nit probably is the ", '3rd .chomp()'
+dl.chomp!("the ")
+is dl, "If it walks like a parrot\nand if it squaaks like a parrot\nit probably is ", '.chomp!()'
+dl = dl.chop()
+is dl, "If it walks like a parrot\nand if it squaaks like a parrot\nit probably is", '.chop()'
+dl.chop!()
+is dl, "If it walks like a parrot\nand if it squaaks like a parrot\nit probably i", '1st .chop!()'
+s = ""
+is s.chop(), "", '2nd .chop!()'
+
+
Added: cardinal/trunk/t/string/cmp.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/string/cmp.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,5 @@
+require 'test'
+plan 2
+
+is "foo", "foo", "string equality"
+isnt "foo", "bar", "string inequality"
Added: cardinal/trunk/t/string/concat.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/string/concat.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,9 @@
+require 'test'
+plan 2
+s = "foo"
+s << "bar"
+is s, "foobar", "basic concat"
+
+s2 = "P4"
+s2.concat('rr07!')
+is s2, "P4rr07!", ".concat"
Added: cardinal/trunk/t/string/downcase.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/string/downcase.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,8 @@
+require 'test'
+plan 2
+
+str = "squAAK! squAAK!"
+str.downcase
+isnt str, 'squaak! squaak!', '.downcase on String'
+some_other_str = str.downcase
+is some_other_str, 'squaak! squaak!', '.downcase on String'
Added: cardinal/trunk/t/string/eq.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/string/eq.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,10 @@
+require 'test'
+plan 2
+
+str1 = "this is string\none"
+str2 = "this is string\ntwo"
+isnt str1, str2, '== for str1 and str2'
+
+str3 = "lets see if str3 == str4"
+str4 = "lets see if str3 == str4"
+is str3, str4, '== for str1 and str2'
Added: cardinal/trunk/t/string/mult.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/string/mult.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,9 @@
+require 'test'
+plan 2
+
+just_once = 'squAAK!'
+twice = just_once * 2
+is twice, "squAAK!squAAK!", '* operator on String'
+
+ellipsis = '.' * 3
+is ellipsis, '...', '* operator on String'
Added: cardinal/trunk/t/string/new.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/string/new.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,4 @@
+require 'test'
+plan 1
+s = String.new('newing up a string')
+is s, 'newing up a string', '.new for String'
Added: cardinal/trunk/t/string/quote.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/string/quote.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,7 @@
+require 'test'
+plan 2
+
+s1 = %q[Quoted string]
+is s1, 'Quoted string', 'quoted String'
+s2 = %Q|yet another quoted string|
+is s2, 'yet another quoted string', 'quoted String'
Added: cardinal/trunk/t/string/random_access.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/string/random_access.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,18 @@
+require 'test'
+plan 6
+#test against 1.9
+
+s = 'parrot pwns'
+is s.length, 11, '.length'
+elem = s[s.length]
+is elem, nil, '[] with no bounds checking'
+#returns 115 for 1.8
+is s[1], 'a', '[+] with positive int'
+is s[-2], 'n', '[-] with negative int'
+is s[0,6], 'parrot', '[index,length] for substring'
+s[-4] = "rules!"
+is s, 'parrot rules!', '[] for substring replace'
+#s[0..7] = "cardinal!"
+#puts s
+#puts s[1..7]
+#is s, 'cardinal rules!', '[] for Range (index to index) access'
Added: cardinal/trunk/t/string/reverse.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/string/reverse.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,9 @@
+require 'test'
+plan 2
+
+s1 = "testset!"
+s2 = s1.reverse
+is s2, '!testset', '.reverse for String'
+s2 = "!testset"
+s2.reverse!
+is s2, 'testset!', '.reverse! for String'
Added: cardinal/trunk/t/string/upcase.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/string/upcase.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,8 @@
+require 'test'
+plan 2
+
+str = "squaak! squaak!"
+str.upcase
+isnt str, 'SQUAAK! SQUAAK!', '.upcase on String'
+some_other_str = str.upcase
+is some_other_str, 'SQUAAK! SQUAAK!', '.upcase on String'
Added: cardinal/trunk/t/time.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/time.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,55 @@
+require 'test'
+plan 10
+
+
+todo 'fix Time.sec-year test, maybe fix Time.new.to_s output to a 100% correct format, then compare with the parsed string?', 7
+is Time.new.to_s.length, 25, '.to_s on Time'
+# parse Time.new.to_s a match things up with these methods?
+# that might work, but right now the to_s is 100% correct
+t = Time.new
+pass '.sec on Time' if t.sec
+pass '.hour on Time' if t.hour
+pass '.mday on Time' if t.mday
+pass '.day on Time' if t.day
+pass '.month on Time' if t.month
+pass '.year on Time' if t.year
+
+t = Time.new
+if !t.gmt?
+ pass '.gmt? on Time'
+ epoch1 = t.to_i
+ t.gmtime
+ epoch2 = t.to_i
+ if epoch1 != epoch2
+ pass '.gmtime on Time'
+ end
+else
+ pass '.gmt? on Time'
+ epoch1 = t.to_i
+ t.gmtime
+ epoch2 = t.to_i
+ if epoch1 == epoch2
+ pass '.gmtime on Time'
+ end
+end
+
+#p tm.sec.class
+#p "class=", t.class
+#p tm.eql?(t)
+#p tm === t
+
+t1 = Time.new
+t1_epoch = t1.to_i
+
+t = Time.new
+sec = t.sec
+sleep 1
+sec2 = Time.new.sec
+proclaim sec < sec2, 'sleep'
+
+t2_epoch = Time.new.to_i
+isgt t2_epoch, t1_epoch, '.to_i on Time'
+
+todo 'fix Floats in Cardinal', 11
+class_name = sprintf("%s", t.to_f.class)
+is class_name, 'Float', '.to_f on Time'
Added: cardinal/trunk/t/yield.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/yield.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,10 @@
+require 'test'
+plan 2
+
+def invokeLikeSo(a)
+ yield a
+ yield 2
+end
+
+
+invokeLikeSo(1) { |x| is x, x, 'yield block test' }
Added: cardinal/trunk/t/zip.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/t/zip.t Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,10 @@
+require 'test'
+plan 3
+
+
+a = [ 4, 5, 6 ]
+b = [ 7, 8, 9 ]
+
+is [1,2,3].zip(a, b), [[1,4,7], [2,5,8], [3,6,9]], 'zip'
+is [1,2].zip(a,b), [[1,4,7], [2,5,8]], 'zip larger arrays into smaller'
+is a.zip([1,2],[8]), [[4,1,8], [5,2,nil], [6,nil,nil]], 'zip smaller arrays into larger'
Added: cardinal/trunk/test.rb
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cardinal/trunk/test.rb Sun Apr 5 13:06:34 2009 (r66)
@@ -0,0 +1,75 @@
+$testnum = 1
+$failed = 0
+$planned = 0
+$started = 0
+$todo_upto = 0
+$todo_reason
+
+def plan(num)
+ print '1..',num,"\n"
+ $started = 1
+ $planned = num
+end
+
+def pass(desc='')
+ proclaim(1,desc)
+end
+
+def flunk(desc='')
+ proclaim(0,desc)
+end
+
+def ok(cond,desc='')
+ proclaim(cond, desc)
+end
+
+def nok(cond,desc='')
+ if cond then
+ flunk desc
+ else
+ pass desc
+ end
+end
+
+def is(got,expected,desc='')
+ proclaim(got == expected, desc)
+end
+
+def isgt(got,expected,desc='')
+ proclaim(got > expected, desc)
+end
+
+def isge(got,expected,desc='')
+ proclaim(got >= expected, desc)
+end
+
+def isnt(got,expected,desc='')
+ proclaim(got != expected, desc)
+end
+
+def todo(reason,count=1)
+ $todo_upto = $testnum + count
+ $todo_reason = '# TODO ' + reason
+end
+
+def skip(reason='',count=1)
+ 1.upto(count) { proclaim(1,'# SKIP ' + reason) }
+end
+
+def skip_rest(reason='')
+ skip(reason,$planned - $testnum)
+end
+
+def proclaim(cond,desc)
+ if cond then
+ else
+ print "n"
+ $failed += 1 if $todo_upto < $testnum
+ end
+ print 'ok ', $testnum, ' - ', desc
+ $testnum += 1
+ if $todo_reason and $todo_upto < $testnum then
+ print $todo_reason
+ end
+ puts
+end
More information about the parrot-commits
mailing list