Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

.

  • Loading branch information...
commit 56c48b7143e8b30fb3950b92985936d687781e3a 1 parent 074a3d8
@richard-lyman authored
View
19 src/com/lithinos/amotoen/errors.clj
@@ -1,19 +0,0 @@
-; Copyright (c) Richard Lyman. All rights reserved.
-; The use and distribution terms for this software are covered by the
-; Eclipse Public License 1.0 (http://www.eclipse.org/legal/epl-v10.html)
-; which can be found in the file epl-v10.html at the root of this distribution.
-; By using this software in any fashion, you are agreeing to be bound by
-; the terms of this license.
-; You must not remove this notice, or any other, from this software.
-
-(ns com.lithinos.amotoen.errors)
-
-(def #^{:private true} *amotoen-throwable* (Throwable. "Problem specific to using amotoen"))
-(def #^{:private true} *amotoen-cyclical-throwable* (Throwable. "Cyclical problem specific to using amotoen"))
-
-(defn amotoen-error [s] (Error. s *amotoen-throwable*))
-(defn amotoen-cyclical-error [s] (Error. s *amotoen-cyclical-throwable*))
-
-(defn is-amotoen-error [^Throwable e] (= (.getCause e) *amotoen-throwable*))
-(defn is-amotoen-cyclical-error [^Throwable e] (= (.getCause e) *amotoen-cyclical-throwable*))
-
View
104 src/com/lithinos/amotoen/string_wrapper.clj
@@ -1,104 +0,0 @@
-; Copyright (c) Richard Lyman. All rights reserved.
-; The use and distribution terms for this software are covered by the
-; Eclipse Public License 1.0 (http://www.eclipse.org/legal/epl-v10.html)
-; which can be found in the file epl-v10.html at the root of this distribution.
-; By using this software in any fashion, you are agreeing to be bound by
-; the terms of this license.
-; You must not remove this notice, or any other, from this software.
-
-(ns com.lithinos.amotoen.string-wrapper
- (:use (com.lithinos.amotoen errors wrapper))
- (:import (java.util.regex Pattern)))
-
-(defn- until-first-newline [s]
- (let [result (apply
- str
- (seq
- #_(take-while
- (fn [c]
- (not= c \newline))
- s)
- (take 50 s)
- ))]
- (str result
- (if (not= (count s) (count result))
- "..."
- ""))))
-
-(defn- number-of-newlines [s] (count (filter #(= % \newline) s)))
-
-(defn- tabs [l]
- (loop [result ""
- count l]
- (if (= count 0)
- result
- (recur (str result " ")
- (- count 1)))))
-
-(defn wrap-string [#^String i]
- (let [limit (count i)
- location (ref 0)
- ;line (ref 0)
- cycles (ref [])
- debug-switch (ref false)]
-
- (reify IWrapper
-
- (consume? [t terminal]
- (if (= @location limit) false)
- (if (instance? java.util.regex.Pattern terminal)
- (not= (re-find terminal (subs i @location)) nil)
- (.regionMatches i @location terminal 0 (count terminal))))
-
- (consume [t terminal]
- (try
- (let [input-remainder (subs i @location)
- consumed (if (instance? Pattern terminal)
- (re-find terminal input-remainder)
- terminal)
- before @location]
- (dosync (alter location + (count consumed)))
- ;(dosync (alter line + (number-of-newlines consumed)))
- (if (> @location limit)
- (throw (amotoen-error "Consumed more than available")))
- (if @debug-switch (println (str "Consumed: '" consumed "' from '" terminal "' [" before "," @location "]")))
- consumed)
- (catch StringIndexOutOfBoundsException e (throw (amotoen-error "Consumed more than available")))))
-
- (context [t]
- (let [input-remainder (subs i (max 0 @location))
- remainder (until-first-newline input-remainder)]
- (subs remainder
- 0
- (min (count remainder) 40))))
-
- (cyclical? [t terminal]
- (let [sl (filter #(= (first (keys %)) terminal) @cycles) ; Is there a way to speed this up? Specifically the anon fn
- slv (map #(first (vals %)) sl) ; Maybe here too...
- m (get-mark t)]
- (some #(= % m) slv))) ; Maybe here too...
-
- (cyclical-pop [t] (dosync (alter cycles pop)))
- (cyclical-track [t terminal] (dosync (alter cycles conj {terminal (get-mark t)})))
- (debug [t indent s] (if @debug-switch (println (tabs indent) s)))
- (debug-with-context [t indent s] (if @debug-switch (println (tabs indent) s (str "\t->'" (context t) "'<-"))))
-
- (fail [t throwable] (println "ERROR:")
- (println " Context: " (context t))
- (println " " \u25B2)
- ;(println " Line:" @line)
- (println " Character:" @location)
- ;(print " Parse path:")
- (print " Error Message:")
- (println (.getMessage ^Throwable throwable)))
-
- (get-mark [t] [@location @cycles])
- (end? [t] (>= @location limit))
- (reset [t]
- (dosync (ref-set location 0))
- ;(dosync (ref-set line 0))
- (dosync (ref-set cycles []))
- (dosync (ref-set debug-switch false)))
- (return-to-mark [t mark] (dosync (ref-set location (first mark)) (ref-set cycles (second mark))) true)
- (set-debug [t state] (dosync (ref-set debug-switch state))))))
-
View
54 src/com/lithinos/amotoen/utils.clj
@@ -1,54 +0,0 @@
-; Copyright (c) Richard Lyman. All rights reserved.
-; The use and distribution terms for this software are covered by the
-; Eclipse Public License 1.0 (http://www.eclipse.org/legal/epl-v10.html)
-; which can be found in the file epl-v10.html at the root of this distribution.
-; By using this software in any fashion, you are agreeing to be bound by
-; the terms of this license.
-; You must not remove this notice, or any other, from this software.
-
-(ns com.lithinos.amotoen.utils)
-
-(defn pp-grammar [grammar]
- (let [ks (keys grammar)
- m (+ 1 (apply max (map #(count (name %)) ks)))]
- (doseq [k (sort ks)]
- (printf (str "\t%" m "." m "s %s\n") k (k grammar)))))
-
-(defn terminal? [o] (@#'com.lithinos.amotoen.core/terminal? o))
-(defn strict-terminal? [o] (@#'com.lithinos.amotoen.core/strict-terminal? o))
-
-(defn non-terminals [base grammar] (filter (complement terminal?) (flatten (base grammar))))
-
-(defn extract [base grammar]
- (loop [previous-count 0
- base-set (non-terminals base grammar)]
- (if (= (count base-set) previous-count)
- (filter #(not (= nil (first (vals %)))) (map #(let [k % v (% grammar)] {k v}) base-set))
- (recur (count base-set)
- (distinct (concat base-set (flatten (map #(non-terminals % grammar) base-set))))))))
-
-(defn add [non-terminal grammar old-rules]
- (merge old-rules (apply merge (extract non-terminal grammar))))
-
-(declare lookahead)
-
-(defn first-terminal [non-terminal grammar]
- (if (strict-terminal? non-terminal)
- non-terminal
- (let [base (if (keyword? non-terminal)
- (non-terminal grammar)
- non-terminal)]
- (cond
- (strict-terminal? base) base
- (keyword? base) (first-terminal base grammar)
- (vector? base) (first-terminal (first base) grammar)
- (list? base) (if (= '| (first base))
- nil;(lookahead non-terminal grammar)
- (first-terminal (second base) grammar))
- true nil))))
-
-(defn lookahead [non-terminal grammar]
- (let [base (non-terminal grammar)]
- (if (not= (first base) '|) (throw (Error. "Lookahead is only useful for option groups")))
- (map (fn [i] {(first-terminal i grammar) i}) (rest base))))
-
View
26 src/com/lithinos/amotoen/wrapper.clj
@@ -1,26 +0,0 @@
-; Copyright (c) Richard Lyman. All rights reserved.
-; The use and distribution terms for this software are covered by the
-; Eclipse Public License 1.0 (http://www.eclipse.org/legal/epl-v10.html)
-; which can be found in the file epl-v10.html at the root of this distribution.
-; By using this software in any fashion, you are agreeing to be bound by
-; the terms of this license.
-; You must not remove this notice, or any other, from this software.
-
-(ns com.lithinos.amotoen.wrapper)
-
-(defprotocol IWrapper
- (consume? [t terminal] "Returns true if the given terminal can be successfully consumed.")
- (consume [t terminal] "Returns the result of consuming the given terminal.")
- (context [t] "Returns anything to describe the current context.")
- (cyclical? [t terminal] "Returns true if processing the given terminal would start an endless cycle because the terminal had been 'tracked' before.")
- (cyclical-pop [t] "Backs out of tracking a terminal.")
- (cyclical-track [t terminal] "Tracks the process of walking a grammar.")
- (debug [t indent s] )
- (debug-with-context [t indent s] )
- (fail [t throwable] )
- (get-mark [t] "Returns anything that could be the parameter to and would result in a successful invocation of 'return-to-mark'")
- (end? [t] "Returns true if there is no more input")
- (reset [t] )
- (return-to-mark [t mark] "Used for backtracking")
- (set-debug [t state] ))
-
Please sign in to comment.
Something went wrong with that request. Please try again.