nendo 0.3.3 → 0.3.4

data/lib/nendo.rb

@@ -153,6 +153,17 @@ module Nendo
     attr_reader :values
   end
   
+  class LispRegexp
+    def initialize( str )
+      @exp        = str[ 1 ... str.size ]
+      @ignoreCase = (str[0] == 'i')
+    end
+    def escape
+      @exp.gsub( /\\/, "\\\\\\\\" )
+    end
+    attr_reader :ignoreCase
+  end
+
   class LispKeyword
     def initialize( str )
       @key = str.intern
@@ -176,6 +187,49 @@ module Nendo
   
     attr_reader :key
   end
+
+  class SourceInfo
+    def initialize
+      @varname       = nil
+      @sourcefile    = nil
+      @lineno        = nil
+      @source_sexp   = Cell.new
+      @expanded_sexp = Cell.new
+      @compiled_str  = nil
+    end
+
+    def deepCopy( sexp )
+      Marshal.load(Marshal.dump( sexp ))
+    end
+
+    def setVarname( varname )
+      @varname        = varname
+    end
+
+    def setSource( sourcefile, lineno, source_sexp )
+      @sourcefile     = sourcefile
+      @lineno         = lineno
+      @source_sexp    = self.deepCopy( source_sexp )
+    end
+
+    def setExpanded( expanded_sexp )
+      @expanded_sexp  = self.deepCopy( expanded_sexp )
+    end
+
+    def setCompiled( compiled_str )
+      @compiled_str   = compiled_str
+    end
+
+    def debugPrint
+      printf( "=== sourceInfo === \n" )
+      printf( "  varname       = %s\n", @varname )
+      printf( "  sourcefile    = %s\n", @sourcefile )
+      printf( "  lineno        = %s\n", @lineno)
+      printf( "  compiled_str  = %s\n", @compiled_str )
+    end
+
+    attr_reader :varname, :sourcefile, :lineno, :source_sexp, :expanded_sexp, :compiled_str
+  end
   
   class DelayedCallPacket
     def initialize( _origname, _pred, _args )
@@ -261,6 +315,7 @@ module Nendo
     T_LINEFEED            = :t_linefeed
     T_COMMENT             = :t_comment
     T_DEBUG_PRINT         = :t_debug_print
+    T_REGEXP              = :t_regexp
   
     # inport is IO class
     def initialize( inport, sourcefile, debug = false )
@@ -362,7 +417,33 @@ module Nendo
       end
       ret
     end
-  
+
+    def readRegexp()
+      ret = ""
+      while true
+        ch = @chReader.getc
+        #printf( "      readRegexp1: [%s]\n", ch )
+        if !ch # eof?
+          break
+        end
+        if ch.chr == "\\"    #escape
+          ch2 = @chReader.getc
+          #printf( "      readRegexp2: [%s]\n", ch2 )
+          if ch2.chr == '/'
+            ret += ch2.chr # drop escape "\\" char
+          else
+            ret += ch.chr
+            ret += ch2.chr
+          end
+        elsif ch.chr == '/'
+          break
+        else
+          ret += ch.chr
+        end
+      end
+      ret
+    end
+
     def tokenWithComment
       skipspace
       ch = @chReader.getc
@@ -401,7 +482,7 @@ module Nendo
             str = ""
             T_COMMENT
           when /[#]/
-            nextch = peekchar( /[?!tfbodx(]/ )
+            nextch = peekchar( /[?!tfbodx(\/]/ )
             case nextch
             when "?"
               if peekchar( /[=]/ )
@@ -454,6 +535,11 @@ module Nendo
               end
               str = Integer( str ).to_s
               T_NUM
+            when "/"  # T_REGEXP's str takes  "iXXXXX"(igreno case)  or  " XXXXXX"(case sensitive)  value.
+              readwhile( /[\/]/ ) # consume
+              str =  readRegexp()
+              str =  ((0 < readwhile( /[i]/ ).size) ? "i" : " ") + str
+              T_REGEXP
             else
               str += readwhile( /[^ \t\r\n]/ )
               raise NameError, sprintf( "Error: unknown #xxxx syntax for Nendo %s", str )
@@ -526,6 +612,8 @@ module Nendo
         end
       when T_STRING
         cur.str
+      when T_REGEXP
+        LispRegexp.new( cur.str )
       when T_QUOTE
         :quote
       when T_QUASIQUOTE
@@ -557,7 +645,12 @@ module Nendo
         when T_LINEFEED
           token # skipEnter
         when T_EOF
-          raise RuntimeError, "Error: unbalanced vector's paren(4)"
+          begin
+            raise RuntimeError, "Error: unbalanced vector's paren(4)"
+          rescue => e
+            e.set_backtrace( [sprintf( "%s:%d", curtoken.sourcefile, curtoken.lineno )] + e.backtrace )
+            raise e
+          end
         when T_LPAREN, T_LVECTOR
           arr << sexp()
         when T_RPAREN
@@ -586,7 +679,12 @@ module Nendo
         when T_LINEFEED
           token # skipEnter
         when T_EOF
-          raise RuntimeError, "Error: unbalanced paren(1)"
+          begin
+            raise RuntimeError, "Error: unbalanced paren(1)"
+          rescue => e
+            e.set_backtrace( [sprintf( "%s:%d", curtoken.sourcefile, curtoken.lineno )] + e.backtrace )
+            raise e
+          end
         when T_LPAREN, T_LVECTOR
           cells << Cell.new( sexp() )
         when T_RPAREN
@@ -644,7 +742,12 @@ module Nendo
         token
         sexp()
       when T_EOF
-        raise RuntimeError, "Error: unbalanced paren(2)"
+        begin
+          raise RuntimeError, "Error: unbalanced paren(2)"
+        rescue => e
+          e.set_backtrace( [sprintf( "%s:%d", curtoken.sourcefile, curtoken.lineno )] + e.backtrace )
+          raise e
+        end
       when T_LPAREN
         skipEnter
         token # consume '('
@@ -653,7 +756,13 @@ module Nendo
         token # consume ')'
         ret
       when T_RPAREN
-        raise RuntimeError, "Error: unbalanced paren(3)"
+        token # consume ')'
+        begin
+          raise RuntimeError, "Error: unbalanced vector's paren(3)"
+        rescue => e
+          e.set_backtrace( [sprintf( "%s:%d", curtoken.sourcefile, curtoken.lineno )] + e.backtrace )
+          raise e
+        end
       when T_LVECTOR
         skipEnter
         token # consume '#('
@@ -901,7 +1010,6 @@ module Nendo
       end
     end
     def _list(    *args)           args[0] end
-    def _sort(     arg )           arg.to_arr.sort.to_list end
     def _reverse(  arg )           arg.to_arr.reverse.to_list end
     def _uniq(     arg )           arg.to_arr.uniq.to_list end
     def _range(    num, *args )
@@ -946,6 +1054,13 @@ module Nendo
         (Cell == arg.class)
       end
     end
+    def __PAMARKlist_QUMARK(      arg )   
+      if _pair_QUMARK( arg )
+        (not arg.lastAtom) and (1 <= arg.to_arr.size) # it means proper list?
+      else
+        _null_QUMARK( arg )
+      end
+    end
     def _integer_QUMARK(   arg )   arg.is_a? Integer   end
     def _number_QUMARK(   arg )    arg.is_a? Numeric   end
     def _string_QUMARK(   arg )    String == arg.class end
@@ -1000,7 +1115,7 @@ module Nendo
       end
     end
     def _require( arg )
-      Kernel::require( arg )
+      require( arg )
       false
     end
     def _read( *args )
@@ -1076,11 +1191,9 @@ module Nendo
     end
   
     def _hash_MIMARKtable_MIMARKget( h, key, *args )
-      if !((key.is_a? String) or ( key.is_a? Symbol))
-        raise TypeError, "Error: argument key requires String or Symbol.\n"
-      end
-      if h.has_key?( key )
-        h[key]
+      val = h[key]
+      if val
+        val
       else
         arr = args[0].to_arr
         if 0 < arr.length
@@ -1092,11 +1205,13 @@ module Nendo
     end
   
     def _hash_MIMARKtable_MIMARKput_EXMARK( h, key, value )
-      if !((key.is_a? String) or ( key.is_a? Symbol))
-        raise TypeError, "Error: argument key requires String or Symbol.\n"
-      end
       h[key] = value
     end
+
+    def _hash_MIMARKtable_MIMARKexist_QUMARK( h, key )
+      # don't use h.has_key(k), because has_key method undefined on some database bindings. (e.g. KyotoCabinet)
+      h[key] ? true : false
+    end
   
     # backtrace expects this format "filename:lineno: place message ". e.g.  "init.nnd:10: in aaa macro.".
     def _raise( exception, message, backtrace )
@@ -1120,6 +1235,7 @@ module Nendo
       end
       v[index] = value
     end
+
   end
   
   
@@ -1130,10 +1246,12 @@ module Nendo
     EXEC_TYPE_ANONYMOUS = 2
     EXEC_TYPE_TAILCALL  = 3
 
-    def initialize( debug = false )
+    def initialize( core, debug = false )
+      @core    = core
       @indent  = "  "
       @binding = binding
       @debug   = debug
+      @trace_debug = false
       @char_table_lisp_to_ruby = {
         # list     (! $ % & * + - . / : < = > ? @ ^ _ ~)
         '!' => '_EXMARK',
@@ -1165,7 +1283,7 @@ module Nendo
         x.to_s.match( /^_/ )
       }.map { |name|
         [
-         defMethodStr( name ),
+         defMethodStr( name, false ),
          sprintf( "@%s                        = self.method( :%s        ).to_proc", name, name ),
          sprintf( "@global_lisp_binding['%s'] = self.method( :%s_METHOD ).to_proc", name, name ),
         ].join( " ; " )
@@ -1175,13 +1293,17 @@ module Nendo
       # reset gensym counter
       @gensym_counter = 0
 
+      # call depth counter
+      @call_depth     = 0
+
       # init optimize level
       @optimize_level = 1
   
       # compiled ruby code
       #  { 'filename1' => [ 'code1' 'code2' ... ], 
       #    'filename2' => [ 'code1' 'code2' ... ], ... }
-      @compiled_code = Hash.new
+      @compiled_code    = Hash.new
+      @source_info_hash = Hash.new
       
       global_lisp_define( toRubySymbol( "%compile-phase-functions" ), Cell.new())
     end
@@ -1204,10 +1326,28 @@ module Nendo
       @optimize_level
     end
   
-    def defMethodStr( name )
-      sprintf( "def self.%s_METHOD( origname, pred, args ) callProcedure( origname, pred, args ) end", name )
+    def lispMethodEntry( name, _log )
+      @call_depth += 1
+      if @trace_debug and _log
+        puts " " * @call_depth + "ENTRY: " + name 
+      end
+    end
+    def lispMethodExit( name, _log )
+      if @trace_debug and _log
+        puts " " * @call_depth + "exit:  " + name
+      end
+      @call_depth -= 1
     end
 
+    def defMethodStr( name, _log )
+      [ "def self." + name.to_s + "_METHOD( origname, pred, args ) ",
+        "  lispMethodEntry( origname, " + _log.to_s + " ) ; ",
+        "  ret = callProcedure( origname, pred, args ) ;",
+        "  lispMethodExit( origname,  " + _log.to_s + " ) ; ",
+        "  return ret ",
+        "end " ].join
+    end
+  
     def _gensym( )
       @gensym_counter += 1
       filename = if @lastSourcefile.is_a? String
@@ -1321,14 +1461,14 @@ module Nendo
     end
 
     def method_missing( name, *args )
-      sym = toRubySymbol( name );
+      sym = toRubySymbol( name )
       if @global_lisp_binding[name].is_a? Proc
         @global_lisp_binding[name].call( args[0], args[1], args[2] )
       else
         callProcedure( args[0], args[1], args[2] )
       end
     end
-
+    
     def delayCall( origname, pred, args )
       case @optimize_level
       when 0 # no optimize
@@ -1357,17 +1497,20 @@ module Nendo
       }
     end
 
-    def execFunc( funcname, args, sourcefile, lineno, locals, execType )
+    def execFunc( funcname, args, sourcefile, lineno, locals, sourceInfo, execType )
       case funcname
       when :define, :set!   # `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 : "@"
+        if global_cap and sourceInfo
+          sourceInfo.setVarname( toLispSymbol( variable_sym ))
+        end
         [ "begin",
           [
            if global_cap
              [
-              defMethodStr( variable_sym ),
+              defMethodStr( variable_sym, true ),
               sprintf( "@global_lisp_binding['%s'] = self.method( :%s_METHOD )", variable_sym, variable_sym )
              ]
            else
@@ -1471,6 +1614,8 @@ module Nendo
               sprintf( "LispMacro.new { %s ", argStr )
             when :lambda
               sprintf( "Proc.new { %s ", argStr )
+            when :"&block"
+              sprintf( "&Proc.new { %s ", argStr )
             else
               raise "Error: makeClosure: unknown symbol type " + sym
             end
@@ -1552,13 +1697,13 @@ module Nendo
        "end"]
     end
   
-    def apply( car, cdr, sourcefile, lineno, locals, execType )
+    def apply( car, cdr, sourcefile, lineno, locals, sourceInfo, execType )
       cdr.each { |x| 
         if Cell == x.class
-          x.car = translate( x.car, locals )
+          x.car = translate( x.car, locals, sourceInfo )
         end
       }
-      execFunc( car, cdr, sourcefile, lineno, locals, execType )
+      execFunc( car, cdr, sourcefile, lineno, locals, sourceInfo, execType )
     end
   
     def genQuote( sexp, str = "" )
@@ -1638,7 +1783,7 @@ module Nendo
     #        (let ((c 3))
     #            (print (+ a b c))))
     #         => locals must be  [["_a" "_b"]["_c"]] value.
-    def translate( sexp, locals )
+    def translate( sexp, locals, sourceInfo = nil )
       case sexp
       when Cell
         if :quote == sexp.car
@@ -1648,13 +1793,15 @@ module Nendo
         elsif sexp.isNull
           [ "Cell.new()" ]
         elsif Cell == sexp.car.class
-          self.apply( translate( sexp.car, locals ), sexp.cdr, sexp.car.car.sourcefile, sexp.car.car.lineno, locals, EXEC_TYPE_ANONYMOUS )
+          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
           self.makeBegin( sexp.cdr, locals )
         elsif :lambda == sexp.car
           self.makeClosure( :lambda, sexp.cdr, locals )
         elsif :macro == sexp.car
           self.makeClosure( :macro, sexp.cdr, locals )
+        elsif :"&block" == sexp.car
+          self.makeClosure( :"&block", sexp.cdr, locals )
         elsif :if == sexp.car
           self.makeIf( sexp.cdr,    locals )
         elsif :let == sexp.car
@@ -1664,12 +1811,12 @@ module Nendo
         elsif :"%tailcall" == sexp.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, EXEC_TYPE_TAILCALL )
+            self.apply( sexp.car, sexp.cdr, sexp.car.sourcefile, sexp.car.lineno, locals, sourceInfo, EXEC_TYPE_TAILCALL )
           else
             raise RuntimeError, "Error: special form tailcall expects function call expression."
           end
         else
-          self.apply( sexp.car, sexp.cdr, sexp.car.sourcefile, sexp.car.lineno, locals, EXEC_TYPE_NORMAL )
+          self.apply( sexp.car, sexp.cdr, sexp.car.sourcefile, sexp.car.lineno, locals, sourceInfo, EXEC_TYPE_NORMAL )
         end
       when Array
         raise RuntimeError, "Error: can't eval unquoted vector."
@@ -1683,6 +1830,12 @@ module Nendo
           sexp.to_s
         when String, LispString
           sprintf( "\"%s\"", LispString.escape( sexp ))
+        when LispRegexp
+          if sexp.ignoreCase
+            sprintf( "Regexp.new( \"%s\", Regexp::IGNORECASE)", sexp.escape )
+          else
+            sprintf( "Regexp.new( \"%s\")", sexp.escape )
+          end
         when LispKeyword
           sprintf( "LispKeyword.new( \"%s\" )", sexp.key )
         when Nil
@@ -1716,7 +1869,7 @@ module Nendo
       when Cell
         if :quote == sexp.car or :quasiquote == sexp.car 
           sexp
-        elsif :define == sexp.car or :set! == sexp.car or :lambda == sexp.car or :macro == sexp.car
+        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 )
           sexp
@@ -1822,8 +1975,10 @@ module Nendo
     end
   
     def lispEval( sexp, sourcefile, lineno )
+      sourceInfo = SourceInfo.new
       @lastSourcefile = sourcefile
       @lastLineno     = lineno
+      sourceInfo.setSource( sourcefile, lineno, sexp )
       sexp = macroExpandPhase( sexp )
       sexp = quotingPhase( sexp )
       if @debug
@@ -1838,13 +1993,18 @@ module Nendo
           printf( "\n          compiled=<<< %s >>>\n", (Printer.new())._print(sexp))
         end
       end
+      sourceInfo.setExpanded( sexp )
       
-      arr = [ "trampCall( ", translate( sexp, [] ), " )" ]
+      arr = [ "trampCall( ", translate( sexp, [], sourceInfo ), " )" ]
       rubyExp = ppRubyExp( 0, arr ).flatten.join
+      sourceInfo.setCompiled( rubyExp )
       if not @compiled_code.has_key?( sourcefile )
         @compiled_code[ sourcefile ] = Array.new
       end
       @compiled_code[ sourcefile ] << rubyExp
+      if sourceInfo.varname
+        @source_info_hash[ sourceInfo.varname ] = sourceInfo
+      end
       printf( "          rubyExp=<<<\n%s\n>>>\n", rubyExp ) if @debug
       eval( rubyExp, @binding, @lastSourcefile, @lastLineno )
     end
@@ -1903,12 +2063,60 @@ module Nendo
     def _disable_MIMARKidebug()
       @debug = false
     end
+    def _enable_MIMARKtrace()
+      @trace_debug = true
+    end
+    def _disable_MIMARKtrace()
+      @trace_debug = false
+    end
     def _set_MIMARKoptimize_MIMARKlevel(level)
       self.setOptimizeLevel( level )
     end
     def _get_MIMARKoptimize_MIMARKlevel()
       self.getOptimizeLevel
     end
+
+    def _get_MIMARKsource_MIMARKinfo( varname )
+      info = @source_info_hash[ varname.to_s ]
+      if info
+        [
+         Cell.new( "varname",           info.varname ),
+         Cell.new( "sourcefile",        info.sourcefile ),
+         Cell.new( "lineno",            info.lineno ),
+         Cell.new( "source",            info.source_sexp ),
+         Cell.new( "expanded",          info.expanded_sexp ),
+         Cell.new( "compiled_str",      info.compiled_str ) ].to_list
+      else
+        raise NameError, sprintf( "Error: not found variable [%s]. \n", varname.to_s )
+      end
+    end
+    
+    def __PAMARKexport_MIMARKto_MIMARKruby( origname, pred )
+      if toRubySymbol( origname ) != ("_" + origname)
+        raise ArgumentError, "Error: %export-to-ruby requires function name in ruby method naming rule."
+      end
+      if not _procedure_QUMARK( pred )
+        raise ArgumentError, "Error: %export-to-ruby requires 'pred' as a Proc instance."
+      end
+      if 0 > pred.arity
+        raise ArgumentError, "Error: %export-to-ruby requires only a function that have fixed length argument."
+      end
+      if self.methods.include?( origname.intern ) or @core.methods.include?( origname.intern )
+        raise RuntimeError, "Error: %export-to-ruby: Nendo::Core." + origname + " method was already deifned."
+      end
+
+      argsStr = (1..(pred.arity)).map { |n| "arg" + n.to_s }.join( "," )
+      str = [ "def self." + origname + "(" + argsStr + ")",
+              sprintf( "  trampCall( callProcedure( '%s', @_%s, [ " + argsStr + " ].to_list )) ",
+                       origname, origname ),
+              "end ;",
+              "def @core." + origname + "(" + argsStr + ")",
+              "  @evaluator." + origname + "(" + argsStr + ") ",
+              "end"
+            ].join
+      eval( str, @binding )
+      true
+    end
   end
   
   class Printer
@@ -1964,6 +2172,8 @@ module Nendo
         else
           sexp.to_s
         end
+      when Regexp
+        "#/" + sexp.source + "/" + (sexp.casefold? ? "i" : "")
       when LispKeyword
         ":" + sexp.key.to_s
       when Nil
@@ -1987,7 +2197,7 @@ module Nendo
   class Core
     def initialize( debug_evaluator = false, debug_printer = false )
       @debug_evaluator = debug_evaluator
-      @evaluator       = Evaluator.new( debug_evaluator )
+      @evaluator       = Evaluator.new( self, debug_evaluator )
       @debug_printer   = debug_printer
     end
     
@@ -2002,6 +2212,7 @@ module Nendo
       end
       unless done
         @evaluator._load( File.dirname(__FILE__) + "/init.nnd" )
+        @evaluator._load( File.dirname(__FILE__) + "/init.nnd" ) # for %tailcall compile for init.nnd
       end
     end
   
@@ -2057,7 +2268,7 @@ module Nendo
       end
     end
   
-    def replStr( str )
+    def evalStr( str )
       printer   = Printer.new( @debug_printer )
       sio       = StringIO.open( str )
       reader    = Reader.new( sio, "(string)", false )
@@ -2095,7 +2306,7 @@ end
 class Array
   def to_list( lastAtom = false, value = Nendo::Nil.new )
     if 0 == self.length
-      Nendo::Nil.new
+      Nendo::Cell.new()
     else
       cells = self.map { |x|
         Nendo::Cell.new( x )

data/lib/srfi-1.nnd

@@ -790,12 +790,7 @@
 	      '())))
 	    
       ;; Fast path.
-      (let recur ((lis lis1))
-	(if (null-list? lis) lis
-	    (let ((tail (recur (cdr lis))))
-	      (cond ((f (car lis)) => (lambda (x) (cons x tail)))
-		    (else tail)))))))
-
+      (%filter-map f lis1)))
 
 ;;; Map F across lists, guaranteeing to go left-to-right.
 ;;; NOTE: Some implementations of R5RS MAP are compliant with this spec;
@@ -812,18 +807,12 @@
 	      '())))
 	    
       ;; Fast path.
-      (let recur ((lis lis1))
-	(if (null-list? lis) lis
-	    (let ((tail (cdr lis))
-		  (x (f (car lis))))		; Do head first,
-	      (cons x (recur tail)))))))	; then tail.
-
+      (%map f lis1)))
 
 ;;; We extend MAP to handle arguments of unequal length.
 (define map map-in-order)
 (define for-each map-in-order)
 
-
 ;;; filter, remove, partition
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; FILTER, REMOVE, PARTITION and their destructive counterparts do not
@@ -832,17 +821,19 @@
 ;; This FILTER shares the longest tail of L that has no deleted elements.
 ;; If Scheme had multi-continuation calls, they could be made more efficient.
 
-(define (filter pred lis)			; Sleazing with EQ? makes this
-  (check-arg procedure? pred filter)		; one faster.
-  (let recur ((lis lis))		
-    (if (null-list? lis) lis			; Use NOT-PAIR? to handle dotted lists.
-	(let ((head (car lis))
-	      (tail (cdr lis)))
-	  (if (pred head)
-	      (let ((new-tail (recur tail)))	; Replicate the RECUR call so
-		(if (eq? tail new-tail) lis
-		    (cons head new-tail)))
-	      (recur tail))))))			; this one can be a tail call.
+;;(define (filter pred lis)			; Sleazing with EQ? makes this
+;;  (check-arg procedure? pred filter)		; one faster.
+;;  (let recur ((lis lis))		
+;;    (if (null-list? lis) lis			; Use NOT-PAIR? to handle dotted lists.
+;;	(let ((head (car lis))
+;;	      (tail (cdr lis)))
+;;	  (if (pred head)
+;;	      (let ((new-tail (recur tail)))	; Replicate the RECUR call so
+;;		(if (eq? tail new-tail) lis
+;;		    (cons head new-tail)))
+;;	      (recur tail))))))			; this one can be a tail call.
+
+(define filter %filter)
 
 
 ;;; Another version that shares longest tail.