Unlambda

シンタックスハイライトが出来るようになったということで。

require 'stringio'

class Unlambda
  def initialize(src = '', option = {})
    @src = StringIO.new(src)
    @option = {
      :input   => $stdin,
      :verbose => true,
      :debug   => :false
    }.merge!(option)
    @io_out = [StringIO.new]
    @io_out << $stdout if @option[:verbose]
    case @option[:input]
    when String
      @io_in = StringIO.new(@option[:input])
    when IO, StringIO
      @io_in = @option[:input]
    else
      raise 'input option error'
    end
    @debug = @option[:debug] ? true : false
    
    @rb = []
    @sexp = [[]]
    @st_toplv = []	# top level: collection of S-expressions
    @current_character = nil
    @cont_id = 0
  end
  
  def push_sexp str
    if str == '`'
      @sexp << []
    else
      @sexp[-1] << str
    end
    while @sexp.last.size == 2
      tmp = @sexp.pop
      @sexp[-1] << tmp
    end
    if @sexp[0] != []
      @st_toplv << @sexp[0][0]
      @sexp[0] = []
    end
  end
  
  def to_sexp(un_src = @src)
    while c = un_src.getc 
      case c
      when (?`)	# apply
	push_sexp '`'
      when ?i	# identity
	push_sexp 'Proc.new{|x| x}, '
      when ?k	# constant
	push_sexp 'Proc.new{|x| Proc.new{|y| y; x}}, '
      when ?s	# substitution
	push_sexp 'Proc.new{|x| Proc.new{|y| Proc.new{|z| x[z][y[z]]}}}, '
      when ?.	# print
	c = un_src.getc
	push_sexp "Proc.new{|x| @io_out.each{|o| o.putc #{c}}; x}, "
      when ?v	# void
	push_sexp 'Proc.new{t = Proc.new{|x| t}}.call(), '
      when ?r	# newline
	push_sexp 'Proc.new{|x| @io_out.each{|o| o.putc ?\n}; x}, '
      when ?@	# read
	push_sexp "Proc.new{|x| if @current_character = @io_in.getc ; x[Proc.new{|y| y}] else x[Proc.new{t = Proc.new{|y| t}}.call()] end}, "
      when ??	# compare
	c = un_src.getc
	push_sexp "Proc.new{|x| if @current_character == #{c} ; x[Proc.new{|y| y}] else x[Proc.new{t = Proc.new{|y| t}}.call()] end}, "
      when ?|	# reprint
	push_sexp 'Proc.new{|x| s = @current_character; @io_out.each{|o| o.putc(s)} ? x[Proc.new{|y| @io_out.each{|o| o.putc s}; y}] : x[Proc.new{ t = Proc.new{|y| t}}.call()]}, '
      when ?e	# exit
	push_sexp 'Proc.new{|x| exit}, '
      when ?d	# delay
	push_sexp :d
      when ?c	# continuation
	push_sexp "Proc.new{|x| cid = @cont_id; @cont_id += 1; eval(\"Ex\#{cid} = Class.new(Exception)\").class_eval{define_method(:initialize){|arg|@y = arg}; define_method(:y){@y};}; cont = Proc.new{|y| raise eval(\"Ex\#{cid}\").new(y) }; begin; x[cont]; rescue eval(\"Ex\#{cid}\") => ex; ex.y;  end;}, "
      when ?#	# comment
	un_src.gets
      when ?\ , ?\n, ?\r
	# ignore
      else
	raise 'must not happen'
      end
    end
  end
  
  def s2rb
    @rb = ''
    @st_toplv.each do |s|
      @rb += s2rb_sub(s) + ';'
    end
  end
  
  # S-exp to ruby string
  def s2rb_sub sexp
    if String === sexp
      return sexp
    end
    s2rb_sub(sexp[0]) + '[' + s2rb_sub(sexp[1]) + ']'
  end
  
  def eval_sexp
    ret = nil
    @st_toplv.each do |s|
      ret = eval_sexp_sub(s)
    end
    ret
  end
  
  def eval_sexp_sub sexp
    case sexp
    when String
      sanitize sexp
      eval(sexp)
    when Array
      if sexp[0] == :d
	Proc.new{|p| eval_sexp_sub(sexp[1])[p]}
      else
	eval_sexp_sub(sexp[0])[eval_sexp_sub(sexp[1])]
      end
    else
      raise 'must not happen'
    end
  end
  
  def sanitize str
    while str.gsub!(/, *\)/, ')') ||
          str.gsub!(/, *\[/, '[') ||
          str.gsub!(/, *\]/, ']') ||
          str.gsub!(/, *;/,  ';') ||
	  str.gsub!(/, *$/,   '')
    end
  end
  
  def output_result
    @io_out[0].string.dup
  end
end

__END__

a = Unlambda.new('`r`````````````.H.e.l.l.o.,. .w.o.r.l.d.!.a')
a.to_sexp
a.eval_sexp

p a.output_result

http://hw001.gate01.com/eggplant/tcf/unlambda/http://hw001.gate01.com/eggplant/tcf/unlambda/tutorial.htmlを見て、できると思ったのが間違いだった。http://hw001.gate01.com/eggplant/tcf/unlambda/reference.htmlまでちゃんと見て、継続とか遅延とかあると知ってたらやらなかった。

メモ

  • 定数への代入警告が出るけど、直し方がよくわからないので放置。
  • メモリ使用量、実行時間がひどい。直せると思うけど、ソースがすっきりしてしまうので保留。
  • The Unlambda Programming Languageから取れるソースで大体動いた。
  • 世の中にあるUnlambdaのソースの過半はquineな気がする。