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

(.module:
  [library
   [lux (#- list)
    ["@" target]
    [abstract
     [monoid (#+ Monoid)]
     [functor (#+ Functor)]
     [equivalence (#+ Equivalence)]
     [mix (#+ Mix)]
     [predicate (#+ Predicate)]]
    [control
     ["." maybe]]
    [data
     ["." product]
     [collection
      ["." list ("#\." mix)]]]
    [math
     [number
      ["n" nat]]]]])

(def: .public type_name
  "#Array")

(type: .public (Array a)
  (#.Primitive ..type_name (#.Item a #.End)))

(with_expansions [<index_type> (primitive "java.lang.Long")
                  <elem_type> (primitive "java.lang.Object")
                  <array_type> (type (Array <elem_type>))]
  (for {@.jvm
        (template: (!int value)
          [(|> value
               (:as <index_type>)
               "jvm object cast"
               "jvm conversion long-to-int")])}
       (as_is))
  
  (def: .public (empty size)
    (All [a] (-> Nat (Array a)))
    (for {@.old
          (:expected ("jvm anewarray" "(java.lang.Object )" size))

          @.jvm
          (|> size
              !int
              "jvm array new object"
              (: <array_type>)
              :expected)

          @.js ("js array new" size)
          @.python ("python array new" size)
          @.lua ("lua array new" size)
          @.ruby ("ruby array new" size)
          @.php ("php array new" size)
          @.scheme ("scheme array new" size)}))

  (def: .public (size array)
    (All [a] (-> (Array a) Nat))
    (for {@.old
          ("jvm arraylength" array)

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

          @.js ("js array length" array)
          @.python ("python array length" array)
          @.lua ("lua array length" array)
          @.ruby ("ruby array length" array)
          @.php ("php array length" array)
          @.scheme ("scheme array length" array)}))

  (template: (!read! <read!> <null?>)
    [(let [output (<read!> index array)]
       (if (<null?> output)
         #.None
         (#.Some output)))])

  (def: .public (read! index array)
    (All [a]
      (-> Nat (Array a) (Maybe a)))
    (if (n.< (size array) index)
      (for {@.old
            (let [value ("jvm aaload" array index)]
              (if ("jvm object null?" value)
                #.None
                (#.Some value)))

            @.jvm
            (let [value (|> array
                            (:as <array_type>)
                            ("jvm array read object" (!int index)))]
              (if ("jvm object null?" value)
                #.None
                (#.Some (:expected value))))

            @.js (!read! "js array read" "js object undefined?")
            @.python (!read! "python array read" "python object none?")
            @.lua (!read! "lua array read" "lua object nil?")
            @.ruby (!read! "ruby array read" "ruby object nil?")
            @.php (!read! "php array read" "php object null?")
            @.scheme (!read! "scheme array read" "scheme object nil?")})
      #.None))

  (def: .public (write! index value array)
    (All [a]
      (-> Nat a (Array a) (Array a)))
    (for {@.old
          ("jvm aastore" array index value)

          @.jvm
          (|> array
              (:as <array_type>)
              ("jvm array write object" (!int index) (:as <elem_type> value))
              :expected)

          @.js ("js array write" index value array)
          @.python ("python array write" index value array)
          @.lua ("lua array write" index value array)
          @.ruby ("ruby array write" index value array)
          @.php ("php array write" index value array)
          @.scheme ("scheme array write" index value array)}))

  (def: .public (delete! index array)
    (All [a]
      (-> Nat (Array a) (Array a)))
    (if (n.< (size array) index)
      (for {@.old
            (write! index (:expected ("jvm object null")) array)

            @.jvm
            (write! index (:expected (: <elem_type> ("jvm object null"))) array)

            @.js ("js array delete" index array)
            @.python ("python array delete" index array)
            @.lua ("lua array delete" index array)
            @.ruby ("ruby array delete" index array)
            @.php ("php array delete" index array)
            @.scheme ("scheme array delete" index array)})
      array))
  )

(def: .public (contains? index array)
  (All [a]
    (-> Nat (Array a) Bit))
  (case (..read! index array)
    (#.Some _)
    true

    _
    false))

(def: .public (update! index transform array)
  (All [a]
    (-> Nat (-> a a) (Array a) (Array a)))
  (case (read! index array)
    #.None
    array

    (#.Some value)
    (write! index (transform value) array)))

(def: .public (upsert! index default transform array)
  (All [a]
    (-> Nat a (-> a a) (Array a) (Array a)))
  (write! index
          (|> array (read! index) (maybe.else default) transform)
          array))

(def: .public (copy! length src_start src_array dest_start dest_array)
  (All [a]
    (-> Nat Nat (Array a) Nat (Array a)
        (Array a)))
  (if (n.= 0 length)
    dest_array
    (list\mix (function (_ offset target)
                (case (read! (n.+ offset src_start) src_array)
                  #.None
                  target
                  
                  (#.Some value)
                  (write! (n.+ offset dest_start) value target)))
              dest_array
              (list.indices length))))

(def: .public (occupancy array)
  (All [a] (-> (Array a) Nat))
  (list\mix (function (_ idx count)
              (case (read! idx array)
                #.None
                count
                
                (#.Some _)
                (++ count)))
            0
            (list.indices (size array))))

(def: .public (vacancy array)
  (All [a] (-> (Array a) Nat))
  (n.- (..occupancy array) (..size array)))

(def: .public (filter! p xs)
  (All [a]
    (-> (Predicate a) (Array a) (Array a)))
  (list\mix (function (_ idx xs')
              (case (read! idx xs)
                #.None
                xs'

                (#.Some x)
                (if (p x)
                  xs'
                  (delete! idx xs'))))
            xs
            (list.indices (size xs))))

(def: .public (example p xs)
  (All [a]
    (-> (Predicate a) (Array a) (Maybe a)))
  (let [arr_size (size xs)]
    (loop [idx 0]
      (if (n.< arr_size idx)
        (case (read! idx xs)
          #.None
          (recur (++ idx))
          
          (#.Some x)
          (if (p x)
            (#.Some x)
            (recur (++ idx))))
        #.None))))

(def: .public (example+ p xs)
  (All [a]
    (-> (-> Nat a Bit) (Array a) (Maybe [Nat a])))
  (let [arr_size (size xs)]
    (loop [idx 0]
      (if (n.< arr_size idx)
        (case (read! idx xs)
          #.None
          (recur (++ idx))
          
          (#.Some x)
          (if (p idx x)
            (#.Some [idx x])
            (recur (++ idx))))
        #.None))))

(def: .public (clone xs)
  (All [a] (-> (Array a) (Array a)))
  (let [arr_size (size xs)]
    (list\mix (function (_ idx ys)
                (case (read! idx xs)
                  #.None
                  ys

                  (#.Some x)
                  (write! idx x ys)))
              (empty arr_size)
              (list.indices arr_size))))

(def: .public (of_list xs)
  (All [a] (-> (List a) (Array a)))
  (product.right (list\mix (function (_ x [idx arr])
                             [(++ idx) (write! idx x arr)])
                           [0 (empty (list.size xs))]
                           xs)))

(def: underflow
  Nat
  (-- 0))

(def: (list|-default array)
  (All [a] (-> (Array a) (List a)))
  (loop [idx (-- (size array))
         output #.End]
    (case idx
      (^ (static ..underflow))
      output

      _
      (recur (-- idx)
             (case (read! idx array)
               (#.Some head)
               (#.Item head output)

               #.None
               output)))))

(def: (list|+default default array)
  (All [a] (-> a (Array a) (List a)))
  (loop [idx (-- (size array))
         output #.End]
    (case idx
      (^ (static ..underflow))
      output

      _
      (recur (-- idx)
             (#.Item (maybe.else default (read! idx array))
                     output)))))

(def: .public (list default array)
  (All [a] (-> (Maybe a) (Array a) (List a)))
  (case default
    (#.Some default)
    (list|+default default array)
    
    #.None
    (list|-default array)))

(implementation: .public (equivalence (^open ",\."))
  (All [a] (-> (Equivalence a) (Equivalence (Array a))))
  
  (def: (= xs ys)
    (let [sxs (size xs)
          sxy (size ys)]
      (and (n.= sxy sxs)
           (list\mix (function (_ idx prev)
                       (and prev
                            (case [(read! idx xs) (read! idx ys)]
                              [#.None #.None]
                              true

                              [(#.Some x) (#.Some y)]
                              (,\= x y)

                              _
                              false)))
                     true
                     (list.indices sxs))))))

(implementation: .public monoid
  (All [a] (Monoid (Array a)))
  
  (def: identity (empty 0))

  (def: (composite xs ys)
    (let [sxs (size xs)
          sxy (size ys)]
      (|> (empty (n.+ sxy sxs))
          (copy! sxs 0 xs 0)
          (copy! sxy 0 ys sxs)))))

(implementation: .public functor
  (Functor Array)
  
  (def: (each f ma)
    (let [arr_size (size ma)]
      (if (n.= 0 arr_size)
        (empty arr_size)
        (list\mix (function (_ idx mb)
                    (case (read! idx ma)
                      #.None
                      mb

                      (#.Some x)
                      (write! idx (f x) mb)))
                  (empty arr_size)
                  (list.indices arr_size))
        ))))

(implementation: .public mix
  (Mix Array)
  
  (def: (mix f init xs)
    (let [arr_size (size xs)]
      (loop [so_far init
             idx 0]
        (if (n.< arr_size idx)
          (case (read! idx xs)
            #.None
            (recur so_far (++ idx))

            (#.Some value)
            (recur (f value so_far) (++ idx)))
          so_far)))))

(template [<name> <init> <op>]
  [(def: .public (<name> predicate)
     (All [a]
       (-> (Predicate a) (Predicate (Array a))))
     (function (_ array)
       (let [size (..size array)]
         (loop [idx 0]
           (if (n.< size idx)
             (case (..read! idx array)
               (#.Some value)
               (<op> (predicate value)
                     (recur (++ idx)))
               
               #.None
               (recur (++ idx)))
             <init>)))))]

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