Permalink
Browse files

use delayed (requires patch to kotka monad)

  • Loading branch information...
1 parent 6488f98 commit 2eca2f24384e0922edea5fc2f92224d6afd03149 @mmikulicic committed Jan 4, 2010
Showing with 48 additions and 35 deletions.
  1. +1 −1 project.clj
  2. +15 −13 src/clarsec.clj
  3. +32 −21 src/doroty.clj
View
@@ -2,4 +2,4 @@
[org.clojure/clojure "1.1.0-master-SNAPSHOT"]
[org.clojure/clojure-contrib "1.0-SNAPSHOT"]
[monad/monad "1.0.0-SNAPSHOT"]
- ] :main clarsec)
+ ] :main doroty)
View
@@ -25,17 +25,19 @@
(defmethod bind 'Parser
- [m func]
- (make-monad (monad-type m)
- (fn [strn]
- (let [parser (monad m)
- result (parser strn)]
- (if (consumed? result)
- ((monad (func (:value result))) (:rest result))
- result
+ [dm dfunc]
+ (let [m (force dm)
+ func (force dfunc)]
+ (make-monad (monad-type m)
+ (fn [strn]
+ (let [parser (monad m)
+ result (parser strn)]
+ (if (consumed? result)
+ ((force (monad (force (func (:value result))))) (:rest result))
+ result
+ )
)
- )
- )))
+ ))))
(defn result [v] (return 'Parser v))
@@ -46,7 +48,7 @@
(failback
(first
(drop-while failed?
- (map #((monad %) strn) parsers)))
+ (map #((monad (force %)) strn) parsers)))
(failed)
))))
@@ -198,9 +200,9 @@
(stringify (lexeme (between (is-char \") (is-char \") (many (not-char \"))))))
(defn parse [parser input]
- ((monad parser) input)
+ ((monad (force parser)) input)
)
;(defn -main []
-; (println (mytest "ciao mondomondo")))
+; (println (parse (>> (delay letter) (delay letter)) "ca.")))
View
@@ -5,6 +5,12 @@
[de.kotka.monad])
)
+(declare instantiation invocation literal)
+(declare xpath)
+
+
+(def expression
+ (delay (either instantiation invocation literal)))
(def stringLit
(>>== stringLiteral make-string-lit))
@@ -27,20 +33,20 @@
(def literal
(either structure number stringLit reference))
-(def argList
- (sepBy expression comma))
+;(def argList
+; (sepBy expression comma))
(def instantiation
(let-bind [_ (symb "new")
set identifier
- args (parens argList)]
+ args (parens (sepBy expression comma))]
(result (make-instantiation set args))))
(def invocation
(let-bind [target identifier
_ (string ".")
method identifier
- args (parens argList)]
+ args (parens (sepBy expression comma))]
(result (make-call target method args))))
@@ -66,23 +72,30 @@
name (either identifier (symb "*"))]
(result (str attr name)))))
+
(def binaryPredicate
- (let-bind [xp xpath
- op (symb "=")
- expr (either (>>== expression make-xpath-expression) xpath)]
- (result (make-binary-predicate op xp expr))))
+ (delay
+ (let-bind [xp xpath
+ op (symb "=")
+ expr (either (>>== expression make-xpath-expression) xpath)]
+ (result (make-binary-predicate op xp expr)))))
-(def predicate (either binaryPredicate (>>== xpath make-simple-predicate)))
+(def predicate (delay (either binaryPredicate (>>== xpath make-simple-predicate))))
-(def tagexp
- (let-bind [axis (optional (followedBy identifier (symb "::")))
+(def xpath
+ (delay
+ (>>== (sepBy (let-bind [axis (optional (followedBy identifier (symb "::")))
tag tagname
pred (optional (brackets predicate))]
- (result (make-tagexp axis tag pred))))
+ (result (make-tagexp axis tag pred))) (string "/"))
+ make-xpath)))
-(def xpath
- (>>== (sepBy tagexp (string "/"))
- make-xpath))
+
+;(def tagexp
+; (let-bind [axis (optional (followedBy identifier (symb "::")))
+; tag tagname
+; pred (optional (brackets predicate))]
+; (result (make-tagexp axis tag pred))))
(def fieldList
(sepBy identifier comma))
@@ -93,16 +106,14 @@
xp xpath]
(result (make-select fields xp))))
-
-(def expression
- (either instantiation invocation literal))
-
-
(def statement
(either predecl select expression))
(def body
- (endBy statement semi))
+ (followedBy (sepBy1 statement semi) (optional semi)))
(def source
(followedBy body (lexeme eof)))
+
+(defn -main []
+ (println (parse source "1")))

0 comments on commit 2eca2f2

Please sign in to comment.