aboutsummaryrefslogtreecommitdiff
path: root/source/lux/data/list.lux
diff options
context:
space:
mode:
Diffstat (limited to 'source/lux/data/list.lux')
-rw-r--r--source/lux/data/list.lux344
1 files changed, 0 insertions, 344 deletions
diff --git a/source/lux/data/list.lux b/source/lux/data/list.lux
deleted file mode 100644
index 6bf050228..000000000
--- a/source/lux/data/list.lux
+++ /dev/null
@@ -1,344 +0,0 @@
-## Copyright (c) Eduardo Julian. All rights reserved.
-## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
-## If a copy of the MPL was not distributed with this file,
-## You can obtain one at http://mozilla.org/MPL/2.0/.
-
-(;import lux
- (lux (control (monoid #as m #refer #all)
- (functor #as F #refer #all)
- (monad #as M #refer #all)
- (eq #as E)
- (ord #as O)
- (fold #as f))
- (data (number (int #open ("i:" Int/Number Int/Ord Int/Show)))
- bool
- (text #open ("text:" Text/Monoid))
- tuple)
- codata/function))
-
-## [Types]
-## (deftype (List a)
-## (| #Nil
-## (#Cons (, a (List a)))))
-
-## [Functions]
-(defstruct #export List/Fold (f;Fold List)
- (def (foldL f init xs)
- (case xs
- #;Nil
- init
-
- (#;Cons [x xs'])
- (foldL f (f init x) xs')))
-
- (def (foldR f init xs)
- (case xs
- #;Nil
- init
-
- (#;Cons [x xs'])
- (f x (foldR f init xs')))))
-
-(open List/Fold)
-
-(def #export (fold mon xs)
- (All [a]
- (-> (m;Monoid a) (List a) a))
- (using mon
- (foldL ++ unit xs)))
-
-(def #export (reverse xs)
- (All [a]
- (-> (List a) (List a)))
- (foldL (lambda [tail head] (#;Cons [head tail]))
- #;Nil
- xs))
-
-(def #export (filter p xs)
- (All [a]
- (-> (-> a Bool) (List a) (List a)))
- (case xs
- #;Nil
- #;Nil
-
- (#;Cons [x xs'])
- (if (p x)
- (#;Cons [x (filter p xs')])
- (filter p xs'))))
-
-(def #export (partition p xs)
- (All [a] (-> (-> a Bool) (List a) (, (List a) (List a))))
- [(filter p xs) (filter (comp p) xs)])
-
-(def #export (as-pairs xs)
- (All [a] (-> (List a) (List (, a a))))
- (case xs
- (\ (#;Cons [x1 (#;Cons [x2 xs'])]))
- (#;Cons [[x1 x2] (as-pairs xs')])
-
- _
- #;Nil))
-
-(do-template [<name> <then> <else>]
- [(def #export (<name> n xs)
- (All [a]
- (-> Int (List a) (List a)))
- (if (i:> n 0)
- (case xs
- #;Nil
- #;Nil
-
- (#;Cons [x xs'])
- <then>)
- <else>))]
-
- [take (#;Cons [x (take (i:+ -1 n) xs')]) #;Nil]
- [drop (drop (i:+ -1 n) xs') xs]
- )
-
-(do-template [<name> <then> <else>]
- [(def #export (<name> p xs)
- (All [a]
- (-> (-> a Bool) (List a) (List a)))
- (case xs
- #;Nil
- #;Nil
-
- (#;Cons [x xs'])
- (if (p x)
- <then>
- <else>)))]
-
- [take-while (#;Cons [x (take-while p xs')]) #;Nil]
- [drop-while (drop-while p xs') xs]
- )
-
-(def #export (split n xs)
- (All [a]
- (-> Int (List a) (, (List a) (List a))))
- (if (i:> n 0)
- (case xs
- #;Nil
- [#;Nil #;Nil]
-
- (#;Cons [x xs'])
- (let [[tail rest] (split (i:+ -1 n) xs')]
- [(#;Cons [x tail]) rest]))
- [#;Nil xs]))
-
-(def (split-with' p ys xs)
- (All [a]
- (-> (-> a Bool) (List a) (List a) (, (List a) (List a))))
- (case xs
- #;Nil
- [ys xs]
-
- (#;Cons [x xs'])
- (if (p x)
- (split-with' p (#;Cons [x ys]) xs')
- [ys xs])))
-
-(def #export (split-with p xs)
- (All [a]
- (-> (-> a Bool) (List a) (, (List a) (List a))))
- (let [[ys' xs'] (split-with' p #;Nil xs)]
- [(reverse ys') xs']))
-
-(def #export (repeat n x)
- (All [a]
- (-> Int a (List a)))
- (if (i:> n 0)
- (#;Cons [x (repeat (i:+ -1 n) x)])
- #;Nil))
-
-(def #export (iterate f x)
- (All [a]
- (-> (-> a (Maybe a)) a (List a)))
- (case (f x)
- (#;Some x')
- (#;Cons [x (iterate f x')])
-
- #;None
- (#;Cons [x #;Nil])))
-
-(def #export (some f xs)
- (All [a b]
- (-> (-> a (Maybe b)) (List a) (Maybe b)))
- (case xs
- #;Nil
- #;None
-
- (#;Cons [x xs'])
- (case (f x)
- #;None
- (some f xs')
-
- (#;Some y)
- (#;Some y))))
-
-(def #export (interpose sep xs)
- (All [a]
- (-> a (List a) (List a)))
- (case xs
- #;Nil
- xs
-
- (#;Cons [x #;Nil])
- xs
-
- (#;Cons [x xs'])
- (#;Cons [x (#;Cons [sep (interpose sep xs')])])))
-
-(def #export (size list)
- (All [a] (-> (List a) Int))
- (foldL (lambda [acc _] (i:+ 1 acc)) 0 list))
-
-(do-template [<name> <init> <op>]
- [(def #export (<name> p xs)
- (All [a]
- (-> (-> a Bool) (List a) Bool))
- (foldL (lambda [_1 _2] (<op> _1 (p _2))) <init> xs))]
-
- [every? true and]
- [any? false or])
-
-(def #export (@ i xs)
- (All [a]
- (-> Int (List a) (Maybe a)))
- (case xs
- #;Nil
- #;None
-
- (#;Cons [x xs'])
- (if (i:= 0 i)
- (#;Some x)
- (@ (i:+ -1 i) xs'))))
-
-## [Syntax]
-(defmacro #export (@list xs state)
- (#;Right state (#;Cons (foldL (: (-> AST AST AST)
- (lambda [tail head] (` (#;Cons (~ head) (~ tail)))))
- (` #;Nil)
- (reverse xs))
- #;Nil)))
-
-(defmacro #export (@list& xs state)
- (case (reverse xs)
- (#;Cons last init)
- (#;Right state (@list (foldL (: (-> AST AST AST)
- (lambda [tail head] (` (#;Cons (~ head) (~ tail)))))
- last
- init)))
-
- _
- (#;Left "Wrong syntax for @list&")))
-
-## [Structures]
-(defstruct #export (List/Eq eq)
- (All [a] (-> (E;Eq a) (E;Eq (List a))))
- (def (= xs ys)
- (case [xs ys]
- [#;Nil #;Nil]
- true
-
- [(#;Cons x xs') (#;Cons y ys')]
- (and (:: eq (= x y))
- (= xs' ys'))
-
- [_ _]
- false
- )))
-
-(defstruct #export List/Monoid (All [a]
- (Monoid (List a)))
- (def unit #;Nil)
- (def (++ xs ys)
- (case xs
- #;Nil ys
- (#;Cons x xs') (#;Cons x (++ xs' ys)))))
-
-(defstruct #export List/Functor (Functor List)
- (def (map f ma)
- (case ma
- #;Nil #;Nil
- (#;Cons a ma') (#;Cons (f a) (map f ma')))))
-
-(defstruct #export List/Monad (Monad List)
- (def _functor List/Functor)
-
- (def (wrap a)
- (#;Cons a #;Nil))
-
- (def (join mma)
- (using List/Monoid
- (foldL ++ unit mma))))
-
-## [Functions]
-(def #export (sort ord xs)
- (All [a] (-> (O;Ord a) (List a) (List a)))
- (case xs
- #;Nil
- #;Nil
-
- (#;Cons x xs')
- (using ord
- (let [pre (filter (>= x) xs')
- post (filter (< x) xs')
- ++ (:: List/Monoid ++)]
- ($ ++ (sort ord pre) (@list x) (sort ord post))))))
-
-## [Syntax]
-(def (symbol$ name)
- (-> Text AST)
- [["" -1 -1] (#;SymbolS "" name)])
-
-(def (range from to)
- (-> Int Int (List Int))
- (if (i:<= from to)
- (@list& from (range (i:+ 1 from) to))
- (@list)))
-
-(defmacro #export (zip tokens state)
- (case tokens
- (\ (@list [_ (#;IntS num-lists)]))
- (if (i:> num-lists 0)
- (using List/Functor
- (let [indices (range 0 (i:- num-lists 1))
- type-vars (: (List AST) (map (. symbol$ i:show) indices))
- zip-type (` (All [(~@ type-vars)]
- (-> (~@ (map (: (-> AST AST) (lambda [var] (` (List (~ var)))))
- type-vars))
- (List (, (~@ type-vars))))))
- vars+lists (map (lambda [idx]
- (let [base (text:++ "_" (i:show idx))]
- [(symbol$ base)
- (symbol$ (text:++ base "s"))]))
- indices)
- pattern (` [(~@ (map (lambda [[v vs]] (` (#;Cons (~ v) (~ vs))))
- vars+lists))])
- g!step (symbol$ "\tstep\t")
- g!blank (symbol$ "\t_\t")
- list-vars (map second vars+lists)
- code (` (: (~ zip-type)
- (lambda (~ g!step) [(~@ list-vars)]
- (case [(~@ list-vars)]
- (~ pattern)
- (#;Cons [(~@ (map first vars+lists))]
- ((~ g!step) (~@ list-vars)))
-
- (~ g!blank)
- #;Nil))))]
- (#;Right [state (@list code)])))
- (#;Left "Can't zip no lists."))
-
- _
- (#;Left "Wrong syntax for zip")))
-
-(def #export zip2 (zip 2))
-(def #export zip3 (zip 3))
-
-(def #export (empty? xs)
- (All [a] (-> (List a) Bool))
- (case xs
- #;Nil true
- _ false))
generated by cgit v1.2.3 (git 2.25.1) at 2024-09-12 21:01:09 +0000