GTof-ruby-do-notation 0.2

data/Manifest

@@ -0,0 +1,15 @@
+lib/do_notation/monad.rb
+lib/do_notation/monad_plus.rb
+lib/do_notation/monads/array.rb
+lib/do_notation/monads/maybe.rb
+lib/do_notation/monads/simulations.rb
+lib/do_notation/rewriter.rb
+lib/do_notation.rb
+README.markdown
+test/array.rb
+test/maybe.rb
+test/monad_plus.rb
+test/simulations.rb
+test/spec_helper.rb
+test/specs.rb
+Manifest

data/README.markdown

@@ -0,0 +1,34 @@
+Haskell-style monad do-notation for Ruby
+========================================
+
+Example:
+
+    class Array
+      include Monad
+      
+      def self.unit x
+        [x]
+      end
+      
+      def bind &f
+        map(&f).inject([]){ |a,b| a+b }
+      end
+    end
+    
+    Array.run do
+      x <- ["first", "second"]
+      y <- ["once", "twice"]
+  
+      unit("#{x} cousin #{y} removed")
+    end
+
+The above code returns the array:
+
+    ["first cousin once removed",
+     "first cousin twice removed",
+     "second cousin once removed",
+     "second cousin twice removed"]
+
+For more examples, see the test suite.
+
+By Aanand Prasad (aanand.prasad@gmail.com)

data/Rakefile

@@ -0,0 +1,27 @@
+require 'spec/rake/spectask'
+
+spec_list = FileList['test/*.rb']
+
+task :default => :test
+
+desc "Run all specs"
+Spec::Rake::SpecTask.new('spec') do |t|
+  t.spec_files = spec_list
+end
+
+desc "Run all specs with RCov"
+Spec::Rake::SpecTask.new('rcov') do |t|
+  t.spec_files = spec_list
+  t.rcov = true
+end
+
+require 'echoe'
+
+Echoe.new('ruby-do-notation') do |p|
+  p.author = 'Aanand Prasad'
+  p.summary = 'Haskell-style monad do-notation for Ruby'
+  p.email = 'aanand.prasad@gmail.com'
+  p.url = 'http://github.com/aanand/ruby-do-notation/tree/master'
+  p.version = '0.2'
+  p.dependencies = ['ParseTree', 'ruby2ruby']
+end

data/lib/do_notation.rb

@@ -0,0 +1,9 @@
+$: << File.dirname(__FILE__)
+
+require 'rubygems'
+require 'parse_tree'
+require 'sexp_processor'
+require 'ruby2ruby'
+
+require 'do_notation/rewriter'
+require 'do_notation/monad'

data/lib/do_notation/monad.rb

@@ -0,0 +1,101 @@
+# Modeled after Andrzej Filinski's article "Representing
+# Monads" at POPL'94, and a Scheme implementation of it.
+# http://citeseer.ist.psu.edu/filinski94representing.html
+
+module ShiftReset
+  @@metacont = lambda { |x|
+    raise RuntimeError, "You forgot the top-level reset..."
+  }
+
+  def reset(&block)
+    mc = @@metacont
+    callcc { |k|
+      @@metacont = lambda { |v|
+        @@metacont = mc
+        k.call v
+      }
+      x = block.call
+      @@metacont.call x
+    }
+  end
+
+  def shift(&block)
+    callcc { |k|
+      @@metacont.call block.call(lambda { |*v| reset { k.call *v } })
+    }
+  end
+end
+
+include ShiftReset
+
+module Monad
+  module ClassMethods
+    def run &block
+      eval(ruby_for(block), block).call
+    end
+
+    def ruby_for block
+      @cached_ruby ||= {}
+      @cached_ruby[block.to_s] ||= "#{self.name}.instance_eval { #{Ruby2Ruby.new.process(Rewriter.new.process(block.to_method.to_sexp)[2])} }"
+    end
+
+    def sequence l
+      if l.empty?
+       unit([])
+      else
+         run do
+           x <- l[0]
+           q <- sequence(l[1..-1])
+           unit([x] + q)
+         end
+      end
+    end
+
+    def foldM(i,l, &f)
+      if l.empty?
+       unit(i)
+      else
+         run do
+           x <- f.call(i,l[0])
+           foldM(x,l[1..-1]) { |a,b| f.call(a,b) }
+         end
+      end
+    end
+
+    def fmap f
+      lambda { |m| m.bind { |y| unit(f.call(y)) } }
+    end
+
+    def reify &t
+      reset { unit( t.call() ) }
+    end
+
+    def reflect m
+      shift { |k| m.bind { |v| k.call(v) } }
+    end
+  end
+
+  def self.included m
+    m.extend ClassMethods
+  end
+
+  def bind_const &block
+    bind { |_| block.call() }
+  end
+
+  def >> n
+    bind_const { n }
+  end
+
+  def joinM
+    bind { |n| n }
+  end
+
+  # I don't know why this reflect doesn't work
+  # the class method seems to be the same and work
+  # the evaluation moment of the shift in a class method
+  # and in a method may be different
+  def reflect_that_doesnt_work
+    shift { |k| bind { |v| k.call(v) } }
+  end
+end

data/lib/do_notation/monad_plus.rb

@@ -0,0 +1,9 @@
+module MonadPlus
+  def guard p
+    if p
+      unit(mzero)
+    else
+      mzero
+    end
+  end
+end

data/lib/do_notation/monads/array.rb

@@ -0,0 +1,21 @@
+require 'do_notation/monad_plus'
+
+class Array
+  include Monad
+
+  def self.unit x
+    [x]
+  end
+  
+  def bind &f
+    map(&f).inject([]){ |a,b| a+b }
+  end
+  
+  extend MonadPlus
+  
+  def self.mzero
+    []
+  end
+  
+  alias_method :mplus, :+
+end

data/lib/do_notation/monads/maybe.rb

@@ -0,0 +1,31 @@
+require 'do_notation/monad_plus'
+
+class Maybe < Struct.new(:value)
+  include Monad
+  
+  def self.unit value
+    self.new(value)
+  end
+  
+  def bind &f
+    if value.nil?
+      self
+    else
+      f.call(value)
+    end
+  end
+  
+  extend MonadPlus
+  
+  def self.mzero
+    unit(nil)
+  end
+  
+  def mplus m
+    if value.nil?
+      m
+    else
+      self
+    end
+  end
+end

data/lib/do_notation/monads/simulations.rb

@@ -0,0 +1,117 @@
+# converted from Mauricio Fernandez's "Warm fuzzy things for random simulations":
+# http://eigenclass.org/hiki/warm-fuzzy-things-for-random-simulations
+# http://eigenclass.org/hiki.rb?c=plugin;plugin=attach_download;p=warm-fuzzy-things-for-random-simulations;file_name=fuzzy-warm-simulations.rb
+
+module PRNG 
+  def next_state(s); (69069 * s + 5) % (2**32) end
+end
+
+class Simulation
+  extend PRNG
+  include Monad
+  
+  attr_reader :f
+
+  def initialize(&b)
+    @f = b
+  end
+  
+  def self.unit(x)
+    new { |s| [x, s] }
+  end
+  
+  def self.rand(n)
+    self.new do |s|
+      [s.abs % n, next_state(s)]
+    end
+  end
+
+  def bind(&b)
+    self.class.new do |s|
+      x, s = @f.call(s)
+      b.call(x).f.call(s)
+    end
+  end
+  
+  def play(s = 12345)
+    @f.call(s).first
+  end
+end
+
+class Distribution
+  extend PRNG
+  include Monad
+  
+  attr_reader :a
+
+  def initialize(a)
+    @a = a
+  end
+  
+  def self.wrap(a)
+    new(a)
+  end
+  
+  def self.unit(x)
+    wrap [[x, 1.0]]
+  end
+
+  def self.rand(n) 
+    p = 1.0 / n
+    new((0...n).map{|i| [i, p]})
+  end
+
+  def bind(&b)
+    if @a.empty?
+      self.class.wrap([])
+    else
+      x, p = @a[0]
+      self.class.wrap(mulp(p, b.call(x)) + self.class.new(@a[1..-1]).bind(&b).a)
+    end
+  end
+
+  def play
+    h = Hash.new{|h, k| h[k] = 0.0}
+    @a.each{|x, p| h[x] += p}
+    h.to_a.sort_by{|x,| x}
+  end
+
+  private
+  def mulp(p, l)
+    l.a.map{|x, p1| [x, p * p1]}
+  end
+end
+
+class Expectation
+  extend PRNG
+  include Monad
+  
+  attr_reader :f
+
+  def initialize(&b)
+    @f = b
+  end
+  
+  def self.wrap(&proc)
+    new(&proc)
+  end
+
+  def self.unit(x)
+    wrap{ |f| f.call(x) }
+  end
+
+  def self.rand(n)
+    wrap do |k|
+      sum = (0..n-1).map{|x| k.call(x)}.inject{|s,x| s+x}
+      1.0 * sum / n
+    end
+  end
+
+  def bind(&b)
+    self.class.wrap{|k| @f.call(lambda{|x| b.call(x).f.call(k)}) }
+  end
+
+  def play(x)
+    @f.call(lambda{|x1| x1 == x ? 1.0 : 0.0})
+  end
+end

data/lib/do_notation/rewriter.rb

@@ -0,0 +1,63 @@
+class Rewriter < SexpProcessor
+  def process_bmethod exp
+    type = exp.shift
+  
+    exp.shift # throw away arguments
+  
+    body = process(exp.shift)
+  
+    if body[0] == :block
+       body.shift
+    else
+       body = s([*body])
+    end
+
+    s(:iter,  s(:fcall, :proc),  nil, *rewrite_assignments(body))
+  end
+
+  def rewrite_assignments exp
+    return [] if exp.empty?
+  
+    head = exp.shift
+  
+    if head.first == :call and head[1].first == :vcall and head[2] == :< and head[3].first == :array and head[3][1].last == :-@
+      var_name = head[1][1]
+      expression = head[3][1][1]
+    
+      body = rewrite_assignments(exp)
+    
+      if body.first.is_a? Symbol
+        body = [s(*body)]
+      end
+    
+      [s(:iter,
+         s(:call, process(expression), :bind),
+         s(:dasgn_curr, var_name),
+         *body)]
+    elsif exp.empty?
+      [process(head)]
+    else
+      [s(:iter, s(:call, process(head)  , :bind_const), nil , 
+             *rewrite_assignments(exp)) ]
+    end
+  end
+
+  def self.pp(obj, indent='')
+    return obj.inspect unless obj.is_a? Array
+    return '()' if obj.empty?
+
+    str = '(' + pp(obj.first, indent + ' ')
+
+    if obj.length > 1
+      str << ' '
+
+      next_indent = indent + (' ' * str.length)
+
+      str << obj[1..-1].map{ |o| pp(o, next_indent) }.join("\n#{next_indent}")
+    end
+
+    str << ')'
+
+    str
+  end
+end

data/ruby-do-notation.gemspec

@@ -0,0 +1,38 @@
+Gem::Specification.new do |s|
+  s.name = %q{ruby-do-notation}
+  s.version = "0.2"
+
+  s.required_rubygems_version = Gem::Requirement.new(">= 1.2") if s.respond_to? :required_rubygems_version=
+  s.authors = ["Aanand Prasad"]
+  s.date = %q{2009-02-03}
+  s.description = %q{Haskell-style monad do-notation for Ruby}
+  s.email = %q{aanand.prasad@gmail.com}
+  s.extra_rdoc_files = ["lib/do_notation/monad.rb", "lib/do_notation/monad_plus.rb", "lib/do_notation/monads/array.rb", "lib/do_notation/monads/maybe.rb", "lib/do_notation/monads/simulations.rb", "lib/do_notation/rewriter.rb", "lib/do_notation.rb", "README.markdown"]
+  s.files = ["lib/do_notation/monad.rb", "lib/do_notation/monad_plus.rb", "lib/do_notation/monads/array.rb", "lib/do_notation/monads/maybe.rb", "lib/do_notation/monads/simulations.rb", "lib/do_notation/rewriter.rb", "lib/do_notation.rb", "README.markdown", "test/array.rb", "test/maybe.rb", "test/monad_plus.rb", "test/simulations.rb", "test/spec_helper.rb", "test/specs.rb", "Manifest", "ruby-do-notation.gemspec", "Rakefile"]
+  s.has_rdoc = true
+  s.homepage = %q{http://github.com/aanand/ruby-do-notation/tree/master}
+  s.rdoc_options = ["--line-numbers", "--inline-source", "--title", "Ruby-do-notation", "--main", "README.markdown"]
+  s.require_paths = ["lib"]
+  s.rubyforge_project = %q{ruby-do-notation}
+  s.rubygems_version = %q{1.2.0}
+  s.summary = %q{Haskell-style monad do-notation for Ruby}
+
+  if s.respond_to? :specification_version then
+    current_version = Gem::Specification::CURRENT_SPECIFICATION_VERSION
+    s.specification_version = 2
+
+    if current_version >= 3 then
+      s.add_runtime_dependency(%q<ParseTree>, [">= 0"])
+      s.add_runtime_dependency(%q<ruby2ruby>, [">= 0"])
+      s.add_development_dependency(%q<echoe>, [">= 0"])
+    else
+      s.add_dependency(%q<ParseTree>, [">= 0"])
+      s.add_dependency(%q<ruby2ruby>, [">= 0"])
+      s.add_dependency(%q<echoe>, [">= 0"])
+    end
+  else
+    s.add_dependency(%q<ParseTree>, [">= 0"])
+    s.add_dependency(%q<ruby2ruby>, [">= 0"])
+    s.add_dependency(%q<echoe>, [">= 0"])
+  end
+end

data/test/array.rb

@@ -0,0 +1,18 @@
+require File.join(File.dirname(__FILE__), 'spec_helper')
+require 'do_notation/monads/array'
+
+describe "Array:" do
+  specify "all results are calculated and concatenated" do
+    array = Array.run do
+      x <- ["first", "second"]
+      y <- ["once", "twice"]
+  
+      unit("#{x} cousin #{y} removed")
+    end
+
+    array.should == ["first cousin once removed",
+                     "first cousin twice removed",
+                     "second cousin once removed",
+                     "second cousin twice removed"]
+  end
+end

data/test/maybe.rb

@@ -0,0 +1,26 @@
+require File.join(File.dirname(__FILE__), 'spec_helper')
+require 'do_notation/monads/maybe'
+
+describe "Maybe:" do
+  specify "one or more nils results in nil" do
+    maybe = Maybe.run do
+      x <- unit(1)
+      y <- unit(nil)
+  
+      unit(x+y)
+    end
+
+    maybe.value.should == nil
+  end
+
+  specify "all non-nil results in complete calculation" do
+    maybe = Maybe.run do
+      x <- unit(1)
+      y <- unit(2)
+  
+      unit(x+y)
+    end
+    
+    maybe.value.should == 3
+  end
+end

data/test/monad_plus.rb

@@ -0,0 +1,37 @@
+require File.join(File.dirname(__FILE__), 'spec_helper')
+require 'do_notation/monads/array'
+require 'do_notation/monads/maybe'
+
+describe "MonadPlus:" do
+  specify "mzero >>= f = mzero" do
+    Array.mzero.bind{ |x| unit(x+1) }.should == Array.mzero
+    Maybe.mzero.bind{ |x| unit(x+1) }.should == Maybe.mzero
+  end
+  
+  specify "v >> mzero = mzero" do
+    ([1,2,3] >> Array.mzero).should == Array.mzero
+    (Maybe.unit(1) >> Maybe.mzero).should == Maybe.mzero
+  end
+  
+  specify "mzero `mplus` m = m" do
+    Array.mzero.mplus([1,2,3]).should == [1,2,3]
+    Maybe.mzero.mplus(Maybe.unit(1)).should == Maybe.unit(1)
+  end
+  
+  specify "m `mplus` mzero = m" do
+    [1,2,3].mplus(Array.mzero).should == [1,2,3]
+    Maybe.unit(1).mplus(Maybe.mzero).should == Maybe.unit(1)
+  end
+
+  specify "guard() prunes the execution tree" do
+    array = Array.run do
+      x <- [0,1,2,3]
+      y <- [0,1,2,3]
+      guard(x + y == 3)
+
+      unit([x,y])
+    end
+
+    array.should == [[0, 3], [1, 2], [2, 1], [3, 0]]
+  end
+end

data/test/simulations.rb

@@ -0,0 +1,46 @@
+require File.join(File.dirname(__FILE__), 'spec_helper')
+require 'do_notation/monads/simulations'
+
+roll_3d6 = proc do
+  d1 <- rand(6)
+  d2 <- rand(6)
+  d3 <- rand(6)
+  
+  unit(1+d1 + 1+d2 + 1+d3)
+end
+
+roll_3d6_b = proc do
+  d1 <- rand(6)
+  d2 <- rand(6)
+  d3 <- rand(6)
+  
+  if [d1, d2, d3].include?(5)
+    run do
+      d4 <- rand(6)
+      unit(1+d1 + 1+d2 + 1+d3 + 1+d4)
+    end
+  else
+    unit(1+d1 + 1+d2 + 1+d3)
+  end
+end
+
+describe "Simulation" do
+  specify "generates correct answers" do
+    Simulation.run(&roll_3d6).play.should   == 9
+    Simulation.run(&roll_3d6_b).play.should == 9
+  end
+end
+
+describe "Distribution" do
+  specify "generates correct answers" do
+    Distribution.run(&roll_3d6).play.inspect.should == "[[3, 0.00462962962962963], [4, 0.0138888888888889], [5, 0.0277777777777778], [6, 0.0462962962962963], [7, 0.0694444444444444], [8, 0.0972222222222222], [9, 0.115740740740741], [10, 0.125], [11, 0.125], [12, 0.115740740740741], [13, 0.0972222222222222], [14, 0.0694444444444444], [15, 0.0462962962962963], [16, 0.0277777777777778], [17, 0.0138888888888889], [18, 0.00462962962962963]]"
+    Distribution.run(&roll_3d6_b).play.inspect.should == "[[3, 0.00462962962962963], [4, 0.0138888888888889], [5, 0.0277777777777778], [6, 0.0462962962962963], [7, 0.0694444444444444], [8, 0.0833333333333333], [9, 0.0902777777777777], [10, 0.0902777777777778], [11, 0.0833333333333333], [12, 0.0694444444444445], [13, 0.0625000000000001], [14, 0.0601851851851853], [15, 0.0578703703703705], [16, 0.0555555555555557], [17, 0.0532407407407408], [18, 0.0462962962962964], [19, 0.0354938271604938], [20, 0.0239197530864198], [21, 0.0146604938271605], [22, 0.00771604938271605], [23, 0.00308641975308642], [24, 0.000771604938271605]]"
+  end
+end
+
+describe "Expectation" do
+  specify "generates correct answers" do
+    (1..21).collect { |x| Expectation.run(&roll_3d6).play(x) }.inspect.should == "[0.0, 0.0, 0.00462962962962963, 0.0138888888888889, 0.0277777777777778, 0.0462962962962963, 0.0694444444444444, 0.0972222222222222, 0.115740740740741, 0.125, 0.125, 0.115740740740741, 0.0972222222222222, 0.0694444444444444, 0.0462962962962963, 0.0277777777777778, 0.0138888888888889, 0.00462962962962963, 0.0, 0.0, 0.0]"
+    (1..21).collect { |x| Expectation.run(&roll_3d6_b).play(x) }.inspect.should == "[0.0, 0.0, 0.00462962962962963, 0.0138888888888889, 0.0277777777777778, 0.0462962962962963, 0.0694444444444444, 0.0833333333333333, 0.0902777777777778, 0.0902777777777777, 0.0833333333333333, 0.0694444444444444, 0.0625, 0.0601851851851852, 0.0578703703703704, 0.0555555555555556, 0.0532407407407407, 0.0462962962962963, 0.0354938271604938, 0.0239197530864197, 0.0146604938271605]"
+  end
+end

data/test/spec_helper.rb

@@ -0,0 +1 @@
+require File.join(File.dirname(__FILE__), %w(.. lib do_notation))

data/test/specs.rb

@@ -0,0 +1,66 @@
+require File.join(File.dirname(__FILE__), 'spec_helper')
+require 'do_notation/monads/array'
+
+describe "Monad.run" do
+  specify "should have lexical scope" do
+    foo = "cousin"
+    bar = "removed"
+
+    array = Array.run do
+      x <- ["first", "second"]
+      y <- ["once", "twice"]
+
+      unit("#{x} #{foo} #{y} #{bar}")
+    end
+
+    array.should == ["first cousin once removed",
+                     "first cousin twice removed",
+                     "second cousin once removed",
+                     "second cousin twice removed"]
+  end
+  
+  specify "should be nestable" do
+    array = Array.run do
+      x <- run do
+        a <- ['A','a']
+        b <- ['B','b']
+
+        unit(a+b)
+      end
+
+      y <- run do
+        c <- ['C','c']
+        d <- ['D','d']
+
+        unit(c+d)
+      end
+
+      unit(x+y)
+    end
+    
+    array.should == ["ABCD", "ABCd", "ABcD", "ABcd",
+                     "AbCD", "AbCd", "AbcD", "Abcd",
+                     "aBCD", "aBCd", "aBcD", "aBcd",
+                     "abCD", "abCd", "abcD", "abcd"]
+  end
+end
+
+describe 'Monad#>>' do
+  specify "should compose two values, discarding the first" do
+    ([1] >> [2]).should == [2]
+  end
+end
+
+describe "Rewriter.pp" do
+  specify "should produce correct output" do
+    array = [:a, [:b],
+                 [:c, :d,
+                      :e]]
+
+    Rewriter.pp(array).should == <<CODE.strip
+(:a (:b)
+    (:c :d
+        :e))
+CODE
+  end
+end

metadata

@@ -0,0 +1,107 @@
+--- !ruby/object:Gem::Specification 
+name: GTof-ruby-do-notation
+version: !ruby/object:Gem::Version 
+  version: "0.2"
+platform: ruby
+authors: 
+- Aanand Prasad
+autorequire: 
+bindir: bin
+cert_chain: []
+
+date: 2009-02-03 00:00:00 -08:00
+default_executable: 
+dependencies: 
+- !ruby/object:Gem::Dependency 
+  name: ParseTree
+  version_requirement: 
+  version_requirements: !ruby/object:Gem::Requirement 
+    requirements: 
+    - - ">="
+      - !ruby/object:Gem::Version 
+        version: "0"
+    version: 
+- !ruby/object:Gem::Dependency 
+  name: ruby2ruby
+  version_requirement: 
+  version_requirements: !ruby/object:Gem::Requirement 
+    requirements: 
+    - - ">="
+      - !ruby/object:Gem::Version 
+        version: "0"
+    version: 
+- !ruby/object:Gem::Dependency 
+  name: echoe
+  version_requirement: 
+  version_requirements: !ruby/object:Gem::Requirement 
+    requirements: 
+    - - ">="
+      - !ruby/object:Gem::Version 
+        version: "0"
+    version: 
+description: Haskell-style monad do-notation for Ruby
+email: aanand.prasad@gmail.com
+executables: []
+
+extensions: []
+
+extra_rdoc_files: 
+- lib/do_notation/monad.rb
+- lib/do_notation/monad_plus.rb
+- lib/do_notation/monads/array.rb
+- lib/do_notation/monads/maybe.rb
+- lib/do_notation/monads/simulations.rb
+- lib/do_notation/rewriter.rb
+- lib/do_notation.rb
+- README.markdown
+files: 
+- lib/do_notation/monad.rb
+- lib/do_notation/monad_plus.rb
+- lib/do_notation/monads/array.rb
+- lib/do_notation/monads/maybe.rb
+- lib/do_notation/monads/simulations.rb
+- lib/do_notation/rewriter.rb
+- lib/do_notation.rb
+- README.markdown
+- test/array.rb
+- test/maybe.rb
+- test/monad_plus.rb
+- test/simulations.rb
+- test/spec_helper.rb
+- test/specs.rb
+- Manifest
+- ruby-do-notation.gemspec
+- Rakefile
+has_rdoc: true
+homepage: http://github.com/aanand/ruby-do-notation/tree/master
+post_install_message: 
+rdoc_options: 
+- --line-numbers
+- --inline-source
+- --title
+- Ruby-do-notation
+- --main
+- README.markdown
+require_paths: 
+- lib
+required_ruby_version: !ruby/object:Gem::Requirement 
+  requirements: 
+  - - ">="
+    - !ruby/object:Gem::Version 
+      version: "0"
+  version: 
+required_rubygems_version: !ruby/object:Gem::Requirement 
+  requirements: 
+  - - ">="
+    - !ruby/object:Gem::Version 
+      version: "1.2"
+  version: 
+requirements: []
+
+rubyforge_project: ruby-do-notation
+rubygems_version: 1.2.0
+signing_key: 
+specification_version: 2
+summary: Haskell-style monad do-notation for Ruby
+test_files: []
+