From ddcfead3ebf30fd8fef26f495662ef61e652ba4f Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 6 Sep 2021 02:17:41 -0400 Subject: Applied new convention for variants. --- lux-bootstrapper/src/lux/base.clj | 28 ++++----- lux-bootstrapper/src/lux/compiler/jvm/case.clj | 14 ++--- lux-bootstrapper/src/lux/compiler/jvm/lux.clj | 8 ++- lux-bootstrapper/src/lux/compiler/jvm/rt.clj | 86 +++++++++++++++----------- 4 files changed, 76 insertions(+), 60 deletions(-) (limited to 'lux-bootstrapper') diff --git a/lux-bootstrapper/src/lux/base.clj b/lux-bootstrapper/src/lux/base.clj index 41cf66a0f..911884769 100644 --- a/lux-bootstrapper/src/lux/base.clj +++ b/lux-bootstrapper/src/lux/base.clj @@ -31,25 +31,25 @@ (assert (> (count names) 1)) `(do ~@(for [[[name num-params] idx] (map vector names (range (count names))) :let [last-idx (dec (count names)) - is-last? (if (= idx last-idx) - "" - nil) + [lefts right?] (if (= idx last-idx) + [(dec idx) ""] + [idx nil]) def-name (with-meta (symbol (str "$" name)) - {::idx idx - ::is-last? is-last?})]] + {::lefts lefts + ::right? right?})]] (cond (= 0 num-params) `(def ~def-name - (to-array [(int ~idx) ~is-last? unit-tag])) + (to-array [(int ~lefts) ~right? unit-tag])) (= 1 num-params) `(defn ~def-name [arg#] - (to-array [(int ~idx) ~is-last? arg#])) + (to-array [(int ~lefts) ~right? arg#])) :else (let [g!args (map (fn [_] (gensym "arg")) (range num-params))] `(defn ~def-name [~@g!args] - (to-array [(int ~idx) ~is-last? (T [~@g!args])]))) + (to-array [(int ~lefts) ~right? (T [~@g!args])]))) )))) (defmacro deftuple [names] @@ -263,13 +263,11 @@ ;; else (mapv transform-pattern pattern)) - (seq? pattern) [(if-let [tag-var (ns-resolve *ns* (first pattern))] - (-> tag-var - meta - ::idx) - (assert false (str "Unknown var: " (first pattern)))) - '_ - (transform-pattern (vec (rest pattern)))] + (seq? pattern) (if-let [tag-var (ns-resolve *ns* (first pattern))] + [(-> tag-var meta ::lefts) + (-> tag-var meta ::right?) + (transform-pattern (vec (rest pattern)))] + (assert false (str "Unknown var: " (first pattern)))) :else pattern)) (defmacro |case [value & branches] diff --git a/lux-bootstrapper/src/lux/compiler/jvm/case.clj b/lux-bootstrapper/src/lux/compiler/jvm/case.clj index 8a41db0b3..6bd9a3824 100644 --- a/lux-bootstrapper/src/lux/compiler/jvm/case.clj +++ b/lux-bootstrapper/src/lux/compiler/jvm/case.clj @@ -133,17 +133,17 @@ (&o/$VariantPM _idx+) (|let [$success (new Label) $fail (new Label) - [_idx is-last] (|case _idx+ - (&/$Left _idx) - (&/T [_idx false]) + [_lefts _right?] (|case _idx+ + (&/$Left _idx) + (&/T [_idx false]) - (&/$Right _idx) - (&/T [_idx true])) + (&/$Right _idx) + (&/T [(dec _idx) true])) _ (doto writer stack-peek (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;") - (.visitLdcInsn (int _idx))) - _ (if is-last + (.visitLdcInsn (int _lefts))) + _ (if _right? (.visitLdcInsn writer "") (.visitInsn writer Opcodes/ACONST_NULL))] (doto writer diff --git a/lux-bootstrapper/src/lux/compiler/jvm/lux.clj b/lux-bootstrapper/src/lux/compiler/jvm/lux.clj index a93c87ae8..336f46998 100644 --- a/lux-bootstrapper/src/lux/compiler/jvm/lux.clj +++ b/lux-bootstrapper/src/lux/compiler/jvm/lux.clj @@ -75,7 +75,9 @@ (defn compile-variant [compile tag tail? value] (|do [^MethodVisitor *writer* &/get-writer - :let [_ (.visitLdcInsn *writer* (int tag)) + :let [_ (.visitLdcInsn *writer* (int (if tail? + (dec tag) + tag))) _ (if tail? (.visitLdcInsn *writer* "") (.visitInsn *writer* Opcodes/ACONST_NULL))] @@ -342,7 +344,7 @@ $end (new Label) _ (doto main-writer ;; Tail: Begin - (.visitLdcInsn (->> #'&/$End meta ::&/idx int)) ;; I + (.visitLdcInsn (->> #'&/$End meta ::&/lefts int)) ;; I (.visitInsn Opcodes/ACONST_NULL) ;; I? (.visitLdcInsn &/unit-tag) ;; I?U (.visitMethodInsn Opcodes/INVOKESTATIC &rt/rt-class "sum_make" "(ILjava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;") ;; V @@ -381,7 +383,7 @@ (.visitInsn Opcodes/AASTORE) ;; I2 ;; Tuple: End ;; Item: Begin - (.visitLdcInsn (->> #'&/$Item meta ::&/idx int)) ;; I2I + (.visitLdcInsn (->> #'&/$Item meta ::&/lefts int)) ;; I2I (.visitLdcInsn "") ;; I2I? (.visitInsn Opcodes/DUP2_X1) ;; II?2I? (.visitInsn Opcodes/POP2) ;; II?2 diff --git a/lux-bootstrapper/src/lux/compiler/jvm/rt.clj b/lux-bootstrapper/src/lux/compiler/jvm/rt.clj index 73812ef8f..23b7c1be9 100644 --- a/lux-bootstrapper/src/lux/compiler/jvm/rt.clj +++ b/lux-bootstrapper/src/lux/compiler/jvm/rt.clj @@ -153,65 +153,81 @@ (.visitEnd))) _ (let [$loop (new Label) $perfect-match! (new Label) - $tags-match! (new Label) + $lefts-match! (new Label) $maybe-nested (new Label) $mismatch! (new Label) !variant ( (.visitVarInsn Opcodes/ALOAD 0)) - !tag ( (.visitVarInsn Opcodes/ILOAD 1)) - !last? ( (.visitVarInsn Opcodes/ALOAD 2)) + !lefts ( (.visitVarInsn Opcodes/ILOAD 1)) + !right? ( (.visitVarInsn Opcodes/ALOAD 2)) - <>tag ( (.visitLdcInsn (int 0)) - (.visitInsn Opcodes/AALOAD) - &&/unwrap-int) - <>last? ( (.visitLdcInsn (int 1)) - (.visitInsn Opcodes/AALOAD)) + <>lefts ( (.visitLdcInsn (int 0)) + (.visitInsn Opcodes/AALOAD) + &&/unwrap-int) + <>right? ( (.visitLdcInsn (int 1)) + (.visitInsn Opcodes/AALOAD)) <>value ( (.visitLdcInsn (int 2)) (.visitInsn Opcodes/AALOAD)) not-found ( (.visitInsn Opcodes/ACONST_NULL)) - super-nested-tag ( (.visitInsn Opcodes/SWAP) - (.visitInsn Opcodes/ISUB)) - super-nested ( super-nested-tag ;; super-tag - !variant <>last? ;; super-tag, super-last - !variant <>value ;; super-tag, super-last, super-value + super-nested-lefts ( (.visitInsn Opcodes/SWAP) + (.visitInsn Opcodes/ISUB) + (.visitLdcInsn (int 1)) + (.visitInsn Opcodes/ISUB)) + super-nested ( super-nested-lefts ;; super-lefts + !variant <>right? ;; super-lefts, super-right? + !variant <>value ;; super-lefts, super-right?, super-value (.visitMethodInsn Opcodes/INVOKESTATIC rt-class "sum_make" "(ILjava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;")) update-!variant ( !variant <>value (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;") (.visitVarInsn Opcodes/ASTORE 0)) - update-!tag ( (.visitInsn Opcodes/ISUB)) + update-!lefts ( (.visitInsn Opcodes/ISUB) + (.visitLdcInsn (int 1)) + (.visitInsn Opcodes/ISUB)) iterate! (fn [^Label $loop] ( update-!variant - update-!tag + update-!lefts (.visitJumpInsn Opcodes/GOTO $loop)))] (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "sum_get" "([Ljava/lang/Object;ILjava/lang/Object;)Ljava/lang/Object;" nil nil) (.visitCode) - !tag ;; tag + !lefts ;; lefts (.visitLabel $loop) - !variant <>tag ;; tag, variant::tag - (.visitInsn Opcodes/DUP2) (.visitJumpInsn Opcodes/IF_ICMPEQ $tags-match!) ;; tag, variant::tag - (.visitInsn Opcodes/DUP2) (.visitJumpInsn Opcodes/IF_ICMPGT $maybe-nested) ;; tag, variant::tag - !last? (.visitJumpInsn Opcodes/IFNULL $mismatch!) ;; tag, variant::tag + !variant <>lefts ;; lefts, variant::lefts + (.visitInsn Opcodes/DUP2) (.visitJumpInsn Opcodes/IF_ICMPEQ $lefts-match!) ;; lefts, variant::lefts + (.visitInsn Opcodes/DUP2) (.visitJumpInsn Opcodes/IF_ICMPGT $maybe-nested) ;; lefts, variant::lefts + !right? (.visitJumpInsn Opcodes/IFNULL $mismatch!) ;; lefts, variant::lefts super-nested ;; super-variant (.visitInsn Opcodes/ARETURN) - (.visitLabel $tags-match!) ;; tag, variant::tag - !last? ;; tag, variant::tag, last? - !variant <>last? + ;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;;;;;; $lefts-match! ;;;;;; + ;;;;;;;;;;;;;;;;;;;;;;;;;;; + (.visitLabel $lefts-match!) ;; lefts, variant::lefts + !right? ;; lefts, variant::lefts, right? + !variant <>right? ;; lefts, variant::lefts, right?, variant::right? (.visitJumpInsn Opcodes/IF_ACMPEQ $perfect-match!) - (.visitLabel $maybe-nested) ;; tag, variant::tag - !variant <>last? ;; tag, variant::tag, variant::last? - (.visitJumpInsn Opcodes/IFNULL $mismatch!) ;; tag, variant::tag - ((iterate! $loop)) - (.visitLabel $perfect-match!) - ;; (.visitInsn Opcodes/POP2) - !variant <>value - (.visitInsn Opcodes/ARETURN) - (.visitLabel $mismatch!) ;; tag, variant::tag + ;;;;;;;;;;;;;;;;;;;;;;;; + ;;;;;; $mismatch! ;;;;;; + ;;;;;;;;;;;;;;;;;;;;;;;; + (.visitLabel $mismatch!) ;; lefts, variant::lefts ;; (.visitInsn Opcodes/POP2) not-found (.visitInsn Opcodes/ARETURN) + ;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;;;;;; $maybe-nested ;;;;;; + ;;;;;;;;;;;;;;;;;;;;;;;;;;; + (.visitLabel $maybe-nested) ;; lefts, variant::lefts + !variant <>right? ;; lefts, variant::lefts, variant::right? + (.visitJumpInsn Opcodes/IFNULL $mismatch!) ;; lefts, variant::lefts + ((iterate! $loop)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;;;;;; $perfect-match! ;;;;;; + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (.visitLabel $perfect-match!) ;; lefts, variant::lefts + ;; (.visitInsn Opcodes/POP2) ;; + !variant <>value + (.visitInsn Opcodes/ARETURN) (.visitMaxs 0 0) (.visitEnd))) _ (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "sum_make" "(ILjava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;" nil nil) @@ -338,7 +354,7 @@ (.visitEnd)) _ (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "make_none" "()[Ljava/lang/Object;" nil nil) (.visitCode) - (.visitLdcInsn (->> #'&/$None meta ::&/idx int)) ;; I + (.visitLdcInsn (->> #'&/$None meta ::&/lefts int)) ;; I (.visitInsn Opcodes/ACONST_NULL) ;; I? (.visitLdcInsn &/unit-tag) ;; I?U (.visitMethodInsn Opcodes/INVOKESTATIC rt-class "sum_make" "(ILjava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;") @@ -347,7 +363,7 @@ (.visitEnd)) _ (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "make_some" "(Ljava/lang/Object;)[Ljava/lang/Object;" nil nil) (.visitCode) - (.visitLdcInsn (->> #'&/$Some meta ::&/idx int)) ;; I + (.visitLdcInsn (->> #'&/$Some meta ::&/lefts int)) ;; I (.visitLdcInsn "") ;; I? (.visitVarInsn Opcodes/ALOAD 0) ;; I?O (.visitMethodInsn Opcodes/INVOKESTATIC rt-class "sum_make" "(ILjava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;") @@ -400,7 +416,7 @@ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/Throwable" "printStackTrace" "(Ljava/io/PrintWriter;)V") ;; TW (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/io/StringWriter" "toString" "()Ljava/lang/String;") ;; TS (.visitInsn Opcodes/SWAP) (.visitInsn Opcodes/POP) ;; S - (.visitLdcInsn (->> #'&/$Left meta ::&/idx int)) ;; SI + (.visitLdcInsn (->> #'&/$Left meta ::&/lefts int)) ;; SI (.visitInsn Opcodes/ACONST_NULL) ;; SI? swap2x1 ;; I?S (.visitMethodInsn Opcodes/INVOKESTATIC rt-class "sum_make" "(ILjava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;") -- cgit v1.2.3