latest work on ssa

project.clj

@@ -2,7 +2,7 @@
   :description "FIXME: write description"
   :url "http://example.com/FIXME"
   :license {:name "MIT License"}
-  :dependencies [[org.clojure/clojure "1.5.0"]
+  :dependencies [[org.clojure/clojure "1.5.1"]
                  [com.datomic/datomic-free "0.8.3826" ]
                  [speclj "2.5.0"]
                  [net.java.dev.jna/jna "3.4.0"]

src/examples/bf.clj

@@ -96,8 +96,7 @@
   [ip code]
   (let [ip_name (name (gensym "ip_"))
         {ret-code :code ret-ip :ip}
-        (compile-block (exp/->Local ip_name) (next code))
-        ]
+        (compile-block (exp/->Local ip_name) (next code))]
 
     {:ip (exp/->Loop [[ip_name ip]]
                      (c/if (c/is (c/aget cells (exp/->Local ip_name)) Zero8)
@@ -119,7 +118,7 @@
                                  (loop [ip 0
                                         code program-code]
                                    (let [{ip :ip code :code} (compile-bf ip code)]
-                                     #_(println "::::: " code)
+
                                      (if code
                                        (recur ip code)
                                        ip)))))]

src/mjolnir/expressions.clj

@@ -1,5 +1,6 @@
 (ns mjolnir.expressions
   (:require [mjolnir.types :refer :all]
+            [mjolnir.ssa :as ssa]
             [mjolnir.llvmc :as llvm]
             [mjolnir.config :refer :all]
             [clojure.java.shell :as shell]
@@ -331,7 +332,23 @@
                                                              (= :extern
                                                                 (:linkage this))))
       (llvm/SetLinkage gbl (llvm/kw->linkage :extern))
-      gbl)))
+      gbl))
+  ssa/IToDatoms
+  (ssa/-to-datoms [this conn]
+    (let [tp (ssa/-to-datoms type conn)
+          arg-ids (map #(-> (ssa/transact-new conn
+                                              {:argument/name %2
+                                               :argument/idx %1})
+                            :db/id)
+                       (range)
+                       arg-names)
+          names (ssa/transact-seq conn arg-ids)
+          body-id (-> (ssa/-to-datoms body conn)
+                      :db/id)]
+      {:fn/type (:db/id tp)
+       :fn/name name
+       :fn/argument-names names
+       :fn/body body-id})))
 
 (defrecord Module [name body]
   Validatable  
@@ -971,7 +988,17 @@
     (assert *int-type* "No type set for ints")
     *int-type*)
   (build [this]
-    (encode-const *int-type* this)))
+    (encode-const *int-type* this))
+  ssa/IToDatoms
+  (ssa/-to-datoms [this conn]
+    (ssa/transact-new
+     conn
+     {:node/type :type/const
+      :const/int-value this
+      :node/return-type (-> (ssa/-to-datoms
+                             *int-type*
+                             conn)
+                            :db/id)})))
 
 (extend-type java.lang.Double
   Validatable
@@ -982,7 +1009,16 @@
     (assert *float-type* "No type set for floats")
     *float-type*)
   (build [this]
-    (encode-const *float-type* this)))
+    (encode-const *float-type* this))
+  ssa/IToDatoms
+  (ssa/-to-datoms [this conn]
+    (ssa/transact-new
+     conn
+     {:node/type :type/const
+      :node/return-type (-> (ssa/-to-datoms
+                             *float-type*
+                             conn)
+                            :db/id)})))
 
 
 

src/mjolnir/ssa.clj

@@ -18,21 +18,34 @@
 
 (def kw->attrs
   {:one [:db/cardinality :db.cardinality/one]
+   :many [:db/cardinality :db.cardinalty/many]
    :ref [:db/valueType :db.type/ref]
    :keyword [:db/valueType :db.type/keyword]
-   :int [:db/valueType :db.type/long]})
+   :int [:db/valueType :db.type/long]
+   :string [:db/valueType :db.type/string]
+   :unique [:db/unique :db.unique/value]})
 
 
 (defn default-schema []
   {:list/tail #{:one :ref}
    :fn/type #{:one :ref}
+   :fn/argument-names #{:one :ref}
+   :fn/name #{:one :string}
+   :fn/body #{:one :ref}
+
+   :const/int-value #{:one :int}
+
+   :argument/name #{:one :string}
+   :argument/idx #{:one :int}
 
    :type.fn/return #{:one :ref}
    :type.fn/arguments #{:one :ref}
 
    :list/head #{:one :ref} 
 
    :node/type #{:one :keyword}
+   :node/return-type #{:one :ref}
+
    :type/width #{:one :int}
 
    :type/element-type #{:one :ref}

test/mjolnir/ssa_test.clj

@@ -1,11 +1,14 @@
 (ns mjolnir.ssa-test
   (:require
+   [mjolnir.config :refer [*int-type*]]
    [mjolnir.ssa :refer :all]
    [mjolnir.types :refer [Int64 Int32 Float64 Float32 Float32* Float64*
                           ->FunctionType]]
+   [mjolnir.expressions :refer [->Fn]]
    [midje.sweet :refer :all]))
 
-(with-state-changes [(around :facts (binding [*db-conn* (new-db)] ?form))]
+(with-state-changes [(around :facts (binding [*db-conn* (new-db)
+                                              *int-type* Int64] ?form))]
   (facts "IntegerType"
          (fact "IntegerType is singleton"
                (to-datoms Int64) => (to-datoms Int64))
@@ -38,4 +41,36 @@
                  (to-seq (:type.fn/arguments (to-datoms ft)))
                  =>
                  [(to-datoms Float64)
-                  (to-datoms Int64)]))))
+                  (to-datoms Int64)])))
+
+  (let [ft (->FunctionType [Int64] Int64)
+        f (->Fn "ret0" ft ["a" "b"]
+                0)]
+    (facts "Fn"
+           (fact "Functions create new entities each time"
+                 (to-datoms f)
+                 =not=>
+                 (to-datoms f))
+           (fact "Functions with the same types are the same types"
+                 (:fn/type (to-datoms f))
+                 =>
+                 (:fn/type (to-datoms f)))
+           (fact "Functions assert names"
+                 (->> (to-datoms f)
+                      :fn/argument-names
+                      to-seq
+                      (map :argument/name))
+                 =>
+                 ["a" "b"])
+           (fact "Functions assert indexes"
+                 (->> (to-datoms f)
+                      :fn/argument-names
+                      to-seq
+                      (map :argument/idx))
+                 =>
+                 [0 1]))
+    (facts "Long"
+           (fact "Can be transacted"
+                 (:const/int-value (to-datoms 0))
+                 =>
+                 0))))