Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add some list functions. #182

Open
wants to merge 8 commits into
base: master
Choose a base branch
from
Open
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Jump to
Jump to file
Failed to load files.
Diff view
Diff view
335 changes: 335 additions & 0 deletions lib-satysfi/dist/packages/list.satyg
Original file line number Diff line number Diff line change
Expand Up @@ -18,6 +18,38 @@ module List
val mapi-adjacent : (int -> 'a -> 'a option -> 'a option -> 'b) -> 'a list -> 'b list
val length : 'a list -> int
val nth : int -> 'a list -> 'a option
val apply : 'a -> ('a -> 'b) list -> 'b list
val null : 'a list -> bool
val take : int -> 'a list -> 'a list
val drop : int -> 'a list -> 'a list
val takewhile : ('a -> bool) -> 'a list -> 'a list
val dropwhile : ('a -> bool) -> 'a list -> 'a list
val splitat : int -> 'a list -> ('a list * 'a list)
val span : ('a -> bool) -> 'a list -> ('a list * 'a list)
val break : ('a -> bool) -> 'a list -> ('a list * 'a list)
val head : 'a list -> 'a option
val tail : 'a list -> ('a list) option
val last : 'a list -> 'a option
val init : 'a list -> ('a list) option
val reverse-append : 'a list -> 'a list -> 'a list
val reverse-map : ('a -> 'b) -> 'a list -> 'b list
val all-and : bool list -> bool
val or : bool list -> bool
val for-all : ('a -> bool) -> 'a list -> bool
val exists : ('a -> bool) -> 'a list -> bool
val for-all2 : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool option
val exists2 : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool option
val find : ('a -> bool) -> 'a list -> 'a option
val partition : ('a -> bool) -> 'a list -> 'a list * 'a list
val split : ('a * 'b) list -> 'a list * 'b list
val combine : 'a list -> 'b list -> (('a * 'b) list) option
val show-opt : ('a option) list -> 'a list
val iterate : int -> ('a -> 'a) -> 'a -> 'a list
val repeat : int -> 'a -> 'a list
val make-cycle : int -> 'a list -> 'a list
val max : ('a -> 'a -> int) -> 'a list -> 'a option
val mini : ('a -> 'a -> int) -> 'a list -> 'a option
val bubblesort : ('a -> 'a -> int) -> 'a list -> 'a list
end
= struct

Expand Down Expand Up @@ -132,4 +164,307 @@ module List
in
aux 0 lst


let (^&&) b-opt1 b-opt2 =
match (b-opt1, b-opt2) with
| (Some(b1), Some(b2)) -> Some(b1 && b2)
| (_, _) -> None


let (^||) b-opt1 b-opt2 =
match (b-opt1, b-opt2) with
| (Some(b1), Some(b2)) -> Some(b1 || b2)
| (_, _) -> None


let (^::) a-opt1 lst-opt2 =
match (a-opt1, lst-opt2) with
| (Some(x), Some(xs)) -> Some(x :: xs)
| (_, _) -> None


let-rec apply v lst =
match lst with
| [] -> []
| x :: xs -> x v :: apply v xs


let null lst =
match lst with
| [] -> true
| _ -> false


let-rec take i lst =
match lst with
| [] -> []
| x :: xs -> (
if i < 0 then
[]
else
x :: (take (i - 1) xs)
)


let-rec drop i lst =
if i < 0 then
lst
else
match lst with
| [] -> []
| x :: xs -> (
if i < 1 then
xs
else
drop (i - 1) xs
)


let-rec takewhile f lst =
match lst with
| [] -> []
| x :: xs -> (
if f x then
x :: takewhile f xs
else
takewhile f xs
)


let-rec dropwhile f lst =
match lst with
| [] -> []
| x :: xs -> (
if f x then
dropwhile f xs
else
x :: dropwhile f xs
)


let splitat n lst =
(take n lst, drop n lst)


let span f lst =
let-rec span-sub lst1 lst2 =
match lst2 with
| y :: ys -> (
if f y then
span-sub (y :: lst1) ys
else
(reverse lst1, lst2)
)
| _ -> (reverse lst1, lst2)
in
span-sub [] lst


let break f lst =
let-rec break-sub lst1 lst2 =
match lst2 with
| y :: ys -> (
if f y then
(reverse lst1, lst2)
else
break-sub (y :: lst1) ys
)
| [] -> (reverse lst1, lst2)
in
break-sub [] lst


let head lst =
match lst with
| [] -> None
| head :: _ -> Some(head)


let tail lst =
match lst with
| [] -> None
| _ :: tail -> Some(tail)


let-rec last lst =
match lst with
| [] -> None
| x :: [] -> Some(x)
| _ :: xs -> last xs


let-rec init lst =
match lst with
| [] -> None
| x :: [] -> Some([])
| x :: xs -> Some(x) ^:: (init xs)


let-rec reverse-append lst1 lst2 =
match lst1 with
| [] -> lst2
| x :: xs -> reverse-append xs (x :: lst2)


let reverse-map f lst =
let-rec rmap-f accu lst =
match lst with
| [] -> accu
| (x :: xs) -> rmap-f (f x :: accu) xs
in
rmap-f [] lst

let-rec all-and lst =
match lst with
| [] -> true
| x :: xs -> x && all-and xs


let-rec or lst =
match lst with
| [] -> false
| x :: xs -> x || or xs


let-rec for-all f lst =
match lst with
| [] -> true
| x :: xs -> f x && for-all f xs


let-rec exists f lst =
match lst with
| [] -> false
| x :: xs -> f x || exists f xs


let-rec for-all2 f lst1 lst2 =
match (lst1, lst2) with
| ([], []) -> Some(true)
| (x1 :: xs1, x2 :: xs2) -> Some(f x1 x2) ^&& for-all2 f xs1 xs2
| (_, _) -> None


let-rec exists2 f lst1 lst2 =
match (lst1, lst2) with
| ([], []) -> Some(false)
| (x1 :: xs1, x2 :: xs2) -> Some(f x1 x2) ^|| (exists2 f xs1 xs2)
| (_, _) -> None


let-rec find f lst =
match lst with
| [] -> None
| x :: xs -> if f x then Some(x) else find f xs


let partition f lst =
let-rec part yes no lst =
match lst with
| [] -> (reverse yes, reverse no)
| x :: xs -> if f x then part (x :: yes) no xs else part yes (x :: no) xs
in
part [] [] lst


let-rec split lst =
match lst with
| [] -> ([], [])
| (x, y) :: xs -> let (rx, ry) = split xs in (x :: rx, y :: ry)


let-rec combine lst1 lst2 =
match (lst1, lst2) with
| ([], []) -> Some([])
| (x1 :: xs1, x2 :: xs2) -> Some((x1, x2)) ^:: (combine xs1 xs2)
| (_, _) -> None


let-rec show-opt lst =
match lst with
| [] -> []
| x :: xs -> (
match x with
| Some(x) -> x :: show-opt xs
| None -> show-opt xs
)


let-rec iterate n f initial =
if n == 0 then
[]
else
f initial :: iterate (n - 1) f (f initial)

let-rec repeat n initial =
if n == 0 then
[]
else
initial :: repeat (n - 1) initial


let-rec make-cycle n lst =
if n == 0 then
[]
else
append lst (make-cycle (n - 1) lst)


let-rec max f lst =
match lst with
| [] -> None
| x :: [] -> Some(x)
| x :: y :: zs -> (
if (f x y) < 0 then
max f (y :: zs)
else
max f (x :: zs)
)


let-rec mini f lst =
match lst with
| [] -> None
| x :: [] -> Some(x)
| x :: y :: zs -> (
if (f x y) > 0 then
mini f (y :: zs)
else
mini f (x :: zs)
)


let-rec bubblesort f lst =
let-rec last lst =
match lst with
| x :: [] -> x
| _ :: xs -> last xs
in
let-rec init lst =
match lst with
| _ :: [] -> []
| x :: xs -> x :: (init xs)
in
let-rec bs-sub lst =
match lst with
| (x :: y :: zs) -> (
if (f x y) < 0 then
y :: bs-sub (x :: zs)
else
x :: bs-sub (y :: zs)
)
| _ -> lst
in
match lst with
| [] -> []
| x :: [] -> [x]
| _ -> (
let a = bs-sub lst in
let x = last a in
let xs = init a in
match xs with
| [] -> x :: []
| _ -> x :: (bubblesort f xs)
)

end