This is very close to right, but it isn't working yet.
This commit is contained in:
parent
93a0f3ea1d
commit
4de7b0beb4
|
@ -1,10 +1,9 @@
|
||||||
(ns ^{:doc "parse multiple rules from a stream, possibly a file."
|
(ns ^{:doc "parse multiple rules from a stream, possibly a file."
|
||||||
:author "Simon Brooke"}
|
:author "Simon Brooke"}
|
||||||
mw-parser.bulk
|
mw-parser.bulk
|
||||||
(:use mw-parser.core
|
(:require [clojure.string :refer [split trim]]
|
||||||
mw-engine.utils
|
[mw-engine.utils :refer [member?]]
|
||||||
clojure.java.io
|
[mw-parser.declarative :refer [compile-rule]])
|
||||||
[clojure.string :only [split trim]])
|
|
||||||
(:import (java.io BufferedReader StringReader)))
|
(:import (java.io BufferedReader StringReader)))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
@ -30,7 +29,6 @@
|
||||||
;;;;
|
;;;;
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
|
||||||
(defn comment?
|
(defn comment?
|
||||||
"Is this `line` a comment?"
|
"Is this `line` a comment?"
|
||||||
[line]
|
[line]
|
||||||
|
@ -40,8 +38,8 @@
|
||||||
"Parse rules from successive lines in this `string`, assumed to have multiple
|
"Parse rules from successive lines in this `string`, assumed to have multiple
|
||||||
lines delimited by the new-line character. Return a list of S-expressions."
|
lines delimited by the new-line character. Return a list of S-expressions."
|
||||||
[string]
|
[string]
|
||||||
;; TODO: tried to do this using with-open, but couldn't make it work.
|
(map compile-rule
|
||||||
(map #(parse-rule (trim %)) (remove comment? (split string #"\n"))))
|
(remove comment? (split string #"\n"))))
|
||||||
|
|
||||||
(defn parse-file
|
(defn parse-file
|
||||||
"Parse rules from successive lines in the file loaded from this `filename`.
|
"Parse rules from successive lines in the file loaded from this `filename`.
|
||||||
|
|
|
@ -158,16 +158,20 @@
|
||||||
|
|
||||||
Throws an exception if parsing fails."
|
Throws an exception if parsing fails."
|
||||||
([rule-text return-tuple?]
|
([rule-text return-tuple?]
|
||||||
(assert (string? rule-text))
|
(let [src (trim rule-text)
|
||||||
(let [rule (trim rule-text)
|
parse-tree (simplify (parse src))
|
||||||
tree (simplify (parse-rule rule))
|
fn' (generate parse-tree)
|
||||||
afn (if (rule? tree) (eval (generate tree))
|
afn (try
|
||||||
;; else
|
(if (= 'fn (first fn'))
|
||||||
(throw-parse-exception tree))]
|
(vary-meta (eval fn') merge (meta fn'))
|
||||||
(if return-tuple?
|
(throw (Exception. (format "Parse of `%s` did not return a functionn" src))))
|
||||||
(list afn rule)
|
(catch Exception any (throw (ex-info (.getMessage any)
|
||||||
;; else
|
{:src src
|
||||||
|
:parse parse-tree
|
||||||
|
:fn fn'}))))]
|
||||||
|
(if
|
||||||
|
return-tuple?
|
||||||
|
(list afn (trim rule-text))
|
||||||
afn)))
|
afn)))
|
||||||
([rule-text]
|
([rule-text]
|
||||||
(compile-rule rule-text false)))
|
(compile-rule rule-text false)))
|
||||||
|
|
||||||
|
|
|
@ -32,13 +32,11 @@
|
||||||
;; (3) the reason for the error
|
;; (3) the reason for the error
|
||||||
(def bad-parse-error "I did not understand:\n '%s'\n %s\n %s")
|
(def bad-parse-error "I did not understand:\n '%s'\n %s\n %s")
|
||||||
|
|
||||||
|
|
||||||
(defn- explain-parse-error-reason
|
(defn- explain-parse-error-reason
|
||||||
"Attempt to explain the reason for the parse error."
|
"Attempt to explain the reason for the parse error."
|
||||||
[reason]
|
[reason]
|
||||||
(str "Expecting one of (" (apply str (map #(str (:expecting %) " ") reason)) ")"))
|
(str "Expecting one of (" (apply str (map #(str (:expecting %) " ") reason)) ")"))
|
||||||
|
|
||||||
|
|
||||||
(defn- parser-error-to-map
|
(defn- parser-error-to-map
|
||||||
[parser-error]
|
[parser-error]
|
||||||
(let [m (reduce (fn [map item](merge map {(first item)(second item)})) {} parser-error)
|
(let [m (reduce (fn [map item](merge map {(first item)(second item)})) {} parser-error)
|
||||||
|
@ -47,7 +45,6 @@
|
||||||
(:reason m))]
|
(:reason m))]
|
||||||
(merge m {:reason reason})))
|
(merge m {:reason reason})))
|
||||||
|
|
||||||
|
|
||||||
(defn throw-parse-exception
|
(defn throw-parse-exception
|
||||||
"Construct a helpful error message from this `parser-error`, and throw an exception with that message."
|
"Construct a helpful error message from this `parser-error`, and throw an exception with that message."
|
||||||
[parser-error]
|
[parser-error]
|
||||||
|
|
|
@ -289,7 +289,7 @@
|
||||||
[source property quantity-frag destinations]
|
[source property quantity-frag destinations]
|
||||||
(vary-meta
|
(vary-meta
|
||||||
(list 'fn ['cell 'world]
|
(list 'fn ['cell 'world]
|
||||||
(list 'when (list 'and source (list 'pos? 'cell property))
|
(list 'when (list 'and source (list 'pos? (list 'cell property)))
|
||||||
(list 'map
|
(list 'map
|
||||||
(list 'fn ['d]
|
(list 'fn ['d]
|
||||||
{:source (list 'select-keys 'cell [:x :y])
|
{:source (list 'select-keys 'cell [:x :y])
|
||||||
|
@ -310,6 +310,12 @@
|
||||||
:NUMBER (generate q-clause)
|
:NUMBER (generate q-clause)
|
||||||
:PERCENTAGE (let [multiplier (/ (generate (second q-clause)) 100)]
|
:PERCENTAGE (let [multiplier (/ (generate (second q-clause)) 100)]
|
||||||
(list '* multiplier (list property 'cell)))
|
(list '* multiplier (list property 'cell)))
|
||||||
|
:SIMPLE-EXPRESSION (if (= (count q-clause) 2)
|
||||||
|
(generate-quantity-accessor (second q-clause) property)
|
||||||
|
(throw (ex-info
|
||||||
|
(format "Cannot yet handle q-clause of form: `%s`" q-clause)
|
||||||
|
{:clause q-clause
|
||||||
|
:property property})))
|
||||||
:SOME (list 'rand (list property 'cell))
|
:SOME (list 'rand (list property 'cell))
|
||||||
(throw (ex-info
|
(throw (ex-info
|
||||||
(format "Unexpected QUANTITY type: `%s`" (first q-clause))
|
(format "Unexpected QUANTITY type: `%s`" (first q-clause))
|
||||||
|
@ -343,30 +349,6 @@
|
||||||
:LEAST (list 'mw-engine.utils/get-least-cell 'candidates prop)
|
:LEAST (list 'mw-engine.utils/get-least-cell 'candidates prop)
|
||||||
:MOST (list 'mw-engine.utils/get-most-cell 'candidates prop))))
|
:MOST (list 'mw-engine.utils/get-most-cell 'candidates prop))))
|
||||||
'candidates))))
|
'candidates))))
|
||||||
;; (fn
|
|
||||||
;; [cell world]
|
|
||||||
;; (when
|
|
||||||
;; (and (= (:state cell) (or (:house cell) :house)) (pos? cell :food))
|
|
||||||
;; (map
|
|
||||||
;; (fn
|
|
||||||
;; [d]
|
|
||||||
;; (assoc
|
|
||||||
;; {}
|
|
||||||
;; :source
|
|
||||||
;; (select-keys cell [:x :y])
|
|
||||||
;; :destination
|
|
||||||
;; (select-keys d [:x :y])
|
|
||||||
;; :property
|
|
||||||
;; :food
|
|
||||||
;; :quantity
|
|
||||||
;; (* 1/10 (:food cell)))
|
|
||||||
;; {})
|
|
||||||
;; (let
|
|
||||||
;; [candidates
|
|
||||||
;; (filter
|
|
||||||
;; (fn [cell] (= (:state cell) (or (:house cell) :house)))
|
|
||||||
;; (mw-engine.utils/get-neighbours world cell 2))]
|
|
||||||
;; (list (mw-engine.utils/get-least-cell candidates :food))))))
|
|
||||||
|
|
||||||
(defn generate-flow
|
(defn generate-flow
|
||||||
[tree]
|
[tree]
|
||||||
|
|
Loading…
Reference in a new issue