aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/lux/compiler.clj3
-rw-r--r--src/lux/compiler/lux.clj14
-rw-r--r--src/lux/optimizer.clj47
3 files changed, 64 insertions, 0 deletions
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 19832d4e6..fe3a24c32 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -94,6 +94,9 @@
(&o/$let _value _register _body)
(&&lux/compile-let (partial compile-expression $begin) _value _register _body)
+ (&o/$record-get _value _path)
+ (&&lux/compile-record-get (partial compile-expression $begin) _value _path)
+
(&o/$function ?arity ?scope ?env ?body)
(&&lambda/compile-function compile-expression &/$None ?arity ?scope ?env ?body)
diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj
index 83bb2ac44..6b5ec6a19 100644
--- a/src/lux/compiler/lux.clj
+++ b/src/lux/compiler/lux.clj
@@ -189,6 +189,20 @@
_ (compile _body)]
(return nil)))
+(defn compile-record-get [compile _value _path]
+ (|do [^MethodVisitor *writer* &/get-writer
+ _ (compile _value)
+ :let [_ (&/|map (fn [step]
+ (|let [[idx tail?] step]
+ (doto *writer*
+ (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;")
+ (.visitLdcInsn (int idx))
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT"
+ (if tail? "product_getRight" "product_getLeft")
+ "([Ljava/lang/Object;I)Ljava/lang/Object;"))))
+ _path)]]
+ (return nil)))
+
(defn ^:private compile-def-type [compile ?body]
(|do [:let [?def-type (|case ?body
[[?def-type ?def-cursor] (&a/$ann ?def-value ?type-expr ?def-value-type)]
diff --git a/src/lux/optimizer.clj b/src/lux/optimizer.clj
index fd859d90d..933849be3 100644
--- a/src/lux/optimizer.clj
+++ b/src/lux/optimizer.clj
@@ -28,6 +28,7 @@
;; Purely for optimizations
("loop" 1)
("let" 3)
+ ("record-get" 2)
)
;; For pattern-matching
@@ -311,11 +312,47 @@
(inc _register)
_register)
(shift-function-body old-scope new-scope own-body? _body))])
+
+ ($record-get _value _path)
+ (&/T [meta ($record-get (shift-function-body old-scope new-scope own-body? _value)
+ _path)])
_
body
)))
+(defn ^:private record-read-path [pms member-idx]
+ "(-> (List PM) Idx (List Idx))"
+ (loop [current-idx 0
+ pms pms]
+ (|case pms
+ (&/$Nil)
+ &/$None
+
+ (&/$Cons _pm _pms)
+ (|case _pm
+ (&a-case/$NoTestAC)
+ (recur (inc current-idx)
+ _pms)
+
+ (&a-case/$StoreTestAC _register)
+ (if (= member-idx _register)
+ (&/|list (&/T [current-idx (&/|empty? _pms)]))
+ (recur (inc current-idx)
+ _pms))
+
+ (&a-case/$TupleTestAC _sub-tests)
+ (let [sub-path (record-read-path _sub-tests member-idx)]
+ (if (not (&/|empty? sub-path))
+ (&/$Cons (&/T [current-idx (&/|empty? _pms)]) sub-path)
+ (recur (inc current-idx)
+ _pms)
+ ))
+
+ _
+ (&/|list))
+ )))
+
(defn ^:private optimize-loop [arity optim]
"(-> Int Optimized Optimized)"
(|let [[meta optim-] optim]
@@ -382,6 +419,16 @@
(&/$Cons [(&a-case/$StoreTestAC _register) _body] (&/$Nil))
(&/T [meta ($let (pass-0 value) _register (pass-0 _body))])
+ (&/$Cons [(&a-case/$TupleTestAC _sub-tests) [_ (&a/$var (&/$Local _member-idx))]] (&/$Nil))
+ (|let [_path (record-read-path _sub-tests _member-idx)]
+ (if (&/|empty? _path)
+ (&/T [meta ($case (pass-0 value)
+ (optimize-pm (&/|map (fn [branch]
+ (|let [[_pattern _body] branch]
+ (&/T [_pattern (pass-0 _body)])))
+ branches)))])
+ (&/T [meta ($record-get (pass-0 value) _path)])))
+
_
(&/T [meta ($case (pass-0 value)
(optimize-pm (&/|map (fn [branch]