nendo 0.4.1 → 0.5.0

data/lib/nendo.rb

@@ -35,6 +35,8 @@
 #  $Id: 
 #
 
+require 'pp'
+
 module Nendo
   require 'stringio'
   require 'digest/sha1'
@@ -71,6 +73,16 @@ module Nendo
   
   class LispMacro < Proc
   end
+
+  class LispSyntax < Proc
+  end
+
+  class LispCoreSyntax
+    def initialize( syntaxName )
+      @syntaxName = syntaxName
+    end
+    attr_reader :syntaxName
+  end
   
   class Cell
     include Enumerable
@@ -821,16 +833,12 @@ module Nendo
     def _equal_QUMARK( a, b )
       if a.is_a? String  and  b.is_a? String
         a === b
+      elsif _null_QUMARK( a ) and _null_QUMARK( b )
+        true
       elsif a.class != b.class
         false
       elsif a.class == Cell
-        if a.isNull and b.isNull
-          true
-        else
-          _equal_QUMARK( a.car, b.car ) and _equal_QUMARK( a.cdr, b.cdr )
-        end
-      elsif a.class == Nil and b.class == Nil
-        true
+        _equal_QUMARK( a.car, b.car ) and _equal_QUMARK( a.cdr, b.cdr )
       else
         (a === b)
       end
@@ -1047,6 +1055,14 @@ module Nendo
     def _macro_QUMARK( arg )       (LispMacro == arg.class) end
     def _symbol_QUMARK(    arg )   (Symbol == arg.class) end
     def _keyword_QUMARK(    arg )  (arg.is_a? LispKeyword) end
+    def _syntax_QUMARK( arg )      (arg.is_a? LispSyntax)  end
+    def _core_MIMARKsyntax_QUMARK( arg )
+      if arg.is_a? LispCoreSyntax
+        arg.syntaxName
+      else
+        nil
+      end
+    end
     def _pair_QUMARK(      arg )   
       if _null_QUMARK( arg )
         false
@@ -1154,7 +1170,7 @@ module Nendo
   
     def _global_MIMARKvariables
       self.instance_variables.select { |x|
-        x.match( /^[@]_[a-zA-Z]/ )
+        x.match( /^[@]_[_a-zA-Z]/ )
       }.map{ |name| 
         self.toLispSymbol( name[1..-1] ).intern
       }.to_list
@@ -1258,32 +1274,40 @@ module Nendo
       @debug   = debug
       @trace_debug = false
       @char_table_lisp_to_ruby = {
-        # list     (! $ % & * + - . / : < = > ? @ ^ _ ~)
-        '!' => '_EXMARK',
-        '$' => '_DOMARK',
-        '%' => '_PAMARK',
-        '&' => '_ANMARK',
-        '*' => '_ASMARK',
-        '+' => '_PLMARK',
-        '-' => '_MIMARK',
+        # list     (! $ % & * + - . / : < = > ? @ ^ _ ~ ...)
+        '!'   => '_EXMARK',
+        '$'   => '_DOMARK',
+        '%'   => '_PAMARK',
+        '&'   => '_ANMARK',
+        '*'   => '_ASMARK',
+        '+'   => '_PLMARK',
+        '-'   => '_MIMARK',
         # '.'
-        '/' => '_SLMARK',
-        ':' => '_COMARK',
-        '<' => '_LTMARK',
-        '=' => '_EQMARK',
-        '>' => '_GTMARK',
-        '?' => '_QUMARK',
-        '@' => '_ATMARK',
-        '^' => '_NKMARK',
+        '/'   => '_SLMARK',
+        ':'   => '_COMARK',
+        '<'   => '_LTMARK',
+        '='   => '_EQMARK',
+        '>'   => '_GTMARK',
+        '?'   => '_QUMARK',
+        '@'   => '_ATMARK',
+        '^'   => '_NKMARK',
         # '_'
-        '~' => '_CHMARK',
+        '~'   => '_CHMARK',
+        '...' => '_DOTDOTDOT',
       }
       @char_table_ruby_to_lisp = @char_table_lisp_to_ruby.invert
-  
+
+      @core_syntax_list = [ :quote, :"syntax-quote", :if , :begin , :lambda , :macro , :"&block" , :let , :letrec , :define, :set!, :error, :"%syntax", :"define-syntax" ]
+      @core_syntax_hash = Hash.new
+      @core_syntax_list.each { |x|
+        renamed = ("/nendo/core/" + x.to_s).intern
+        @core_syntax_hash[ x ] = renamed
+      }
+
       # toplevel binding
       @global_lisp_binding = Hash.new
   
-      # initialize buildin functions as Proc objects
+      # initialize builtin functions as Proc objects
       rubyExp = self.methods.select { |x|
         x.to_s.match( /^_/ )
       }.map { |name|
@@ -1294,6 +1318,17 @@ module Nendo
         ].join( " ; " )
       }.join( " ; " )
       eval( rubyExp, @binding )
+
+      # initialize builtin syntax as LispCoreSyntax
+      rubyExp = @core_syntax_hash.map { |k,v|
+        name1 = toRubySymbol( k )
+        name2 = toRubySymbol( v )
+        [ sprintf( "@%s                        = LispCoreSyntax.new( :\"%s\" ) ", name1, k ),
+          sprintf( "@global_lisp_binding['%s'] = @%s ", name1, name1 ),
+          sprintf( "@%s                        = @%s ", name2, name1 ),
+          sprintf( "@global_lisp_binding['%s'] = @%s ", name1, name2 ) ].join( " ; " )
+      }.join( " ; " )
+      eval( rubyExp, @binding )          
   
       # reset gensym counter
       @gensym_counter = 0
@@ -1388,6 +1423,7 @@ module Nendo
       if 0 == name.length
         ""
       else
+        name.gsub!( Regexp.new( Regexp.escape( '...' )), @char_table_lisp_to_ruby[ '...' ] )
         arr = name.gsub( /["]/, '' ).split( /[.]/ )
         tmp = arr[0]
         tmp.gsub!( /[:][:]/, "  " ) # save '::'
@@ -1516,7 +1552,7 @@ module Nendo
 
     def execFunc( funcname, args, sourcefile, lineno, locals, sourceInfo, execType )
       case funcname
-      when :define, :set!   # `define' special form
+      when :define, :set!, :"define-syntax", @core_syntax_hash[ :define ], @core_syntax_hash[ :set! ], @core_syntax_hash[ :"define-syntax" ]   # `define' special form
         ar = args.cdr.map { |x| x.car }
         variable_sym = toRubySymbol( args.car.to_s.sub( /^:/, "" ))
         global_cap = locals.flatten.include?( variable_sym.split( /[.]/ )[0] ) ? nil : "@"
@@ -1537,10 +1573,18 @@ module Nendo
            "trampCall(", [ ar ], ")"],
           "end"
         ]
-      when :error
+      when :error, @core_syntax_hash[ :error ]
+        arr = if args.length < 2
+                args.car
+              else
+                [ args.car + " ' ' + ",
+                  "_write_MIMARKto_MIMARKstring(",
+                  args.cdr.car,
+                  ")" ]
+              end
         [
          'begin raise RuntimeError, ',
-         args.car,
+         arr,
          "rescue => __e ",
          sprintf( "  __e.set_backtrace( [\"%s:%d\"] + __e.backtrace )", sourcefile, lineno ),
          "  raise __e",
@@ -1626,6 +1670,8 @@ module Nendo
               sprintf( "LispMacro.new { %s ", argStr )
             when :lambda
               sprintf( "Proc.new { %s ", argStr )
+            when :"%syntax"
+              sprintf( "LispSyntax.new { %s ", argStr )
             when :"&block"
               sprintf( "&Proc.new { %s ", argStr )
             else
@@ -1800,7 +1846,13 @@ module Nendo
     def translate( sexp, locals, sourceInfo = nil )
       case sexp
       when Cell
-        if :quote == sexp.car
+        inv = @core_syntax_hash.invert
+        car = if inv.has_key?( sexp.car )
+                inv[ sexp.car ]
+              else
+                sexp.car
+              end
+        if :quote == car or :"syntax-quote" == car
           genQuote( sexp.cdr.car )
         elsif sexp.isDotted
           raise NameError, "Error: can't eval dotted pair."
@@ -1808,21 +1860,23 @@ module Nendo
           [ "Cell.new()" ]
         elsif Cell == sexp.car.class
           self.apply( translate( sexp.car, locals, sourceInfo ), sexp.cdr, sexp.car.car.sourcefile, sexp.car.car.lineno, locals, sourceInfo, EXEC_TYPE_ANONYMOUS )
-        elsif :begin == sexp.car
+        elsif :begin == car
           self.makeBegin( sexp.cdr, locals )
-        elsif :lambda == sexp.car
+        elsif :lambda == car
           self.makeClosure( :lambda, sexp.cdr, locals )
-        elsif :macro == sexp.car
+        elsif :macro == car
           self.makeClosure( :macro, sexp.cdr, locals )
-        elsif :"&block" == sexp.car
+        elsif :"%syntax" == car
+          self.makeClosure( :"%syntax", sexp.cdr, locals )
+        elsif :"&block" == car
           self.makeClosure( :"&block", sexp.cdr, locals )
-        elsif :if == sexp.car
+        elsif :if == car
           self.makeIf( sexp.cdr,    locals )
-        elsif :let == sexp.car
+        elsif :let == car
           self.makeLet( sexp.cdr,   locals )
-        elsif :letrec == sexp.car
+        elsif :letrec == car
           self.makeLetrec( sexp.cdr,   locals )
-        elsif :"%tailcall" == sexp.car
+        elsif :"%tailcall" == car
           if sexp.cdr.car.is_a? Cell
             sexp = sexp.cdr.car
             self.apply( sexp.car, sexp.cdr, sexp.car.sourcefile, sexp.car.lineno, locals, sourceInfo, EXEC_TYPE_TAILCALL )
@@ -1881,13 +1935,40 @@ module Nendo
     def quotingPhase( sexp )
       case sexp
       when Cell
-        if :quote == sexp.car or :quasiquote == sexp.car 
+        car = sexp.car
+        if :quote == car or :quasiquote == car or :"syntax-quote" == car or
+            @core_syntax_hash[ :quote ] == car or
+            @core_syntax_hash[ :quasiquote ] == car or
+            @core_syntax_hash[ :"syntax-quote" ] == car
           sexp
-        elsif :define == sexp.car or :set! == sexp.car or :lambda == sexp.car or :macro == sexp.car or :"&block" == sexp.car
-          sexp.cdr.car = Cell.new( :quote, Cell.new( sexp.cdr.car ))
-          sexp.cdr.cdr = quotingPhase( sexp.cdr.cdr )
+        elsif :define == car or :set! == car or :lambda == car or :macro == car or :"&block" == car or :"%syntax" == car or :"define-syntax" == car or
+            @core_syntax_hash[ :define ] == car or
+            @core_syntax_hash[ :set! ] == car or
+            @core_syntax_hash[ :lambda ] == car or
+            @core_syntax_hash[ :macro ] == car or
+            @core_syntax_hash[ :"&block" ] == car or
+            @core_syntax_hash[ :"%syntax" ] == car or 
+            @core_syntax_hash[ :"define-syntax" ] == car
+          if @debug
+            if 2 >= sexp.length
+              printf( "\n    quotingPhase-1      label=%s, sexp.length=%d \n", sexp.car, sexp.length )
+            else
+              printf( "\n    quotingPhase-1      label=%s, sexp.length=%d, sexp.cdr=%s sexp.cdr.car=%s sexp.cdr.cdr=%s\n", sexp.car, sexp.length, sexp.cdr, sexp.cdr.car, sexp.cdr.cdr )
+            end
+          end
+          if 1 == sexp.length
+            nil
+            # do nothing
+          elsif 3 <= sexp.length
+            # argument
+            sexp.cdr.car = Cell.new( :quote, Cell.new( sexp.cdr.car ))
+            # body
+            sexp.cdr.cdr = quotingPhase( sexp.cdr.cdr )
+          else
+            raise RuntimeError, sprintf( "Error: %s is not a illegal form got: %s", sexp.car, _write_MIMARKto_MIMARKstring( sexp ))
+          end
           sexp
-        elsif :let == sexp.car
+        elsif :let == car or @core_syntax_hash[ :let ] == car
           if _null_QUMARK( sexp.cdr )
             # do nothing
           else
@@ -1902,13 +1983,17 @@ module Nendo
             end
           end
           sexp
-        elsif :letrec == sexp.car
-          case sexp.cdr.car
-          when Cell        # letrec
-            sexp.cdr         = Cell.new( letArgumentList( sexp.cdr.car ),
-                                         quotingPhase( sexp.cdr.cdr ))
-          when Symbol      # named letrec is illegal
-            raise RuntimeError, "Error: named letrec is not a illegal form"
+        elsif :letrec == car or @core_syntax_hash[ :letrec ] == car
+          if _null_QUMARK( sexp.cdr )
+            # do nothing
+          else
+            case sexp.cdr.car
+            when Cell        # letrec
+              sexp.cdr         = Cell.new( letArgumentList( sexp.cdr.car ),
+                                           quotingPhase( sexp.cdr.cdr ))
+            when Symbol      # named letrec is illegal
+              raise RuntimeError, "Error: named letrec is not a illegal form"
+            end
           end
           sexp
         else
@@ -1926,10 +2011,14 @@ module Nendo
     def macroexpandEngine( sexp )
       case sexp
       when Cell
-        if :quote == sexp.car
+        car = sexp.car
+        if :quote == car or :"syntax-quote" == car or @core_syntax_hash[ :quote ] == car or @core_syntax_hash[ :"syntax-quote" ] == car
           sexp
         else
           sym = sexp.car.to_s
+          p 'macroexpandEngine' if @debug
+          p sexp.car.class if @debug
+          p sym            if @debug
           sym = toRubySymbol( sym )
           newSexp = sexp
           if isRubyInterface( sym )
@@ -1938,6 +2027,13 @@ module Nendo
           elsif sexp.car.class == Symbol and eval( sprintf( "(defined? @%s and LispMacro == @%s.class)", sym,sym ), @binding )
             eval( sprintf( "@__macro = @%s", sym ), @binding )
             newSexp = trampCall( callProcedure( sym, @__macro, sexp.cdr.to_arr ))
+          elsif sexp.car.class == Symbol and eval( sprintf( "(defined? @%s and LispSyntax == @%s.class)", sym,sym ), @binding )
+            # expected input is
+            #   (syntaxName arg1 arg2 ...)
+            # will be transformed
+            #   (syntaxName (syntaxName arg1 arg2 ...) () (global-variables))
+            eval( sprintf( "@__syntax = @%s", sym ), @binding )
+            newSexp = trampCall( callProcedure( sym, @__syntax, [ sexp, Cell.new(), _global_MIMARKvariables( ) ] ))
           end
           if _equal_QUMARK( newSexp, sexp )
             sexp.map { |x|
@@ -2149,6 +2245,20 @@ module Nendo
       eval( str, @binding )
       true
     end
+
+    def _make_MIMARKsyntactic_MIMARKclosure( mac_env, use_env, identifier )
+      if _pair_QUMARK( identifier )
+        raise RuntimeError, "Error: make-syntactic-closure requires symbol only..."
+      else
+        if mac_env.to_arr.include?( identifier )
+          identifier
+        else
+          sym = toRubySymbol( identifier ) + _gensym( ).to_s
+          sym.intern
+        end
+      end
+    end
+
   end
   
   class Printer
@@ -2234,7 +2344,7 @@ module Nendo
     end
 
     def self.version
-      "0.4.1"  ##NENDO-VERSION
+      "0.5.0"  ##NENDO-VERSION
     end
     
     def loadInitFile( use_compiled = true )

data/lib/rfc/json.nnd

@@ -35,7 +35,7 @@
 ;;;
 
 (require "json")
-
+(use util.list)
 
 ;; ------------------------------
 (define (%json:hash-table->alist obj)

data/lib/rfc/json.nndc

@@ -18,6 +18,21 @@ trampCall(
  )
 #--------------------
 
+trampCall( 
+  delayCall( '_load',  'load',
+      begin
+        if @global_lisp_binding.has_key?('_load') then
+          trampCall(@_load)
+        else raise NameError.new( "Error: undefined variable _load", "_load" ) end
+        rescue => __e ; __e.set_backtrace( [":1"] + __e.backtrace ) ; raise __e
+      end    ,
+  [
+      "util/list"
+  ]
+               )
+ )
+#--------------------
+
 trampCall( 
   begin
       def self.__PAMARKjson_COMARKhash_MIMARKtable_MIMARK_GTMARKalist_METHOD( origname, pred, args )   lispMethodEntry( origname, true ) ;   ret = callProcedure( origname, pred, args ) ;  lispMethodExit( origname,  true ) ;   return ret end 
@@ -517,7 +532,7 @@ trampCall(
                     end
                 } ; ___lambda.call(
                       begin
-                        ___lambda = lambda { |___gensym__6e1da08b054bbf0469585c6330e1b00b59b91d4c_20019| 
+                        ___lambda = lambda { |___gensym__6e1da08b054bbf0469585c6330e1b00b59b91d4c_80019| 
                             if ( 
                               trampCall( self._null_QUMARK_METHOD(  'null?',
                                   begin
@@ -528,7 +543,7 @@ trampCall(
                                   end                                ,
                               [
                                     begin
-                                        trampCall(___gensym__6e1da08b054bbf0469585c6330e1b00b59b91d4c_20019)
+                                        trampCall(___gensym__6e1da08b054bbf0469585c6330e1b00b59b91d4c_80019)
                                       rescue => __e ; __e.set_backtrace( [":1"] + __e.backtrace ) ; raise __e
                                     end
                               ]
@@ -548,7 +563,7 @@ trampCall(
                                     end                                  ,
                                 [
                                       begin
-                                          trampCall(___gensym__6e1da08b054bbf0469585c6330e1b00b59b91d4c_20019)
+                                          trampCall(___gensym__6e1da08b054bbf0469585c6330e1b00b59b91d4c_80019)
                                         rescue => __e ; __e.set_backtrace( [":1"] + __e.backtrace ) ; raise __e
                                       end
                                 ]
@@ -631,7 +646,7 @@ trampCall(
                     end
                 } ; ___lambda.call(
                       begin
-                        ___lambda = lambda { |___gensym__6e1da08b054bbf0469585c6330e1b00b59b91d4c_20020| 
+                        ___lambda = lambda { |___gensym__6e1da08b054bbf0469585c6330e1b00b59b91d4c_80020| 
                             if ( 
                               trampCall( self._null_QUMARK_METHOD(  'null?',
                                   begin
@@ -642,7 +657,7 @@ trampCall(
                                   end                                ,
                               [
                                     begin
-                                        trampCall(___gensym__6e1da08b054bbf0469585c6330e1b00b59b91d4c_20020)
+                                        trampCall(___gensym__6e1da08b054bbf0469585c6330e1b00b59b91d4c_80020)
                                       rescue => __e ; __e.set_backtrace( [":1"] + __e.backtrace ) ; raise __e
                                     end
                               ]
@@ -662,7 +677,7 @@ trampCall(
                                     end                                  ,
                                 [
                                       begin
-                                          trampCall(___gensym__6e1da08b054bbf0469585c6330e1b00b59b91d4c_20020)
+                                          trampCall(___gensym__6e1da08b054bbf0469585c6330e1b00b59b91d4c_80020)
                                         rescue => __e ; __e.set_backtrace( [":1"] + __e.backtrace ) ; raise __e
                                       end
                                 ]

data/lib/srfi-1.nnd

@@ -1057,11 +1057,15 @@
     (check-arg procedure? elt= delete-duplicates!)
     (let recur ((lis lis))
       (if (null-list? lis) lis
-	  (let* ((x (car lis))
-		 (tail (cdr lis))
-		 (new-tail (recur (delete! x tail elt=))))
-	    (if (eq? tail new-tail) lis (cons x new-tail)))))))
-
+          (let* ((x (car lis))
+                 (tail (cdr lis))
+                 (new-tail (recur (delete! x tail elt=))))
+            (if (eq? tail new-tail)
+                lis
+                (begin
+                  (set-car! lis x)
+                  (set-cdr! lis new-tail)
+                  lis)))))))
 
 ;;; alist stuff
 ;;;;;;;;;;;;;;;