Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

bundle patched monad lib

  • Loading branch information...
commit 7127fcb91f522c8f7d03f01682d399c8cf80e86c 1 parent 2eca2f2
Marko Mikulicic authored January 04, 2010
1  project.clj
... ...
@@ -1,5 +1,4 @@
1 1
 (defproject clarsec "1.0.0-SNAPSHOT" :description "FIXME: write" :dependencies [
2 2
         [org.clojure/clojure "1.1.0-master-SNAPSHOT"]
3 3
         [org.clojure/clojure-contrib "1.0-SNAPSHOT"]
4  
-        [monad/monad "1.0.0-SNAPSHOT"]
5 4
         ] :main doroty)
2  src/clarsec.clj
... ...
@@ -1,6 +1,6 @@
1 1
 (ns clarsec
2 2
   (:gen-class)
3  
-  (:use [de.kotka.monad]))
  3
+  (:use [monad]))
4 4
 
5 5
 
6 6
 (defn consumed? [x]  (= (x :type) :consumed)) 
10  src/doroty.clj
@@ -2,7 +2,7 @@
2 2
   (:gen-class)
3 3
   (:use [clarsec]
4 4
 	[ast]
5  
-	[de.kotka.monad])
  5
+	[monad])
6 6
 )
7 7
 
8 8
 (declare instantiation invocation literal)
@@ -33,20 +33,20 @@
33 33
 (def literal
34 34
      (either structure number stringLit reference))
35 35
      
36  
-;(def argList
37  
-;     (sepBy expression comma))
  36
+(def argList
  37
+     (delay (sepBy expression comma)))
38 38
 
39 39
 (def instantiation
40 40
      (let-bind [_      (symb "new")
41 41
 		set    identifier
42  
-		args   (parens (sepBy expression comma))]
  42
+		args   (parens argList)]
43 43
 	       (result (make-instantiation set args))))
44 44
 
45 45
 (def invocation
46 46
      (let-bind [target identifier
47 47
 		_      (string ".")
48 48
 		method identifier
49  
-		args  (parens (sepBy expression comma))]
  49
+		args  (parens argList)]
50 50
 		(result (make-call target method args))))
51 51
 
52 52
 
122  src/monad.clj
... ...
@@ -0,0 +1,122 @@
  1
+;-
  2
+; Copyright 2008 (c) Meikel Brandmeyer.
  3
+; All rights reserved.
  4
+;
  5
+; Permission is hereby granted, free of charge, to any person obtaining a copy
  6
+; of this software and associated documentation files (the "Software"), to deal
  7
+; in the Software without restriction, including without limitation the rights
  8
+; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
  9
+; copies of the Software, and to permit persons to whom the Software is
  10
+; furnished to do so, subject to the following conditions:
  11
+;
  12
+; The above copyright notice and this permission notice shall be included in
  13
+; all copies or substantial portions of the Software.
  14
+;
  15
+; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
  16
+; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
  17
+; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
  18
+; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
  19
+; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
  20
+; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
  21
+; THE SOFTWARE.
  22
+
  23
+; this is a slightly patched version which accepts "Delay" objects is monadic objects
  24
+; this hack shouldn't be necessary but I was in a hurry 
  25
+; the correct solution is to perform the delay forcing within the monadic operators 
  26
+
  27
+(clojure.core/ns monad
  28
+  (:use
  29
+     [clojure.contrib.def :only (defstruct-)]))
  30
+
  31
+(declare Monad MZero MRunnable)
  32
+
  33
+(derive `MZero `Monad)
  34
+
  35
+(defstruct- monad-structure :type :monad)
  36
+
  37
+(defn make-monad
  38
+  "Bless an object with the given monad type."
  39
+  [t m]
  40
+  (struct monad-structure t m))
  41
+
  42
+(defn monad
  43
+  "Return the monad of a blessed object."
  44
+  [m]
  45
+  (m :monad))
  46
+
  47
+(defn monad-type
  48
+  "Return the type of a blessed object."
  49
+  [m]
  50
+  (m :type))
  51
+
  52
+(defmulti
  53
+  #^{:arglists '([monad-type monad-argument])
  54
+     :doc
  55
+  "Return a monad of the given type with the given argument."}
  56
+  return
  57
+  (fn [t _] t))
  58
+
  59
+(defmethod return `Monad
  60
+  [t m]
  61
+  (make-monad t m))
  62
+
  63
+(defmulti
  64
+  #^{:doc
  65
+  "bind makes the value of the given monad available to a function.
  66
+  The function may act on the value, but it must return another monad.
  67
+  Although this cannot be enforced in Clojure."}
  68
+  bind (fn [m _] (monad-type (force m))))
  69
+
  70
+(defmethod bind `MZero [m _] m)
  71
+(defmethod bind `Monad [m f] (f (monad m)))
  72
+
  73
+(defmulti
  74
+  #^{:doc
  75
+  "If the first argument is not a `MZero, return it. Otherwise return
  76
+  the second value."}
  77
+  mplus
  78
+  (fn [m1 m2] #(vec (map monad-type [%1 %2]))))
  79
+
  80
+(defmethod mplus [`MZero `Monad] [_ m2] m2)
  81
+(defmethod mplus [`Monad `Monad] [m1 _] m1)
  82
+
  83
+(defmacro let-bind
  84
+  "let-bind binds the result of the given monads to the given variables
  85
+  and executes the body in an implicit do block. How this done exactly
  86
+  depends on the actual monad. The let-bind body should again return a
  87
+  monad."
  88
+  [clauses & body]
  89
+  (let [[v monad & clauses] clauses]
  90
+    (if (nil? clauses)
  91
+      `(bind ~monad (fn [~v] ~@body))
  92
+      `(bind ~monad (fn [~v] (let-bind ~clauses ~@body))))))
  93
+
  94
+(defn m-sequence
  95
+  "Convert the given sequence of monads into a monad of the given
  96
+  type with the value set to the sequence of the values. There must
  97
+  be at least one monad in the monad collection."
  98
+  [monads]
  99
+  (let [f (fn [ms m]
  100
+            (let-bind [result  m
  101
+                       results ms]
  102
+              (return (monad-type m) (conj results result))))]
  103
+    (reduce f (return (-> monads first monad-type) nil) (reverse monads))))
  104
+
  105
+(defmacro lift-into
  106
+  "Call the given function f into the given monad with the values of
  107
+  all given monads in the same order."
  108
+  [m f & ms]
  109
+  (let [xs (take (count ms) (drop 1 (iterate gensym "lift__")))]
  110
+    `(let-bind ~(vec (interleave xs ms)) (return ~m (~f ~@xs)))))
  111
+
  112
+(defmulti
  113
+  #^{:arglists '([monad & args])
  114
+     :doc
  115
+  "Applies the value of the given monad to the arguments and returns
  116
+  the result. Not all monad types are `Runnable."}
  117
+  run
  118
+  (fn [m & _] (monad-type m)))
  119
+
  120
+(defmethod run `MRunnable
  121
+  [m & args]
  122
+  (apply (monad m) args))

0 notes on commit 7127fcb

Please sign in to comment.
Something went wrong with that request. Please try again.