1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
|
;;; tertiary.clj
;;; Copyright (C) 2012 Stephen Compall
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
(ns com.nocandysw.cloj-dummy.scala.tertiary
"Utilities for parent."
(:use [clojure.pprint :only (cl-format)]
[clojure.core.match :only (match)]))
(defmacro an-expr
"Answer X literally, what its expression type is, the eval of
X, and its value type."
[x]
`(let [xv# ~x]
['~x, (class '~x), xv#, (class xv#)]))
(defn relativize
"Relativize FNAME, according to current directory if not provided."
([fname] (relativize (System/getProperty "user.dir") fname))
([wd fname]
(let [wd (str wd), fname (str fname)]
(if (.startsWith fname wd)
(subs fname (inc (count wd)))
fname))))
(defmacro fnmatch
"Lift a variadic series of match clauses into a `fn'."
{:arglists '([name? clauses])}
[sym-or-fst & args]
(let [[fname args] (if (symbol? sym-or-fst)
[[sym-or-fst] args]
[nil (cons sym-or-fst args)])]
`(fn ~@fname
~@(->> args (partition 2)
(group-by (comp count first))
(sort-by first)
(map (fn [[arity clauses]]
(let [ll (take arity (repeatedly gensym))]
`([~@ll] (match [~@ll]
~@(apply concat clauses))))))))))
(defn compile-time-warning
"Nicely format a compiler warning."
[form msg]
(cl-format *err* "~A:~A: Warning: ~A~%"
(when *file* (relativize *file*))
(-> form meta :line)
msg)
(.flush *err*))
(defn illegal-arg!
"Complain WHY."
[why]
(throw (IllegalArgumentException. (str why))))
;;; tertiary.clj ends here
|