path: root/stdlib/source/unsafe/lux/data/collection/array.lux

(.using
 [library
  [lux (.except type list)
   ["@" target]
   [abstract
    ["[0]" functor]]
   [data
    [collection
     ["[0]" list]]]
   [type
    ["[0]" variance]]]])

(def: .public type
  "#Array")

(template [<item> <array>]
  [(type: .public <array>
     {.#Primitive ..type {.#Item <item> {.#End}}})]

  [(variance.Mutable r w) (Array' r w)]
  [(variance.Mutable a a) (Array a)]
  )

(with_expansions [<index_type> (.Primitive "java.lang.Long")
                  <item_type> (.Primitive "java.lang.Object")]
  (for @.jvm (template: (jvm_int value)
               [(.|> value
                     (.as <index_type>)
                     "jvm object cast"
                     "jvm conversion long-to-int")])
       (these))
  
  (`` (template: .public (empty <size>)
        [((.is (.All (_ a) (.-> .Nat (..Array a)))
               (.function (empty size)
                 (.as_expected
                  (.for (~~ (.static @.old))
                        ("jvm anewarray" "(java.lang.Object )" size)

                        (~~ (.static @.jvm))
                        (|> (~~ (..jvm_int size))
                            "jvm array new object"
                            (.is (..Array <item_type>)))

                        (~~ (.static @.js)) ("js array new" size)
                        (~~ (.static @.python)) ("python array new" size)
                        (~~ (.static @.lua)) ("lua array new" size)
                        (~~ (.static @.ruby)) ("ruby array new" size)
                        (~~ (.static @.php)) ("php array new" size)
                        (~~ (.static @.scheme)) ("scheme array new" size)))))
          <size>)]))

  (`` (template: .public (size <array>)
        [((.is (.All (_ r w) (.-> (..Array' r w) .Nat))
               (.function (size array)
                 (.for (~~ (.static @.old))
                       ("jvm arraylength" array)

                       (~~ (.static @.jvm))
                       (.|> array
                            "jvm array length object"
                            "jvm conversion int-to-long"
                            "jvm object cast"
                            (.is <index_type>)
                            (.as .Nat))

                       (~~ (.static @.js)) ("js array length" array)
                       (~~ (.static @.python)) ("python array length" array)
                       (~~ (.static @.lua)) ("lua array length" array)
                       (~~ (.static @.ruby)) ("ruby array length" array)
                       (~~ (.static @.php)) ("php array length" array)
                       (~~ (.static @.scheme)) ("scheme array length" array))))
          <array>)]))

  (template: (lacks?' <read!> <null?> index array)
    [(<null?> (<read!> index array))])

  (`` (template: .public (lacks? <index> <array>)
        [((.is (.All (_ r w)
                 (.-> .Nat (..Array' r w) .Bit))
               (.function (lacks? index array)
                 (.let [size (..size array)]
                   (.if ("lux i64 <" (.int size) (.int index))
                     (.for (~~ (.static @.old))
                           ("jvm object null?" ("jvm aaload" array index))

                           (~~ (.static @.jvm))
                           (.|> array
                                ("jvm array read object" (~~ (jvm_int index)))
                                "jvm object null?")

                           (~~ (.static @.js)) (~~ (lacks?' "js array read" "js object undefined?" index array))
                           (~~ (.static @.python)) (~~ (lacks?' "python array read" "python object none?" index array))
                           (~~ (.static @.lua)) (~~ (lacks?' "lua array read" "lua object nil?" index array))
                           (~~ (.static @.ruby)) (~~ (lacks?' "ruby array read" "ruby object nil?" index array))
                           (~~ (.static @.php)) (~~ (lacks?' "php array read" "php object null?" index array))
                           (~~ (.static @.scheme)) (~~ (lacks?' "scheme array read" "scheme object nil?" index array)))
                     .true))))
          <index> <array>)]))

  (template: .public (has? index array)
    [(.not (..lacks? index array))])

  (`` (template: .public (item <index> <array>)
        [((.is (.All (_ r w)
                 (.-> .Nat (..Array' r w) r))
               (.function (item index array)
                 (.as_expected
                  (.for (~~ (.static @.old))
                        ("jvm aaload" array index)

                        (~~ (.static @.jvm))
                        ("jvm array read object" (~~ (jvm_int index)) array)

                        (~~ (.static @.js)) ("js array read" index array)
                        (~~ (.static @.python)) ("python array read" index array)
                        (~~ (.static @.lua)) ("lua array read" index array)
                        (~~ (.static @.ruby)) ("ruby array read" index array)
                        (~~ (.static @.php)) ("php array read" index array)
                        (~~ (.static @.scheme)) ("scheme array read" index array)))))
          <index> <array>)]))

  (`` (template: .public (has! <index> <value> <array>)
        [((.is (.All (_ r w)
                 (.-> .Nat w (..Array' r w) (..Array' r w)))
               (.function (has! index value array)
                 (.for (~~ (.static @.old))
                       ("jvm aastore" array index value)

                       (~~ (.static @.jvm))
                       (.|> array
                            ("jvm array write object" (~~ (jvm_int index)) value)
                            .as_expected)

                       (~~ (.static @.js)) ("js array write" index (.as_expected value) array)
                       (~~ (.static @.python)) ("python array write" index (.as_expected value) array)
                       (~~ (.static @.lua)) ("lua array write" index (.as_expected value) array)
                       (~~ (.static @.ruby)) ("ruby array write" index (.as_expected value) array)
                       (~~ (.static @.php)) ("php array write" index (.as_expected value) array)
                       (~~ (.static @.scheme)) ("scheme array write" index (.as_expected value) array))))
          <index> <value> <array>)]))

  (`` (template: .public (lacks! <index> <array>)
        [((.is (.All (_ r w)
                 (.-> .Nat (..Array' r w) (..Array' r w)))
               (.function (lacks! index array)
                 (.let [size (..size array)]
                   (.if ("lux i64 <" (.int size) (.int index))
                     (.for (~~ (.static @.old))
                           (..has! index (.as_expected ("jvm object null")) array)
                           
                           (~~ (.static @.jvm))
                           (..has! index (.as_expected (is <item_type> ("jvm object null"))) array)

                           (~~ (.static @.js)) ("js array delete" index array)
                           (~~ (.static @.python)) ("python array delete" index array)
                           (~~ (.static @.lua)) ("lua array delete" index array)
                           (~~ (.static @.ruby)) ("ruby array delete" index array)
                           (~~ (.static @.php)) ("php array delete" index array)
                           (~~ (.static @.scheme)) ("scheme array delete" index array))
                     array))))
          <index> <array>)]))
  )

(template: .public (revised! <index> <$> <array>)
  [((.is (.All (_ r w)
           (.-> .Nat (.-> r w) (..Array' r w) (..Array' r w)))
         (.function (revised! index $ array)
           (.if (..lacks? index array)
             array
             (..has! index ($ (..item index array)) array))))
    <index> <$> <array>)])

(template: .public (upsert! <index> <default> <$> <array>)
  [((.is (.All (_ r w)
           (.-> .Nat r (.-> r w) (..Array' r w) (..Array' r w)))
         (.function (upsert! index default $ array)
           (..has! index
                   ($ (.if (..lacks? index array)
                        default
                        (..item index array)))
                   array)))
    <index> <default> <$> <array>)])

(template: .public (copy! <length> <src_start> <src_array> <dest_start> <dest_array>)
  [((.is (.All (_ r w)
           (.-> .Nat .Nat (..Array' w .Nothing) .Nat (..Array' r w)
                (..Array' r w)))
         (.function (copy! length src_start src_array dest_start dest_array)
           (.loop (again [offset 0])
             (.if ("lux i64 <" (.int length) (.int offset))
               (.exec
                 (.if (..lacks? ("lux i64 +" offset src_start) src_array)
                   (..lacks! ("lux i64 +" offset dest_start) dest_array)
                   (..has! ("lux i64 +" offset dest_start)
                           (..item ("lux i64 +" offset src_start) src_array)
                           dest_array))
                 (again ("lux i64 +" 1 offset)))
               dest_array))))
    <length> <src_start> <src_array> <dest_start> <dest_array>)])

(template [<name> <when_lacks> <when_has>]
  [(template: .public (<name> <array>)
     [((.is (.All (_ r w) (.-> (..Array' r w) .Nat))
            (.function (occupancy array)
              (.let [size (..size array)]
                (.loop (again [index 0
                               it 0])
                  (.if ("lux i64 <" (.int size) (.int index))
                    (.if (..lacks? index array)
                      (again ("lux i64 +" 1 index) <when_lacks>)
                      (again ("lux i64 +" 1 index) <when_has>))
                    it)))))
       <array>)])]

  [occupancy it ("lux i64 +" 1 it)]
  [vacancy ("lux i64 +" 1 it) it]
  )

(template: .public (only! <?> <it>)
  [((.is (.All (_ r w)
           (.-> (.-> r .Bit) (..Array' r w) (..Array' r w)))
         (.function (only! ? it)
           (.let [size (..size it)]
             (.loop (again [index 0])
               (.if ("lux i64 <" (.int size) (.int index))
                 (.exec
                   (.if (..lacks? index it)
                     it
                     (.if (? (..item index it))
                       it
                       (..lacks! index it)))
                   (again ("lux i64 +" 1 index)))
                 it)))))
    <?> <it>)])

(template [<name> <predicate> <test> <type> <term>]
  [(template: .public (<name> <?> <it>)
     [((.is (.All (_ r w)
              (.-> <predicate> (..Array' r w) (.Maybe <type>)))
            (.function (<name> ? it)
              (.let [size (..size it)]
                (.loop (again [index 0])
                  (.if ("lux i64 <" (.int size) (.int index))
                    (.if (..lacks? index it)
                      (again ("lux i64 +" 1 index))
                      (.let [it (..item index it)]
                        (.if <test>
                          {.#Some <term>}
                          (again ("lux i64 +" 1 index)))))
                    {.#None})))))
       <?> <it>)])]

  [example (.-> r .Bit) (? it) r it]
  [example' (.-> Nat r .Bit) (? index it) [Nat r] [index it]]
  )

(template: .public (clone <it>)
  [((.is (.All (_ a) (.-> (..Array a) (..Array a)))
         (.function (clone it)
           (.let [size (..size it)]
             (..copy! size 0 it 0 (..empty size)))))
    <it>)])

(template: .public (of_list <input>)
  [((.is (.All (_ a) (.-> (.List a) (..Array a)))
         (.function (of_list input)
           (.let [size (list.size input)
                  output (..empty size)]
             (.loop (again [index 0
                            input input])
               (.case input
                 {.#End}
                 output
                 
                 {.#Item head tail}
                 (.exec
                   (..has! index head output)
                   (again ("lux i64 +" 1 index) tail)))))))
    <input>)])

(def: underflow
  Nat
  (-- 0))

(`` (template: (list|-default <empty> <array>)
      [((.is (.All (_ r w) (.-> (.List r) (..Array' r w) (.List r)))
             (.function (list|-default empty array)
               (.loop (again [index ("lux i64 -" 1 (..size array))
                              output empty])
                 (.if ("lux i64 =" (~~ (.static ..underflow)) index)
                   output
                   (again ("lux i64 -" 1 index)
                          (.if (..lacks? index array)
                            output
                            {.#Item (..item index array) output}))))))
        <empty> <array>)]))

(`` (template: (list|+default <default> <array>)
      [((.is (.All (_ r w) (.-> r (..Array' r w) (.List r)))
             (.function (list|+default default array)
               (.loop (again [index ("lux i64 -" 1 (..size array))
                              output (`` (.is (.List (~~ (.these (~~ (.type_of default)))))
                                              {.#End}))])
                 (.if ("lux i64 =" (~~ (.static ..underflow)) index)
                   output
                   (again ("lux i64 -" 1 index)
                          {.#Item (.if (..lacks? index array)
                                    default
                                    (..item index array))
                                  output})))))
        <default> <array>)]))

(`` (template: .public (list <default> <array>)
      [((.is (.All (_ r w) (.-> (.Maybe r) (..Array' r w) (.List r)))
             (.function (list default array)
               (.case default
                 {.#Some default}
                 (~~ (..list|+default default array))

                 {.#None}
                 (~~ (..list|-default {.#End} array)))))
        <default> <array>)]))

(template: .public (= <//#=> <left/*> <right/*>)
  [((.is (.All (_ r w0 w1) (.-> (.-> r r .Bit) (..Array' r w0) (..Array' r w1) .Bit))
         (.function (= //#= left/* right/*)
           (.let [size (..size left/*)]
             (.and ("lux i64 =" (..size right/*) size)
                   (.loop (again [index 0])
                     (.if ("lux i64 <" (.int size) (.int index))
                       (.if (..lacks? index left/*)
                         (..lacks? index right/*)
                         (.if (..lacks? index right/*)
                           .false
                           (.and (//#= (..item index left/*)
                                       (..item index right/*))
                                 (again ("lux i64 +" 1 index)))))
                       true))))))
    <//#=> <left/*> <right/*>)])

(template: .public (composite <left/*> <right/*>)
  [((.is (.All (_ a) (.-> (..Array' a .Nothing) (..Array' a .Nothing) (..Array a)))
         (.function (composite left/* right/*)
           (.let [|left| (..size left/*)
                  |right| (..size right/*)]
             (.|> (..empty ("lux i64 +" |left| |right|))
                  (..copy! |left| 0 left/* 0)
                  (..copy! |right| 0 right/* |left|)))))
    <left/*> <right/*>)])

(template: .public (mix <$> <init> <it>)
  [((.is (.All (_ r w s)
           (.-> (.-> Nat r s s) s (..Array' r w) s))
         (.function (mix $ init it)
           (.let [size (..size it)]
             (.loop (again [index 0
                            so_far init])
               (.if ("lux i64 <" (.int size) (.int index))
                 (.if (..lacks? index it)
                   (again ("lux i64 +" 1 index) so_far)
                   (again ("lux i64 +" 1 index) ($ index (..item index it) so_far)))
                 so_far)))))
    <$> <init> <it>)])

(template: .public (each <$> <input>)
  [((.is (functor.Functor ..Array)
         (.function (each $ input)
           (..mix (.function (_ index item output)
                    (..has! index ($ item) output))
                  (..empty (..size input))
                  input)))
    <$> <input>)])

(template [<name> <init> <op>]
  [(template: .public (<name> <?> <it>)
     [((.is (.All (_ r w)
              (.-> (.-> r .Bit)
                   (.-> (..Array' r w) .Bit)))
            (.function (<name> ? it)
              (.let [size (..size it)]
                (.loop (again [index 0])
                  (.if ("lux i64 <" (.int size) (.int index))
                    (.if (..lacks? index it)
                      (again ("lux i64 +" 1 index))
                      (<op> (? (..item index it))
                            (again ("lux i64 +" 1 index))))
                    <init>)))))
       <?> <it>)])]

  [every? .true  and]
  [any?   .false or]
  )

(template: .public (one <?> <it>)
  [((.is (.All (_ r r' w)
           (.-> (.-> r (.Maybe r')) (..Array' r w) (.Maybe r')))
         (.function (one ? it)
           (.let [size (..size it)]
             (.loop (again [index 0])
               (.if ("lux i64 <" (.int size) (.int index))
                 (with_expansions [<again> (again ("lux i64 +" 1 index))]
                   (.if (..lacks? index it)
                     <again>
                     (.case (? (..item index it))
                       {.#None}
                       <again>

                       output
                       output)))
                 {.#None})))))
    <?> <it>)])