Permalink
Browse files

Added deftype and defrecord

  • Loading branch information...
1 parent 0db62c2 commit 1b76af2bc4dc6ca9cbcf9489c2890ee6c82e1ba5 @jonase committed Aug 25, 2012
Showing with 44 additions and 0 deletions.
  1. +14 −0 src/scape/core.clj
  2. +16 −0 src/scape/emitter.clj
  3. +14 −0 src/scape/schema.clj
View
@@ -288,4 +288,18 @@
rules/child)
:cljs.core/map)
+ ;; List all deftypes in ?ns
+ (q '[:find ?deftype
+ :in $ ?ns
+ :where
+ [?d :ast.deftype*/name ?deftype]
+ [?d :ast.deftype*/ns ?ns]]
+ ast-db :cljs.core)
+
+ ;; List all defrecords
+ (q '[:find ?defrecord
+ :where
+ [_ :ast.defrecord*/name ?defrecord]]
+ ast-db)
+
)
View
@@ -115,6 +115,22 @@
:ast.recur/arg (map :db/id args))]
(mapcat emit args))))
+(defmethod emit :deftype* [expr-obj]
+ (let [t (:t expr-obj)]
+ [(assoc (emit-common expr-obj)
+ :ast.deftype*/name (name t)
+ :ast.deftype*/ns (namespace t)
+ :ast.deftype*/ns-qualified-name t
+ :ast.deftype*/field (:fields expr-obj))]))
+
+(defmethod emit :defrecord* [expr-obj]
+ (let [t (:t expr-obj)]
+ [(assoc (emit-common expr-obj)
+ :ast.defrecord*/name (name t)
+ :ast.defrecord*/ns (namespace t)
+ :ast.defrecord*/ns-qualified-name t
+ :ast.defrecord*/field (:fields expr-obj))]))
+
(defmethod emit :default [expr-obj]
(let [children (map assoc-id (:children expr-obj))]
(concat [(assoc (emit-common expr-obj)
View
@@ -68,6 +68,18 @@
(def op-recur
[[:ast.recur/arg :ref :many]])
+(def op-deftype*
+ [[:ast.deftype*/name :keyword :one]
+ [:ast.deftype*/ns :keyword :one]
+ [:ast.deftype*/ns-qualified-name :keyword :one]
+ [:ast.deftype*/field :keyword :many]])
+
+(def op-defrecord*
+ [[:ast.defrecord*/name :keyword :one]
+ [:ast.defrecord*/ns :keyword :one]
+ [:ast.defrecord*/ns-qualified-name :keyword :one]
+ [:ast.defrecord*/field :keyword :many]])
+
(def op-default
[[:ast.default/op :keyword :one]
[:ast.default/child :ref :many]])
@@ -86,6 +98,8 @@
op-let
op-invoke
op-recur
+ op-deftype*
+ op-defrecord*
op-default)))

0 comments on commit 1b76af2

Please sign in to comment.