erlang.clj

;;Jonathan Smith 2010
;;inspired by esessoms clj-interface
;;http://github.com/esessoms/clj-interface

(ns libs.erlang (:import
	    [com.ericsson.otp.erlang
	     OtpErlangAtom
	     OtpErlangBinary
	     OtpErlangBoolean
	     OtpErlangChar
	     OtpErlangDouble
	     OtpErlangInt
	     OtpErlangList
	     OtpErlangLong
	     OtpErlangObject
	     OtpErlangRef
	     OtpErlangString
	     OtpErlangTuple
	     OtpNode]
	    [java.lang Thread Runtime])
    (:require [clojure.contrib.types :as types]))
 

  (defmulti convert class)
 
 
  (defmethod convert clojure.lang.Keyword [s]
    (new OtpErlangAtom (name s)))

  (defmethod convert OtpErlangAtom [s]
    (keyword (.atomValue s)))
 
  (defmethod convert java.lang.Object [o]
    (new OtpErlangBinary o))
 
  (defmethod convert OtpErlangBinary [o]
    (.getObject o))
 
  (defmethod convert java.lang.Boolean [b]
    (new OtpErlangBoolean b))
 
  (defmethod convert OtpErlangBoolean [b]
    (.booleanValue b))
 
  (defmethod convert java.lang.Character [c]
    (new OtpErlangChar c))
 
  (defmethod convert OtpErlangChar [c]
    (.charValue c))
 
  (defmethod convert java.lang.Double [d]
    (new OtpErlangDouble d))
 
  (defmethod convert OtpErlangDouble [d]
    (.doubleValue d))
 
  (defmethod convert java.lang.Integer [i]
    (new OtpErlangInt i))
 
  (defmethod convert OtpErlangInt [i]
    (.intValue i))

  (defmethod convert java.lang.String [s]
    (new OtpErlangString s))
 
  (defmethod convert OtpErlangString [s]
    (.stringValue s))

  (defmethod convert java.lang.Long [i]
    (new OtpErlangLong i))
 
  (defmethod convert OtpErlangLong [i]
    (.longValue i))

  (defmethod convert nil [_]
    (new OtpErlangList (into-array OtpErlangObject [])))

  (defmethod convert clojure.lang.IPersistentVector [vec]
    (new OtpErlangTuple (into-array OtpErlangObject (map convert vec))))

  (defmethod convert OtpErlangTuple [vec]
    (apply vector (map convert (seq (.elements vec)))))

  (defmethod convert OtpErlangObject [o]
    o)
 
(let [to-erlang-list 
      (fn [lst] 
	(new OtpErlangList 
	     (into-array OtpErlangObject 
			 (map convert lst))))]

  (defmethod convert clojure.lang.Sequential [lst]
    (to-erlang-list lst))
 
  (defmethod convert clojure.lang.PersistentHashMap [map]
    (to-erlang-list (cons :hash-map (seq map))))

  (defmethod convert clojure.lang.PersistentHashSet [set]
    (to-erlang-list (cons :hash-set (seq set))))

  (defmethod convert clojure.lang.PersistentTreeMap [tmap]
    (to-erlang-list (cons :tree-map (seq tmap))))

  (defmethod convert clojure.lang.PersistentTreeSet [tset]
    (to-erlang-list (cons :tree-set (seq tset)))))

(let [to-clojure-seq (fn [lst] (map convert (seq (.elements lst))))]
  (defmethod convert OtpErlangList [lst]
    (let [seq (to-clojure-seq lst)
	  H (first seq), T (rest seq)]
      (cond (= H :hash-map)
	    (apply hash-map T)
	    (= H :hash-set)
	    (apply hash-set T)
	    (= H :tree-map)
	    (apply sorted-map T)
	    (= H :tree-set)
	    (apply sorted-set T)
	    :else seq))))

(defn start-epmd [] (.exec (Runtime/getRuntime) "epmd"))

(def *epmd* (start-epmd))
(def *node* (new OtpNode "clojure" "cookie"))
(def *mbox* (.createMbox *node*))

(defmacro erl-receive [& body]
  `(let [rec*# (.receive *mbox*)
	 rec# (convert rec*#)]
     ;(println (list rec*# rec#))
     (types/match rec# ~@body)))

(defn erl-send
  ([pid msg]
     (erl-send *mbox* pid msg))
  ([mbox pid msg]
     (if (vector? pid)
       (let [[name node] pid]
	 (erl-send mbox name node msg))
       (.send mbox pid (convert msg))))
  ([mbox name node msg]
     (.send mbox (str name) (str node) (convert msg))))


(defn spawn 
  ([fun funargs]
     (let [mbox (.createMbox *node*)
	   node *node*]
       (.start (new Thread #(binding [*node* node
				      *mbox* mbox] 
			      (apply fun funargs))))
       (.self mbox)))
  ([process-name fun funargs]
     (let [mbox (.createMbox *node* process-name)
	   node *node*]
       (.start (new Thread #(binding [*node* node
				      *mbox* mbox] 
			      (apply fun funargs)
			      (.registerName *mbox* nil))))
       (.self mbox))))


(defn self []
  (.self *mbox*))

(defmacro defnode [name [node-name cookie]]
  `(defonce ~name (new OtpNode ~node-name ~cookie)))

(defmacro with-node [node & body]
  `(binding [*node* ~node]
     ~@body))

(defmacro with-mbox [node & body]
  `(with-node 
    ~node
    (binding [*mbox* (.createMbox *node*)]
      ~@body)))