facets 1.1.0 → 1.2.0

data/lib/facets/more/ioredirect.rb

@@ -0,0 +1,130 @@
+#--
+# IORedirect
+#
+# Copyright (C) 2002 Paul Brannan <paul@atdesk.com>
+# (Ported from Ruby Treasures)
+#
+# Ruby License
+#
+# This module is free software. You may use, modify, and/or redistribute this
+# software under the same terms as Ruby.
+#
+# This program is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+# FOR A PARTICULAR PURPOSE.
+#
+#
+# ==========================================================================
+# Revision History ::
+# --------------------------------------------------------------------------
+#  2004-09  Trans    * Ported to Calibre.
+# ==========================================================================
+#++
+
+#:title: IORedirect
+#
+# A class to redirect $stdout, or other IO object, to a StringIO object,
+# or any other object with a write() method.
+#
+# == Synopsis
+#
+#   require 'mega/io-redirect'
+#
+#   s = StringIO.new
+#   r = Redirector.redirect($stdout, s) do
+#     $stdout.puts "this is a test"
+#   end
+#
+# == Author(s)
+#
+# * Paul Brannan
+#
+
+class IORedirect
+
+  # Start redirection from one IO object to any other object with a
+  # write() method. +from+ is the IO object to redirect from,
+  # and +to+ is the object to redirect to.
+  def initialize(from, to)
+    @from = from
+    @to = to
+    start()
+  end
+
+  # Start redirection, if it has not already been started.
+  def start
+    raise "Redirection already in progress" if @t
+    tmp = @from.dup        
+    r, w = IO.pipe
+    @from.reopen(w)
+    @t = Thread.new do
+      begin
+        loop do
+          s = r.read(1) # TODO: can I make this buffered?
+          @to.write(s)
+        end
+      ensure
+        @from.reopen(tmp)
+        @t = nil
+      end
+    end
+  end
+
+  # Stop redirection, if it is occurring
+  def stop
+    raise "Redirection already stopped" if not @t
+    @t.kill
+  end
+
+  # An exception-safe class method for redirection
+  def self.redirect(from, to)
+    s = self.new(from, to)
+    begin
+      yield
+    ensure
+      s.stop
+    end
+  end
+end
+
+
+# --- test ---
+
+if __FILE__ == $0 then
+  
+  class SimpleStringIO
+    attr_reader :str
+    def initialize; @str = ''; end
+    def write(str); @str << str; end
+  end
+
+  Thread.abort_on_exception = true
+  s = SimpleStringIO.new
+  r = Redirector.redirect($stdout, s) do
+    $stdout.puts "this is a test"
+    $stdout.puts "of the StringIO redirection system"
+  end
+  puts "Done redirecting."
+  puts "Result:\n#{s.str}"
+
+end
+
+
+
+#  _____         _
+# |_   _|__  ___| |_
+#   | |/ _ \/ __| __|
+#   | |  __/\__ \ |_
+#   |_|\___||___/\__|
+#
+
+# TODO
+
+=begin #testing
+
+  require 'test/unit'
+
+=end
+
+
+

data/lib/facets/more/lisp.rb

@@ -0,0 +1,387 @@
+#--
+# Lisp Mixin
+#
+# Copyright (C) 2003,2004 Florian Frank
+#
+# Ruby License
+#
+# This module is free software. You may use, modify, and/or redistribute this
+# software under the same terms as Ruby.
+#
+# This program is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+# FOR A PARTICULAR PURPOSE.
+#
+#
+# ==========================================================================
+# Revision History ::
+# --------------------------------------------------------------------------
+#  2005.04.12  1.1  TO   * Changed the name of Pair class to DottedPair.
+#                        * Added a new method #pair! which converts an array 
+#                          to a DottedPair. This is then used in #car and
+#                          #cdr to automatically convert arrays passed to 'em.
+#                        * Note: There may be other places that #pair! 
+#                          conversion is needed.
+# ==========================================================================
+#++
+
+#:title: Lisp Mixin
+#
+# This module provides Lisp-like functional notation.
+# With this module it almost possible to write real
+# Lisp code in Ruby.
+#
+# == Usage
+#
+# It's hardly believable, but the following IS valid ruby code:
+#
+#   (def accumulate (fun, x, list)
+#     (if (null? list)
+#       x
+#     else
+#       (accumulate fun, (fun.call x, (car list)), (cdr list))
+#     end)
+#   end)
+#
+# A real programmer can write LISP in any language ;)
+#
+# == Author(s)
+#
+# * Florian Frank
+#
+
+module Lisp
+
+  # DottedPair
+
+  class DottedPair
+
+    include Lisp
+    include Enumerable
+
+    def initialize(first = nil, second = nil)
+      @first, @second = first, second
+    end
+
+    attr_accessor :first, :second
+
+    def DottedPair.[](*array)
+      if array.empty?
+        nil
+      else
+        DottedPair.new(array.shift, DottedPair[*array])
+      end
+    end
+
+    def each(&block)
+      if @first
+        if @first.is_a? DottedPair
+          @first.each(&block)
+        else
+          block.call(@first)
+        end
+      end
+      if @second
+        if @second.is_a? DottedPair
+          @second.each(&block)
+        else
+          block.call(@second)
+        end
+      end
+    end
+
+    def to_s
+      '(' + repr + ')'
+    end
+
+    def inspect
+      '(' + repr + ')'
+    end
+
+    def to_a
+      a = []
+      each { |e| a << e }
+      a
+    end
+
+    def ==(other)
+      if pair?(self) and pair?(other)
+        car(self) == car(other) and cdr(self) == cdr(other)
+      else
+        if pair?(self) then false else self == other end
+      end
+    end
+
+    protected
+
+    def repr
+      case @second
+        when DottedPair then @first.to_s + ' ' + @second.repr
+        when nil then @first.to_s
+        else @first.to_s + ' . ' + @second.to_s
+      end
+    end
+
+  end # DottedPair
+
+  # Functional API
+
+  def cons(car, cdr)
+    DottedPair.new(car, cdr)
+  end
+
+  def consonto(cdr, car)
+    DottedPair.new(car, cdr)
+  end
+
+  def car(pair)
+    pair = pair!(pair)
+    pair.first
+  end
+
+  def cdr(pair)
+    pair = pair!(pair)
+    pair.second
+  end
+
+  def set(var, val, binding)
+    eval "var = #{val}", binding
+  end
+
+  def set_car!(pair, val)
+    pair.first = val
+  end
+
+  def set_cdr!(pair, val)
+    pair.second = val
+  end
+
+  def null?(x)
+    x == nil
+  end
+
+  def pair?(x)
+    x.is_a?(DottedPair)
+  end
+
+  def pair!(x)
+    return x if pair?(x)
+    return DottedPair[*x]
+  end
+
+  def atom?(x)
+    not pair?(x) || null?(x)
+  end
+
+  def equal?(l, m)
+    l == m
+  end
+
+  def list(*elms)
+    if elms.empty?
+      nil
+    else
+      cons(elms.shift, list(*elms))
+    end
+  end
+
+  def append(l, m)
+    if null?(l)
+      if null?(m)
+        nil
+      else
+        cons(car(m), append(l, cdr(m)))
+      end
+    else
+      cons(car(l), append(cdr(l), m))
+    end
+  end
+
+  def length(list)
+    if null?(list)
+      0
+    else
+      1 + length(cdr(list))
+    end
+  end
+
+  def map(fun, list)
+    if null?(list)
+      nil
+    else
+      cons(fun.call(car(list)), map(fun, cdr(list)))
+    end
+  end
+
+  def zip(fun, l, m)
+    if null?(l) and null?(m)
+      nil
+    elsif null?(l) or null?(m)
+      raise ArgumentError.new("zip with unequal length lists")
+    else
+      cons(fun.call(car(l), car(m)), zip(fun, cdr(l), cdr(m)))
+    end
+  end
+
+  def pairlis(l, m)
+    zip(lambda { |x, y| cons(x, y) }, l, m)
+  end
+
+  def member?(x, list)
+    if null?(list)
+      false
+    else
+      if x == car(list)
+        true
+      else
+        member?(x, cdr(list))
+      end
+    end
+  end
+
+  def filter(pred, list)
+    if null?(list)
+      nil
+    else
+      if pred.call(car(list))
+        cons(car(list), filter(pred, cdr(list)))
+      else
+        filter(pred, cdr(list))
+      end
+    end
+  end
+
+  def assoc(x, list)
+    f = filter(lambda { |y| x == car(y)}, list)
+    if null?(f) then nil else car(f) end
+  end
+
+  def exists?(pred, list)
+    if null?(list)
+      false
+    else
+      if pred.call(car(list))
+        true
+      else
+        exists?(pred, cdr(list))
+      end
+    end
+  end
+
+  def all?(pred, list)
+    if null?(list)
+      true
+    else
+      if pred.call(car(list))
+        all?(pred, cdr(list))
+      else
+        false
+      end
+    end
+  end
+
+  def accumulate(fun, x, list)
+    if null?(list)
+      x
+    else
+      accumulate(fun, fun.call(x, car(list)), cdr(list))
+    end
+  end
+
+  alias foldleft accumulate
+
+  def reduce(fun, x, list)
+    if null?(list)
+      x
+    else
+      fun.call(car(list), reduce(fun, x, cdr(list)))
+    end
+  end
+
+  alias foldright reduce
+
+  def link(lists)
+    accumulate(lambda { |x, y| append(x, y) }, nil, lists)
+  end
+
+  def explode(string)
+    list(*(string.split(//)))
+  end
+
+  def implode(list)
+    accumulate(lambda { |x, y| x + y }, '', list)
+  end
+
+  def sum(list)
+    accumulate(lambda { |x, y| x + y }, 0, list)
+  end
+
+  def prod(list)
+    accumulate(lambda { |x, y| x * y }, 1, list)
+  end
+
+  def reverse(lists)
+    accumulate(lambda { |x, y| consonto(x, y) }, nil, lists)
+  end
+
+  def take(l, n)
+    if n > 0 and not null?(l)
+      cons(car(l), take(cdr(l), n - 1))
+    else
+      nil
+    end
+  end
+
+  def drop(l, n)
+    if n > 0 and not null?(l)
+        drop(cdr(l), n - 1)
+    else
+        l
+    end
+  end
+
+end
+
+
+
+#  _____         _
+# |_   _|__  ___| |_
+#   | |/ _ \/ __| __|
+#   | |  __/\__ \ |_
+#   |_|\___||___/\__|
+#
+
+=begin test
+
+  require 'test/unit'
+
+  # fixture
+
+  class T
+
+    include Lisp
+
+    (def accumulate (fun, x, list)
+      (if (null? list)
+        x
+      else
+        (accumulate fun, (fun.call x, (car list)), (cdr list))
+      end)
+    end)
+
+  end
+
+  # test
+
+  class TC_Lisp < Test::Unit::TestCase
+
+    include Lisp
+
+    def test_accumulate
+      t = T.new
+      t.accumulate( proc{ |x,y| x+y }, 0, [1,2,3] )
+    end
+
+  end
+
+=end