wl

commit 4e5a57e516f9e20336cf7afe3101fe864977b2bd
parent 700ff5f2a8793615e197a0d83581a2adf56edc55
Author: Tomas Hlavaty <tom@logand.com>
Date:   Sun, 10 Oct 2010 18:14:10 +0200

fibo experiment and some rewrite in java for performance

Diffstat:
M
java.wl
 | 
18
+++++++++++++-----
M
wl.java
 | 
99
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

2 files changed, 112 insertions(+), 5 deletions(-)
diff --git a/java.wl b/java.wl
@@ -2,7 +2,7 @@
 
 # *In *Out *Args
 
-(def 'de '(L (def (pop 'L) L)))
+(def 'de. '(L (def (pop 'L) L)))
 
 (de caar (L) (car (car L)))
 (de cadr (L) (car (cdr L)))
@@ -26,7 +26,7 @@
 (de nil P (run P 1) NIL)
 (de t P (run P 1) T)
 
-(de if (C . L)
+(de if. (C . L)
    (loop
       (T C (up. '@ @) (eval (car L) 1))
       (T T (run (cdr L) 1)) ) )
@@ -273,13 +273,13 @@
 (de * @ (when (args) (foldl1 '((X Y) (X 'multiply Y)) (rest))))
 (de / @ (when (args) (foldl1 '((X Y) (X 'divide Y)) (rest))))
 (de % @ (when (args) (foldl1 '((X Y) (X 'remainder Y)) (rest))))
-(de - @
+(de -. @
    (when (args)
       (let A (rest)
          (if (pair (cdr A))
             (foldl1 '((X Y) (X 'subtract Y)) (rest))
             (0 'subtract (car A)) ) ) ) )
-(de + @ (when (args) (- (pass - 0))))
+(de +. @ (when (args) (- (pass - 0))))
 
 (de & @ (when (args) (foldl1 '((X Y) (X 'and Y)) (rest))))
 (de | @ (when (args) (foldl1 '((X Y) (X 'or Y)) (rest))))
@@ -475,7 +475,7 @@
       (1+ X)
       (set X (+ (val X) (or (next) 1))) ) )
 
-(de dec (X . @)
+(de dec. (X . @)
    (if (num? X)
       (1- X)
       (set X (- (val X) (or (next) 1))) ) )
@@ -551,8 +551,16 @@
             (T (and (atom (setq C (pop 'L))) (== K C)) (setq S T))
             (T (and (pair C) (== K (cdr C))) (setq S (car C))) ) ) ) )
 
+(de fibo (N)
+   (if (< N 2)
+      1
+      (+ (fibo (dec N)) (fibo (- N 2))) ) )
 #(de ; (S . L) (apply get L S))
 #(de : L (apply get L This))
 #(de :: (S . L) (apply prop L S)) # ???
 
+(de fibo.. (N)
+   (if. (< N 2)
+      1
+      (+. (fibo.. (dec. N)) (fibo.. (-. N 2))) ) )
 (de with (This . P) (run P 1 '(This)))
diff --git a/wl.java b/wl.java
@@ -1374,6 +1374,105 @@ class wl implements Runnable {
                 }
                 if(NIL != X && E != X) {
                     S.print(". ");
+
+        // optimization by native code rewrite
+        //
+        //           java wl    ErsatzLisp   Pil32    Pil64
+        //           +---------------------------------------
+        // (fibo 22) |   25        0.19       0.015    0.016
+        // (fibo 23) |   45        0.25       0.026    0.024
+        // (fibo 24) |   69        0.36       0.041    0.039
+        // (fibo 25) |  122        0.52       0.060    0.063
+        //
+        // (de fibo (N)
+        //    (if (< N 2)
+        //       1
+        //       (+ (fibo (dec N)) (fibo (- N 2))) ) )
+        // (fibo 25)
+        // (bye)
+        //
+        // $ time cat x |java wl
+        // $ time cat x |ersatz/picolisp
+        // $ time cat x |bin/picolisp
+
+        fn("de", new Fn() {public Any fn(Any E) {
+            Any X = E.cdr();
+            Any A = X.car();
+            A.val(X.cdr());
+            return A;
+        }});
+        fn("if", new Fn() {public Any fn(Any E) {
+            Any X = E.cdr();
+            Any Z = NIL;
+            if(NIL == eval(X.car())) {
+                Any L = X.cdr().cdr();
+                while(NIL != L) {
+                    Z = eval(L.car());
+                    L = L.cdr();
+                }
+            } else Z = eval(X.cdr().car());
+            return Z;
+        }});
+        fn("+", new Fn() {public Any fn(Any E) {
+            Any L = E.cdr();
+            if(NIL == L) return NIL;
+            Any A = eval(L.car());
+            BigInteger z = (BigInteger) A.obj();
+            L = L.cdr();
+            while(NIL != L) {
+                Any B = eval(L.car());
+                if(NIL == B) return NIL;
+                z = z.add((BigInteger) B.obj());
+                L = L.cdr();
+            }
+            return mkObj(z);
+        }});
+        fn("-", new Fn() {public Any fn(Any E) {
+            Any L = E.cdr();
+            if(NIL == L) return NIL;
+            Any A = eval(L.car());
+            BigInteger z = (BigInteger) A.obj();
+            L = L.cdr();
+            while(NIL != L) {
+                Any B = eval(L.car());
+                if(NIL == B) return NIL;
+                z = z.subtract((BigInteger) B.obj());
+                L = L.cdr();
+            }
+            return mkObj(z);
+        }});
+        fn("dec", new Fn() {public Any fn(Any E) {
+            Any X = E.cdr();
+            Any A = eval(X.car());
+            if(NIL == X.cdr()) {
+                if(A.isOnum()) return mkObj(((BigInteger) A.obj()).subtract(one));
+                else return A.val(mkObj(((BigInteger) A.val().obj()).subtract(one)));
+            } else {
+                Any B = eval(X.cdr().car());
+                BigInteger n = (BigInteger) B.obj();
+                return A.val(mkObj(((BigInteger) A.val().obj()).subtract(n)));
+            }
+        }});
+
+        fn("fibo.", new Fibo());
+    }
+
+    final static BigInteger zero = BigInteger.ZERO;
+    final static Any Zero = mkObj(zero);
+    final static BigInteger one = BigInteger.ONE;
+    final static Any One = mkObj(one);
+    final static BigInteger two = BigInteger.ONE.add(BigInteger.ONE);
+    final static Any Two = mkObj(two);
+
+    class Fibo implements Fn {
+        BigInteger fibo(BigInteger n) {
+            if(-1 == n.compareTo(two)) return one;
+            else return fibo(n.subtract(one)).add(fibo(n.subtract(two)));
+        }
+        public Any fn(Any E) {
+            Any N = eval(E.cdr().car());
+            return mkObj(fibo((BigInteger) N.obj()));
+        }
                     print(X);
                 }
                 S.print(')');