carats 0.3.0

data/lib/carat/lisp.rb

@@ -0,0 +1,336 @@
+=begin rdoc
+
+= Lisp Mixin
+
+This module provides Lisp-like functional notation.
+With this module it almost possibel to write real
+Lisp code in Ruby.
+
+== Example
+
+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
+* Thomas Sawyer
+
+== Legal
+
+Based on original work func.rb by Florain Frank.
+Copyright (c)2005 Florian Frank <flori@ping.de>
+Ruby License
+
+== History
+
+* 2005.04.12 
+** 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 them.
+** Note: There may be other places that #pair! conversion is needed.
+
+=end
+
+module Lisp
+
+  VERSION = 1.1
+
+  # 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
+
+  # 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

data/lib/carat/macro.rb

@@ -0,0 +1,68 @@
+# = Module Macros
+#
+# A macro construction for creating dynamic mixins.
+#
+# == Example
+#
+#   module Mixin
+#     macro { |options| %{
+#       def hello
+#         puts 'Hello from #{options[:name]}'
+#       end
+#     } }
+#   end
+#
+#   class MyClass
+#     include Mixin, :name => 'tml'
+#   end
+#
+#   m = MyClass.new
+#   m.hello -> 'Hello from tml'
+#
+# == Author
+#
+#   Based on original code by George Moschovitis <gm@navel.gr>
+#
+class Module
+
+  def macro( &blk )
+    (@macros ||= []) << blk
+  end
+
+  def macros ; @macros ||= [] ; end
+
+  alias_method :include_without_macros, :include
+
+  def include(*args)
+    options = args.last.is_a?(Hash) ? args.pop : {}
+    for mod in args
+      mod.append_dynamic_features( self, options )
+    end
+    include_without_macros(*args)
+  end
+
+  # Note: Is this the best name for this callback?
+  def append_dynamic_features( base, options )
+    macros.each do |m|
+      base.class_eval m.call( options )
+    end
+  end
+
+  alias_method :extend_without_macros, :extend
+  
+  def extend(*args)
+    options = args.last.is_a?(Hash) ? args.pop : {}
+    for mod in args
+      mod.extend_dynamic_object( self, options )
+    end
+    extend_without_macros(*args)
+  end
+
+  # Note: Is this the best name for this callback?
+  def extend_dynamic_object( base, options )
+    macros.each do |m|
+      (class << base; self ; end).class_eval m.call( options )
+    end
+  end
+
+end

data/lib/carat/multiton.rb

@@ -0,0 +1,153 @@
+=begin rdoc
+
+= Multiton
+
+Multiton module that ensures only one object to be allocated for a given
+argument list.
+
+The 'multiton' pattern is similar to a singleton, but instead of only one
+instance, there are several similar instances.  it's usefull when you want to
+avoid constructing objects many times because of some huge expence (connecting
+to a database for example), require a set of similar but not identical
+objects, and cannot easily control how many time a contructor may be called.
+
+== Synopsis
+
+  require 'carat/multiton'
+
+  class SomeMultitonClass
+    include Multiton
+    attr :arg
+    def initialize(arg)
+      @arg = arg
+    end
+  end
+  
+  a = SomeMultitonClass.instance(4)
+  b = SomeMultitonClass.instance(4)	 # a and b are same object
+  c = SomeMultitonClass.instance(2)  # c is a different object
+ 
+In previous versions the Class.new method was made private, but for
+Semi Multitons this restriction has been lifted with the following 
+caveat: Class.instance will attempt to retreive a previously cached
+object, constructing one if needed, but Class.new will *always* 
+construct a new object - this should allow great flexiblity with
+multiton classes.
+
+== How It Works
+
+We try to use a previously cached object, if one is not found
+we construct one and cache it in the pool based on class and 
+the args given to the contructor
+
+note: a limitation of this approach is that it is impossible to
+detect if different blocks were given to a contructor (if it takes a
+block.  Thus, it is the constructor *args _exclusively_ which determine
+the uniqueness of an object. A workaround is for the class to define
+the _class_ method multiton_id, eg:
+
+  def Klass.multiton_id(*args, &block)
+    # ...
+  end
+
+Which should return a hash key used to identify the object being
+constructed as (not) unique.
+
+== Author(s)
+
+* Thomas Sawyer
+
+== Legal
+
+Ruby License
+Copyright (c)2005 Thomas Sawyer
+
+== History
+
+* 2005.04.12  Passed basic tests.
+
+=end
+
+
+module Multiton
+
+  VERSION = "2.0"
+
+  # pools of objects cached on class type
+  POOLS = {}
+
+  # method which can be defined by a class to determine object uniqueness
+  MULTITON_ID_HOOK = :multiton_id
+
+  # method which can be defined by a class to create multiton objects 
+  MULTITON_NEW_HOOK = :multiton_new
+
+  def self.append_features(klass)
+    klass.private_class_method(:new)
+    def klass.instance(*args, &block)
+      # if the class defined 'multiton_id' we use this as the key
+      # otherwise we simply use the argument list.
+      k = (respond_to?(MULTITON_ID_HOOK) ? send(MULTITON_ID_HOOK, *args, &block) : args)
+      unless (obj = (POOLS[self] ||= {})[k])
+        begin
+          critical = Thread.critical
+          Thread.critical = true
+          meth = self.respond_to?(MULTITON_NEW_HOOK) ? MULTITON_NEW_HOOK : :new
+          obj = (POOLS[self][k] = self.send(meth, *args, &block))
+        ensure
+          Thread.critical = critical # restore state
+        end
+      end
+      return obj
+    end
+  end
+  
+  # A new-multiton uses the #new method rather than the #instance method.
+  module New
+    def self.append_features(klass)
+      def klass.new(*args, &block)
+        # if the class defined 'multiton_id' we use this as the key
+        # otherwise we simply use the argument list.
+        k = (respond_to?(MULTITON_ID_HOOK) ? send(MULTITON_ID_HOOK, *args, &block) : args)
+        unless (obj = (POOLS[self] ||= {})[k])
+          begin
+            critical = Thread.critical
+            Thread.critical = true
+            if self.respond_to?(MULTITON_NEW_HOOK)
+              obj = (POOLS[self][k] = self.send(MULTITON_NEW_HOOK, *args, &block))
+            else
+              obj = super
+            end
+          ensure
+            Thread.critical = critical # restore state
+          end
+        end
+        return obj
+      end
+    end
+  end
+
+  #
+  module Semi
+    def self.append_features(klass)
+      def klass.instance(*args, &block)
+        # if the class defined 'multiton_id' we use this as the key
+        # otherwise we simply use the argument list.
+        k = (respond_to?(MULTITON_ID_HOOK) ? send(MULTITON_ID_HOOK, *args, &block) : args)
+        unless (obj = (POOLS[self] ||= {})[k])
+          begin
+            critical = Thread.critical
+            Thread.critical = true
+            meth = self.respond_to?(MULTITON_NEW_HOOK) ? MULTITON_NEW_HOOK : :new
+            obj = (POOLS[self][k] = self.send(meth, *args, &block))
+          ensure
+            Thread.critical = critical # restore state
+          end
+        end
+        return obj
+      end
+    end
+  end
+
+end
+