1. Shlomi Fish
  2. spark

Commits

Shlomi Fish  committed 29b95ec

Added the parspark sources from the github repos.

  • Participants
  • Parent commits 2d63e98
  • Branches default

Comments (0)

Files changed (22)

File parspark/COPYING

View file
+Copyright (c) 2009 Stephen Weeks
+
+Permission is hereby granted, free of charge, to any person
+obtaining a copy of this software and associated documentation
+files (the "Software"), to deal in the Software without
+restriction, including without limitation the rights to use,
+copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the
+Software is furnished to do so, subject to the following
+conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
+OTHER DEALINGS IN THE SOFTWARE.
+

File parspark/Configure.pl

View file
+#! perl
+use 5.008;
+use strict;
+use warnings;
+use Getopt::Long;
+
+MAIN: {
+    my %options;
+    GetOptions(\%options, 'help!', 'parrot-config=s',
+               'gen-parrot!', 'gen-parrot-option=s@');
+
+    # Print help if it's requested
+    if ($options{'help'}) {
+        print_help();
+        exit(0);
+    }
+
+    # Update/generate parrot build if needed
+    if ($options{'gen-parrot'}) {
+        my @opts    = @{ $options{'gen-parrot-option'} || [] };
+        my @command = ($^X, "build/gen_parrot.pl", @opts);
+
+        print "Generating Parrot ...\n";
+        print "@command\n\n";
+        system @command;
+    }
+
+    # Get a list of parrot-configs to invoke.
+    my @parrot_config_exe = qw(
+        parrot/parrot_config
+        ../../parrot_config
+        parrot_config
+    );
+
+    if ($options{'parrot-config'} && $options{'parrot-config'} ne '1') {
+        @parrot_config_exe = ($options{'parrot-config'});
+    }
+
+    #  Get configuration information from parrot_config
+    my %config = read_parrot_config(@parrot_config_exe);
+    unless (%config) {
+        die <<'END';
+Unable to locate parrot_config.
+To automatically checkout (svn) and build a copy of parrot,
+try re-running Configure.pl with the '--gen-parrot' option.
+Or, use the '--parrot-config' option to explicitly specify
+the location of parrot_config.
+END
+    }
+
+#  Create the Makefile using the information we just got
+    create_makefile(%config);
+
+    my $make = $config{'make'};
+    print <<"END";
+
+You can now use '$make' to build Spark.
+After that, you can use '$make test' to run some local tests.
+
+END
+    exit 0;
+
+}
+
+
+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 "\nReading configuration information from $exe ...\n";
+            while (<$PARROT_CONFIG>) {
+                if (/(\w+) => '(.*)'/) { $config{$1} = $2 }
+            }
+            close $PARROT_CONFIG or die $!;
+            last if %config;
+        }
+    }
+    return %config;
+}
+
+
+#  Generate a Makefile from a configuration
+sub create_makefile {
+    my %config = @_;
+
+    my $maketext = slurp( 'build/Makefile.in' );
+
+    $config{'win32_libparrot_copy'} = $^O eq 'MSWin32' ? 'copy $(BUILD_DIR)\libparrot.dll .' : '';
+    $maketext =~ s/@(\w+)@/$config{$1}/g;
+    if ($^O eq 'MSWin32') {
+        # use backslashes.
+        $maketext =~ s{/}{\\}g;
+        # wildcards (for clean rules) need an additional backslash, see Rakudo RT #65006
+        $maketext =~ s{\\\*}{\\\\*}g;
+        # use forward slashes again for HTTP URLs
+        $maketext =~ s{http:\S+}{ do {my $t = $&; $t =~ s'\\'/'g; $t} }eg;
+    }
+
+    my $outfile = 'Makefile';
+    print "\nCreating $outfile ...\n";
+    open(my $MAKEOUT, '>', $outfile) ||
+        die "Unable to write $outfile\n";
+    print {$MAKEOUT} $maketext;
+    close $MAKEOUT or die $!;
+
+    return;
+}
+
+sub slurp {
+    my $filename = shift;
+
+    open my $fh, '<', $filename or die "Unable to read $filename\n";
+    local $/ = undef;
+    my $maketext = <$fh>;
+    close $fh or die $!;
+
+    return $maketext;
+}
+
+
+#  Print some help text.
+sub print_help {
+    print <<'END';
+Configure.pl - Spark Configure
+
+General Options:
+    --help             Show this text
+    --parrot-config=(config)
+                       Use configuration information from config
+    --gen-parrot       Download and build a copy of Parrot to use
+    --gen-parrot-option='--option=value'
+                       Set parrot config option when using --gen-parrot
+END
+
+    return;
+}
+
+# Local Variables:
+#   mode: cperl
+#   cperl-indent-level: 4
+#   fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
+

File parspark/README

View file
+This is parspark - the Parrot Spark Implementation. Spark is a fun dynamic
+programming language, based on Lisp and other languages. Its temporary
+homepage is:
+
+http://www.shlomifish.org/open-source/projects/Spark/
+
+Currently it just implements a subset of Scheme, but we want to convert
+it into Sparkisms eventually.
+
+Installation:
+-------------
+
+Run "perl Configure.pl -h" and follow the instructions.
+
+License:
+--------
+
+Spark is made available under the MIT/X11 Licence:
+
+* http://www.opensource.org/licenses/mit-license.php
+
+* http://en.wikipedia.org/wiki/MIT_License
+

File parspark/build/Makefile.in

View file
+# $Id$
+
+# arguments we want to run parrot with
+PARROT_ARGS =
+
+# values from parrot_config
+BUILD_DIR     = @build_dir@
+LOAD_EXT      = @load_ext@
+O             = @o@
+EXE           = @exe@
+MAKE          = @make_c@
+PERL          = @perl@
+RM_F          = @rm_f@
+HAS_ICU       = @has_icu@
+
+# Various paths
+PARROT_DYNEXT = $(BUILD_DIR)/runtime/parrot/dynext
+PERL6GRAMMAR  = $(BUILD_DIR)/runtime/parrot/library/PGE/Perl6Grammar.pbc
+NQP           = $(BUILD_DIR)/compilers/nqp/nqp.pbc
+PCT           = $(BUILD_DIR)/runtime/parrot/library/PCT.pbc
+PMC_DIR       = src/pmc
+OPSDIR        = src/ops
+OPSLIB        = spark
+OPS_FILE      = src/ops/spark.ops
+
+# Setup some commands
+PARROT        = $(BUILD_DIR)/parrot$(EXE)
+CAT           = $(PERL) -MExtUtils::Command -e cat
+BUILD_DYNPMC  = $(PERL) $(BUILD_DIR)/tools/build/dynpmc.pl
+BUILD_DYNOPS  = $(PERL) $(BUILD_DIR)/tools/build/dynoplibs.pl
+PBC_TO_EXE    = $(BUILD_DIR)/pbc_to_exe$(EXE)
+
+SOURCES = spark.pir \
+  src/gen_grammar.pir \
+  src/gen_actions.pir \
+  src/gen_builtins.pir \
+  $(STEME_GROUP)
+
+BUILTINS_PIR = \
+  src/builtins/say.pir \
+  src/builtins/math.pir \
+  src/builtins/cmp.pir \
+  src/builtins/library.pir \
+  src/builtins/control.pir \
+
+# PMCS        = spark
+# PMC_SOURCES = $(PMC_DIR)/spark.pmc
+# STEME_GROUP  = $(PMC_DIR)/spark_group$(LOAD_EXT)
+
+CLEANUPS = \
+  spark.pbc \
+  spark.c \
+  *.manifest \
+  *.pdb \
+  spark$(O) \
+  spark$(EXE) \
+  src/gen_*.pir \
+  src/gen_*.pm \
+  $(PMC_DIR)/*.h \
+  $(PMC_DIR)/*.c \
+  $(PMC_DIR)/*.dump \
+  $(PMC_DIR)/*$(O) \
+  $(PMC_DIR)/*$(LOAD_EXT) \
+  $(PMC_DIR)/*.exp \
+  $(PMC_DIR)/*.ilk \
+  $(PMC_DIR)/*.manifest \
+  $(PMC_DIR)/*.pdb \
+  $(PMC_DIR)/*.lib \
+  $(PMC_DIR)/objectref.pmc \
+  $(OPSDIR)/*.h \
+  $(OPSDIR)/*.c \
+  $(OPSDIR)/*$(O) \
+  $(OPSDIR)/*$(LOAD_EXT) \
+
+HARNESS = $(PERL) t/harness --keep-exit-code --icu=$(HAS_ICU)
+HARNESS_JOBS = $(HARNESS) --jobs
+
+# the default target
+all: spark$(EXE)
+
+##  targets for building a standalone executable
+spark$(EXE): spark.pbc
+	$(PBC_TO_EXE) spark.pbc
+	@win32_libparrot_copy@
+
+# the compiler .pbc
+spark.pbc: Makefile $(PARROT) $(SOURCES) $(BUILTINS_PIR)
+	$(PARROT) $(PARROT_ARGS) -o spark.pbc spark.pir
+
+src/gen_grammar.pir: $(PARROT) $(PERL6GRAMMAR) src/pct/grammar.pg
+	$(PARROT) $(PARROT_ARGS) $(PERL6GRAMMAR) \
+	    --output=src/gen_grammar.pir \
+	    src/pct/grammar.pg
+
+src/gen_actions.pir: $(PARROT) $(NQP) $(PCT) src/pct/actions.pm
+	$(PARROT) $(PARROT_ARGS) $(NQP) --output=src/gen_actions.pir \
+	    --encoding=fixed_8 --target=pir src/pct/actions.pm
+
+src/gen_builtins.pir: Makefile build/gen_builtins_pir.pl
+	$(PERL) build/gen_builtins_pir.pl $(BUILTINS_PIR) > src/gen_builtins.pir
+
+$(STEME_GROUP): Makefile $(PARROT) $(PMC_SOURCES)
+	cd $(PMC_DIR) && $(BUILD_DYNPMC) generate $(PMCS)
+	cd $(PMC_DIR) && $(BUILD_DYNPMC) compile $(PMCS)
+	cd $(PMC_DIR) && $(BUILD_DYNPMC) linklibs $(PMCS)
+	cd $(PMC_DIR) && $(BUILD_DYNPMC) copy --destination=$(PARROT_DYNEXT) $(PMCS)
+
+src/ops/spark_ops$(LOAD_EXT) : $(PARROT) $(OPS_FILE)
+	@cd $(OPSDIR) && $(BUILD_DYNOPS) generate $(OPSLIB)
+	@cd $(OPSDIR) && $(BUILD_DYNOPS) compile $(OPSLIB)
+	@cd $(OPSDIR) && $(BUILD_DYNOPS) linklibs $(OPSLIB)
+	@cd $(OPSDIR) && $(BUILD_DYNOPS) copy "--destination=$(PARROT_DYNEXT)" $(OPSLIB)
+
+##  local copy of Parrot
+parrot: parrot/parrot_config build/PARROT_REVISION
+	$(PERL) build/gen_parrot.pl
+
+parrot/parrot_config:
+	@echo "Don't see parrot/parrot_config."
+
+test: spark$(EXE)
+	$(PERL) t/harness t/
+
+# Run a single test
+t/*.t t/*/*.t t/*/*/*.t: all Test.pir
+	@$(HARNESS_WITH_FUDGE) --verbosity=1 $@
+
+##  cleaning
+clean:
+	$(RM_F) $(CLEANUPS)
+
+distclean: realclean
+
+realclean: clean
+	$(RM_F) src/utils/Makefile Makefile
+
+testclean:
+
+
+##  miscellaneous targets
+# a listing of all targets meant to be called by users
+help:
+	@echo ""
+	@echo "Following targets are available for the user:"
+	@echo ""
+	@echo "  all:               spark.exe"
+	@echo "                     This is the default."
+	@echo ""
+	@echo "Testing:"
+	@echo "  test:              Run Rakudo's sanity tests."
+	@echo ""
+	@echo "Cleaning:"
+	@echo "  clean:             Basic cleaning up."
+	@echo "  distclean:         Removes also anything built, in theory."
+	@echo "  realclean:         Removes also files generated by 'Configure.pl'."
+	@echo "  testclean:         Clean up test results."
+	@echo ""
+	@echo "Misc:"
+	@echo "  help:              Print this help message."
+	@echo ""
+
+Makefile: build/Makefile.in
+	@echo ""
+	@echo "warning: Makefile is out of date... re-run Configure.pl"
+	@echo ""
+
+manifest:
+	echo MANIFEST >MANIFEST
+	git ls-files | $(PERL) -ne '/^\./ || print' >>MANIFEST
+
+release: manifest
+	[ -n "$(VERSION)" ] || ( echo "\nTry 'make release VERSION=yyyymm'\n\n"; exit 1 )
+	[ -d spark-$(VERSION) ] || ln -s . spark-$(VERSION)
+	$(PERL) -ne 'print "spark-$(VERSION)/$$_"' MANIFEST | \
+	    tar -zcv -T - -f spark-$(VERSION).tar.gz
+	rm spark-$(VERSION)
+

File parspark/build/PARROT_REVISION

View file
+$Revision$

File parspark/build/gen_builtins_pir.pl

View file
+#!/usr/bin/perl
+# $Id$
+
+use strict;
+use warnings;
+
+my @files = @ARGV;
+
+print <<"END_PRELUDE";
+# This file automatically generated by $0.
+
+END_PRELUDE
+
+foreach my $file (@files) {
+    print ".include '$file'\n";
+}
+
+

File parspark/build/gen_parrot.pl

View file
+#! perl
+
+=head1 TITLE
+
+gen_parrot.pl - script to obtain and build Parrot
+
+=head2 SYNOPSIS
+
+    perl gen_parrot.pl [--parrot --configure=options]
+
+=head2 DESCRIPTION
+
+Maintains an appropriate copy of Parrot in the parrot/ subdirectory.
+The revision of Parrot to be used in the build is given by the
+build/PARROT_REVISION file.
+
+=cut
+
+use strict;
+use warnings;
+use 5.008;
+
+#  Work out slash character to use.
+my $slash = $^O eq 'MSWin32' ? '\\' : '/';
+
+##  determine what revision of Parrot we require
+open my $REQ, "build/PARROT_REVISION"
+  || die "cannot open build/PARROT_REVISION\n";
+my $required = 0+<$REQ>;
+close $REQ;
+
+{
+    no warnings;
+    if (open my $REV, '-|', "parrot${slash}parrot_config revision") {
+        my $revision = 0+<$REV>;
+        close $REV;
+        if ($revision >= $required) {
+            print "Parrot r$revision already available (r$required required)\n";
+            exit(0);
+        }
+    }
+}
+
+print "Checking out Parrot r$required via svn...\n";
+system(qw(svn checkout -r),  $required , qw(https://svn.parrot.org/parrot/trunk parrot));
+
+chdir('parrot');
+
+
+##  If we have a Makefile from a previous build, do a 'make realclean'
+if (-f 'Makefile') {
+    my %config = read_parrot_config();
+    my $make = $config{'make'};
+    if ($make) {
+        print "\nPerforming '$make realclean' ...\n";
+        system($make, "realclean");
+    }
+}
+
+print "\nConfiguring Parrot ...\n";
+my @config_command = ($^X, 'Configure.pl', @ARGV);
+print "@config_command\n";
+system @config_command;
+
+print "\nBuilding Parrot ...\n";
+my %config = read_parrot_config();
+my $make = $config{'make'} or exit(1);
+system($make);
+
+sub read_parrot_config {
+    my %config = ();
+    if (open my $CFG, "config_lib.pasm") {
+        while (<$CFG>) {
+            if (/P0\["(.*?)"], "(.*?)"/) { $config{$1} = $2 }
+        }
+        close $CFG;
+    }
+    %config;
+}
+

File parspark/spark.pir

View file
+=head1 TITLE
+
+spark.pir - A Spark compiler.
+
+=head2 Description
+
+This is the base file for the Spark 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 'Spark'.
+
+=head2 Functions
+
+=over 4
+
+=item onload()
+
+Creates the Spark compiler using a C<PCT::HLLCompiler>
+object.
+
+=cut
+
+.HLL 'spark'
+
+.namespace []
+
+.loadlib 'spark_group'
+
+.sub '' :anon :load :init
+    load_bytecode 'PCT.pbc'
+    .local pmc parrotns, hllns, exports
+    parrotns = get_root_namespace ['parrot']
+    hllns = get_hll_namespace
+    exports = split ' ', 'PAST PCT PGE'
+    parrotns.'export_to'(hllns, exports)
+.end
+
+.include 'src/gen_grammar.pir'
+.include 'src/gen_actions.pir'
+
+.namespace [ 'Spark';'Compiler' ]
+.sub 'onload' :anon :load :init
+    .local pmc spark
+    $P0 = get_root_global ['parrot'], 'P6metaclass'
+    spark = $P0.'new_class'('Spark::Compiler', 'parent'=>'PCT::HLLCompiler')
+    spark.'language'('spark')
+    $P0 = get_hll_namespace ['Spark';'Grammar']
+    spark.'parsegrammar'($P0)
+    $P0 = get_hll_namespace ['Spark';'Grammar';'Actions']
+    spark.'parseactions'($P0)
+
+    ## Create a list for holding the stack of nested blocks
+    $P0 = new 'ResizablePMCArray'
+    set_hll_global ['Spark';'Grammar';'Actions'], '@?BLOCK', $P0
+    $P0 = new 'ResizablePMCArray'
+    set_hll_global ['Spark';'Grammar';'Actions'], '@?LIBRARY', $P0
+.end
+
+=item main(args :slurpy)  :main
+
+Start compilation by passing any command line C<args>
+to the Spark compiler.
+
+=cut
+
+.sub 'main' :main
+    .param pmc args
+
+    $P0 = compreg 'spark'
+    $P1 = $P0.'command_line'(args)
+.end
+
+.sub 'load_library' :method
+    .param pmc ns
+    .param pmc extra :named :slurpy
+    .local pmc sourcens, ex, library
+    .local string file, lang
+    file = join '/', ns
+    file = concat file, '.scm'
+    # TODO We need a registry to prevent re-loading
+    # TODO We need a search path
+    self.'evalfiles'(file, 'encoding'=>'utf8', 'transcode'=>'ascii iso-8859-1')
+
+    library = root_new ['parrot';'Hash']
+    sourcens = get_hll_namespace ns
+    library['name'] = ns
+    library['namespace'] = sourcens
+    $P0 = root_new ['parrot';'Hash']
+    $P0['ALL'] = sourcens
+    ex = sourcens['@EXPORTS']
+    if null ex goto no_ex
+    $P1 = root_new ['parrot';'NameSpace']
+    sourcens.'export_to'($P1, ex)
+    $P0['DEFAULT'] = $P1
+    goto have_ex
+  no_ex:
+    $P0['DEFAULT'] = sourcens
+  have_ex:
+    library['symbols'] = $P0
+    .return (library)
+.end
+
+.namespace []
+.include 'src/gen_builtins.pir'
+
+=back
+
+=cut
+
+# Local Variables:
+#   mode: pir
+#   fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
+

File parspark/src/builtins/cmp.pir

View file
+# $Id$
+
+=head1
+
+cmp.pir -- simple implementation of comparison functions
+
+=cut
+
+.namespace []
+
+.sub '='
+    .param pmc a
+    .param pmc b
+    eq a, b, true
+    .return (0)
+  true:
+    .return (1)
+.end
+
+.sub '<'
+    .param pmc a
+    .param pmc b
+    lt a, b, true
+    .return (0)
+  true:
+    .return (1)
+.end
+
+.sub '>'
+    .param pmc a
+    .param pmc b
+    gt a, b, true
+    .return (0)
+  true:
+    .return (1)
+.end
+
+.sub '<='
+    .param pmc a
+    .param pmc b
+    le a, b, true
+    .return (0)
+  true:
+    .return (1)
+.end
+
+.sub '>='
+    .param pmc a
+    .param pmc b
+    ge a, b, true
+    .return (0)
+  true:
+    .return (1)
+.end
+
+
+# Local Variables:
+#   mode: pir
+#   fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
+

File parspark/src/builtins/control.pir

View file
+# $Id$
+
+=head1
+
+control.pir -- basic flow control
+
+=cut
+
+.namespace []
+
+.sub 'sleep'
+    .param num t
+    .local num before, after
+    before = time
+    sleep t
+    after = time
+    $N0 = after - before
+    .return ($N0)
+.end
+
+
+# Local Variables:
+#   mode: pir
+#   fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
+

File parspark/src/builtins/library.pir

View file
+# $Id$
+
+=head1
+
+library.pir -- library functions
+
+=cut
+
+.namespace []
+
+.sub 'export'
+    .param pmc sym
+    .local pmc ns, ex
+    $P0 = getinterp
+    ns = $P0['namespace';1]
+    ex = ns['@EXPORTS']
+    unless null ex goto have_ex
+    ex = root_new ['parrot';'ResizablePMCArray']
+  have_ex:
+    ex.'push'(sym)
+    ns['@EXPORTS'] = ex
+    .return ()
+.end
+
+.sub 'import'
+    .param pmc ns :slurpy
+    .param pmc hll :named('hll') :optional
+    .param pmc has_hll :opt_flag
+    .local pmc compiler, targetns, symbols, nsiter, library
+    .local string lang
+    lang = 'spark'
+    if null hll goto no_hll
+    lang = hll
+    compiler = compreg lang
+    unless null compiler goto have_compiler
+    'load_language'(lang)
+  no_hll:
+    compiler = compreg lang
+  have_compiler:
+    library = compiler.'load_library'(ns)
+
+    $P0 = getinterp
+    targetns = $P0['namespace';1]
+    $P0 = library['symbols']
+    symbols = $P0['DEFAULT']
+    nsiter = iter symbols
+  import_loop:
+    unless nsiter goto import_loop_end
+    $S0 = shift nsiter
+    $P0 = symbols[$S0]
+    targetns[$S0] = $P0
+    goto import_loop
+  import_loop_end:
+    .return ()
+.end
+
+
+.HLL 'parrot'   # work around a parrot bug
+.sub 'load_language'
+    .param string lang
+    load_language lang
+.end
+
+.HLL 'spark'
+# Local Variables:
+#   mode: pir
+#   fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
+

File parspark/src/builtins/math.pir

View file
+# $Id$
+
+=head1
+
+math.pir -- simple implementation of math functions
+
+=cut
+
+.namespace []
+
+.sub '+'
+    .param pmc a
+    .param pmc b
+    $P0 = add a, b
+    .return ($P0)
+.end
+
+.sub '-'
+    .param pmc a
+    .param pmc b
+    $P0 = sub a, b
+    .return ($P0)
+.end
+
+.sub '*'
+    .param pmc a
+    .param pmc b
+    $P0 = mul a, b
+    .return ($P0)
+.end
+
+.sub '/'
+    .param pmc a
+    .param pmc b
+    $P0 = div a, b
+    .return ($P0)
+.end
+
+
+# Local Variables:
+#   mode: pir
+#   fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
+

File parspark/src/builtins/say.pir

View file
+# $Id$
+
+=head1
+
+say.pir -- simple implementation of a say function
+
+=cut
+
+.namespace []
+
+.sub 'say'
+    .param pmc args            :slurpy
+    .local pmc it
+    it = iter args
+  it_loop:
+    unless it goto it_end
+    $P0 = shift it
+    print $P0
+    goto it_loop
+  it_end:
+    print "\n"
+    .return ()
+.end
+
+
+# Local Variables:
+#   mode: pir
+#   fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
+

File parspark/src/pct/actions.pm

View file
+# $Id$
+
+=begin comments
+
+Spark::Grammar::Actions - ast transformations for Spark
+
+This file contains the methods that are used by the parse grammar
+to build the PAST representation of an Spark 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 Spark::Grammar::Actions;
+
+method TOP($/, $key) {
+    our @?BLOCK;
+    our @?LIBRARY;
+    my $past;
+    if $key eq 'begin' {
+        my @empty;
+        $past:= PAST::Block.new(
+            :blocktype('declaration'),
+            :node( $/ ),
+            :hll('Spark'),
+            :namespace(@empty),
+        );
+        @?BLOCK.unshift($past);
+        @?LIBRARY.unshift($past);
+    }
+    else {
+        $past := @?BLOCK.shift();
+        for $<statement> {
+            $past.push( $_.ast );
+        }
+        make $past;
+        @?LIBRARY.shift();
+    }
+}
+
+
+method statement($/, $key) {
+    make $/{$key}.ast
+}
+
+method special($/, $key) {
+    make $/{$key}.ast
+}
+
+method if($/) {
+    make PAST::Op.new(
+        $<cond>.ast,
+        $<iftrue>.ast,
+        $<iffalse>.ast,
+        :pasttype('if'),
+        :node($/),
+    );
+}
+
+method my($/) {
+    our @?BLOCK;
+    my $block := @?BLOCK[0];
+    my $stmts := PAST::Stmts.new();
+    for $<ident> {
+        my $name := ~$_;
+        my $var := PAST::Var.new(
+            :name( $name ),
+            :scope( 'lexical' ),
+            :isdecl(1),
+            :node( $_ ),
+        );
+        $stmts.push($var);
+        $block.symbol( $name, :scope('lexical') );
+    }
+    make $stmts;
+}
+
+method set($/) {
+    my $var := $<var>.ast;
+    my $val := $<val>.ast;
+    make PAST::Op.new( $var, $val, :pasttype('bind'), :node($/) );
+}
+
+method our($/) {
+    our @?LIBRARY;
+    my $lib := @?LIBRARY[0];
+    my @ns := $lib.namespace();
+    my $stmts := PAST::Stmts.new();
+    for $<ident> {
+        my $name := ~$_;
+        my $var := PAST::Var.new(
+            :name( $name ),
+            :scope( 'package' ),
+            :isdecl(1),
+            :node( $_ ),
+        );
+        $stmts.push($var);
+        $lib.symbol( $name, :scope('package') );
+    }
+    make $stmts;
+}
+
+method let($/, $key) {
+    our @?BLOCK;
+    my $block;
+    if $key eq 'begin' {
+        $block := PAST::Block.new( :blocktype('immediate'), :node($/) );
+        my $init := PAST::Stmts.new();
+        for $<var> {
+            my $var := $_.ast;
+            my $val := $<val>.shift.ast;
+            $var.scope('lexical');
+            $var.isdecl(1);
+            $block.symbol($var.name(), :scope('lexical'));
+            $init.push( PAST::Op.new( $var, $val, :pasttype('bind')));
+        }
+        $block.unshift($init);
+        @?BLOCK.unshift($block);
+    }
+    else {
+        my $stmts := PAST::Stmts.new();
+        for $<statement> {
+            $stmts.push( $_.ast );
+        }
+        $block := @?BLOCK.shift();
+        $block.push($stmts);
+        make $block;
+    }
+}
+
+method lambda($/, $key) {
+    our @?BLOCK;
+    my $block;
+    if $key eq 'begin' {
+        $block := PAST::Block.new( :blocktype('declaration'), :node($/) );
+        my $init := PAST::Stmts.new();
+        for $<var> {
+            my $var := $_.ast;
+            $var.scope('parameter');
+            $var.isdecl(1);
+            $block.symbol($var.name(), :scope('lexical'));
+            $init.push($var);
+        }
+        $block.unshift($init);
+        @?BLOCK.unshift($block);
+    }
+    else {
+        my $stmts := PAST::Stmts.new();
+        for $<statement> {
+            $stmts.push( $_.ast );
+        }
+        $block := @?BLOCK.shift();
+        $block.push($stmts);
+        make $block;
+    }
+}
+
+method library($/, $key) {
+    our @?BLOCK;
+    our @?LIBRARY;
+    my $block;
+    my @ns := $<ns>;
+    if $key eq 'begin' {
+        $block := PAST::Block.new( :blocktype('immediate'), :namespace(@ns), :node($/) );
+        @?BLOCK.unshift($block);
+        @?LIBRARY.unshift($block);
+    }
+    else {
+        my $stmts := PAST::Stmts.new();
+        for $<statement> {
+            $stmts.push( $_.ast );
+        }
+        $block := @?BLOCK.shift();
+        $block.push($stmts);
+        make $block;
+        @?LIBRARY.shift();
+    }
+}
+
+method export($/) {
+    my $past := PAST::Op.new(
+        :pasttype('call'),
+        :name('export'),
+        :node( $/ ),
+        PAST::Val.new(:value(~$<sym>), :returns('String')),
+    );
+    make $past;
+}
+
+method import($/) {
+    my $past := PAST::Stmts.new();
+    for $<libs> {
+        my $ns := $_;
+        my $import := PAST::Op.new(
+            :pasttype('call'),
+            :name('import'),
+            :node( $/ ),
+        );
+        for $_<ns> {
+            $import.push(PAST::Val.new(:value(~$_), :returns('String'))),
+        }
+        $past.push($import);
+    }
+    make $past;
+}
+
+method hllimport($/) {
+    my $past := PAST::Stmts.new();
+    for $<libs> {
+        my $ns := $_;
+        my $import := PAST::Op.new(
+            :pasttype('call'),
+            :name('import'),
+            :node( $/ ),
+        );
+        for $_<ns> {
+            $import.push(PAST::Val.new(:value(~$_), :returns('String'))),
+        }
+        $import.push(PAST::Val.new(:value(~$_<hll>), :returns('String'), :named('hll')));
+        $past.push($import);
+    }
+    make $past;
+}
+
+method simple($/) {
+    my $cmd := $<cmd>.ast;
+    my $past := PAST::Op.new(
+        :pasttype('call'),
+        :node( $/ ),
+    );
+    if ~$cmd.WHAT() eq 'PAST::Var()' && $cmd.scope() eq 'package' {
+        $cmd := $cmd.name();
+        $past.name($cmd);
+    }
+    else {
+        $past.push($cmd);
+    }
+    for $<term> {
+        $past.push( $_.ast );
+    }
+    make $past;
+}
+
+##  term:
+##    Like 'statement' above, the $key has been set to let us know
+##    which term subrule was matched.
+method term($/, $key) {
+    make $/{$key}.ast;
+}
+
+
+method value($/, $key) {
+    make $/{$key}.ast;
+}
+
+method symbol($/) {
+    our @?BLOCK;
+    my $scope := 'package';
+    my $name := ~$<symbol>;
+    for @?BLOCK {
+        if $_.symbol($name) && $scope eq 'package' {
+            $scope := $_.symbol($name)<scope>;
+        }
+    }
+    make PAST::Var.new(
+        :name( $name ),
+        :scope( $scope ),
+        :node( $/ ),
+    );
+}
+
+
+method integer($/) {
+    make PAST::Val.new(
+        :value( ~$/ ),
+        :returns('Integer'),
+        :node($/),
+    );
+}
+
+
+method quote($/) {
+    make PAST::Val.new(
+        :value( $<string_literal>.ast ),
+        :node($/),
+    );
+}
+
+
+# Local Variables:
+#   mode: cperl
+#   cperl-indent-level: 4
+#   fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
+

File parspark/src/pct/grammar.pg

View file
+# $Id$
+
+=begin overview
+
+This is the grammar for Spark written as a sequence of Perl 6 rules.
+
+=end overview
+
+grammar Spark::Grammar is PCT::Grammar;
+
+rule TOP {
+    {*}                                          #= begin
+    <statement>*
+    [ $ || <panic: 'Syntax error'> ]
+    {*}                                          #= end
+}
+
+##  this <ws> rule treats # as "comment to eol"
+token ws {
+    <!ww>
+    [ ';' \N* \n? | \s+ ]*
+}
+
+rule statement {
+    '('
+    [
+        | <special> {*}                          #= special
+        | <simple> {*}                           #= simple
+    ]
+    ')'
+}
+
+token special {
+    | <if> {*}                                   #= if
+    | <my> {*}                                   #= my
+    | <set> {*}                                  #= set
+    | <our> {*}                                  #= our
+    | <let> {*}                                  #= let
+    | <lambda> {*}                               #= lambda
+    | <library> {*}                              #= library
+    | <export> {*}                               #= export
+    | <import> {*}                               #= import
+    | <hllimport> {*}                            #= hllimport
+}
+
+rule if {
+    'if'
+    <cond=term>
+    <iftrue=term>
+    <iffalse=term>
+    {*}
+}
+
+rule my {
+    'my'
+    [<ident> ]+
+    {*}
+}
+
+rule set {
+    ':='
+    <var=symbol>
+    <val=term>
+    {*}
+}
+
+rule our {
+    'our'
+    [<ident> ]+
+    {*}
+}
+
+rule let {
+    'let'
+    '('
+    [
+        '('
+        <var=symbol>
+        <val=term>
+        ')'
+    ]+
+    ')' {*}                                      #= begin
+    <statement>+
+    {*}                                          #= end
+}
+
+rule lambda {
+    'lambda'
+    '('
+    [
+        <var=symbol>
+    ]*
+    ')' {*}                                      #= begin
+    <statement>+
+    {*}                                          #= end
+}
+
+rule library {
+    'library'
+    '('
+    [<ns=ident> ]+
+    ')' {*}                                      #= begin
+    <statement>+
+    {*}                                          #= end
+}
+
+rule export {
+    'export'
+    <sym=ident>
+    {*}
+}
+
+rule import {
+    'import'
+    $<libs>=('('
+    [<ns=ident> ]+
+    ')' )+
+    {*}
+}
+
+rule hllimport {
+    'hllimport'
+    $<libs>=('('
+    <hll=ident> [<ns=ident> ]+
+    ')' )+
+    {*}
+}
+
+rule simple {
+    <cmd=term>
+    [<term> ]*
+    {*}
+}
+
+rule value {
+    | <integer> {*}                              #= integer
+    | <quote> {*}                                #= quote
+}
+
+token integer { \d+ {*} }
+
+token quote {
+    [ \' <string_literal: '\'' > \' | \" <string_literal: '"' > \" ]
+    {*}
+}
+
+##  terms
+token term {
+    | <value> {*}                                #= value
+    | <symbol> {*}                               #= symbol
+    | <statement> {*}                            #= statement
+}
+
+token symbol {
+    <symbol=ident> {*}
+}
+
+token ident {
+    [<!before <[()]>> \S]+
+}

File parspark/t/00-sanity.t

View file
+; This just checks that the basic parsing and call to builtin say works.
+(say '1..5')
+(say 'ok 1')
+(say 'ok ' 2)
+(say 'ok' ' ' 3)
+(say 'ok ' (+ 2 2))
+(say 'ok ' (/ (* 2 (+ 3 2)) 2))

File parspark/t/01-if.t

View file
+(say '1..2')
+(if 1 (say 'ok 1') (say 'nok 1'))
+(say (if (< 1 2) 'ok ' 'nok ') 2)

File parspark/t/02-our.t

View file
+(say '1..2')
+(our a b)
+(:= a 1)
+(:= b 2)
+(say 'ok ' a)
+(say 'ok ' b)

File parspark/t/03-let.t

View file
+(say '1..3')
+(let ((a 1)(b 2))
+    (say 'ok ' a)
+    (say 'ok ' b)
+    (say 'ok ' (+ a b)))

File parspark/t/04-lambda.t

View file
+(say '1..4')
+(let ((ok (lambda (msg) (say 'ok ' msg)))
+      (sum (lambda (a b) (+ a b)))
+      (double (lambda (a) (* a 2))))
+    (ok 1)
+    (ok (double 1))
+    (ok (sum 1 (double 1)))
+    (ok (double (sum 1 1)))
+)

File parspark/t/05-lexical.t

View file
+(say '1..2')
+(my a b c)
+(:= a 1)
+(:= b 2)
+(say 'ok ' a)
+(say 'ok ' b)

File parspark/t/harness

View file
+#! perl
+
+# $Id$
+
+use strict;
+use warnings;
+
+use FindBin;
+use File::Spec;
+use Getopt::Long qw(:config pass_through);
+
+$ENV{'HARNESS_PERL'} = './spark';
+use Test::Harness;
+$Test::Harness::switches = '';
+
+GetOptions(
+    'tests-from-file=s' => \my $list_file,
+    'verbosity=i'       => \$Test::Harness::verbose,
+    'jobs:3'            => \my $jobs,
+    'icu:1'             => \my $do_icu,
+);
+
+my @pass_through_options = grep m/^--?[^-]/, @ARGV;
+my @files = grep m/^[^-]/, @ARGV;
+
+my $slash = $^O eq 'MSWin32' ? '\\' : '/';
+
+if ($list_file) {
+    open(my $f, '<', $list_file)
+        or die "Can't open file '$list_file' for reading: $!";
+    while (<$f>) {
+        next if m/^\s*#/;
+        next unless m/\S/;
+        chomp;
+        my ($fn, $flags) = split /\s+#\s*/;
+        next if ($flags && ($flags =~ m/icu/) && !$do_icu);
+        $fn = "t/spec/$fn" unless $fn =~ m/^t\Q$slash\Espec\Q$slash\E/;
+        $fn =~ s{/}{$slash}g;
+        if ( -r $fn ) {
+            push @files, $fn;
+        }
+        else {
+            warn "Missing test file: $fn\n";
+        }
+    }
+    close $f or die $!;
+}
+
+my @tfiles = map { all_in($_) } sort @files;
+
+if (eval { require TAP::Harness; 1 }) {
+    my %harness_options = (
+        exec      => ['./spark'],
+        verbosity => 0+$Test::Harness::verbose,
+        jobs      => $jobs || 1,
+    );
+    TAP::Harness->new( \%harness_options )->runtests(@tfiles);
+}
+else {
+    runtests(@tfiles);
+}
+
+# adapted to return only files ending in '.t'
+sub all_in {
+    my $start = shift;
+
+    return $start unless -d $start;
+
+    my @skip = ( File::Spec->updir, File::Spec->curdir, qw( .svn CVS .git ) );
+    my %skip = map {($_,1)} @skip;
+
+    my @hits = ();
+
+    if ( opendir( my $dh, $start ) ) {
+        my @files = sort readdir $dh;
+        closedir $dh or die $!;
+        for my $file ( @files ) {
+            next if $skip{$file};
+
+            my $currfile = File::Spec->catfile( $start, $file );
+            if ( -d $currfile ) {
+                push( @hits, all_in( $currfile ) );
+            }
+            else {
+                push( @hits, $currfile ) if $currfile =~ /\.t$/;
+            }
+        }
+    }
+    else {
+        warn "$start: $!\n";
+    }
+
+    return @hits;
+}
+