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

(.require
 [library
  [lux (.except revised all only with)
   [abstract
    [monoid (.only Monoid)]
    [apply (.only Apply)]
    [equivalence (.only Equivalence)]
    [hash (.only Hash)]
    [mix (.only Mix)]
    ["[0]" functor (.only Functor)]
    ["[0]" monad (.only Monad do)]
    ["[0]" enum]]
   [control
    [function
     [predicate (.only Predicate)]]]
   [data
    ["[0]" bit]
    ["[0]" product]]
   [math
    [number
     ["n" nat]]]
   [meta
    ["@" target]]]])

... (type (List a)
...   #End
...   {#Item a (List a)})

(def .public mix
  (Mix List)
  (implementation
   (def (mix f init xs)
     (case xs
       {.#End}
       init

       {.#Item x xs'}
       (mix f (f x init) xs')))))

(def .public (mixes f init inputs)
  (All (_ a b) (-> (-> a b b) b (List a) (List b)))
  (case inputs
    {.#End}
    (list init)
    
    {.#Item [head tail]}
    {.#Item [init (mixes f (f head init) tail)]}))

(def .public (reversed xs)
  (All (_ a)
    (-> (List a) (List a)))
  (mix (function (_ head tail)
         {.#Item head tail})
       {.#End}
       xs))

(def .public (only keep? xs)
  (All (_ a)
    (-> (Predicate a) (List a) (List a)))
  (case xs
    {.#End}
    {.#End}
    
    {.#Item x xs'}
    (if (keep? x)
      {.#Item x (only keep? xs')}
      (only keep? xs'))))

(def .public (partition satisfies? list)
  (All (_ a) (-> (Predicate a) (List a) [(List a) (List a)]))
  (case list
    {.#End}
    [{.#End} {.#End}]

    {.#Item head tail}
    (let [[in out] (partition satisfies? tail)]
      (if (satisfies? head)
        [{.#Item head in} out]
        [in {.#Item head out}]))))

(def wrong_syntax_error
  (template (_ <it>)
    [((`` ("lux in-module" (,, (static .prelude)) .wrong_syntax_error))
      (symbol <it>))]))

(def .public partial
  (macro (_ tokens state)
    (case (reversed tokens)
      {.#Item tail heads}
      {.#Right [state (list (..mix (function (_ head tail)
                                     (` {.#Item (, head) (, tail)}))
                                   tail
                                   heads))]}

      _
      {.#Left (wrong_syntax_error ..partial)})))

(def .public (pairs xs)
  (All (_ a) (-> (List a) (Maybe (List [a a]))))
  (case xs
    (partial x1 x2 xs')
    (case (pairs xs')
      {.#Some tail}
      {.#Some (partial [x1 x2] tail)}

      {.#None}
      {.#None})

    (list)
    {.#Some (list)}

    _
    {.#None}))

(with_template [<name> <then> <else>]
  [(def .public (<name> n xs)
     (All (_ a)
       (-> Nat (List a) (List a)))
     (if (n.> 0 n)
       (case xs
         {.#End}
         {.#End}
         
         {.#Item x xs'}
         <then>)
       <else>))]
  
  [first {.#Item x (first (-- n) xs')} {.#End}]
  [after (after (-- n) xs') xs]
  )

(with_template [<name> <then> <else>]
  [(def .public (<name> predicate xs)
     (All (_ a)
       (-> (Predicate a) (List a) (List a)))
     (case xs
       {.#End}
       {.#End}
       
       {.#Item x xs'}
       (if (predicate x)
         <then>
         <else>)))]

  [while {.#Item x (while predicate xs')} {.#End}]
  [until (until predicate xs') xs]
  )

(def .public (split_at n xs)
  (All (_ a)
    (-> Nat (List a) [(List a) (List a)]))
  (case n
    0 [{.#End} xs]
    _ (case xs
        {.#End}
        [{.#End} {.#End}]
        
        {.#Item x xs'}
        (let [[tail rest] (split_at (-- n) xs')]
          [{.#Item x tail} rest]))))

(def (split_when' predicate ys xs)
  (All (_ a)
    (-> (Predicate a) (List a) (List a) [(List a) (List a)]))
  (case xs
    {.#End}
    [ys xs]

    {.#Item x xs'}
    (if (predicate x)
      [ys xs]
      (split_when' predicate {.#Item x ys} xs'))))

(def .public (split_when predicate xs)
  (All (_ a)
    (-> (Predicate a) (List a) [(List a) (List a)]))
  (let [[ys' xs'] (split_when' predicate {.#End} xs)]
    [(reversed ys') xs']))

(def .public (sub size list)
  (All (_ a) (-> Nat (List a) (List (List a))))
  (case list
    {.#End}
    {.#End}

    _
    (let [[pre post] (split_at size list)]
      {.#Item pre (sub size post)})))

(def .public (repeated n x)
  (All (_ a)
    (-> Nat a (List a)))
  (case n
    0 {.#End}
    _ {.#Item x (repeated (-- n) x)}))

(def (iterations' f x)
  (All (_ a)
    (-> (-> a (Maybe a)) a (List a)))
  (case (f x)
    {.#Some x'}
    {.#Item x (iterations' f x')}

    {.#None}
    (list)))

(def .public (iterations f x)
  (All (_ a)
    (-> (-> a (Maybe a)) a (List a)))
  (case (f x)
    {.#Some x'}
    {.#Item x (iterations' f x')}

    {.#None}
    (list x)))

(def .public (one check xs)
  (All (_ a b)
    (-> (-> a (Maybe b)) (List a) (Maybe b)))
  (case xs
    {.#End}
    {.#None}

    {.#Item x xs'}
    (case (check x)
      {.#Some output}
      {.#Some output}
      
      {.#None}
      (one check xs'))))

(def .public (all check xs)
  (All (_ a b)
    (-> (-> a (Maybe b)) (List a) (List b)))
  (for @.js
       ... TODO: Stop relying on this ASAP.
       (mix (function (_ head tail)
              (case (check head)
                {.#Some head}
                {.#Item head tail}
                
                {.#None}
                tail))
            {.#End}
            (reversed xs))
       (case xs
         {.#End}
         {.#End}

         {.#Item x xs'}
         (case (check x)
           {.#Some output}
           {.#Item output (all check xs')}
           
           {.#None}
           (all check xs')))))

(def .public (example predicate xs)
  (All (_ a)
    (-> (Predicate a) (List a) (Maybe a)))
  (..one (function (_ value)
           (if (predicate value)
             {.#Some value}
             {.#None}))
         xs))

(def .public (interposed sep xs)
  (All (_ a)
    (-> a (List a) (List a)))
  (case xs
    {.#End}
    xs

    {.#Item x {.#End}}
    xs

    {.#Item x xs'}
    (partial x sep (interposed sep xs'))))

(def .public (size list)
  (All (_ a) (-> (List a) Nat))
  (mix (function (_ _ acc) (n.+ 1 acc)) 0 list))

(with_template [<name> <init> <op>]
  [(def .public (<name> predicate items)
     (All (_ a)
       (-> (Predicate a) (List a) Bit))
     (case items
       {.#End}
       <init>

       {.#Item head tail}
       (<op> (predicate head)
             (<name> predicate tail))))]

  [every? #1 and]
  [any?   #0 or]
  )

(def .public (item i xs)
  (All (_ a)
    (-> Nat (List a) (Maybe a)))
  (case xs
    {.#End}
    {.#None}

    {.#Item x xs'}
    (case i
      0 {.#Some x}
      _ (item (-- i) xs'))))

(def .public (equivalence Equivalence<a>)
  (All (_ a) (-> (Equivalence a) (Equivalence (List a))))
  (implementation
   (def (= xs ys)
     (case [xs ys]
       [{.#End} {.#End}]
       true

       [{.#Item x xs'} {.#Item y ys'}]
       (and (at Equivalence<a> = x y)
            (= xs' ys'))

       [_ _]
       false))))

(def .public (hash super)
  (All (_ a) (-> (Hash a) (Hash (List a))))
  (implementation
   (def equivalence
     (..equivalence (at super equivalence)))
   
   (def hash
     (at ..mix mix
         (function (_ member hash)
           (n.+ (at super hash member) hash))
         0))))

(def .public monoid
  (All (_ a) (Monoid (List a)))
  (implementation
   (def identity
     {.#End})
   (def (composite xs ys)
     (case xs
       {.#End}
       ys
       
       {.#Item x xs'}
       {.#Item x (composite xs' ys)}))))

(use "[0]" ..monoid)

(def .public functor
  (Functor List)
  (implementation
   (def (each f ma)
     (case ma
       {.#End}
       {.#End}
       
       {.#Item a ma'}
       {.#Item (f a) (each f ma')}))))

(use "[0]" ..functor)

(def .public apply
  (Apply List)
  (implementation
   (def functor ..functor)

   (def (on fa ff)
     (case ff
       {.#End}
       {.#End}
       
       {.#Item f ff'}
       (|> ff'
           (on fa)
           (composite (each f fa)))))))

(def .public monad
  (Monad List)
  (implementation
   (def functor ..functor)

   (def (in a)
     {.#Item a {.#End}})

   (def conjoint
     (|>> reversed (mix composite identity)))))

(def .public (sorted < xs)
  (All (_ a) (-> (-> a a Bit) (List a) (List a)))
  (case xs
    {.#End}
    (list)
    
    {.#Item x xs'}
    (let [[pre post] (mix (function (_ x' [pre post])
                            (if (< x x')
                              [{.#Item x' pre} post]
                              [pre {.#Item x' post}]))
                          (`` [(is (,, (type_of xs))
                                   (list))
                               (is (,, (type_of xs))
                                   (list))])
                          xs')]
      (.all composite (sorted < pre) (list x) (sorted < post)))))

(def .public (empty? xs)
  (All (_ a) (Predicate (List a)))
  (case xs
    {.#End}
    true
    
    _
    false))

(def .public (member? eq xs x)
  (All (_ a) (-> (Equivalence a) (List a) a Bit))
  (case xs
    {.#End}
    false
    
    {.#Item x' xs'}
    (or (at eq = x x')
        (member? eq xs' x))))

(with_template [<name> <output> <side>]
  [(def .public (<name> xs)
     (All (_ a) (-> (List a) (Maybe <output>)))
     (case xs
       {.#End}
       {.#None}

       {.#Item x xs'}
       {.#Some <side>}))]

  [head a        x]
  [tail (List a) xs']
  )

(def .public (indices size)
  (All (_ a) (-> Nat (List Nat)))
  (case size
    0 (list)
    _ (|> size -- (enum.range n.enum 0))))

(def (symbol$ name)
  (-> Text Code)
  [["" 0 0] {.#Symbol "" name}])

(def (nat#encoded value)
  (-> Nat Text)
  (loop (again [input value
                output ""])
    (let [digit (case (n.% 10 input)
                  0 "0"
                  1 "1"
                  2 "2"
                  3 "3"
                  4 "4"
                  5 "5"
                  6 "6"
                  7 "7"
                  8 "8"
                  9 "9"
                  _ (undefined))
          output' ("lux text concat" digit output)
          input' (n./ 10 input)]
      (case input'
        0 output'
        _ (again input' output')))))

(def .public zipped
  (macro (_ tokens state)
    (case tokens
      (list [_ {.#Nat num_lists}])
      (if (n.> 0 num_lists)
        (let [(open "[0]") ..functor
              indices (..indices num_lists)
              type_vars (is (List Code) (each (|>> nat#encoded symbol$) indices))
              zipped_type (` (.All ((, (symbol$ "0_")) (,* type_vars))
                               (-> (,* (each (is (-> Code Code) (function (_ var) (` (List (, var)))))
                                             type_vars))
                                   (List [(,* type_vars)]))))
              vars+lists (|> indices
                             (each ++)
                             (each (function (_ idx)
                                     (let [base (nat#encoded idx)]
                                       [(symbol$ base)
                                        (symbol$ ("lux text concat" base "'"))]))))
              pattern (` [(,* (each (function (_ [v vs]) (` {.#Item (, v) (, vs)}))
                                    vars+lists))])
              g!step (symbol$ "0step0")
              g!blank (symbol$ "0,0")
              list_vars (each product.right vars+lists)
              code (` (is (, zipped_type)
                          (function ((, g!step) (,* list_vars))
                            (case [(,* list_vars)]
                              (, pattern)
                              {.#Item [(,* (each product.left vars+lists))]
                                      ((, g!step) (,* list_vars))}

                              (, g!blank)
                              {.#End}))))]
          {.#Right [state (list code)]})
        {.#Left "Cannot zipped 0 lists."})

      _
      {.#Left (wrong_syntax_error ..zipped)})))

(def .public zipped_2 (zipped 2))
(def .public zipped_3 (zipped 3))

(def .public zipped_with
  (macro (_ tokens state)
    (case tokens
      (list [_ {.#Nat num_lists}])
      (if (n.> 0 num_lists)
        (let [(open "[0]") ..functor
              indices (..indices num_lists)
              g!return_type (symbol$ "0return_type0")
              g!func (symbol$ "0func0")
              type_vars (is (List Code) (each (|>> nat#encoded symbol$) indices))
              zipped_type (` (All ((, (symbol$ "0_")) (,* type_vars) (, g!return_type))
                               (-> (-> (,* type_vars) (, g!return_type))
                                   (,* (each (is (-> Code Code) (function (_ var) (` (List (, var)))))
                                             type_vars))
                                   (List (, g!return_type)))))
              vars+lists (|> indices
                             (each ++)
                             (each (function (_ idx)
                                     (let [base (nat#encoded idx)]
                                       [(symbol$ base)
                                        (symbol$ ("lux text concat" base "'"))]))))
              pattern (` [(,* (each (function (_ [v vs]) (` {.#Item (, v) (, vs)}))
                                    vars+lists))])
              g!step (symbol$ "0step0")
              g!blank (symbol$ "0,0")
              list_vars (each product.right vars+lists)
              code (` (is (, zipped_type)
                          (function ((, g!step) (, g!func) (,* list_vars))
                            (case [(,* list_vars)]
                              (, pattern)
                              {.#Item ((, g!func) (,* (each product.left vars+lists)))
                                      ((, g!step) (, g!func) (,* list_vars))}

                              (, g!blank)
                              {.#End}))))]
          {.#Right [state (list code)]})
        {.#Left "Cannot zipped_with 0 lists."})

      _
      {.#Left (wrong_syntax_error ..zipped_with)})))

(def .public zipped_with_2 (zipped_with 2))
(def .public zipped_with_3 (zipped_with 3))

(def .public (last xs)
  (All (_ a) (-> (List a) (Maybe a)))
  (case xs
    {.#End}
    {.#None}

    {.#Item x {.#End}}
    {.#Some x}
    
    {.#Item x xs'}
    (last xs')))

(def .public (inits xs)
  (All (_ a) (-> (List a) (Maybe (List a))))
  (case xs
    {.#End}
    {.#None}

    {.#Item x {.#End}}
    {.#Some {.#End}}
    
    {.#Item x xs'}
    (case (inits xs')
      {.#None}
      (undefined)

      {.#Some tail}
      {.#Some {.#Item x tail}})
    ))

(def .public together
  (All (_ a) (-> (List (List a)) (List a)))
  (at ..monad conjoint))

(def .public (with monad)
  (All (_ M) (-> (Monad M) (Monad (All (_ a) (M (List a))))))
  (implementation
   (def functor
     (functor.composite (the monad.functor monad)
                        ..functor))

   (def in
     (|>> (at ..monad in) (at monad in)))
   
   (def (conjoint MlMla)
     (do [! monad]
       [lMla MlMla
        ... TODO: Remove this version ASAP and use one below.
        lla (for @.old (is {.#Apply (type_literal (List (List (parameter 1))))
                                    (parameter 0)}
                           (monad.all ! lMla))
                 (monad.all ! lMla))]
       (in (..together lla))))))

(def .public (lifted monad)
  (All (_ M a) (-> (Monad M) (-> (M a) (M (List a)))))
  (at monad each (at ..monad in)))

(def .public (enumeration xs)
  (All (_ a) (-> (List a) (List [Nat a])))
  (loop (again [idx 0
                xs xs])
    (case xs
      {.#End}
      {.#End}

      {.#Item x xs'}
      {.#Item [idx x] (again (++ idx) xs')})))

(def .public when
  (macro (_ tokens state)
    (case tokens
      (list test then)
      {.#Right [state (.list (` (.if (, test)
                                  (, then)
                                  (.list))))]}

      _
      {.#Left (wrong_syntax_error ..when)})))

(def .public (revised item revision it)
  (All (_ a) (-> Nat (-> a a) (List a) (List a)))
  (case it
    {.#End}
    {.#End}

    {.#Item head tail}
    (case item
      0 {.#Item (revision head) tail}
      _ (revised (-- item) revision it))))