Permalink
Browse files

impl mp6.pl -Blisp

  • Loading branch information...
1 parent 9a4065b commit f1ee3c4a0cfb16b3a567247a6dd6a083d3b0600d @fglock committed Jan 13, 2010
Showing with 22 additions and 3 deletions.
  1. +2 −1 ChangeLog
  2. +6 −0 lib/MiniPerl6/Lisp/Emitter.pm
  3. +2 −0 lib/MiniPerl6/Lisp/Runtime.lisp
  4. +1 −1 lib5/MiniPerl6/Lisp/Emitter.pm
  5. +11 −1 mp6.pl
View
3 ChangeLog
@@ -1,4 +1,5 @@
+- the compiler command line script is now written in MiniPerl6
- Go language backend
- new repository at http://github.com/fglock/Perlito
- new web page at http://www.perlito.org created by nferraz (Nelson Ferraz)
@@ -11,7 +12,7 @@
- Lisp (SBCL) bootstrap
- Changed accessors to lvalue
-date? -
+[intermission]
- Perl5 emitter: fixed Array inside signature: method ( $a, [ $b, $c ] ) ...
- Perl5 emitter: implemented "warn"
View
6 lib/MiniPerl6/Lisp/Emitter.pm
@@ -310,6 +310,12 @@ class Var {
if $.namespace {
$ns := Main::to_lisp_namespace( $.namespace ) ~ '::';
}
+ else {
+ if ($.sigil eq '@') && ($.twigil eq '*') && ($.name eq 'ARGS') {
+ return 'COMMON-LISP-USER::*posix-argv*'
+ }
+ }
+
( $.twigil eq '.' )
?? ( '(' ~ Main::to_lisp_identifier( $.name ) ~ ' sv-self)' )
!! ( ( $.name eq '/' )
View
2 lib/MiniPerl6/Lisp/Runtime.lisp
@@ -18,6 +18,8 @@
#:sv-defined))
(in-package mp-Main)
+(setf COMMON-LISP-USER::*posix-argv* (cdr COMMON-LISP-USER::*posix-argv*))
+
;; "undef"
(if (not (ignore-errors (find-class 'mp-Undef)))
View
2 lib5/MiniPerl6/Lisp/Emitter.pm
@@ -148,7 +148,7 @@ sub sigil { @_ == 1 ? ( $_[0]->{sigil} ) : ( $_[0]->{sigil} = $_[1] ) };
sub twigil { @_ == 1 ? ( $_[0]->{twigil} ) : ( $_[0]->{twigil} = $_[1] ) };
sub namespace { @_ == 1 ? ( $_[0]->{namespace} ) : ( $_[0]->{namespace} = $_[1] ) };
sub name { @_ == 1 ? ( $_[0]->{name} ) : ( $_[0]->{name} = $_[1] ) };
-sub emit_lisp { my $self = shift; my $List__ = \@_; do { [] }; (my $ns = ''); do { if ($self->{namespace}) { ($ns = Main::to_lisp_namespace($self->{namespace}) . '::') } else { } }; (($self->{twigil} eq '.') ? '(' . Main::to_lisp_identifier($self->{name}) . ' sv-self)' : (($self->{name} eq '/') ? Main::to_lisp_identifier('MATCH') : $ns . Main::to_lisp_identifier($self->{name}))) }
+sub emit_lisp { my $self = shift; my $List__ = \@_; do { [] }; (my $ns = ''); do { if ($self->{namespace}) { ($ns = Main::to_lisp_namespace($self->{namespace}) . '::') } else { do { if ((($self->{sigil} eq '@') && (($self->{twigil} eq '*') && ($self->{name} eq 'ARGS')))) { return('COMMON-LISP-USER::*posix-argv*') } else { } } } }; (($self->{twigil} eq '.') ? '(' . Main::to_lisp_identifier($self->{name}) . ' sv-self)' : (($self->{name} eq '/') ? Main::to_lisp_identifier('MATCH') : $ns . Main::to_lisp_identifier($self->{name}))) }
}
{
View
12 mp6.pl
@@ -178,7 +178,17 @@ package Main;
}
if ( $execute ) {
- die "execute Lisp not implemented\n";
+ open( OUT, '>', $tmp_filename . '.lisp' )
+ or die "Cannot write to ${tmp_filename}.lisp\n";
+
+ open FILE, "lib/MiniPerl6/Lisp/Runtime.lisp";
+ local $/ = undef;
+ my $lib = <FILE>;
+ print OUT $lib, "\n", $result;
+ close(OUT);
+ warn "calling lisp compiler\n" if $verbose;
+ exec "sbcl --script $tmp_filename.lisp"
+ or die "can't execute";
}
}
elsif ( $backend eq 'parrot' ) {

0 comments on commit f1ee3c4

Please sign in to comment.