From 2fad6a18372476bc96094d4e1ad3508c943f64f0 Mon Sep 17 00:00:00 2001 From: Aanand Prasad Date: Mon, 14 Jan 2008 00:28:44 +0000 Subject: [PATCH] Now uses arrows!! Monad is now a module Got rid of List, mixed Monad into Array instead --- README | 29 ++++++++-- Rakefile | 3 + init.rb | 6 +- lib/array.rb | 11 ++++ lib/list.rb | 26 --------- lib/maybe.rb | 4 +- lib/monad.rb | 181 ++++++++++++++++++++++++++++++++-------------------------- monad.tmproj | 161 ++++++++++++++++++++++++++++++++++++++++++++++++++- test/specs.rb | 55 +++++++++++++----- 9 files changed, 342 insertions(+), 134 deletions(-) create mode 100644 Rakefile create mode 100644 lib/array.rb delete mode 100644 lib/list.rb rewrite lib/monad.rb (70%) diff --git a/README b/README index 2d31079..f6ea8a9 100644 --- a/README +++ b/README @@ -1,10 +1,27 @@ Haskell-style monad do-notation for Ruby -By Aanand Prasad (aanand.prasad@gmail.com) +Example: -A first attempt, nervous and shaky. It is liable -to drop its cigarette in fear if you look it -too closely in the eye. + class Array + extend Monad + + def self.unit x + [x] + end + + def bind &f + map(&f).inject([]){ |a,b| a+b } + end + end + + Array.run do + x <- ['A', 'a'] + y <- ['B', 'b'] + + unit(x+y) + end + + # => ["AB", "Ab", "aB", "ab"] Its biggest failing, and I don't see a way out, is that you don't get lexical scope. ParseTree @@ -15,4 +32,6 @@ stuff from the outside as arguments to `run', and specifying those arguments on the block you pass in as well. -Examples at the bottom. +For more examples, see the test suite. + +By Aanand Prasad (aanand.prasad@gmail.com) diff --git a/Rakefile b/Rakefile new file mode 100644 index 0000000..5955835 --- /dev/null +++ b/Rakefile @@ -0,0 +1,3 @@ +task :test do + system 'spec test/specs.rb' +end \ No newline at end of file diff --git a/init.rb b/init.rb index 4a3e9e5..e6fb905 100644 --- a/init.rb +++ b/init.rb @@ -1,3 +1,3 @@ -require 'lib/monad' -require 'lib/maybe' -require 'lib/list' +%w(monad maybe array).each do |file| + require File.join(File.dirname(__FILE__), 'lib', file) +end diff --git a/lib/array.rb b/lib/array.rb new file mode 100644 index 0000000..7d4852c --- /dev/null +++ b/lib/array.rb @@ -0,0 +1,11 @@ +class Array + extend Monad + + def self.unit x + [x] + end + + def bind &f + map(&f).inject([]){ |a,b| a+b } + end +end diff --git a/lib/list.rb b/lib/list.rb deleted file mode 100644 index bcd85cd..0000000 --- a/lib/list.rb +++ /dev/null @@ -1,26 +0,0 @@ -class List < Monad - class << self - alias_method :list, :new - alias_method :unit, :list - end - - attr_accessor :array - - def initialize *args - @array = args - end - - def ==(l) - l.is_a? List and array == l.array - end - - def bind &f - lists = @array.map{ |x| f.call(x) } - - List.unit(*lists.inject([]) { |acc, l| acc + l.array }) - end - - def to_s - @array.inspect - end -end diff --git a/lib/maybe.rb b/lib/maybe.rb index 306ed2f..9bfd5dc 100644 --- a/lib/maybe.rb +++ b/lib/maybe.rb @@ -1,4 +1,6 @@ -class Maybe < Monad +class Maybe + extend Monad + class << self alias_method :nothing, :new alias_method :just, :new diff --git a/lib/monad.rb b/lib/monad.rb dissimilarity index 70% index 2351963..4464901 100644 --- a/lib/monad.rb +++ b/lib/monad.rb @@ -1,82 +1,99 @@ -require 'rubygems' -require 'parse_tree' -require 'sexp_processor' -require 'ruby2ruby' - -class Monad - class << self - def run *args, &block - sexp = transform_sexp(block) - ruby = generate_ruby(sexp) - eval(ruby).call(*args) - end - - def transform_sexp block - DoNotation.new.process(block.to_method.to_sexp) - end - - # gnarly text munging copied & pasted from ruby2ruby source - def generate_ruby sexp - ruby = Ruby2Ruby.new.process(sexp) - ruby.sub!(/\A(def \S+)\(([^\)]*)\)/, '\1 |\2|') # move args - ruby.sub!(/\Adef[^\n\|]+/, 'proc { ') # strip def name - ruby.sub!(/end\Z/, '}') # strip end - ruby.gsub!(/\s+$/, '') # trailing WS bugs me - ruby - end - end -end - -class DoNotation < SexpProcessor - def process_bmethod exp - type = exp.shift - - arg_assignment = process(exp.shift) - - if arg_assignment.first == :dasgn_curr - arg_name = arg_assignment[1] - args = [] - elsif arg_assignment.first == :masgn - arg_name = arg_assignment[1][1][1] - args = arg_assignment[1][2..-1].collect { |e| e[1] } - else - raise DoNotationError, "I can't parse this block :(" - end - - block = process(exp.shift) - - assert_type block, :block - block.shift - - s(:scope, - s(:block, - s(:args, *args), - *rewrite_assignments(block, arg_name))) - end - - def rewrite_assignments exp, arg_name - return [] if exp.empty? - - head = exp.shift - - if head[0] == :dasgn_curr and head[2][0] == :fcall and head[2][1] == arg_name - var_name = head[1] - expression = head[2][2][1] - - body = rewrite_assignments(exp, arg_name) - - if body.first.is_a? Symbol - body = [s(*body)] - end - - [s(:iter, - s(:call, process(expression), :bind), - s(:dasgn_curr, var_name), - *body)] - else - head + rewrite_assignments(exp, arg_name) - end - end -end - -class DoNotationError < StandardError; end +require 'rubygems' +require 'parse_tree' +require 'sexp_processor' +require 'ruby2ruby' + +module Monad + def run *args, &block + sexp = transform_sexp(block) + ruby = generate_ruby(sexp) + eval(ruby).call(*args) + end + + def transform_sexp block + DoNotation.new.process(block.to_method.to_sexp) + end + + # gnarly text munging copied & pasted from ruby2ruby source + def generate_ruby sexp + ruby = Ruby2Ruby.new.process(sexp) + ruby.sub!(/\A(def \S+)\(([^\)]*)\)/, '\1 |\2|') # move args + ruby.sub!(/\Adef[^\n\|]+/, 'proc { ') # strip def name + ruby.sub!(/end\Z/, '}') # strip end + ruby.gsub!(/\s+$/, '') # trailing WS bugs me + ruby + end +end + +class DoNotation < SexpProcessor + def process_bmethod exp + type = exp.shift + + if arg_assignment = process(exp.shift) + if arg_assignment.first == :dasgn or arg_assignment.first == :dasgn_curr + args = [arg_assignment[1]] + elsif arg_assignment.first == :masgn + args = arg_assignment[1][1..-1].collect { |e| e[1] } + else + raise DoNotationError, "I can't parse this block :(" + end + else + args = [] + end + + block = process(exp.shift) + + assert_type block, :block + block.shift + + s(:scope, + s(:block, + s(:args, *args), + *rewrite_assignments(block))) + 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)] + else + head + 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 + +class DoNotationError < StandardError; end diff --git a/monad.tmproj b/monad.tmproj index 9d09f34..14118de 100644 --- a/monad.tmproj +++ b/monad.tmproj @@ -2,6 +2,8 @@ + currentDocument + test/specs.rb documents @@ -18,10 +20,165 @@ fileHierarchyDrawerWidth 200 metaData - + + README + + caret + + column + 0 + line + 0 + + firstVisibleColumn + 0 + firstVisibleLine + 0 + + Rakefile + + caret + + column + 29 + line + 1 + + firstVisibleColumn + 0 + firstVisibleLine + 0 + + init.rb + + caret + + column + 0 + line + 3 + + firstVisibleColumn + 0 + firstVisibleLine + 0 + + lib/list.rb + + caret + + column + 34 + line + 23 + + firstVisibleColumn + 0 + firstVisibleLine + 0 + + lib/maybe.rb + + caret + + column + 66 + line + 18 + + firstVisibleColumn + 0 + firstVisibleLine + 0 + + lib/monad.rb + + caret + + column + 0 + line + 34 + + firstVisibleColumn + 0 + firstVisibleLine + 24 + + test/arrows.rb + + caret + + column + 54 + line + 0 + + columnSelection + + firstVisibleColumn + 0 + firstVisibleLine + 0 + selectFrom + + column + 0 + line + 0 + + selectTo + + column + 54 + line + 0 + + + test/nested.rb + + caret + + column + 0 + line + 20 + + firstVisibleColumn + 0 + firstVisibleLine + 0 + + test/specs.rb + + caret + + column + 0 + line + 38 + + firstVisibleColumn + 0 + firstVisibleLine + 25 + + + openDocuments + + lib/monad.rb + init.rb + README + Rakefile + test/specs.rb + test/arrows.rb + lib/maybe.rb + lib/list.rb + test/nested.rb + showFileHierarchyDrawer windowFrame - {{203, 8}, {1068, 770}} + {{210, 4}, {1070, 998}} diff --git a/test/specs.rb b/test/specs.rb index aea79f3..ff138bf 100644 --- a/test/specs.rb +++ b/test/specs.rb @@ -2,9 +2,9 @@ require File.join(File.dirname(__FILE__), %w(.. init)) describe "Maybe:" do specify "one or more `nothing's results in `nothing'" do - maybe = Maybe.run do |m| - x =m just(1) - y =m nothing + maybe = Maybe.run do + x <- just(1) + y <- nothing unit(x+y) end @@ -13,9 +13,9 @@ describe "Maybe:" do end specify "all `just' results in `just'" do - maybe = Maybe.run do |m| - x =m just(1) - y =m just(2) + maybe = Maybe.run do + x <- just(1) + y <- just(2) unit(x+y) end @@ -24,16 +24,16 @@ describe "Maybe:" do end end -describe "List:" do +describe "Array:" do specify "all results are calculated and concatenated" do - list = List.run do |m| - x =m list(1,2,3) - y =m list(10,20,30) + array = Array.run do + x <- [1,2,3] + y <- [10,20,30] unit(x+y) end - list.should == List.list(11, 21, 31, 12, 22, 32, 13, 23, 33) + array.should == [11, 21, 31, 12, 22, 32, 13, 23, 33] end end @@ -41,13 +41,38 @@ describe "Monad.run" do specify "should pass extra arguments into the block" do foo = 100 - list = List.run(foo) do |m, foo| - x =m list(1,2,3) - y =m list(10,20,30) + array = Array.run(foo) do |foo| + x <- [1,2,3] + y <- [10,20,30] unit(x+y+foo) end - list.should == List.list(111, 121, 131, 112, 122, 132, 113, 123, 133) + array.should == [111, 121, 131, 112, 122, 132, 113, 123, 133] + end + + specify "should be nestable" do + array = Array.run do + x <- Array.run do + a <- ['A','a'] + b <- ['B','b'] + + unit(a+b) + end + + y <- Array.run do + a <- ['C','c'] + b <- ['D','d'] + + unit(a+b) + 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 -- 2.11.4.GIT