root/lang/ruby/RedLisp/trunk/redlisp.rb @ 31335

#!/usr/bin/env ruby
#
# RedLisp
#   "Principle of Least Surprise (for Rubyist)"
#
#
require 'stringio'
require 'pp'

class Nil
end

class Cell
  include Enumerable

  def initialize( car = Nil.new, cdr = Nil.new )
    @car = car
    @cdr = cdr
  end
  attr_accessor :car, :cdr

  def each                    # Supporting iterator
    it = self
    begin
      yield it
      it = it.cdr
    end while Nil != it.class
  end

  def length
    count = 0
    p = self
    begin
      p = p.car
      count += 1
    end while Nil != it.class
  end

  def isDotted
    ((Cell != @cdr.class) and (Nil != @cdr.class))
  end
    
end


class Token
  def initialize( type, str )
    @type = type
    @str  = str
  end
  attr_accessor :type, :str
end


class Reader
  ## tokens
  T_EOF       = :t_eof
  T_LPAREN    = :t_lparen
  T_RPAREN    = :t_rparen
  T_SYMBOL    = :t_symbol
  T_NUM       = :t_num
  T_QUOTE     = :t_quote
  T_DOT       = :t_dot

  # inport is IO class
  def initialize( inport )
    @inport   = inport
    @curtoken = nil
  end

  def skipspace
    ch = @inport.getc
    if !@inport.eof? 
      while ch.chr.match( /[ \t\r\n]/ )
        ch = @inport.getc
      end
      @inport.ungetc( ch )
    end
  end

  def readwhile( exp )
    ret = ""
    while true
      ch = @inport.getc
      if @inport.eof? 
        break
      end
      if ch.chr.match( exp )
        ret += ch.chr
      else
        @inport.ungetc( ch )
        break
      end
    end
    ret
  end

  def token
    skipspace
    ch = @inport.getc
    if @inport.eof?
      @curtoken = Token.new( T_EOF, "" )
    else
      str = ch.chr
      type =
        case str
        when '('
          T_LPAREN
        when ')'
          T_RPAREN
        when '.'
          T_DOT
        when /[a-zA-Z+*\/=!-]/ # symbol
          str += readwhile( /[a-zA-Z+*\/=!-]/ )
          T_SYMBOL
        when /[0-9]/        # number
          str += readwhile( /[0-9.]/ )
          T_NUM
        when /[\']/
          T_QUOTE
        end
      p "  [" + str + "] : " + type.to_s
      @curtoken = Token.new( type, str )
    end
  end

  def curtoken
    @curtoken
  end

  def atom( tok )
    case tok.type
    when T_SYMBOL
      tok.str
    when T_NUM
      tok.str.to_i
    when T_QUOTE
      "quote"
    end
  end

  def list( tok )
    dotted = false
    cells = []
    while true
      case tok.type
      when T_EOF
        print "Error: unbalanced paren(2)\n"
        raise ExceptionParen
      when T_LPAREN
        cells << Cell.new( list( token ))
        tok = curtoken
      when T_RPAREN
        token
        break
      else
        if tok.type == T_DOT
          if 1 == cells.size
            dotted = true
            tok = token
          else
            print "Error : illegal dotted pair syntax"
            break
          end
        elsif tok.type == T_QUOTE
          cells << Cell.new( Cell.new( atom( tok ), Cell.new( sexp( token ))))
          tok = curtoken
        else
          cells << Cell.new( atom( tok ))
          tok = token
        end
      end
    end
    if dotted
      ## dotted list
      Cell.new( cells[0].car, cells[1].car )
    else
      ## setup list
      if 1 < cells.size
        ptr = cells.pop
        cells.reverse.each { |x|
          x.cdr = ptr
          ptr = x
        }
      end
      cells.first
    end
  end
  def sexp( tok )
    case tok.type
    when T_EOF
      break
    when T_LPAREN
      list( token )
    when T_RPAREN
      print "Error: unbalanced paren(1)\n"
      raise ExceptionParen
    when T_QUOTE
      Cell.new( Cell.new( tom( tok ), Cell.new( sexp( token ))))
    else
      atom( tok )
    end
  end

  def _read
    sexp( token )
  end
end


class Evaluator 
  def initialize
    @sym = {
      '+' => getIFunc( '+' ),
      '-' => getIFunc( '-' ),
      '*' => getIFunc( '*' ),
      '/' => getIFunc( '/' ),
      '%' => getIFunc( '%' ),

      'car'    => getIFunc( 'car' ),
      'cdr'    => getIFunc( 'cdr' ),
    }
  end

  def argCheck( args )
    if 0 == args.length
      nil
    else
      args.each { |x|
        if x.class != Fixnum
          print "Error: + - * / % operator got illegal argument. "
          return nil
        end
      }
    end
  end
    
  def getIFunc( name )
    case name
    when '+'
      lambda {|args| 
        argCheck( args )
        args.inject(0) {|x,y| x + y}
      }
    when '-'
      lambda {|args|
        argCheck( args )
        if 1 == args.length 
          - args[0]
        else
          args[1..-1].inject(args[0]) {|x,y| x - y}
        end
      }
    when '*'
      lambda {|args|
        argCheck( args )
        args.inject(1) {|x,y| x * y}
      }
    when '/'
      lambda {|args|
        argCheck( args )
        if 1 == args.length 
          1 / args[0]
        else
          args[1..-1].inject(args[0]) {|x,y| x / y}
        end
      }
    when '%'
      lambda {|args|
        argCheck( args )
        if 1 == args.length 
          1 % args[0]
        else
          args[1..-1].inject(args[0]) {|x,y| x % y}
        end
      }
    when 'car'
      lambda {|args|
        p "function car():", args.car
        if Cell == args.class
          args.car.car
        else
          print "Error: car argument error\n"
          raise ExceptionArgument
        end
      }
    when 'cdr'
      lambda {|args|
        p "function cdr():", args.car
        if Cell == args.class
          args.car.cdr
        else
          print "Error: car argument error\n"
          raise ExceptionArgument
        end
      }
    end
  end

  def execFunc( funcname, args )
    printf( "execFunc( %s, %s )\n", funcname, "xxx" )
    pp args
    if @sym[ funcname ] 
      @sym[ funcname ].call( args )
    else
      printf( "Error: no such function %s\n", funcname )
      raise ExceptionNoSymbol
    end
  end

  def apply( car, cdr )
    p "apply() car.class.to_s: " + car.class.to_s + ":" + car
    ptr = cdr
    while Nil != ptr.class
      print "ptr.car: "
      pp ptr.car
      ptr.car = _eval( ptr.car )
      ptr = ptr.cdr
    end
    execFunc( car, cdr )
  end

  def _eval( sexp )
    case sexp.class.to_s
    when "Cell"
      if "quote" == sexp.car
        sexp.cdr.car
      elsif sexp.isDotted
        print "Error: can't eval dotted pair"
        raise ExceptionNoSymbol        
      elsif Cell == sexp.car.class
        _eval( sexp.car )
      else
        self.apply( sexp.car, sexp.cdr )
      end
    else
      sexp
    end
  end
end


class Printer
  def _print( sexp, str = "" )
    case sexp.class.to_s
    when "Cell"
      str += "("
      str += _print( sexp.car )
      ptr = sexp.cdr
      while Nil != ptr.class
        str += _print( ptr.car )
        ptr = ptr.cdr
      end
      str += ")"
    else
      str += sprintf( "%s ", sexp )
    end
    str
  end
end


class Core
  def initialize( io )
    @reader       = Reader.new( io )
    @evaluator    = Evaluator.new
    @printer      = Printer.new
  end
  
  def repl
    while true
      @printer._print( @evaluator._eval( @reader._read ))
    end
  end
end


# test
def readerTest( sexp )
  sio = StringIO.open( sexp )
  reader = Reader.new( sio )
  p "--- " + sexp + " --- is "
  pp reader._read
end

#test 
def readerPrinterTest( sexp )
  sio = StringIO.open( sexp )
  reader = Reader.new( sio )
  print "--- " + sexp + " --- is       \n"
  s = reader._read
  printer = Printer.new
  print "--- " + sexp + " --- prints   \n"
  printf( "   %s\n\n", printer._print( s ))
end

#test 
def replTest( sexp )
  sio = StringIO.open( sexp )
  reader = Reader.new( sio )
  print "--- " + sexp + " --- is       \n"
  s = reader._read
  printer = Printer.new
  print "--- " + sexp + " --- prints   \n"
  printf( "   %s\n", printer._print( s ))
  evaluator = Evaluator.new
  print "--- " + sexp + " --- evals    \n"
  printf( "   %s\n", printer._print( evaluator._eval( s )))
end

replTest( " + " )
replTest( " 123 " )
replTest( " (car '(a b c)) " )
replTest( " (cdr '(a b c)) " )
#replTest( " (+ 1 2 3 4 ) " )
#replTest( " (* 1 2 3 4 ) " )
#replTest( " (- 10 5 1 ) " )
#replTest( " (/ 10 4 2 ) " )
#replTest( " (+ (+ 1 2) (+ 3 4 )) " )
#replTest( " (- (* 3 3) (* 2 2 )) " )
#replTest( " ( 1 . 2 ) " )
#replTest( " ( 1 ) " )
#replTest( " (car '(1 . 2)) " )
#replTest( " (cdr '(1 . 2)) " )
#replTest( " '( 1 2 3 '4 ) " )
#replTest( " (( 1 )) " )
#replTest( " ( 1 2 ( 3 4 )) " )
#replTest( " ( " )
#replTest( " ) " )


#def main
#  sio = StringIO.open( " (car 1 2 3) " )
#  core = Core.new( sio )
#  while true
#    core.repl
#  end
#end