1979-811
Copyright © 2012-2013 Håkan Råberg | shower
神(define unique
{(list A) --> (list A)}
[] -> []
[X | Y] -> (unique Y) where (element? X Y)
[X | Y] -> [X | (unique Y)])
Shen runs under a reduced instruction Lisp and is designed for portability. [..] It currently runs under CLisp and SBCL, Clojure, Scheme, Ruby, Java and Javascript.
LOC 836 shen.clj, 1744 Shen.java
GNU Emacs 24.2 (jvm-1.8.0-ea_clojure-1.5.1)
of 2013-05-04 on X202E
buffer.c
coding.c
data.c
editfns.c
eval.c
fileio.c
fns.c
frame.c
keyboard.c
keymap.c
lread.c
minibuf.c
process.c
search.c
window.c
xdisp.c
...
CDEFUN ("sqrt", Fsqrt, Ssqrt, 1, 1, 0,
doc: /* Return the square root of ARG. */)
(register Lisp_Object arg) {
double d = extract_float (arg);
#ifdef FLOAT_CHECK_DOMAIN
if (d < 0.0)
domain_error ("sqrt", arg);
#endif
IN_FLOAT (d = sqrt (d), "sqrt", arg);
return make_float (d);
}
Clojure(defun sqrt (arg)
"Return the square root of ARG."
(Math/sqrt arg))
Emacs Lisp defun(defun make-vector (length init)
"Return a newly created vector of length LENGTH,
with each element being INIT.
See also the function `vector'."
Clojure body (doto (object-array length)
Java interop (Arrays/fill init))
Clojure(defn el-var [name]
((some-fn
*dynamic-vars*
(partial el-var-buffer-local true)
global)
name))
...
(create-ns 'deuce.emacs-lisp.globals)
Emacs Lisp(defvar x -99) ⇒ x
(defun getx ()
x) ⇒ getx
(let ((x 1))
(getx)) ⇒ 1
(getx) ⇒ -99
Emacs Lisp(defun delete-dups (list)
"Destructively remove `equal' duplicates from LIST.
Store the result in LIST and return it."
(let ((tail list))
(while tail
(setcdr tail (delete (car tail) (cdr tail)))
(setq tail (cdr tail))))
list)
Clojure(defn field-accessor [prefix field class]
(eval `(def ^{:private true :tag `Field}
~(symbol (str prefix (name field)))
(doto (.getDeclaredField ~class ~(name field))
(.setAccessible true)))))
(doseq [field '[_first _rest _count]]
(field-accessor "l" field PersistentList))
ICons
(setcar [^PersistentList this val]
(do (.set l_first this val) val))
Clojure(c/defmacro ^:clojure-special-form if
[cond then & else]
`(c/cond (not-null? ~(el->clj cond)) ~(el->clj then)
:else (progn ~@else)))
(c/defmacro progn [& body]
`(do ~@(map el->clj body)))
Clojure
(defn el->clj [x]
(condp some [x]
#{()} nil
seq? (c/let [[fst & rst] x]
(if (c/and (symbol? fst)
(not= 'progn fst)
(-> (fun fst) meta :macro))
(if (c/or (clojure-special-forms fst) ('#{let lambda} fst)) ;; defun defvar ?
(if (= 'quote fst)
(if-let [s (c/and (symbol? (first rst)) (not (next rst)) (first rst))]
(list 'quote (if (= "deuce.emacs" (namespace s)) (sym s) s))
(if (= '(()) rst) () x))
(apply cons/list (c/cons (symbol "deuce.emacs-lisp" (name fst)) rst)))
(apply cons/list x))
(if (#{`el-var-get `el-var-set `el-var-set-default `delayed-eval
'#el/sym "\\," '#el/sym "\\,@"} fst)
x
(if (= '#el/sym "\\`" fst)
(emacs-lisp-backquote x) ;; See below, we dont want to duplicate this if not necessary.
(if (c/and (symbol? fst)
(not (namespace fst))
(not (fun fst)))
(if (*disallow-undefined* fst)
`(throw* '~'void-function '~fst)
(do (debug fst "NOT DEFINED")
(list `delayed-eval x)))
(expand-dotted-lists (c/cons
(if (seq? fst) (el->clj fst) fst)
(map el->clj rst))))))))
symbol? (if (namespace x)
(if (-> (resolve x) meta :macro) (resolve x) x)
(if (#{'#el/sym "\\," '#el/sym "\\,@" '.} x)
x
(list `el-var-get x)))
x))
Emacs Lisp(let ((x 1))
(getx))
⇒
Clojure(let* [local__2368 1
x local__2368]
(deuce.emacs-lisp/with-local-el-vars (x x)
(deuce.emacs-lisp/progn
(getx))))
Emacs Lisp(pcase res
(`(,_ . ,(and (pred functionp) f)) (funcall f))
(`(,hookfun . (,start ,end ,collection . ,plist))
(let* ((completion-extra-properties plist)
(completion-in-region-mode-predicate
(lambda ()
;; We're still in the same completion field.
(eq (car-safe (funcall hookfun)) start))))
(completion-in-region start end collection
(plist-get plist :predicate))))
;; Maybe completion already happened
(_ (cdr res)))))
Clojure(pcase res
((#el/sym "\\`"
((#el/sym "\\," _) . (#el/sym "\\," (and (pred functionp) f))))
(funcall f))
((#el/sym "\\`"
((#el/sym "\\," hookfun)
.
((#el/sym "\\," start)
(#el/sym "\\," end)
(#el/sym "\\," collection)
.
(#el/sym "\\," plist))))
(let* ((completion-extra-properties plist)
(completion-in-region-mode-predicate
(lambda () (eq (car-safe (funcall hookfun)) start))))
(completion-in-region start end collection
(plist-get plist :predicate))))
(_ (cdr res)))
Emacs Lisp;;;***
;;;### (autoloads (doctor) "doctor" "play/doctor.el" (20800 51483))
;;; Generated autoloads from play/doctor.el
(autoload 'doctor "doctor" "\
Switch to *doctor* buffer and start giving psychotherapy.
\(fn)" t nil)
Clojure(defun autoload (function file &optional docstring interactive type)
(when (or (not (el/fun function)) (-> (el/fun function) meta :autoload))
(let [autoload-symbol (fn autoload-symbol [function]
(let [f (el/fun function)]
(when (-> f meta :autoload)
(ns-unmap 'deuce.emacs (el/sym function))
((el/fun 'load) (-> f meta :file) nil true))))
definition (fn autoload [& args]
(autoload-symbol function)
(c/apply (el/fun function) args))] ;; el->clj?
(ns-unmap 'deuce.emacs function)
(el/defvar-helper* 'deuce.emacs function definition docstring)
(alter-meta! (el/fun function) merge {:autoload true :file file}
(when interactive {:interactive nil}))
function))
CharTable
BufferText
Buffer
Marker
Frame
Window
...
[..] the ad-hoc mess of "vectors of length 259 of lists whose first element is the symbol `indirect' and whose tail is an alist of conses whose ..."1
