Hatena::Groupcoders

ラシウラ出張所 このページをアンテナに追加 RSSフィード

2007/06/10

[] RunHaskell moduleデモ  RunHaskell moduleのデモ - ラシウラ出張所 を含むブックマーク はてなブックマーク -  RunHaskell moduleのデモ - ラシウラ出張所  RunHaskell moduleのデモ - ラシウラ出張所 のブックマークコメント

で書いたような

  result = RunHaskell.run do
    main!(:mfoldr, "[]", [1,2,3]).where(%q{
      mfoldr = foldr (\elem bot -> "[" ++ (show elem) ++ ", " ++ bot ++ "]")
    })
  end

という感じで使えるもの。

とりあえず版だけど、show出力はパーズしてRubyオブジェクトにしてる。

require "tempfile"

module RunHaskell

  class HsRunner
    @@command = "runhaskell"
    def run(source)
      file = Tempfile.new "runhaskell"
      fname = file.path + ".hs"
      File.rename file.path, fname
      hsfile = File.new(fname, "w")
      hsfile.puts(source)
      hsfile.close
      io = IO.popen(@@command + " " + hsfile.path)
      result = io.read()
      io.close
      File.unlink hsfile.path
      result
    end
  end

  class HsParser
    def initialize(code)
      @code = code
      @index = 0
      @tokens = []
      tokenize
    end
    def parse()
      tok = shift
      case tok[0]
      when :numeric
        return HsNumeric.new(eval(tok[1]))
      when :string
        return HsString.new(eval(tok[1]))
      when :identifier
        return HsData.new(tok[1].to_sym, parse())
      when :lparen
        elems = []
        while true
          elem = parse()
          break if elem == nil
          elems << elem
          tok = shift
          case tok[0]
          when :rparen
            break
          when :comma
            next
          else
            unshift tok
            return nil
          end
        end
        return HsTuple.new(elems)
      when :lbracket
        elems = []
        while true
          elem = parse()
          break if elem == nil
          elems << elem
          tok = shift
          case tok[0]
          when :rbracket
            break
          when :comma
            next
          else
            unshift tok
            return nil
          end
        end
        return HsList.new(elems)
      when :lbrace
        elems = {}
        while true
          tok = shift
          unless tok[0] == :identifier
            unshift tok
            break
          end
          key = tok[1]
          tok = shift
          unless tok[0] == :equal
            unshift tok
            return nil
          end
          elem = parse()
          break if elem == nil
          elems[key] = elem
          tok = shift
          case tok[0]
          when :rbracket
            break
          when :comma
            next
          else
            unshift tok
            return nil
          end
        end
        return HsRecordPart.new(elems)
      else
        unshift tok
        return nil
      end
      nil
    end

    def tokenize
      while @index < @code.size
        token =  next_token(@code[(@index)..-1])
        @index += token[1].size
        @tokens << token unless token[0] == :space
      end
    end
    def shift()
      @tokens.shift
    end
    def unshift(token)
      @tokens.unshift token
    end

    def next_token(code)
      case code
      when /^(\s+)/
        [:space, $1]
      when /^(\{)/
        [:lbrace, $1]
      when /^(\})/
        [:rbrace, $1]
      when /^(\[)/
        [:lbracket, $1]
      when /^(\])/
        [:rbracket, $1]
      when /^(\()/
        [:lparen, $1]
      when /^(\))/
        [:rparen, $1]
      when /^([,])/
        [:comma, $1]
      when /^([=])/
        [:equal, $1]
      when /^([A-Za-z_][A-Za-z0-9_]*)/
        [:identifier, $1]
      when /^([-+]?[0-9]+([.][0-9]+)?(e[0-9]+)?)/
        [:numeric, $1]
      when /^(\"(\\\"|[^"])*\")/
        [:string, $1]
      end
    end
  end

  class HsNumeric
    def initialize(str)
      @core = str
    end
    def to_hs
      @core.to_s
    end
    def to_rb
      @core
    end
  end
  class HsString
    def initialize(str)
      @core = str
    end
    def to_hs
      core = @core.to_s.sub("\\", "\\\\")
      core = core.sub("\"", "\\\"")
      core = core.sub("\n", "\\n")
      core = core.sub("\r", "\\r")
      core = core.sub("\t", "\\t")
      core = core.sub("\b", "\\b")
      result = "\"" + core + "\""
      result
    end
    def to_rb
      @core
    end
  end
  class HsList
    def initialize(array)
      @core = array
    end
    def to_hs
      result = "["
      i = 0
      @core.each do |elem|
        i += 1
        result += elem.to_hs
        result += ", " unless i == @core.size
      end
      result += "]"
      result
    end
    def to_rb
      result = []
      @core.each do |elem|
        result << elem.to_rb
      end
      result
    end
  end
  class HsTuple
    def initialize(array)
      @core = array
    end
    def to_hs
      result = "("
      i = 0
      @core.each do |elem|
        i += 1
        result += elem.to_hs
        result += ", " unless i == @core.size
      end
      result += ")"
      result
    end
    def to_rb
      result = []
      @core.each do |elem|
        result << elem.to_rb
      end
      result
    end
  end
  class HsData
    def initialize(name, child)
      @name = name
      @child = child
    end
    def to_hs
      result = @name.to_s
      result += @child.to_hs unless @child
      result
    end
    def to_rb
      @child.to_rb unless @child
    end
  end
  class HsRecordPart
    def initialize(child)
      @child = child
    end
    def to_hs
      result = "{"
      i = 0
      @core.each do |key, elem|
        i += 1
        result += key.to_s + " = " + elem.to_hs
        result += ", " unless i == @core.size
      end
      result += "}"
      result
    end
    def to_rb
      result = {}
      @core.each do |key, elem|
        result[key] = elem.to_rb
      end
      result
    end
  end

  class Source
    def initialize(source="")
      @source = source
      @main = nil
    end
    def main!(name, *args)
      @main = Decl.new(:main)
      body = "putStrLn.show $ " + name.to_s
      args.each do |arg|
        body += " " + arg.to_hs
      end
      body += "\n"
      @main.body = body
      @main
    end
    def to_s
      source = @source
      source += "\n" + @main.to_s if @main
      source
    end
  end

  class Decl
    def initialize(name, *args)
      @name = name
      @args = args
      @body = ""
      @where = nil
    end
    attr_accessor :body
    def where(source)
      @where = source
    end
    def to_s
      result = @name.to_s
      @args.each do |arg|
        result += " " + arg.to_hs
      end
      result += " = " + @body
      if @where
        result += " where \n"
        result += @where
      end
      result
    end
  end

  def self.run(code="", &block)
    src = Source.new code
    src.instance_eval(&block) if block
    runner = HsRunner.new
    result = runner.run(src.to_s)
    parser = RunHaskell::HsParser.new(result)
    parser.parse.to_rb
  end
end

class String
  def to_hs
    RunHaskell::HsString.new(self).to_hs
  end
end
class Numeric
  def to_hs
    RunHaskell::HsNumeric.new(self).to_hs
  end
end
class Array
  def to_hs
    hs_list.to_hs
  end
  def hs_list
    RunHaskell::HsList.new(self)
  end
  def hs_tuple
    RunHaskell::HsTuple.new(self)
  end
end
class Hash
  def hs_data(name)
    RunHaskell::HsData.new(name, RunHaskell::HsRecordPart.new(self))
  end
end
class Symbol
  def to_hs
    self.to_s
  end
end