Changeset 22528

Timestamp:

10/07/08 21:28:28 (6 weeks ago)

Author:

putter

Message:

[elfish/on_sbcl] Still struggling towards self compilation.
[elf_h] Tweaks.

Location:

misc

Files:

• elf/elf_h (modified) (6 diffs)
• elf/elf_h_src/EmitSimpleP5.pm (modified) (1 diff)
• elf/elf_h_src/IRx1_Analysis.pm (modified) (1 diff)
• elf/elf_h_src/IRx1_FromAST.pm (modified) (2 diffs)
• elf/elf_h_src/IRx1_FromAST_create.pl (modified) (2 diffs)
• elf/elf_h_src/PrimitivesP5.pm (modified) (1 diff)
• elfish/on_sbcl/EmitSBCL.pm (modified) (9 diffs)
• elfish/on_sbcl/Makefile (modified) (1 diff)
• elfish/on_sbcl/PrimitivesSBCL.pm (modified) (4 diffs)

misc/elf/elf_h

@@ -100 +100 @@
   sub lcfirst  { CORE::lcfirst($_[0]); }
 
-  sub length   { CORE::length($_[0]); }
   sub bytes    { use bytes; CORE::length($_[0]); }
   sub chars    { CORE::length($_[0]); }
@@ -2204 +2203 @@
 (do{my $v = ($m->match_string());
 my $s = GLOBAL::substr($v, 0, 1);
-my $n = GLOBAL::substr($v, 1, $v->length());
+my $n = GLOBAL::substr($v, 1, $v->chars());
 IRx1::Var->newp($m, $s, GLOBAL::undef(), $n)})};
 my $construct_circumfix = sub {my($m)=@_;
@@ -2336 +2335 @@
 (do{($multisig = [IRx1::Signature->newp($m, [], GLOBAL::undef())])})
 };
-IRx1::MethodDecl->newp($m, GLOBAL::undef(), GLOBAL::undef(), $plurality, irbuild_ir($m->hash()->{"ident"}), $multisig->[0], irbuild_ir($m->hash()->{"trait"}), irbuild_ir($m->hash()->{"block"}))})};
+IRx1::MethodDecl->newp($m, GLOBAL::undef(), GLOBAL::undef(), $plurality, irbuild_ir($m->hash()->{"ident"}), $multisig->[0], irbuild_ir($m->hash()->{"trait"}), irbuild_ir($m->hash()->{"block"}), GLOBAL::undef(), GLOBAL::undef())})};
 my $construct_signature = sub {my($m)=@_;
 (do{IRx1::Signature->newp($m, irbuild_ir($m->hash()->{"parsep"}), GLOBAL::undef())})};
@@ -2904 +2903 @@
 ;
 
+{ package IRx1::Apply;
+use base "Any";(do{sub provides_a_list{my $self=CORE::shift;(do{(($self->function eq "infix\:\,") && $self->capture->contains_a_list())})}})
+}
+;
+
 { package IRx1::Capture;
-use base "Any";(do{sub contains_a_list{my $self=CORE::shift;(do{my $found;
-$self->arguments->map(sub {my($e)=@_;
-(do{if((($e->isa("IRx1\:\:Base") && $e->provides_a_list()))) {
-(do{($found = 1)})
-}})});
-$found})}})
+use base "Any";(do{sub contains_a_list{my $self=CORE::shift;(do{for(($self->arguments)->flatten){
+(do{if((($_->isa("IRx1\:\:Base") && $_->provides_a_list()))) {
+(do{return(1)})
+}})
+};
+GLOBAL::undef()})}})
 }
 ;
@@ -3037 +3041 @@
 \ \ sub\ lcfirst\ \ \{\ CORE\:\:lcfirst\(\$_\[0\]\)\;\ \}\
 \
-\ \ sub\ length\ \ \ \{\ CORE\:\:length\(\$_\[0\]\)\;\ \}\
 \ \ sub\ bytes\ \ \ \ \{\ use\ bytes\;\ CORE\:\:length\(\$_\[0\]\)\;\ \}\
 \ \ sub\ chars\ \ \ \ \{\ CORE\:\:length\(\$_\[0\]\)\;\ \}\
@@ -3914 +3917 @@
 ;
 ($GLOBAL::PID = (sub {$$})->());
+($GLOBAL::OS = (sub {$^O})->());
+($GLOBAL::OSVER = (sub {`/bin/uname -a`})->());
+($GLOBAL::EXECUTABLE_NAME = (sub {$0})->());
+sub not_used_only_once{(do{[$GLOBAL::OS, $GLOBAL::OSVER, $GLOBAL::EXECUTABLE_NAME]})};
 
 { package GLOBAL;

misc/elf/elf_h_src/EmitSimpleP5.pm

@@ -133 +133 @@
   sub lcfirst  { CORE::lcfirst($_[0]); }
 
-  sub length   { CORE::length($_[0]); }
   sub bytes    { use bytes; CORE::length($_[0]); }
   sub chars    { CORE::length($_[0]); }

misc/elf/elf_h_src/IRx1_Analysis.pm

@@ -239 +239 @@
   method provides_a_list { self.method eq "flatten" }
 }
+class IRx1::Apply {
+  method provides_a_list {
+    $.function eq 'infix:,' && $.capture.contains_a_list;
+  }
+}
 class IRx1::Capture {
   method contains_a_list {
-    my $found;
-    $.arguments.map(sub($e){
-      if ($e.isa('IRx1::Base') && $e.provides_a_list) { $found = 1 }});
-    $found;
-  }
-}
+    for $.arguments {
+      if ($_.isa('IRx1::Base') && $_.provides_a_list) { return 1 }
+    }
+    undef;
+  }
+}

misc/elf/elf_h_src/IRx1_FromAST.pm

@@ -322 +322 @@
       my $v = ($m.match_string);
 my $s = substr($v,0,1);
-my $n = substr($v,1,$v.length);
+my $n = substr($v,1,$v.chars);
 IRx1::Var.newp($m,$s,undef,$n);
     };
@@ -492 +492 @@
 my $multisig = irbuild_ir($m.hash{'multisig'});
 if not($multisig) { $multisig = [IRx1::Signature.newp($m,[],undef)]; }
-IRx1::MethodDecl.newp($m,undef,undef,$plurality,irbuild_ir($m.hash{'ident'}),$multisig.[0],irbuild_ir($m.hash{'trait'}),irbuild_ir($m.hash{'block'}));
+IRx1::MethodDecl.newp($m,undef,undef,$plurality,irbuild_ir($m.hash{'ident'}),$multisig.[0],irbuild_ir($m.hash{'trait'}),irbuild_ir($m.hash{'block'}),undef,undef);
     };
 

misc/elf/elf_h_src/IRx1_FromAST_create.pl

@@ -237 +237 @@
 my $v = *text*;
 my $s = substr($v,0,1);
-my $n = substr($v,1,$v.length);
+my $n = substr($v,1,$v.chars);
 Var.newp($s,undef,$n)
 
@@ -372 +372 @@
 my $multisig = $m<multisig>;
 if not($multisig) { $multisig = [Signature.newp([],undef)]; }
-MethodDecl.newp(undef,undef,$plurality,$m<ident>,$multisig.[0],$m<trait>,$m<block>)
+MethodDecl.newp(undef,undef,$plurality,$m<ident>,$multisig.[0],$m<trait>,$m<block>,undef,undef)
 
 signature

misc/elf/elf_h_src/PrimitivesP5.pm

@@ -9 +9 @@
 
 $*PID = (sub () is p5 {'$$'}).();
+$*OS = (sub () is p5 {'$^O'}).();
+$*OSVER = (sub () is p5 {'`/bin/uname -a`'}).();
+$*EXECUTABLE_NAME = (sub () is p5 {'$0'}).();
+sub not_used_only_once { [$*OS,$*OSVER,$*EXECUTABLE_NAME] }
 
 package GLOBAL { # sub *f(){} isn't working yet.

misc/elfish/on_sbcl/EmitSBCL.pm

@@ -21 +21 @@
    '';
   }
-  method prelude ($n) {
+  method prelude {
   '#|
-#fasl=`dirname $0`/`basename $0 .lisp`.fasl
-#[ $fasl -ot $0 ] && sbcl --noinform --eval "(compile-file \"$0\")" --eval "(quit)"
-#exec sbcl --noinform --load $fasl --end-toplevel-options "$@"
-exec sbcl --noinform --load $0 --eval "(quit)" --end-toplevel-options "$@"
+fasl=`dirname $0`/`basename $0 .lisp`.fasl
+[ $fasl -ot $0 ] && sbcl --noinform --eval "(compile-file \"$0\")" --eval "(quit)"
+exec sbcl --noinform --load $fasl --end-toplevel-options "$@"
+#exec sbcl --noinform --load $0 --eval "(quit)" --end-toplevel-options "$@"
 |#
 
@@ -257 +257 @@
 (defun flatten-lists (args)
   (reduce #\'append
-          (mapcar (lambda (e) (if (and (listp e) (not (null e)))
-                                  e (list e)))
+          (mapcar (lambda (e)
+                    (if (and (listp e)
+                             ;;(not (null e)) ;#XXX disappears undef args!
+                             ;;# boxing undef is now important. :/
+                             )
+                        e (list e)))
                   args)))
 
@@ -292 +296 @@
 
 (dm |M::Str| ((x null) &rest argl) (declare (ignorable x argl)) "")
-(dm |M::WHAT| ((x null) &rest argl) (declare (ignorable x argl)) "nil")
+(dm |M::WHAT| ((x null) &rest argl) (declare (ignorable x argl)) "Undef")
 (dm |M::substr| ((s string) from len) (subseq s from (+ from len)))
 
@@ -367 +371 @@
       \'nil
     (let ((sym (gensym)))
-      `(let ((,sym ,(car args))) (if (to-b ,sym) ,sym (or6 ,@(cdr args)))))))
+      `(let ((,sym ,(car args)))
+         (if (or ,(null (cdr args)) (to-b ,sym)) ,sym (or6 ,@(cdr args)))))))
 (defmacro and6 (&rest args)
   (cond ((null args) t)
@@ -380 +385 @@
   }
 
-  method e($x) {
+  method e ($x) {
     my $ref = $x.WHAT;
     if $ref eq 'Undef' { $x }
@@ -676 +681 @@
         my $words = $s.split('\s+');
         my $self = self;
-        $e_capture = $words.map(sub($x){$self.qstr($x)}).join(" ");
+        $e_capture = $words.map(sub($x){$self.UP_qstr($x)}).join(" ");
       }
     }
     if $n.capture.contains_a_list {
-      '(ap '~$meth~' (cons '~$invocant~' (flatten-lists '~$e_capture~')))';
+      '(ap '~$meth~' (cons '~$invocant~' (flatten-lists (list '~$e_capture~'))))';
     }
     else {
@@ -694 +699 @@
   method qstr ($str) {
      '"'~$str.re_gsub('\\\\','\\\\').re_gsub('"','\"')~'"'
+  }
+  method UP_qstr ($str) {
+     '(UP "'~$str.re_gsub('\\\\','\\\\').re_gsub('"','\"')~'")'
   }
 
@@ -763 +771 @@
         my $words = $s.split('\s+');
         my $self = self;
-        return $.emit_array($words.map(sub($x){$self.qstr($x)}).join(" "));
+        return $.emit_array($words.map(sub($x){$self.UP_qstr($x)}).join(" "));
       }
     }
@@ -789 +797 @@
     if $n.capture.contains_a_list {
       $pre = '(ap ';
-      $mid = ' (flatten-lists ';
-      $post = '))';
+      $mid = ' (flatten-lists (list ';
+      $post = ')))';
     }
 

misc/elfish/on_sbcl/Makefile

@@ -11 +11 @@
         ${ELF} -I ${ELFDIR} EmitSBCL.pm -x -o elfcl Elf_SBCL.pm
         time ${SBCL} --eval '(compile-file "elfcl")' --eval '(quit)' >& elfcl.out
+        chmod a+x elfcl
 
 have_parser_cache:

misc/elfish/on_sbcl/PrimitivesSBCL.pm

@@ -104 +104 @@
   multi unlink_ ($filename) is cl {' (sb-unix:unix-unlink (S |$filename|)) '}
   multi not ($x) { if $x { undef } else { 1 } }
-  multi defined ($x) is cl {' (UP (if |$x| 1 nil)) '} #X undef as nil
+  multi defined ($x) is cl {' (UP (if |$x| 1 nil)) '} ;#X undef as nil
+  multi substr($s,$offset,$length) { $s.substr($offset,$length) }
 }
 
@@ -151 +152 @@
     (UP (if (probe-file (S |$filename|)) t nil))
   '}
-  sub elf_main () { Program.new().main(@*ARGS); }
+  sub elf_main () {
+    Program.new().main(@*ARGS);
+    exit(0);
+  }
+  sub module_require ($module) {
+    my $file = find_required_module($module);
+    $file || die("Cant locate $module in ( "~@*INC.join(" ")~" ).\n");
+    eval_file($file);
+  };
+  sub find_required_module ($module) {
+    my $names = [$module, $module~".pm", $module~".p6"];
+    for @*INC { my $dir = $_;
+      for $names { my $name = $_;
+        my $file = $dir~"/"~$name;
+        if file_exists($file) {
+          return $file;
+        }
+      }
+    }
+    return undef;
+  }
+  sub import ($module,*@args) {
+    undef
+  }
+  sub eval_file ($file) {
+    $*compiler0.eval_file($file);
+  }
+  sub eval_perl6 ($code,$env) {
+    $*compiler0.eval_perl6($code,$env);
+  }
+  sub eval ($code,$env) {
+    eval_perl6($code,$env);
+  }
+
 }
 # regexp elf bootstrap primitives
@@ -227 +261 @@
       (UP (subseq s off (min len (+ off (N |$length|))))))
   '}
+  method chars () is cl {'
+    (let* ((s (slot-value self \'|Str::._native_|))
+           (len (length s)))
+      (UP len))
+  '}
 }
 
@@ -297 +336 @@
            (from (wrapped-index len (N |$from|)))
            (to (wrapped-index len (N |$to|))))
-      (new-Array (subseq a from to)))
+      (new-Array (coerce (subseq a from to) \'list)))
   '}
   method reverse () is cl {'