started tutorial.clj

.classpath

@@ -0,0 +1,13 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<classpath>
+	<classpathentry kind="con" path="org.eclipse.jdt.launching.JRE_CONTAINER"/>
+	<classpathentry kind="src" path="src"/>
+	<classpathentry kind="src" path="test"/>
+	<classpathentry kind="lib" path="target/classes">
+		<attributes>
+			<attribute name="optional" value="true"/>
+		</attributes>
+	</classpathentry>
+	<classpathentry kind="con" path="ccw.LEININGEN_CONTAINER"/>
+	<classpathentry kind="output" path="classes"/>
+</classpath>

demos/clparsec/demos/tutorial.clj

@@ -0,0 +1,29 @@
+(ns clparsec.demos.tutorial
+  (:use [clojure.algo.monads][clparsec.core][clparsec.primitives][clparsec.char-parsers])
+  (:require [clojure [set :as set]])
+  (:import [clparsec.errors ErrorMessage]
+           [Character])
+  (:refer-clojure :exclude #{newline}))
+
+(defn test-parse [p str]
+  (let [reply (run p str)]
+    (if (success? reply)
+      (println "Success:" (result reply))
+      (println "Failure:" (.toString (errors reply))))))
+
+(test-parse pfloat "1.25")
+
+(test-parse pfloat "1.25E 3")
+
+
+;;;;;;;;; parsing floats between brackets ;;;;;;;;;;;;;;
+(def float-between-brackets (|>> (>>| (pstring "[") pfloat) (pstring "]")))
+
+(test-parse float-between-brackets "[1.0]")
+
+(test-parse float-between-brackets "[]")
+
+(test-parse float-between-brackets "[1.0")
+
+;;;;;;;;;;;;;; abstracting parsers ;;;;;;;;;;;;;;;;
+

src/clparsec/char_parsers.clj

@@ -252,7 +252,7 @@
       (let [flags (conj flags :has-exponent)
             next-state (skip-one state)
             [e-sign next-state] (p-exp-sign next-state)]
-        (if-not (is-digit? (peep state))
+        (if (is-digit? (peep next-state))
           (let [pdigit-res (pdigits next-state)]
             {:errors nil, :state (:state pdigit-res),
              :flags flags, :result (str c e-sign (:result pdigit-res))})

src/clparsec/core.clj

@@ -6,12 +6,16 @@
 (def ^:dynamic *newline-chars* #{\return \newline "\r\n"})
 (def ^:dynamic *whitespace* #{\space \tab \newline \return \formfeed})
 (defprotocol AReply
-  (success? [r]))
+  (success? [r])
+  (result [r])
+  (errors [r]))
 
 (defrecord Reply
   [status result errors state]
   AReply
-  (success? [this] (if (= status :success) true false)))
+  (success? [this] (if (= status :success) true false))
+  (result [this] result)
+  (errors [this] errors))
 
 (defprotocol ALocation
   (location-code [location]))
@@ -124,7 +128,7 @@
                        (if (< i length)
                          (when (=(nth strn i) (nth remainder i))
                            (recur (inc i)))
-                         (assoc this :remainder (.substring remainder i)
+                         (assoc this :remainder (drop i remainder)
                                 :position (+ position i)
                                 :location (plus-column location i)))))))
     (read-chars-or-newlines-while [this pred1 pred normalize-n] ;todo normalize newlines

src/clparsec/errors.clj

@@ -0,0 +1,64 @@
+(ns clparsec.errors
+  (:use [clparsec.core])
+  (:require [clojure [set :as set]]))
+
+(defrecord ErrorMessage
+  [type message])
+
+(defrecord ParseError
+  [position location messages]
+  Object
+  (toString [this] (let [msg (reduce str (map :message messages))]
+                     (str "expected: " msg " at location: " (location-code location)))))
+
+(defn- merge2-errors
+  "Returns the union of the error messages if the replys are at the same position
+   and the errors of reply2 otherwise."  
+  ([error1 error2]
+    (if (and error1 (= (:position error1) (:position error2)))
+      (assoc error1 :messages
+             (set/union (:messages error1) (:messages error2)))
+      (if-not error2 error1 error2))))
+(defn merge-errors
+  "Returns the union of the error messages if the replys are at the same position
+   and the errors of reply2 otherwise."  
+  ([& errors]
+    (when errors
+      (reduce merge2-errors (reverse errors)))))
+
+(defn union-error [& errors]
+  (assoc (first errors) :messages (set/union (map :messages errors))))
+
+(defn merge-reply-errors
+  ([reply] reply)
+  ([reply1 reply2]
+    ;(println "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\n"reply1 "\n" reply2 "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\n")
+    (if (<(:position (:state reply1))(:position (:state reply2)))
+      reply2
+      (if (>(:position (:state reply1))(:position (:state reply1)))
+        reply1
+        (assoc reply2 :errors (merge2-errors (:errors reply1) (:errors reply2))))))
+  ([reply1 reply2 & replys]
+    ;(println reply1 reply2 replys)
+    (let [replys (conj replys reply2)]
+      ;(println reply1 replys)
+      (loop [reply reply1
+             replys replys]
+        (if-let [reply2 (first replys)]
+          (recur (merge-reply-errors reply reply2) (rest replys))
+          reply)))))
+
+
+(defn make-parse-error [state message]
+  (ParseError. (position state) (location state) #{message}))
+
+(defn expected [label]
+  (ErrorMessage. :expected label))
+
+(defn message-error [label]
+  (ErrorMessage. :message label))
+
+(defn expected-list [label] (#{expected}))
+
+(defn swap-error-messages [reply messages]
+  (assoc reply :errors (assoc (:errors reply) :messages messages)))