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 +++++++++++-------- lux-jvm/source/luxc/lang/translation/jvm/case.lux | 2 +- .../source/luxc/lang/translation/jvm/program.lux | 2 +- .../source/luxc/lang/translation/jvm/runtime.lux | 96 +++++++++++++--------- .../source/luxc/lang/translation/jvm/structure.lux | 6 +- .../source/library/lux/control/parser/binary.lux | 10 --- stdlib/source/library/lux/data/format/binary.lux | 23 ------ .../library/lux/tool/compiler/language/lux.lux | 22 ++--- 11 files changed, 147 insertions(+), 150 deletions(-) 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;") diff --git a/lux-jvm/source/luxc/lang/translation/jvm/case.lux b/lux-jvm/source/luxc/lang/translation/jvm/case.lux index 33aa7f793..b8ef09945 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/case.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/case.lux @@ -98,7 +98,7 @@ (type.method [(list) (list //.$Value) type.boolean (list)])) (def: sideJT - (type.method [(list) (list //.$Variant runtime.$Tag runtime.$Flag) runtime.$Value (list)])) + (type.method [(list) (list //.$Variant runtime.$Lefts runtime.$Right?) runtime.$Value (list)])) (def: (path' stack_depth @else @end phase archive path) (-> Nat Label Label Phase Archive Path (Operation Inst)) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/program.lux b/lux-jvm/source/luxc/lang/translation/jvm/program.lux index ebce2d74a..e12e3b0e7 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/program.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/program.lux @@ -49,7 +49,7 @@ ($i.int +1) $i.SWAP $i.AASTORE) - consI (|>> ($i.int +1) + consI (|>> ($i.int +0) ($i.string "") $i.DUP2_X1 $i.POP2 diff --git a/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux b/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux index a3552e3ba..c351dd21c 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux @@ -40,8 +40,8 @@ ["." // {"+" [ByteCode]}]) (def: $Text (type.class "java.lang.String" (list))) -(def: .public $Tag type.int) -(def: .public $Flag (type.class "java.lang.Object" (list))) +(def: .public $Lefts type.int) +(def: .public $Right? (type.class "java.lang.Object" (list))) (def: .public $Value (type.class "java.lang.Object" (list))) (def: .public $Index type.int) (def: .public $Stack (type.array $Value)) @@ -63,7 +63,7 @@ outI _.SWAP (printI "println")))) (def: variant_method - (type.method [(list) (list $Tag $Flag $Value) //.$Variant (list)])) + (type.method [(list) (list $Lefts $Right? $Value) //.$Variant (list)])) (def: .public variantI Inst @@ -79,7 +79,7 @@ (def: .public rightI Inst - (|>> _.ICONST_1 + (|>> _.ICONST_0 (_.string "") _.DUP2_X1 _.POP2 @@ -119,14 +119,14 @@ (def: adt_methods Def - (let [store_tagI (|>> _.DUP _.ICONST_0 (_.ILOAD 0) (_.wrap type.int) _.AASTORE) + (let [store_leftsI (|>> _.DUP _.ICONST_0 (_.ILOAD 0) (_.wrap type.int) _.AASTORE) store_flagI (|>> _.DUP _.ICONST_1 (_.ALOAD 1) _.AASTORE) store_valueI (|>> _.DUP _.ICONST_2 (_.ALOAD 2) _.AASTORE)] (|>> ($d.method #$.Public $.staticM "variant_make" - (type.method [(list) (list $Tag $Flag $Value) //.$Variant (list)]) + (type.method [(list) (list $Lefts $Right? $Value) //.$Variant (list)]) (|>> _.ICONST_3 (_.ANEWARRAY $Value) - store_tagI + store_leftsI store_flagI store_valueI _.ARETURN))))) @@ -187,65 +187,79 @@ (_.ALOAD 1) _.AASTORE _.ARETURN)) - ($d.method #$.Public $.staticM "pm_variant" (type.method [(list) (list //.$Variant $Tag $Flag) $Value (list)]) + ($d.method #$.Public $.staticM "pm_variant" (type.method [(list) (list //.$Variant $Lefts $Right?) $Value (list)]) (<| _.with_label (function (_ @loop)) _.with_label (function (_ @perfect_match!)) - _.with_label (function (_ @tags_match!)) + _.with_label (function (_ @lefts_match!)) _.with_label (function (_ @maybe_nested)) _.with_label (function (_ @mismatch!)) (let [$variant (_.ALOAD 0) - $tag (_.ILOAD 1) - $last? (_.ALOAD 2) + $lefts (_.ILOAD 1) + $right? (_.ALOAD 2) variant_partI (: (-> Nat Inst) (function (_ idx) (|>> (_.int (.int idx)) _.AALOAD))) - ::tag (: Inst - (|>> (variant_partI 0) (_.unwrap type.int))) - ::last? (variant_partI 1) + ::lefts (: Inst + (|>> (variant_partI 0) + (_.unwrap type.int))) + ::right? (variant_partI 1) ::value (variant_partI 2) + + not_found _.NULL - super_nested_tag (|>> _.SWAP ... variant::tag, tag - _.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 (|>> _.SWAP ... variant::lefts, lefts + _.ISUB + (_.int +1) + _.ISUB) + super_nested (|>> super_nested_lefts ... super_lefts + $variant ::right? ... super_lefts, super_right? + $variant ::value ... super_lefts, super_right?, super_value ..variantI) - update_$tag _.ISUB update_$variant (|>> $variant ::value (_.CHECKCAST //.$Variant) (_.ASTORE 0)) + update_$lefts (|>> _.ISUB + (_.int +1) + _.ISUB) iterate! (: (-> Label Inst) (function (_ @loop) (|>> update_$variant - update_$tag - (_.GOTO @loop)))) - - not_found _.NULL]) - (|>> $tag ... tag + update_$lefts + (_.GOTO @loop))))]) + (|>> $lefts ... lefts (_.label @loop) - $variant ::tag ... tag, variant::tag - _.DUP2 (_.IF_ICMPEQ @tags_match!) ... tag, variant::tag - _.DUP2 (_.IF_ICMPGT @maybe_nested) ... tag, variant::tag - $last? (_.IFNULL @mismatch!) ... tag, variant::tag + $variant ::lefts ... lefts, variant::lefts + _.DUP2 (_.IF_ICMPEQ @lefts_match!) ... lefts, variant::lefts + _.DUP2 (_.IF_ICMPGT @maybe_nested) ... lefts, variant::lefts + $right? (_.IFNULL @mismatch!) ... lefts, variant::lefts super_nested ... super_variant _.ARETURN - (_.label @tags_match!) ... tag, variant::tag - $last? ... tag, variant::tag, last? - $variant ::last? ... tag, variant::tag, last?, variant::last? - (_.IF_ACMPEQ @perfect_match!) ... tag, variant::tag - (_.label @maybe_nested) ... tag, variant::tag - $variant ::last? ... tag, variant::tag, variant::last? - (_.IFNULL @mismatch!) ... tag, variant::tag - (iterate! @loop) - (_.label @perfect_match!) ... tag, variant::tag + ........................... + ...... @lefts_match! ...... + ........................... + (_.label @lefts_match!) ... lefts, variant::lefts + $right? ... lefts, variant::lefts, right? + $variant ::right? ... lefts, variant::lefts, right?, variant::right? + (_.IF_ACMPEQ @perfect_match!) ... lefts, variant::lefts + ........................ + ...... @mismatch! ...... + ........................ + (_.label @mismatch!) ... lefts, variant::lefts ... _.POP2 - $variant ::value + not_found _.ARETURN - (_.label @mismatch!) ... tag, variant::tag + (_.label @maybe_nested) ... lefts, variant::lefts + $variant ::right? ... lefts, variant::lefts, variant::right? + (_.IFNULL @mismatch!) ... lefts, variant::lefts + (iterate! @loop) + ............................. + ...... @perfect_match! ...... + ............................. + (_.label @perfect_match!) ... lefts, variant::lefts ... _.POP2 - not_found + $variant ::value _.ARETURN))) ($d.method #$.Public $.staticM "tuple_left" (type.method [(list) (list //.$Tuple $Index) $Value (list)]) (<| _.with_label (function (_ @loop)) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/structure.lux b/lux-jvm/source/luxc/lang/translation/jvm/structure.lux index 8e4e309de..a8c117f6e 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/structure.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/structure.lux @@ -74,9 +74,7 @@ (def: .public (tagI lefts right?) (-> Nat Bit Inst) - (case (if right? - (.++ lefts) - lefts) + (case lefts 0 _.ICONST_0 1 _.ICONST_1 2 _.ICONST_2 @@ -115,6 +113,6 @@ (_.INVOKESTATIC //.$Runtime "variant_make" (type.method [(list) - (list //runtime.$Tag //runtime.$Flag //runtime.$Value) + (list //runtime.$Lefts //runtime.$Right? //runtime.$Value) //.$Variant (list)])))))) diff --git a/stdlib/source/library/lux/control/parser/binary.lux b/stdlib/source/library/lux/control/parser/binary.lux index 1491e0cea..846f952d3 100644 --- a/stdlib/source/library/lux/control/parser/binary.lux +++ b/stdlib/source/library/lux/control/parser/binary.lux @@ -123,16 +123,6 @@ (!variant [[0 [#.Left] left] [1 [#.Right] right]])) -(def: .public (or/5 p/0 p/1 p/2 p/3 p/4) - (All (_ p/0 p/1 p/2 p/3 p/4) - (-> (Parser p/0) (Parser p/1) (Parser p/2) (Parser p/3) (Parser p/4) - (Parser (Or p/0 p/1 p/2 p/3 p/4)))) - (!variant [[0 [0 #0] p/0] - [1 [1 #0] p/1] - [2 [2 #0] p/2] - [3 [3 #0] p/3] - [4 [3 #1] p/4]])) - (def: .public (rec body) (All (_ a) (-> (-> (Parser a) (Parser a)) (Parser a))) (function (_ input) diff --git a/stdlib/source/library/lux/data/format/binary.lux b/stdlib/source/library/lux/data/format/binary.lux index e57bbf11c..71aeb6fc6 100644 --- a/stdlib/source/library/lux/data/format/binary.lux +++ b/stdlib/source/library/lux/data/format/binary.lux @@ -98,29 +98,6 @@ [1 #.Right right]) ))) -(def: .public (or/5 w/0 w/1 w/2 w/3 w/4) - (All (_ w/0 w/1 w/2 w/3 w/4) - (-> (Writer w/0) (Writer w/1) (Writer w/2) (Writer w/3) (Writer w/4) - (Writer (Or w/0 w/1 w/2 w/3 w/4)))) - (function (_ altV) - (case altV - (^template [ ] - [( caseV) - (let [[caseS caseT] ( caseV)] - [(.++ caseS) - (function (_ [offset binary]) - (|> binary - (binary.write/8! offset ) - try.trusted - [(.++ offset)] - caseT))])]) - ([0 0 #0 w/0] - [1 1 #0 w/1] - [2 2 #0 w/2] - [3 3 #0 w/3] - [4 3 #1 w/4]) - ))) - (def: .public (and pre post) (All (_ a b) (-> (Writer a) (Writer b) (Writer [a b]))) (function (_ [preV postV]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux.lux b/stdlib/source/library/lux/tool/compiler/language/lux.lux index 30465ca7d..8d0ac3171 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux.lux @@ -36,11 +36,12 @@ alias (: (Writer Alias) (_.and _.text _.text)) global (: (Writer Global) - (_.or/5 definition - global_type - global_label - global_label - alias))] + ($_ _.or + definition + global_type + global_label + global_label + alias))] ($_ _.and ... #module_hash _.nat @@ -71,11 +72,12 @@ alias (: (Parser Alias) (<>.and .text .text)) global (: (Parser Global) - (.or/5 definition - global_type - global_label - global_label - alias))] + ($_ .or + definition + global_type + global_label + global_label + alias))] ($_ <>.and ... #module_hash .nat -- cgit v1.2.3