Permalink
Browse files

Improved parser dispatch-form to handle namespace qualified symbol an…

…d added support for contrib version of deftype, fixes #39.
  • Loading branch information...
1 parent f292c87 commit 488b4e240c50a03e4c67da7f66dda0566e46a846 @budu committed May 14, 2011
Showing with 32 additions and 4 deletions.
  1. +17 −3 src/marginalia/parser.clj
  2. +15 −1 src/problem_cases/general.clj
View
@@ -86,11 +86,17 @@
;; HACK: to handle types
(catch Exception _)))
-(defmulti dispatch-form (fn [form _ _] (first form)))
+(defn unsymbol [sym]
+ (seq (.split (str sym) "/")))
+
+(defmulti dispatch-form
+ (fn [form _ _]
+ (let [[s1 s2] (-> form first unsymbol)]
+ (symbol (or s2 s1)))))
(defn- extract-common-docstring
- [form raw nspace-sym]
- (let [sym (second form)]
+ [form raw nspace-sym & [extractor]]
+ (let [sym ((or extractor second) form)]
(if (symbol? sym)
(do
(when (= 'ns (first form))
@@ -153,6 +159,14 @@
[form raw nspace-sym]
[nil raw nspace-sym])
+(defmethod dispatch-form 'deftype
+ [form raw nspace-sym]
+ (let [v (->> form first (ns-resolve nspace-sym))]
+ (if (and (= (str (.ns v)) "clojure.contrib.types")
+ (= (str (.sym v)) "deftype"))
+ (extract-common-docstring form raw nspace-sym #(nth % 2))
+ [nil raw nspace-sym])))
+
(defn dispatch-inner-form
[form raw nspace-sym]
(conj
@@ -1,6 +1,6 @@
(ns problem-cases.general
"A place to examine poor parser behavior. These should go in tests when they get written."
- )
+ (:require [clojure.contrib.types :as t]))
;; Should have only this comment in the left margin.
@@ -152,3 +152,17 @@
(greater 2 1) => truthy)
'(file->tickets commits)
+
+(t/deftype ::foo foo-t)
+
+(t/deftype ::foo2 foo2-t identity)
+
+(t/deftype ::bar bar-t "normal docstring")
+
+(t/deftype ::bar2 bar2-t "normal docstring" identity)
+
+;; this shouldn't happen in practice!
+
+(t/deftype ::baz baz-t {:doc "docs in attr-map"})
+
+(t/deftype ::baz2 baz2-t {:doc "docs in attr-map"} identity)

0 comments on commit 488b4e2

Please sign in to comment.