nendo 0.3.1 → 0.3.2

data/lib/nendo.rb

@@ -3,7 +3,7 @@
 #
 # nendo.rb  -  "language core of nendo"
 #  
-#   Copyright (c) 2000-2010  Kiyoka Nishiyama  <kiyoka@sumibi.org>
+#   Copyright (c) 2009-2010  Kiyoka Nishiyama  <kiyoka@sumibi.org>
 #   
 #   Redistribution and use in source and binary forms, with or without
 #   modification, are permitted provided that the following conditions
@@ -35,6 +35,7 @@
 #  $Id: 
 #
 require 'stringio'
+require 'digest/sha1'
 #require 'profile'
 
 class Nil
@@ -57,7 +58,7 @@ end
 class LispString < String
   def LispString.escape( str )
     if str.is_a? String
-      str.gsub( /["]/, "\\\"" )
+      str.gsub( /\\/, "\\\\\\\\" ).gsub( /["]/, "\\\"" ).gsub( /[\r]/, "\\r" ).gsub( /[\t]/, "\\t" )
     else
       raise TypeError
     end
@@ -262,6 +263,7 @@ class Reader
   T_EOF                 = :t_eof
   T_LPAREN              = :t_lparen
   T_RPAREN              = :t_rparen
+  T_LVECTOR             = :t_lvector
   T_SYMBOL              = :t_symbol
   T_KEYWORD             = :t_keyword
   T_NUM                 = :t_num
@@ -304,7 +306,7 @@ class Reader
     @chReader.ungetc( ch ) if nil != ch 
   end
 
-  def readwhile( exp )
+  def readwhile( exp, oneshot = false )
     ret = ""
     while true
       ch = @chReader.getc
@@ -318,10 +320,25 @@ class Reader
         @chReader.ungetc( ch )
         break
       end
+      if oneshot then   break   end
     end
     ret
   end
 
+  def peekchar( exp )
+    ch = @chReader.getc
+    #printf( "      peekchar: [%02x]\n", ch ) if @debug
+    if !ch # eof?
+      return nil
+    end
+    if ch.chr.match( exp )
+      ch.chr
+    else
+      @chReader.ungetc( ch )
+      nil
+    end
+  end
+  
   def readstring()
     ret = ""
     while true
@@ -330,15 +347,23 @@ class Reader
       if !ch # eof?
         break
       end
-      if ch.chr.match( /[\\]/ )
+      if ch.chr == "\\"
         ch2 = @chReader.getc
-        if ch2.chr == "\""    #  \"  reduce to "  
-          ret += "\""
-        else
-          ret += ch.chr
-          ret += ch2.chr
-        end
-      elsif ch.chr.match( /[^"]/ )
+        ret += case ch2.chr
+               when '"'    #  \"  reduce to "
+                 '"'
+               when '\\'   #  \\  reduce to \
+                 "\\"
+               when 'n'
+                 "\n"
+               when 'r'
+                 "\r"
+               when 't'
+                 "\t"
+               else
+                 ""
+               end
+      elsif ch.chr != '"'
         ret += ch.chr
       else
         @chReader.ungetc( ch )
@@ -362,7 +387,7 @@ class Reader
         when /[\`]/
           T_QUASIQUOTE
         when /[,]/
-          str += readwhile( /[@]/ )
+          str += readwhile( /[@]/, true )
           if 1 == str.length
             T_UNQUOTE
           else
@@ -386,28 +411,62 @@ class Reader
           str = ""
           T_COMMENT
         when /[#]/
-          keyword = readwhile( /[?=!]/ )
-          case keyword
-          when /[?=]/
-            str = ""
-            T_DEBUG_PRINT
-          when /[!]/
-            readwhile( /[^\r\n]/ )
-            str = ""
-            T_COMMENT
-          else
-            keyword = readwhile( /[a-z]/ )
-            case keyword
-            when "t"
-              str = "true"
-              T_SYMBOL
-            when "f"
-              str = "false"
-              T_SYMBOL
+          nextch = peekchar( /[?!tfbodx(]/ )
+          case nextch
+          when "?"
+            if peekchar( /[=]/ )
+              str = ""
+              T_DEBUG_PRINT
             else
               str += readwhile( /[^ \t\r\n]/ )
               raise NameError, sprintf( "Error: unknown #xxxx syntax for Nendo %s", str )
+            end              
+          when "!"
+            readwhile( /[^\r\n]/ )
+            str = ""
+            T_COMMENT
+          when "("
+            str = ""
+            T_LVECTOR
+          when "t"
+            str = "true"
+            T_SYMBOL
+          when "f"
+            str = "false"
+            T_SYMBOL
+          when "b","o","d","x"
+            str = readwhile( /[0-9a-zA-Z]/ )
+            case nextch
+            when "b"
+              if str.match( /^[0-1]+$/ )
+                str = "0b" + str
+              else
+                raise RuntimeError, sprintf( "Error: illegal #b number for Nendo #b%s", str )
+              end
+            when "o"
+              if str.match( /^[0-7]+$/ )
+                str = "0o" + str
+              else
+                raise RuntimeError, sprintf( "Error: illegal #o number for Nendo #o%s", str )
+              end
+            when "d"
+              if str.match( /^[0-9]+$/ )
+                str = "0d" + str
+              else
+                raise RuntimeError, sprintf( "Error: illegal #d number for Nendo #d%s", str )
+              end
+            when "x"
+              if str.match( /^[0-9a-fA-F]+$/ )
+                str = "0x" + str
+              else
+                raise RuntimeError, sprintf( "Error: illegal #x number for Nendo #x%s", str )
+              end
             end
+            str = Integer( str ).to_s
+            T_NUM
+          else
+            str += readwhile( /[^ \t\r\n]/ )
+            raise NameError, sprintf( "Error: unknown #xxxx syntax for Nendo %s", str )
           end
         when /[_a-zA-Z!$%&*+\/:<=>?@^~-]/      # symbol
           str += readwhile( /[0-9._a-zA-Z!$%&*+\/:<=>?@^~-]/ )
@@ -421,7 +480,7 @@ class Reader
           else
             T_SYMBOL
           end
-        when /[0-9]/           # number
+        when /[0-9]/           # Numeric
           str += readwhile( /[0-9.]/ )
           T_NUM
         when /["]/             # String
@@ -498,6 +557,32 @@ class Reader
     end
   end
 
+  # vector := sexp 
+  #      | atom ... atom
+  def vector
+    printf( "  NonT: [%s]\n", "vector" ) if @debug
+    arr = []
+    while true
+      case curtoken.kind
+      when T_LINEFEED
+        token # skipEnter
+      when T_EOF
+        raise RuntimeError, "Error: unbalanced vector's paren(4)"
+      when T_LPAREN, T_LVECTOR
+        arr << sexp()
+      when T_RPAREN
+        break
+      when T_QUOTE , T_QUASIQUOTE , T_UNQUOTE , T_UNQUOTE_SPLICING, T_DEBUG_PRINT
+        arr << sexp()
+      when T_DOT
+        raise RuntimeError, "Error: illegal list."
+      else
+        arr << atom()
+      end
+    end
+    arr
+  end
+  
   # list := sexp 
   #      | atom ... atom
   #      | atom ... . atom 
@@ -511,8 +596,8 @@ class Reader
       when T_LINEFEED
         token # skipEnter
       when T_EOF
-        raise SyntaxError, "Error: unbalanced paren(1)"
-      when T_LPAREN
+        raise RuntimeError, "Error: unbalanced paren(1)"
+      when T_LPAREN, T_LVECTOR
         cells << Cell.new( sexp() )
       when T_RPAREN
         break
@@ -565,7 +650,7 @@ class Reader
     end
   end
 
-  # sexp := ( list ) | 'sexp | `sexp | atom
+  # sexp := ( list ) | | #( vector ) | 'sexp | `sexp | atom
   def sexp
     printf( "  NonT: [%s]\n", "sexp" ) if @debug
     case curtoken.kind
@@ -573,7 +658,7 @@ class Reader
       token
       sexp()
     when T_EOF
-      raise SyntaxError, "Error: unbalanced paren(2)"
+      raise RuntimeError, "Error: unbalanced paren(2)"
     when T_LPAREN
       skipEnter
       token # consume '('
@@ -582,7 +667,14 @@ class Reader
       token # consume ')'
       ret
     when T_RPAREN
-      raise SyntaxError, "Error: unbalanced paren(3)"
+      raise RuntimeError, "Error: unbalanced paren(3)"
+    when T_LVECTOR
+      skipEnter
+      token # consume '#('
+      ret = vector()
+      skipEnter
+      token # consume ')'
+      ret
     when T_QUOTE , T_QUASIQUOTE , T_UNQUOTE , T_UNQUOTE_SPLICING
       _atom = atom() ## "quote" symbol
       Cell.new( _atom, Cell.new( sexp() ))
@@ -825,7 +917,7 @@ module BuiltinFunctions
       (Cell == arg.class)
     end
   end
-  def _number_QUMARK(   arg )    ((Fixnum == arg.class) or (Float == arg.class)) end
+  def _number_QUMARK(   arg )    arg.is_a? Numeric   end
   def _string_QUMARK(   arg )    String == arg.class end
   def _macroexpand_MIMARK1( arg )
     if _pair_QUMARK( arg )
@@ -850,11 +942,31 @@ module BuiltinFunctions
       raise TypeError
     end
   end
+  def _to_arr( arg )                 _to_MIMARKarr( arg ) end
+  def _to_MIMARKarr( arg )
+    case arg
+    when Cell
+      arg.to_arr
+    when Array
+      arg
+    else
+      raise TypeError
+    end
+  end
   def _intern( arg )                            arg.intern  end
   def _string_MIMARK_GTMARKsymbol( arg )        arg.intern  end
   def _symbol_MIMARK_GTMARKstring( arg )        arg.to_s    end
-  def _string_MIMARKjoin( lst, delim )
-    lst.to_a.map{ |x| x.car }.join( delim )
+  def _string_MIMARKjoin( lst, *args )
+    arr = args[0].to_arr
+    if 0 < arr.length
+      if not arr[0].is_a? String
+        raise TypeError, "Error string-join's expects delimitter as String."
+      else
+        lst.to_a.map{ |x| x.car }.join( arr[0] )
+      end
+    else
+      lst.to_a.map{ |x| x.car }.join
+    end
   end
   def _require( arg )
     Kernel::require( arg )
@@ -967,8 +1079,17 @@ module BuiltinFunctions
   def __ASMARKFILE_ASMARK()
     @lastSourcefile
   end
-end
 
+  def _vector_MIMARKset_EXMARK( v, index, value )
+    if !(v.is_a? Array)
+      raise TypeError, "Error: vector-set! requires Array as argument v(Lisp's vector).\n"
+    end
+    if (index < 0) or (v.size <= index)
+      raise ArgumentError, "Error: vector-set! requires index  between 0 and (size-1) number.\n"
+    end
+    v[index] = value
+  end
+end
 
 
 # Translate S expression to Ruby expression and Evaluation
@@ -1006,9 +1127,7 @@ class Evaluator
 
     # built-in functions
     self.methods.grep( /^_/ ) { |rubySymbol|
-      @___tmp = self.method( rubySymbol )
-      eval( sprintf( "@%s = @___tmp;", rubySymbol ), @binding )
-      eval( sprintf( "@global_lisp_binding['%s'] = true;", rubySymbol ), @binding )
+      global_lisp_define( rubySymbol, self.method( rubySymbol ))
     }
 
     # initialize buildin functions as Proc objects
@@ -1028,9 +1147,24 @@ class Evaluator
     @compiled_code = Hash.new
   end
 
+  def global_lisp_define( rubySymbol, val )
+    @___tmp = val
+    eval( sprintf( "@%s = @___tmp;", rubySymbol ), @binding )
+    eval( sprintf( "@global_lisp_binding['%s'] = true;", rubySymbol ), @binding )
+  end
+
+  def setArgv( argv )
+    self.global_lisp_define( toRubySymbol( "*argv*"), argv.to_list )
+  end
+
   def _gensym( )
     @gensym_counter += 1
-    sprintf( "__gensym__%d", @gensym_counter ).intern
+    filename = if @lastSourcefile.is_a? String
+                 Digest::SHA1.hexdigest( @lastSourcefile )
+               else
+                 ""
+               end
+    sprintf( "__gensym__%s_%d", filename, @gensym_counter ).intern
   end
   
   def forward_gensym_counter( )
@@ -1342,9 +1476,12 @@ class Evaluator
         str += "," + genQuote( lastAtom )  if lastAtom
         str += arr.map{ |e| ")" }.join
       end
+    when Array
+      arr = sexp.map { |x| genQuote( x ) }
+      str += "[" +  arr.join(",") + "]"
     when Symbol
       str += sprintf( ":\"%s\"", sexp.to_s )
-    when String
+    when String, LispString
       str += sprintf( "\"%s\"", LispString.escape( sexp ))
     when LispKeyword
       str += sprintf( "LispKeyword.new( \"%s\" )", sexp.key.to_s )
@@ -1419,6 +1556,8 @@ class Evaluator
       else
         self.apply( sexp.car, sexp.cdr, sexp.car.sourcefile, sexp.car.lineno, locals )
       end
+    when Array
+      raise RuntimeError, "Error: can't eval unquoted vector."
     else
       case sexp
       when Symbol
@@ -1427,7 +1566,7 @@ class Evaluator
         lispSymbolReference( sym, locals, nil, sexp.sourcefile, sexp.lineno )
       when Fixnum
         sexp.to_s
-      when String
+      when String, LispString
         sprintf( "\"%s\"", LispString.escape( sexp ))
       when LispKeyword
         sprintf( "LispKeyword.new( \"%s\" )", sexp.key )
@@ -1488,7 +1627,7 @@ class Evaluator
           sexp.cdr         = Cell.new( letArgumentList( sexp.cdr.car ),
                                        quoting( sexp.cdr.cdr ))
         when Symbol      # named letrec is illegal
-          raise SyntaxError, "Error: named letrec is not a illegal form"
+          raise RuntimeError, "Error: named letrec is not a illegal form"
         end
         sexp
       else
@@ -1642,14 +1781,22 @@ class Evaluator
     forward_gensym_counter()
   end
 
+  def _load_MIMARKcompiled_MIMARKcode_MIMARKfrom_MIMARKstring( rubyExp )
+    eval( rubyExp, @binding )
+    forward_gensym_counter()
+  end
+
   def _load_MIMARKcompiled_MIMARKcode( filename )
     open( filename, "r:utf-8" ) { |f|
-      rubyExp = f.read
-      eval( rubyExp, @binding )
+      eval( f.read, @binding )
     }
     forward_gensym_counter()
   end
 
+  def _clean_MIMARKcompiled_MIMARKcode
+    @compiled_code = Hash.new
+  end
+  
   def _get_MIMARKcompiled_MIMARKcode
     @compiled_code
     ret = Hash.new
@@ -1705,6 +1852,13 @@ class Printer
       else
         "(" +  arr.join( " " ) + (lastAtom ? " . " + lastAtom : "") + ")"
       end
+    when Array # is a vector in the Nendo world.
+      arr = sexp.map { |x| __write( x, readable ) }
+      "#(" + arr.join( " " ) + ")"
+    when true
+      "#t"
+    when false
+      "#f"
     when Symbol
       keyword = getQuoteKeyword.call( sexp )
       if keyword
@@ -1712,7 +1866,7 @@ class Printer
       else
         sprintf( "%s", sexp.to_s )
       end
-    when String
+    when String, LispString
       if readable
         sprintf( "\"%s\"", LispString.escape( sexp.to_s ))
       else
@@ -1763,6 +1917,22 @@ class Nendo
     @evaluator._load( path )
   end
 
+  def load_compiled_code( path )
+    @evaluator._load_MIMARKcompiled_MIMARKcode( path )
+  end
+
+  def load_compiled_code_from_string( rubyExp )
+    @evaluator._load_MIMARKcompiled_MIMARKcode_MIMARKfrom_MIMARKstring( rubyExp )
+  end
+
+  def setArgv( argv )
+    @evaluator.setArgv( argv )
+  end
+
+  def clean_compiled_code
+    @evaluator._clean_MIMARKcompiled_MIMARKcode()
+  end
+
   def repl
     printer = Printer.new( @debug_printer )
     reader = nil