Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

use kotka monads

  • Loading branch information...
commit 030c67d7a54f0adacba4b76b2bbc5aa3b92e449e 1 parent 4936feb
@mmikulicic authored
Showing with 170 additions and 100 deletions.
  1. +124 −0 src/clarsec-om.clj
  2. +46 −100 src/clarsec.clj
View
124 src/clarsec-om.clj
@@ -0,0 +1,124 @@
+(ns clarsec
+ (:gen-class)
+ (:use [clojure.contrib.monads]))
+
+(defn consumed? [x] (= (:type x) :consumed))
+(defn failed? [x] (= (:type x) :failed))
+
+(defn failed [] {:type :failed})
+(defn consumed [value rest] {:type :consumed
+ :value value
+ :rest rest})
+
+(defn failback [v f] (if (nil? v) f v))
+
+(defmonad parser-m
+ [m-result (fn m-result-parser [x] (fn [strn] (consumed x strn)))
+ m-bind (fn m-bind-parser [parser func]
+ (fn [strn]
+ (let [result (parser strn)]
+ (if (consumed? result)
+ ((func (:value result)) (:rest result))
+ result
+ ))))
+
+ m-zero (fn [strn] (failed))
+
+ m-plus (fn [& parsers]
+ (fn [strn]
+ (failback
+ (first
+ (drop-while failed?
+ (map #(% strn) parsers)))
+ (failed)
+ )))
+
+ ]
+)
+
+(defmonadfn any-char [strn]
+ (if (= "" strn)
+ (failed)
+ (consumed (first strn)
+ (. strn (substring 1))))
+ )
+
+(defn char-test [pred]
+ (domonad parser-m
+ [c any-char
+ :when (pred c)]
+ (str c)))
+
+(defmonadfn is-char [c]
+ (char-test (partial = c)))
+
+(defmonadfn satisfy [pred]
+ (domonad [c any-char
+ :when (pred c)]
+ (str c)))
+
+(defmonadfn string [strn]
+ (domonad [x (m-seq (map is-char strn))]
+ (apply str x))
+)
+
+(defmonadfn optional [parser]
+ (m-plus parser (m-result nil)))
+
+
+(defmonadfn many1 [parser]
+ (domonad [a parser
+ as (optional (many1 parser))]
+ (concat [a] (if (nil? as) [] as)))
+ )
+
+(defmonadfn many [parser]
+ (domonad [x (optional (many1 parser))]
+ (if (nil? x) [] x))
+)
+
+(defn one-of [target-strn]
+ (let [str-chars (into #{} target-strn)]
+ (char-test #(contains? str-chars %))))
+
+
+(defn alpha [] (one-of "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"))
+
+(defn space []
+ (one-of " \n")
+)
+
+(defmonadfn spaces []
+ (many (space))
+ )
+
+(defmacro <|> [& args]
+ (cons 'm-plus args)
+)
+
+(defmonadfn body []
+ (domonad [x any-char
+ y any-char] (str y x))
+)
+
+(defmonadfn body2 []
+ (domonad [x (<|> (string "ciao") (string "ugo"))
+ y (spaces)
+ z (many (string "mondo"))]
+ z)
+)
+
+
+(defmacro parse [p i]
+ (list 'with-monad 'parser-m (list (list p) i))
+)
+
+
+
+(defn mytest [n]
+ (parse body2 n)
+)
+
+(defn -main []
+ (println (mytest "ciao mondomondo"))
+)
View
146 src/clarsec.clj
@@ -1,124 +1,70 @@
(ns clarsec
(:gen-class)
- (:use [clojure.contrib.monads]))
+ (:use [monad]
+ [de.kotka.monad]))
-(defn consumed? [x] (= (:type x) :consumed))
-(defn failed? [x] (= (:type x) :failed))
+
+(defn consumed? [x] (= (x :type) :consumed))
+(defn failed? [x] (= (x :type) :failed))
(defn failed [] {:type :failed})
(defn consumed [value rest] {:type :consumed
:value value
:rest rest})
-(defn failback [v f] (if (nil? v) f v))
-
-(defmonad parser-m
- [m-result (fn m-result-parser [x] (fn [strn] (consumed x strn)))
- m-bind (fn m-bind-parser [parser func]
- (fn [strn]
- (let [result (parser strn)]
- (if (consumed? result)
- ((func (:value result)) (:rest result))
- result
- ))))
-
- m-zero (fn [strn] (failed))
-
- m-plus (fn [& parsers]
- (fn [strn]
- (failback
- (first
- (drop-while failed?
- (map #(% strn) parsers)))
- (failed)
- )))
-
- ]
-)
-
-(defmonadfn any-char [strn]
- (if (= "" strn)
- (failed)
- (consumed (first strn)
- (. strn (substring 1))))
- )
-
-(defn char-test [pred]
- (domonad parser-m
- [c any-char
- :when (pred c)]
- (str c)))
-
-(defmonadfn is-char [c]
- (char-test (partial = c)))
-
-(defmonadfn satisfy [pred]
- (domonad [c any-char
- :when (pred c)]
- (str c)))
-
-(defmonadfn string [strn]
- (domonad [x (m-seq (map is-char strn))]
- (apply str x))
-)
-(defmonadfn optional [parser]
- (m-plus parser (m-result nil)))
-(defmonadfn many1 [parser]
- (domonad [a parser
- as (optional (many1 parser))]
- (concat [a] (if (nil? as) [] as)))
- )
-
-(defmonadfn many [parser]
- (domonad [x (optional (many1 parser))]
- (if (nil? x) [] x))
-)
-
-(defn one-of [target-strn]
- (let [str-chars (into #{} target-strn)]
- (char-test #(contains? str-chars %))))
+(declare Parser)
+(derive 'clarsec/Parser 'de.kotka.monad/Monad)
-(defn alpha [] (one-of "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"))
-(defn space []
- (one-of " \n")
-)
+(defmethod return 'Parser
+ [t x]
+ (make-monad t (fn p-return [strn] (consumed x strn))))
+
-(defmonadfn spaces []
- (many (space))
- )
+(defmethod bind 'Parser
+ [m func]
+; (println "binding" m)
+ (make-monad (monad-type m)
+ (fn [strn]
+ (let [parser (monad m)
+ result (parser strn)]
+ (if (consumed? result)
+ ((monad (func (:value result))) (:rest result))
+ result
+ )
+ )
+ )))
-(defmacro <|> [& args]
- (cons 'm-plus args)
-)
+;;
-(defmonadfn body []
- (domonad [x any-char
- y any-char] (str y x))
-)
+(def any-char
+ (make-monad 'Parser
+ (fn p-any-char [strn]
+ (if (= "" strn)
+ (failed)
+ (consumed (first strn)
+ (. strn (substring 1))))
+ )
+ ))
-(defmonadfn body2 []
- (domonad [x (<|> (string "ciao") (string "ugo"))
- y (spaces)
- z (many (string "mondo"))]
- z)
-)
+(def fail-char
+ (make-monad 'Parser
+ (fn p-fail-char [strn]
+ (failed))))
+
+;(def myparser
+; (let-bind [x (return 'Parser 12)] x)
+;)
-(defmacro parse [p i]
- (list 'with-monad 'parser-m (list (list p) i))
+(defn parse [parser input]
+ ((monad parser) input)
)
-
-(defn mytest [n]
- (parse body2 n)
-)
-
-(defn -main []
- (println (mytest "ciao mondomondo"))
-)
+;(defn -main []
+; (println (mytest "ciao mondomondo")))
Please sign in to comment.
Something went wrong with that request. Please try again.