latest updates and fixes

resources/examples/simple-lisp/fib.lisp

@@ -7,4 +7,4 @@
          (fib (+ a -2))))))
 
 (defn -run []
-  (print (fib 40)))
+  (fib 10))

src/mjolnir/constructors_init.clj

@@ -301,6 +301,15 @@
 
 (defn- convert-form-1 [x]
   (cond
+   (and (seq? x)
+        (symbol? (first x))
+        (> (count (name (first x))) 2)
+        (= (.substring (name (first x)) 0 2) ".-"))
+   (convert-form (list 'get
+                       (fnext x)
+                       (keyword (.substring (name (first x)) 2))))
+
+
    (seq? x)
    (convert-form x)
 
@@ -312,7 +321,7 @@
 
    (set? x)
    (into #{} (convert-form x))
-
+   
    (and (symbol? x)
         (constructor? x))
    (let [s

src/mjolnir/core.clj

@@ -7,7 +7,7 @@
    [datomic.api :refer [q db] :as d]
    [mjolnir.config :refer [*int-type* *target* default-target]]
    [mjolnir.ssa :refer :all]
-   [mjolnir.llvm-builder :refer [build dump verify]]))
+   [mjolnir.llvm-builder :refer [build dump optimize verify]]))
 
 (defn to-db [m]
   (let [conn (new-db)]
@@ -24,6 +24,7 @@
   (let [built (build (db conn))]
     #_(dump built)
     (verify built)
+    (optimize built)
     built))
 
 (defn build-module [m]

src/mjolnir/inference.clj

@@ -55,26 +55,27 @@
         data (map (fn [[id attr val]]
                     [:db/add id attr val])
                   nodes)]
-    (d/transact conn data)
-    (let [remaining (concat (q '[:find ?id ?attr
+    @(d/transact conn data)
+    (let [db-val (db conn)
+          remaining (concat (q '[:find ?id ?attr
                                  :where
                                  [?id :node/return-type ?tp]
                                  [?tp :node/type :node.type/unknown]
                                  [(identity :node/return-type) ?attr]]
-                               (db conn))
+                               db-val)
                             (q '[:find ?id ?attr
                                  :where
                                  [?id :inst.cast/type :inst.cast/unknown]
                                  [?id :node/return-type ?tp-to]
                                  [?tp-to :node/type ?data1]
                                  [(identity :inst.cast/type) ?attr]]
-                               (db conn)))]
+                               db-val))]
       (when-not (= 0 (count remaining))
         (println "Remaining nodes...")
         (println (pr-str (q '[:find ?nm
                               :where
                               [_ :fn/name ?nm]]
-                            (db conn))))
+                            db-val)))
         (doseq [[id attr] remaining]
           (let [ent (d/entity db-val id)]
             (println

src/mjolnir/llvm_builder.clj

@@ -59,7 +59,6 @@
 (defmulti build-type :node/type)
 
 (defmulti build-instruction (fn [d module builder fn inst defs]
-                              (println (:db/id inst))
                               (:inst/type inst)))
 
 (defmulti build-terminator (fn [module builder fn inst defs]
@@ -88,6 +87,9 @@
   [x]
   (llvm/VoidType))
 
+(defmethod encode-const :type/pointer
+  [tp val]
+  (llvm/ConstNull (build-type tp)))
 
 
 (defmethod build-type :type/float
@@ -314,6 +316,14 @@
                 blocks)]
       (link-phi-nodes this defs))))
 
+(defmethod build-item :node.type/global
+  [db-val module {name :global/name type :global/type :as this}]
+  (when-not (:global/extern? this)
+    (let [gbl (llvm/GetNamedGlobal module name)]
+      (assert gbl (str "Can't find Global " (pr-str name)))
+      (llvm/SetInitializer gbl (encode-const type val))
+      gbl)))
+
 
 (defmethod build-instruction :default
   [d module builder fn itm defs]
@@ -387,6 +397,11 @@
                [dest]
                (llvm/BuildBr builder dest)))
 
+(defmethod build-instruction :inst.type/sizeof
+  [d module builder fn inst defs]
+  (assoc defs inst
+          (llvm/SizeOf (build-type (:inst.sizeof/type inst)))))
+
 (defmethod build-instruction :inst.type/br
   [d module builder fn inst defs]
   (unpack-args defs inst
@@ -496,6 +511,15 @@
      (llvm/BuildCall builder fnc (llvm/map-parr identity args) (count args) (str (:db/id inst)))
      (assoc defs inst))))
 
+(defmethod build-instruction :inst.type/callp
+  [d module builder fn inst defs]
+  (let [args (map defs (args-seq inst))
+        fnc (defs (:inst.callp/fn inst))]
+    (assert (and (every? identity args) fnc))
+    (->>
+     (llvm/BuildCall builder fnc (llvm/map-parr identity args) (count args) (str (:db/id inst)))
+     (assoc defs inst))))
+
 
 (defmethod build-instruction :inst.type/malloc
   [d module builder fn inst defs]
@@ -586,7 +610,6 @@
   [d module builder fn inst defs]
   (unpack-args defs inst
                [val]
-               (println (d/touch inst))
                (let [to-type (-> inst
                                  :node/return-type
                                  build-type)
@@ -660,8 +683,7 @@
                                             (build-type (pointer-to return-type))
                                             (str "casted_" (:db/id inst)))
                      gep (llvm/BuildStructGEP builder casted idx (str "gep_" (:db/id inst)))]
-                 (llvm/BuildLoad builder gep (str "get_"(:db/id inst)))
-                 ptr)))
+                 (llvm/BuildLoad builder gep (str "get_"(:db/id inst))))))
 
 (defn build [db]
   (let [globals (->> (q '[:find ?id

src/mjolnir/ssa_rules.clj

@@ -249,6 +249,12 @@
   [?arg1-t :node/type :type/pointer]
   [(identity :inst.cast.type/bitcast) ?op])
 
+(defrule cast-subtype [?id ?arg0-t ?arg1-t ?op]
+  "Functions can be bitcast"
+  [?arg0-t :node/type :type/fn]
+  [?arg1-t :node/type :type/pointer]
+  [(identity :inst.cast.type/bitcast) ?op])
+
 (defrule cast-subtype [?id ?arg0-t ?arg1-t ?op]
   "Larger Ints truncate to smaller ints"
   [?arg0-t :node/type :type/pointer]

test/mjolnir/simple_tests.clj

@@ -252,7 +252,7 @@
 
 (defnf struct-fn [MyStruct* foo -> Float64*]
   (set foo :x 42)
-  (get foo :x)
+  (.-x foo)
   (Float64* foo))
 
 (deftest compile-struct