nendo 0.3.4 → 0.3.5

data/benchmark/benchmark.nnd

@@ -0,0 +1,57 @@
+#!/bin/sh
+:; #-*- mode: nendo; syntax: scheme -*-;;
+:; exec /usr/local/bin/nendo $0 $*
+
+(require "benchmark")
+(.load   "./benchmark/ruby_benchmark_code.rb")
+( load   "./benchmark/nendo_benchmark_code.nnd")
+
+(require "ruby-prof")
+
+;; ------------------ macro --------------------
+(define bench-task
+  (macro (profile-flag title proc)
+    `(begin
+       (.puts ,title)
+       (.puts Benchmark::CAPTION)
+       ,(if profile-flag
+            `(let* ((result (RubyProf.profile
+                             (&block ()
+                               ,proc)))
+                    (printer (RubyProf::GraphPrinter.new result)))
+               (printer.print STDOUT))
+            `(.puts (Benchmark.measure
+                     (&block ()
+                       ,proc))))
+       (.puts ""))))
+
+
+;; -------------------- fact --------------------
+(bench-task #f
+            "fact (ruby version)"
+            (printf " => %d\n" (RubyBenchmarkCode.new.fact 1000)))
+
+(bench-task #f
+            "fact (nendo version)"
+            (printf " => %d\n" (fact 1000)))
+
+
+;; -------------------- tak --------------------
+(bench-task #f
+            "tak   (ruby version)"
+            (printf " => %d\n" (RubyBenchmarkCode.new.tak  10 5 0)))
+
+(bench-task #f
+            "tak2  (ruby version)"
+            (printf " => %d\n" (RubyBenchmarkCode.new.tak2 10 5 0)))
+
+(bench-task #f
+            "tak3  (ruby version)"
+            (printf " => %d\n" (RubyBenchmarkCode.new.tak3 10 5 0)))
+
+(bench-task #f
+            "tak   (nendo version)"
+            (printf " => %d\n" (tak 10 5 0)))
+
+
+;;[EOF]

data/{example/tak.nnd → benchmark/nendo_benchmark_code.nnd}

@@ -10,5 +10,9 @@
            (tak (- y 1) z x)
            (tak (- z 1) x y))))
 
-(define (main argv)
-  (print (tak 10 5 0)))
+;; factorial
+(define (fact n)
+  (if (zero? n)
+      1
+      (* n (fact (- n 1)))))
+

data/benchmark/ruby_benchmark_code.rb

@@ -0,0 +1,58 @@
+#!/usr/local/bin/ruby
+
+# takeuchi function ( tarai mawashi bench )
+class RubyBenchmarkCode
+
+  def tak( x, y, z )
+    if y >= x
+      y
+    else
+      tak( tak( x-1, y, z ),
+           tak( y-1, z, x ),
+           tak( z-1, x, y ))
+    end
+  end
+
+  def tak2( x, y, z )
+    @inner_tak = Proc.new { |_x,_y,_z| 
+      if ( _y >= _x )
+        _y
+      else
+        @inner_tak.call(
+                        @inner_tak.call( _x-1, _y, _z ),
+                        @inner_tak.call( _y-1, _z, _x ),
+                        @inner_tak.call( _z-1, _x, _y ))
+      end
+    }
+    @inner_tak.call( x, y, z )
+  end
+
+  def tak3( x, y, z )
+    @inner_minus = Proc.new { |_a,_b|
+      _a - _b
+    }
+    @inner_le  = Proc.new { |_a,_b|
+      _a >= _b
+    }
+    @inner_tak = Proc.new { |_x,_y,_z| 
+      if ( @inner_le.call( _y, _x ))
+        _y
+      else
+        @inner_tak.call(
+                        @inner_tak.call( @inner_minus.call(_x,1), _y, _z ),
+                        @inner_tak.call( @inner_minus.call(_y,1), _z, _x ),
+                        @inner_tak.call( @inner_minus.call(_z,1), _x, _y ))
+      end
+    }
+    @inner_tak.call( x, y, z )
+  end
+
+  def fact( n )
+    if 0 == n
+      1
+    else
+      n * fact( n - 1 )
+    end
+  end
+
+end

data/example/scratch.nnd

@@ -4,12 +4,58 @@
 (disable-idebug)
 (define debug-print-length 2000)
 
-(%internal-define-to-letrec
- '(macro (x)
-    (define (foo v) (+ v 1))
-    (define result 10)
-    (define (bar v) (+ v 2))
-    '(1 2 3)))
+
+
+
+(define case
+  (macro (cond-exp . body)
+    (define (case-block val . elem)
+      (let1 block (car elem)
+        (let ((cond-vals (car block))
+              (body      (cdr block)))
+          (let1 v
+              (if (eq? 'else cond-vals)
+                  cond-vals
+                  (cons 'or
+                        (map
+                         (lambda (x)
+                           `(eqv? (quote ,x) ,val))
+                         cond-vals)))
+            `((,v
+               ,@body))))))
   
+    (define (case-iter val lst)
+      (cond
+       ((null? lst)
+        '())
+       ((eq? 1 (length lst))
+        (case-block val (car lst)))
+       (else
+        (append (case-block val (car lst))
+                (case-iter  val (cdr lst))))))
+
+    (let1 sym (gensym)
+      `(let1 ,sym ,cond-exp
+         (cond
+          ,@(case-iter sym body))))))
+
+(pretty-print
+ (macroexpand-1
+  '(case (car '(a b c d))
+     ((a) 'a)
+     ((b) 'b)
+     ((1) 1)
+     (else 'else))))
+
+(case (caddr '(a b 1 2))
+  ((a) 'a)
+  ((b) 'b)
+  ((1) 1)
+  (else 'else))
+
+ 
+
+
+
 (exit)
 

data/lib/debug/syslog.nndc

@@ -4,16 +4,17 @@
 # 
 
 trampCall( 
-  delayCall( 'require',
+  delayCall( '_require',  'require',
       begin
         if @global_lisp_binding.has_key?('_require') then
           trampCall(@_require)
         else raise NameError.new( "Error: undefined variable _require", "_require" ) end
         rescue => __e ; __e.set_backtrace( ["./lib/debug/syslog.nnd:37"] + __e.backtrace ) ; raise __e
       end    ,
-      Cell.new(
+  [
       "syslog"
-               ))
+  ]
+               )
  )
 #--------------------
 
@@ -43,13 +44,14 @@ trampCall(
                               else raise NameError.new( "Error: undefined variable __PLMARK", "__PLMARK" ) end
                               rescue => __e ; __e.set_backtrace( ["./lib/debug/syslog.nnd:41"] + __e.backtrace ) ; raise __e
                             end                          ,
-                            Cell.new(
-                            "Nendo: "                            ,Cell.new(
+                        [
+                            "Nendo: "                            ,
                               begin
                                   trampCall(_str)
                                 rescue => __e ; __e.set_backtrace( ["./lib/debug/syslog.nnd:41"] + __e.backtrace ) ; raise __e
                               end
-                                     ))))
+                        ]
+                                     ))
                     )
                 rescue => __e ; __e.set_backtrace( ["./lib/debug/syslog.nnd:41"] + __e.backtrace ) ; raise __e
               end

data/lib/init.nnd

@@ -652,20 +652,20 @@
                   (cons 'or
                         (map
                          (lambda (x)
-                           `(eqv? ,x ,val))
+                           `(eqv? (quote ,x) ,val))
                          cond-vals)))
             `((,v
                ,@body))))))
   
     (define (case-iter val lst)
       (cond
-       ((eq? 0 (length lst))
+       ((null? lst)
         '())
        ((eq? 1 (length lst))
         (case-block val (car lst)))
-                 (else
-                  (append (case-block val (car lst))
-                          (case-iter  val (cdr lst))))))
+       (else
+        (append (case-block val (car lst))
+                (case-iter  val (cdr lst))))))
 
     (let1 sym (gensym)
       `(let1 ,sym ,cond-exp
@@ -1268,18 +1268,18 @@
     '())
    ((list? sexp)
     (case (car sexp)
-      (('quote)
+      ((quote)
        sexp)
-      (('macro)
+      ((macro)
        sexp)
-      (('begin)
+      ((begin)
        `(begin
           ,@(setup-proc-body (cdr sexp))))
-      (('lambda)
+      ((lambda)
        `(lambda
             ,(second sexp)
           ,@(setup-proc-body (cddr sexp))))
-      (('if)
+      ((if)
        (case (length sexp)
          ((3)
           `(if
@@ -1290,15 +1290,15 @@
             ,(second sexp)
             ,(setup-proc     (third sexp))
             ,(setup-proc     (fourth sexp))))))
-      (('let)
+      ((let)
        `(let
             ,(setup-let-args (second sexp))
           ,@(setup-proc-body (cddr sexp))))
-      (('letrec)
+      ((letrec)
        `(letrec
             ,(setup-let-args (second sexp))
           ,@(setup-proc-body (cddr sexp))))
-      (('define)
+      ((define)
        (let1 val (third sexp)
          `(define
             ,(second sexp)
@@ -1325,5 +1325,5 @@
 ;; global variables
 ;; ----------------------------------------
 (define *nendo-version*
-  "0.3.4"  ;;NENDO-VERSION
+  "0.3.5"  ;;NENDO-VERSION
   )