Created
May 16, 2012 20:43
-
-
Save jamii/2713787 to your computer and use it in GitHub Desktop.
Weird type/syntax checker/walker thing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(ns l-seed.syntax) | |
(defn- fixed-seq [syntax] | |
(take-while #(not= :& %) syntax)) | |
(defn- multi-seq [syntax] | |
(second (drop-while #(not= :& %) syntax))) | |
(defn- extend-seq-syntax | |
"Turn [fixed-seq :& multi-seq] into [fixed-seq multi-seq multi-seq ...] to match ast" | |
[syntax ast] | |
(let [fixed-seq (fixed-seq syntax) | |
multi-seq (multi-seq syntax) | |
repeats (- (count ast) (count fixed-seq))] | |
(concat fixed-seq (repeat repeats multi-seq)))) | |
(defn- walk* [f name syntax ast] ;; name is the last var encountered | |
(if (var? syntax) | |
(recur f syntax @syntax ast) | |
(cond | |
;; a literal symbol | |
(symbol? syntax) (f name :literal syntax ast) | |
;; a primitive type (eg :integer) | |
(keyword? syntax) (f name :type syntax ast) | |
;; a union of literal symbols | |
(set? syntax) (f name :union syntax ast) | |
;; a sequence of types | |
(vector? syntax) (let [new-ast (dorun (map #(walk* f name %1 %2) (extend-seq-syntax syntax ast) ast))] | |
(f name :seq syntax ast)) | |
;; a tagged union of types | |
(map? syntax) (let [tag (first ast) | |
sub-ast (rest ast) | |
sub-syntax (get syntax tag) | |
new-ast (walk* f name sub-syntax sub-ast)] | |
(f name :tagged-union syntax (cons tag new-ast)))))) | |
(defn walk [f syntax ast] | |
(walk* f nil syntax ast)) | |
(defn- check* [name kind syntax ast] | |
(assert syntax) | |
(assert ast) | |
(condp = kind | |
:literal (assert (= syntax ast)) | |
:type (condp = syntax | |
:integer (assert (integer? ast)) | |
:string (assert (string? ast))) | |
:union (assert (contains? syntax ast)) | |
:seq (assert (if (multi-seq syntax) | |
(<= (count (fixed-seq syntax)) (count ast)) | |
(= (count (fixed-seq syntax)) (count ast)))) | |
:tagged-union (assert (contains? syntax (first ast)))) | |
ast) | |
(defn check [syntax ast] | |
(walk check* syntax ast)) | |
(ns l-seed.genotype) | |
(def name :string) | |
(def tag :string) | |
(def global | |
#{'length 'direction}) | |
(def relation | |
#{'== '> '>= '< '<=}) | |
(def condition | |
{'and [:& #'condition] | |
'or [:& #'condition] | |
'not [#'condition] | |
'tag [#'tag] | |
'stem [#'global #'relation :integer]}) | |
(def action | |
{'grow-by [:integer] | |
'grow-to [:integer] | |
'turn [:integer] | |
'tag [#'tag] | |
'blossom [#'tag] | |
'branch [:& [:& #'action]]}) | |
(def rule | |
{'rule [#'name #'condition :& #'action]}) | |
(def syntax | |
[:& #'rule]) | |
(in-ns 'user) | |
(syntax/check | |
genotype/syntax | |
'[(rule "blossom" | |
(and (tag "blossoming") | |
(stem length > 6)) | |
(tag "blossomed") | |
(blossom "sprout"))]) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment