Skip to content

Commit

Permalink
Merge branch 'master' of github.com:partcl/partcl-nqp
Browse files Browse the repository at this point in the history
  • Loading branch information
coke committed Aug 7, 2010
2 parents 11a2c80 + d53f3d6 commit ae8abf9
Show file tree
Hide file tree
Showing 4 changed files with 196 additions and 63 deletions.
14 changes: 11 additions & 3 deletions README
@@ -1,8 +1,16 @@
Partcl - a NQP-based implementation of Tcl
partcl-nqp

This is a proof of concept to reimplement partcl (tcl on parrot) using
the latest compiler tools available for parrot.
Tcl 8.5 on the parrot VM. This does not use the tcl C library, but is a from-
scratch implementation using the Parrot Compiler Toolkit.

"nqp" in the name comes from the "nqp-rx" toolkit. NQP is Not Quite Perl 6,
and is a mini language that is much higher level than PIR. It also provides
a nice interface to writing mini languages, making it much easier to implement
the various mini languages inside tcl (globbing, regexen, binary)

See docs/todo.pod for a list of known issues.

See docs/overview.pod for information on how this version works.

See http://github.com/partcl/partcl for the original non-PCT version that
is more complete, but is only maintained to keep current with parrot changes.
18 changes: 9 additions & 9 deletions docs/overview.pod
Expand Up @@ -2,25 +2,26 @@

partcl-nqp is a tcl 8.5 compiler for the PVM (Parrot Virtual Machine).

It uses the Parrot Compiler Toolkit (NQP-RX, HLL::Compiler) to generate
It uses the Parrot Compiler Toolkit (nqp-rx, HLL::Compiler) to generate
PIR (Parrot Assembly), which is then compiled to PBC (Parrot Bytecode),
which is then bundled into a "fakecutable".
which is then bundled into a "fakecutable". The fakecutable contains the
bytecode, and enough C to invoke the VM. It is NOT a JITted version.

=head1 Architecture
=head1 Languages

partcl-nqp is written primarily in NQP (Not Quite Perl 6; specifically
NQP-R), with some PIR.
nqp-rx), with as little PIR as we can manager.

=head2 Grammars and Actions

There are several Perl 6 Grammars in F<src/>; Partcl contains the main
language, src/ARE is the standard tcl regexes, etc.

Each Grammar.pm file contains the rules (See Perl 6's Synopsis 5) for
parsing that mini language. The Actions.pm file contains instructions to
Each F<Grammar.pm> file contains the rules (See Perl 6's Synopsis 5) for
parsing that mini language. The F<Actions.pm> file contains instructions to
convert the parse into parrot's AST (Abstract Syntax Tree).

The small Compiler.pm for each mini language takes advantage of the parrot
The small F<Compiler.pm> for each mini language takes advantage of the parrot
library to convert the AST to an OST (opcode syntax tree), which is then
converted to PIR, and finally PBC.

Expand Down Expand Up @@ -96,10 +97,9 @@ tests in this directory as a prelude to running the spec tests.

=head1 Alternate history

There is a version of partcl written using PGE & TGE. That version has
There is a version of partcl written using C<PGE> & C<TGE>. That version has
no active development but is maintained minimally so it compiles with the
latest version of parrot. Much of I<this> version includes hand-translated
NQP based on the PIR from that version.

=cut

207 changes: 166 additions & 41 deletions src/Partcl/commands/namespace.pm
@@ -1,50 +1,175 @@
our sub namespace(*@args) {
if +@args < 1 {
Namespace::dispatch_command(|@args);
}

module Namespace;

our %Arg_limits;
our %funcs;
our %Auto_vivify;

INIT {

## Negative limit in "max" position => unlimited.
%funcs<children> := Namespace::children;
%Arg_limits<children> := [ 0, 2, "?name? ?pattern?" ];

%funcs<code> := Namespace::code;
%Arg_limits<code> := [ 1, 1, "script" ];

%funcs<current> := Namespace::current;
%Arg_limits<current> := [ 0, 0, "" ];

%funcs<delete> := Namespace::delete;
%Arg_limits<delete> := [ 0, -1, "" ];

%funcs<ensemble> := Namespace::ensemble;
%Arg_limits<ensemble> := [ 1, 0, "subcommand ?arg...?" ];

%funcs<eval> := Namespace::eval;
%Arg_limits<eval> := [ 2, -1, "name arg ?arg...?" ];

%funcs<exists> := Namespace::exists;
%Arg_limits<exists> := [ 1, 1, "name" ];

%funcs<export> := Namespace::export;
%Arg_limits<export> := [ 0, 0, "namespace" ];

%funcs<forget> := Namespace::forget;
%Arg_limits<forget> := [ 0, 0, "namespace" ];

%funcs<import> := Namespace::import;
%Arg_limits<import> := [ 0, -1, "namespace" ];

%funcs<inscope> := Namespace::inscope;
%Arg_limits<inscope> := [ 0, 0, "namespace" ];

%funcs<origin> := Namespace::origin;
%Arg_limits<origin> := [ 0, 0, "namespace" ];

%funcs<parent> := Namespace::parent;
%Arg_limits<parent> := [ 0, 1, "?name?" ];

%funcs<path> := Namespace::path;
%Arg_limits<path> := [ 0, 1, "namespaceList" ];

%funcs<qualifiers> := Namespace::qualifiers;
%Arg_limits<qualifiers> := [ 1, 1, "string" ];

%funcs<tail> := Namespace::tail;
%Arg_limits<tail> := [ 1, 1, "string" ];

%funcs<upvar> := Namespace::upvar;
%Arg_limits<upvar> := [ 0, 0, "namespace" ];

%funcs<unknown> := Namespace::unknown;
%Arg_limits<unknown> := [ 0, 0, "namespace" ];

%funcs<unknown> := Namespace::unknown;
%Arg_limits<unknown> := [ 0, 0, "namespace" ];

%funcs<which> := Namespace::which;
%Arg_limits<which> := [ 0, 0, "namespace" ];
}

# Parses optional -args, and generates "wrong#args" errors
# Dispatches to fairly normal NQP subs for the detailed work.
our sub dispatch_command(*@args) {
my $num_args := +@args -1 ; # need option

if $num_args < 0 {
error('wrong # args: should be "namespace subcommand ?arg ...?"');
}

my @opts := <children code current delete ensemble eval exists export forget import inscope origin parent path qualifiers tail unknown upvar which>;
my $cmd := _tcl::select_option(@opts, @args.shift() );

if $cmd eq 'children' {
return '';
} elsif $cmd eq 'code' {
return '';
} elsif $cmd eq 'current' {
return '';
} elsif $cmd eq 'delete' {
return '';
} elsif $cmd eq 'ensemble' {
return '';
} elsif $cmd eq 'eval' {
return '';
} elsif $cmd eq 'exists' {
return '';
} elsif $cmd eq 'export' {
return '';
} elsif $cmd eq 'forget' {
return '';
} elsif $cmd eq 'import' {
return '';
} elsif $cmd eq 'inscope' {
return '';
} elsif $cmd eq 'origin' {
return '';
} elsif $cmd eq 'parent' {
return '';
} elsif $cmd eq 'path' {
return '';
} elsif $cmd eq 'qualifiers' {
return '';
} elsif $cmd eq 'tail' {
return '';
} elsif $cmd eq 'upvar' {
return '';
} elsif $cmd eq 'unknkown' {
return '';
} elsif $cmd eq 'which' {
return '';
my $cmd := _tcl::select_option(@opts, @args.shift, 'option');

my @limits := %Arg_limits{$cmd};

if (@limits[1] >= 0 && $num_args > @limits[1]) || $num_args < @limits[0] {
my $msg := @limits[2];
$msg := " $msg" unless $msg eq '';
error("wrong # args: should be \"namespace $cmd$msg\"")
}

my &subcommand := %funcs{$cmd};
&subcommand(|@args);
}

my sub children(*@args) {
'';
}

my sub code(*@args) {
'';
}

my sub current(*@args) {
'';
}

my sub delete(*@args) {
'';
}

my sub ensemble(*@args) {
'';
}

my sub eval(*@args) {
'';
}

my sub exists(*@args) {
'';
}

my sub export(*@args) {
'';
}

my sub forget(*@args) {
'';
}

my sub import(*@args) {
'';
}

my sub inscope(*@args) {
'';
}

my sub origin(*@args) {
'';
}

my sub parent(*@args) {
'';
}

my sub path(*@args) {
'';
}

my sub qualifiers(*@args) {
'';
}

my sub tail(*@args) {
'';
}

my sub upvar(*@args) {
'';
}

my sub unknown(*@args) {
'';
}

my sub which(*@args) {
'';
}

# vim: filetype=perl6:
20 changes: 10 additions & 10 deletions t/cmd_namespace.t
Expand Up @@ -14,7 +14,7 @@ eval_is {namespace asdf} \

eval_is {namespace children a b c} \
{wrong # args: should be "namespace children ?name? ?pattern?"} \
{namespace children: too many args} {TODO NQPRX}
{namespace children: too many args}

eval_is {namespace children what?} \
{namespace "what?" not found in "::"} \
Expand All @@ -38,23 +38,23 @@ is [namespace eval ::audreyt {namespace children}] ::audreyt::Matt \

eval_is {namespace qualifiers} \
{wrong # args: should be "namespace qualifiers string"} \
{namespace qualifiers: no args} {TODO NQPRX}
{namespace qualifiers: no args}

eval_is {namespace qualifiers string string} \
{wrong # args: should be "namespace qualifiers string"} \
{namespace qualifiers: too many args} {TODO NQPRX}
{namespace qualifiers: too many args}

is [namespace qualifiers ::a::b::c] ::a::b {namespace qualifiers: simple} {TODO NQPRX}
is [namespace qualifiers :::a:::b::c] :::a:::b {namespace qualifiers: extra colons} {TODO NQPRX}


eval_is {namespace tail} \
{wrong # args: should be "namespace tail string"} \
{namespace tail: no args} {TODO NQPRX}
{namespace tail: no args}

eval_is {namespace tail string string} \
{wrong # args: should be "namespace tail string"} \
{namespace tail: too many args} {TODO NQPRX}
{namespace tail: too many args}

is [namespace tail ::] {} {namespace tail: main}
is [namespace tail {}] {} {namespace tail: empty}
Expand All @@ -64,11 +64,11 @@ is [namespace tail :::foo:::bar:::baz] baz {namespace tail: extra colons} {TODO

eval_is {namespace exists} \
{wrong # args: should be "namespace exists name"} \
{namespace exists: no args} {TODO NQPRX}
{namespace exists: no args}

eval_is {namespace exists a a} \
{wrong # args: should be "namespace exists name"} \
{namespace exists: too many args} {TODO NQPRX}
{namespace exists: too many args}

eval_is {namespace exists a} 0 {namespace exists: failure} {TODO NQPRX}
is [namespace exists {}] 1 {namespace exists: global implicit} {TODO NQPRX}
Expand All @@ -77,7 +77,7 @@ is [namespace exists ::] 1 {namespace exists: global explicit} {TODO NQPRX}

eval_is {namespace eval foo} \
{wrong # args: should be "namespace eval name arg ?arg...?"} \
{namespace eval: too few args} {TODO NQPRX}
{namespace eval: too few args}

namespace eval foo {
proc bar {} {return ok}
Expand Down Expand Up @@ -108,15 +108,15 @@ eval_is {namespace exists foo} 0 {namespace delete} {TODO NQPRX}

eval_is {namespace current foo} \
{wrong # args: should be "namespace current"} \
{namespace current: too many args} {TODO NQPRX}
{namespace current: too many args}

is [namespace current] :: {namespace current: global} {TODO NQPRX}
is [namespace eval foo {namespace current}] ::foo {namespace current: ::foo} {TODO NQPRX}


eval_is {namespace parent foo bar} \
{wrong # args: should be "namespace parent ?name?"} \
{namespace parent: too many args} {TODO NQPRX}
{namespace parent: too many args}

is [namespace parent ""] {} {namespace parent: ::}
is [namespace parent foo] :: {namespace parent: ::foo (explicit)} {TODO NQPRX}
Expand Down

0 comments on commit ae8abf9

Please sign in to comment.