This is very close to right, but it isn't working yet.

This commit is contained in:
Simon Brooke 2023-07-15 14:59:30 +01:00
parent 93a0f3ea1d
commit 4de7b0beb4
4 changed files with 32 additions and 51 deletions

View file

@ -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`.

View file

@ -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)))

View file

@ -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]

View file

@ -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]