diff options
| -rw-r--r-- | src/lux/compiler.clj | 3 | ||||
| -rw-r--r-- | src/lux/compiler/lux.clj | 14 | ||||
| -rw-r--r-- | src/lux/optimizer.clj | 47 |
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] |