Compare commits
10 commits
1ae966103c
...
41a154dc7c
Author | SHA1 | Date | |
---|---|---|---|
41a154dc7c | |||
9bbe18d54e | |||
60656567c1 | |||
a43a8271b3 | |||
f6e82f5b80 | |||
ab8d166fad | |||
b0063b8512 | |||
ecb7e60551 | |||
bb7fd94dcd | |||
dd98b216e0 |
25 changed files with 809 additions and 30 deletions
14
README.md
Normal file
14
README.md
Normal file
|
@ -0,0 +1,14 @@
|
||||||
|
# Programming Languages
|
||||||
|
my solutions to ["Programming Languages"](https://www.coursera.org/learn/programming-languages) course by Dan Grossman.
|
||||||
|
|
||||||
|
Course consists of three separate parts in which author tries to explain language concepts / paradigms through different languages:
|
||||||
|
- SML
|
||||||
|
- Raket
|
||||||
|
- Ruby
|
||||||
|
|
||||||
|
Each part has exercises for specific language. You can find this exercies and my solutions in repo.
|
||||||
|
|
||||||
|
### TODO
|
||||||
|
- ~~SML~~
|
||||||
|
- Raket
|
||||||
|
- Ruby
|
Binary file not shown.
Binary file not shown.
|
@ -1,4 +1,24 @@
|
||||||
use "operators.sml";
|
(*
|
||||||
|
Pipe operator.
|
||||||
|
Simply to write code like "data |> fun" instead "fun data".
|
||||||
|
Then you can "pipe" results to functions via partial application:
|
||||||
|
|
||||||
|
fun square a b = a * b
|
||||||
|
fun sum a b = a + b
|
||||||
|
|
||||||
|
10 |> sum 10 |> square 2 // 40
|
||||||
|
*)
|
||||||
|
fun |> (x, f) = f x
|
||||||
|
|
||||||
|
(* apply operator *)
|
||||||
|
fun $ (f, x) = f x
|
||||||
|
|
||||||
|
(* composition operator *)
|
||||||
|
fun >> (f, g) x = g(f(x))
|
||||||
|
|
||||||
|
infix |>
|
||||||
|
infix $
|
||||||
|
infix >>
|
||||||
|
|
||||||
(* year * month * day *)
|
(* year * month * day *)
|
||||||
type Date = int * int * int
|
type Date = int * int * int
|
||||||
|
@ -71,6 +91,7 @@ fun uniqe lst =
|
||||||
end
|
end
|
||||||
|
|
||||||
(* naive sort, will blow up the stack. Can't use pattern matching for now :( *)
|
(* naive sort, will blow up the stack. Can't use pattern matching for now :( *)
|
||||||
|
(* also incorrect *)
|
||||||
(* fun sort f lst =
|
(* fun sort f lst =
|
||||||
case lst of
|
case lst of
|
||||||
[] => []
|
[] => []
|
||||||
|
@ -81,7 +102,7 @@ fun uniqe lst =
|
||||||
else first :: second :: sort f rest *)
|
else first :: second :: sort f rest *)
|
||||||
|
|
||||||
(* also will blow up the stack *)
|
(* also will blow up the stack *)
|
||||||
fun sort f lst =
|
fun sort' f lst =
|
||||||
if lst = []
|
if lst = []
|
||||||
then []
|
then []
|
||||||
else
|
else
|
||||||
|
@ -95,18 +116,25 @@ fun sort f lst =
|
||||||
val greater = f first second
|
val greater = f first second
|
||||||
in
|
in
|
||||||
if greater
|
if greater
|
||||||
then second :: first :: sort f rest
|
then second :: sort' f (first :: rest)
|
||||||
else first :: second :: sort f rest
|
else first :: sort' f (second :: rest)
|
||||||
end
|
end
|
||||||
|
|
||||||
|
(* simple recursive convergence *)
|
||||||
|
fun fix f g x =
|
||||||
|
if f g x = x
|
||||||
|
then x
|
||||||
|
else fix f g (f g x)
|
||||||
|
|
||||||
|
(* naive bubble sort *)
|
||||||
|
fun sort f x = fix sort' f x
|
||||||
|
|
||||||
fun is_older ((y1, m1, d1): Date, (y2, m2, d2): Date): bool =
|
fun is_older ((y1, m1, d1): Date, (y2, m2, d2): Date): bool =
|
||||||
let
|
let
|
||||||
val same_dates = y1 = y2 andalso m1 = m2 andalso d1 = d2
|
val first_days = y1 * 360 + m1 * 30 + d1
|
||||||
val older = y1 <= y2 andalso m1 <= m2 andalso d1 <= d2
|
val second_days = y2 * 360 + m2 * 30 + d2
|
||||||
in
|
in
|
||||||
if same_dates
|
first_days < second_days
|
||||||
then false
|
|
||||||
else older
|
|
||||||
end
|
end
|
||||||
|
|
||||||
fun number_in_month (dates: Date list, month_to_find: int): int =
|
fun number_in_month (dates: Date list, month_to_find: int): int =
|
||||||
|
@ -170,16 +198,12 @@ fun date_to_string ((year, month, day): Date): string =
|
||||||
"December"
|
"December"
|
||||||
]
|
]
|
||||||
|
|
||||||
val string_month = get_nth (months, month - 1)
|
val string_month = get_nth (months, month)
|
||||||
|
|
||||||
val to_str = Int.toString
|
val to_str = Int.toString
|
||||||
|
|
||||||
fun pad num =
|
|
||||||
if num < 10
|
|
||||||
then "0" ^ to_str num
|
|
||||||
else to_str num
|
|
||||||
in
|
in
|
||||||
string_month ^ " " ^ pad day ^ ", " ^ to_str year
|
string_month ^ " " ^ to_str day ^ ", " ^ to_str year
|
||||||
end
|
end
|
||||||
|
|
||||||
fun number_before_reaching_sum (sum: int, numbers: int list): int =
|
fun number_before_reaching_sum (sum: int, numbers: int list): int =
|
|
@ -17,6 +17,11 @@ val () =
|
||||||
(sort (fn a => fn b => a > b) [2, 1] = [1, 2])
|
(sort (fn a => fn b => a > b) [2, 1] = [1, 2])
|
||||||
"sort: two elements"
|
"sort: two elements"
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
(is_older ((1,2,25), (6,7,8)) = true)
|
||||||
|
"is_older: first date older than second by year and month"
|
||||||
|
|
||||||
val () =
|
val () =
|
||||||
assert
|
assert
|
||||||
(is_older ((1999, 12, 31), (1999, 12, 31)) = false)
|
(is_older ((1999, 12, 31), (1999, 12, 31)) = false)
|
||||||
|
@ -185,7 +190,12 @@ val () =
|
||||||
|
|
||||||
val () =
|
val () =
|
||||||
assert
|
assert
|
||||||
(date_to_string ((2020, 06, 01)) = "May 01, 2020")
|
(date_to_string (2020, 06, 01) = "June 1, 2020")
|
||||||
|
"date_to_string: returns correct string"
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
(date_to_string (3, 1, 1) = "January 1, 3")
|
||||||
"date_to_string: returns correct string"
|
"date_to_string: returns correct string"
|
||||||
|
|
||||||
val () =
|
val () =
|
||||||
|
@ -258,6 +268,14 @@ val () =
|
||||||
assert (oldest dates = expect) "oldest: returns oldest"
|
assert (oldest dates = expect) "oldest: returns oldest"
|
||||||
end
|
end
|
||||||
|
|
||||||
|
val () =
|
||||||
|
let
|
||||||
|
val dates = [(5,5,2), (5, 10, 2), (5, 2, 2), (5, 12, 2)]
|
||||||
|
val expect = SOME (5, 2, 2)
|
||||||
|
in
|
||||||
|
assert (oldest dates = expect) "oldest: returns oldest"
|
||||||
|
end
|
||||||
|
|
||||||
val () =
|
val () =
|
||||||
let
|
let
|
||||||
val dates = [(2000, 11, 31), (2000, 11, 31)]
|
val dates = [(2000, 11, 31), (2000, 11, 31)]
|
BIN
sml/week3/assignment.pdf
Normal file
BIN
sml/week3/assignment.pdf
Normal file
Binary file not shown.
|
@ -31,7 +31,7 @@ val remove_card: remove_card = fn (cards, to_remove, exp) =>
|
||||||
then (found, card :: acc)
|
then (found, card :: acc)
|
||||||
else (true orelse found, acc)
|
else (true orelse found, acc)
|
||||||
in
|
in
|
||||||
case fold filter (false, []) cards of
|
case foldl filter (false, []) cards of
|
||||||
(true, filtered) => filtered
|
(true, filtered) => filtered
|
||||||
| (false, _) => raise exp
|
| (false, _) => raise exp
|
||||||
end
|
end
|
||||||
|
@ -47,10 +47,11 @@ val rec all_same_color: all_same_color = fn cards =>
|
||||||
|
|
||||||
type sum_cards = card list -> int
|
type sum_cards = card list -> int
|
||||||
val sum_cards: sum_cards = fn cards =>
|
val sum_cards: sum_cards = fn cards =>
|
||||||
cards |> fold (fn card => fn sum => card_value card + sum) 0
|
cards |> foldl (fn card => fn sum => card_value card + sum) 0
|
||||||
|
|
||||||
|
fun sum a b = a + b
|
||||||
(* even shorter via partial application :) *)
|
(* even shorter via partial application :) *)
|
||||||
val sum_cards: sum_cards = fold (fn card => fn sum => card_value card + sum) 0
|
val sum_cards: sum_cards = foldl (card_value >> sum) 0
|
||||||
|
|
||||||
type score = card list * int -> int
|
type score = card list * int -> int
|
||||||
val score: score = fn (cards, goal) =>
|
val score: score = fn (cards, goal) =>
|
||||||
|
@ -83,5 +84,5 @@ val officiate: officiate = fn (deck, moves, goal) =>
|
||||||
|
|
||||||
fun round hand = score (hand, goal)
|
fun round hand = score (hand, goal)
|
||||||
in
|
in
|
||||||
moves |> fold play (deck, []) |> #2 |> round
|
moves |> foldl play (deck, []) |> #2 |> round
|
||||||
end
|
end
|
|
@ -212,4 +212,11 @@ val 0 =
|
||||||
|> (fn _ => expected)
|
|> (fn _ => expected)
|
||||||
end
|
end
|
||||||
|
|
||||||
|
fun by2 a = a * 2
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ map by2 [1, 2, 3] = [2, 4, 6]
|
||||||
|
$ "map test"
|
||||||
|
|
||||||
val () = complete ()
|
val () = complete ()
|
|
@ -2,23 +2,22 @@ use "operators.sml";
|
||||||
|
|
||||||
fun cons head tail = head :: tail
|
fun cons head tail = head :: tail
|
||||||
|
|
||||||
fun fold f acc lst =
|
fun foldl f acc lst =
|
||||||
case lst of
|
case lst of
|
||||||
[] => acc
|
[] => acc
|
||||||
| head :: tail => fold f (f head acc) tail
|
| head :: tail => foldl f (f head acc) tail
|
||||||
|
|
||||||
fun reverse lst =
|
fun reverse lst = foldl cons [] lst
|
||||||
let
|
|
||||||
fun f elm acc = elm :: acc
|
fun foldr f acc = foldl f acc >> reverse
|
||||||
in
|
|
||||||
fold f [] lst
|
fun map f = foldr (f >> cons) []
|
||||||
end
|
|
||||||
|
|
||||||
fun filter predicate lst =
|
fun filter predicate lst =
|
||||||
let
|
let
|
||||||
fun f elm acc = if predicate elm then elm :: acc else acc
|
fun f elm acc = if predicate elm then elm :: acc else acc
|
||||||
in
|
in
|
||||||
lst |> fold f [] |> reverse
|
foldr f [] lst
|
||||||
end
|
end
|
||||||
|
|
||||||
fun empty lst = lst = []
|
fun empty lst = lst = []
|
||||||
|
@ -27,5 +26,5 @@ fun empty lst = lst = []
|
||||||
fun exists elem lst =
|
fun exists elem lst =
|
||||||
lst
|
lst
|
||||||
|> filter (fn needle => elem = needle)
|
|> filter (fn needle => elem = needle)
|
||||||
|> empty
|
|> empty
|
||||||
|> not
|
|> not
|
BIN
sml/week3_2020/assigment.pdf
Normal file
BIN
sml/week3_2020/assigment.pdf
Normal file
Binary file not shown.
106
sml/week3_2020/json.sml
Normal file
106
sml/week3_2020/json.sml
Normal file
|
@ -0,0 +1,106 @@
|
||||||
|
use "operators.sml";
|
||||||
|
use "list.sml";
|
||||||
|
|
||||||
|
exception NotSorted
|
||||||
|
|
||||||
|
datatype json =
|
||||||
|
Num of real
|
||||||
|
| String of string
|
||||||
|
| False
|
||||||
|
| True
|
||||||
|
| Null
|
||||||
|
| Array of json list
|
||||||
|
| Object of (string * json) list
|
||||||
|
|
||||||
|
val strcmp = String.compare
|
||||||
|
|
||||||
|
type make_silly_json = int -> json
|
||||||
|
val make_silly_json: make_silly_json = fn num =>
|
||||||
|
let
|
||||||
|
fun construct num json =
|
||||||
|
case num of
|
||||||
|
0 => json
|
||||||
|
| _ =>
|
||||||
|
case json of
|
||||||
|
Array arr => Array $ arr @ [Object [("b", True), ("n", Num $ Real.fromInt num)]]
|
||||||
|
in
|
||||||
|
construct num (Array [])
|
||||||
|
end
|
||||||
|
|
||||||
|
(* not tail recursive *)
|
||||||
|
type concat_with = string * string list -> string
|
||||||
|
val rec concat_with: concat_with = fn (separator, strings) =>
|
||||||
|
case strings of
|
||||||
|
[] => ""
|
||||||
|
| one :: [] => one
|
||||||
|
| first :: second :: rest =>
|
||||||
|
first ^ separator ^ second ^ concat_with (separator, rest)
|
||||||
|
|
||||||
|
(* complex, two iterations but tail recursive :) *)
|
||||||
|
val rec concat_with: concat_with = fn (separator, strings) =>
|
||||||
|
let
|
||||||
|
fun insert elem acc = elem :: separator :: acc
|
||||||
|
fun concat elem acc = elem ^ acc
|
||||||
|
in
|
||||||
|
case strings of
|
||||||
|
[] => ""
|
||||||
|
| one :: [] => one
|
||||||
|
| head :: tail => foldl insert [head] tail |> foldl concat ""
|
||||||
|
end
|
||||||
|
|
||||||
|
type quote_string = string -> string
|
||||||
|
val quote_string: quote_string = fn str => "\"" ^ str ^ "\""
|
||||||
|
|
||||||
|
type real_to_string_for_json = real -> string
|
||||||
|
val real_to_string_for_json: real_to_string_for_json = fn num =>
|
||||||
|
if num < 0.0
|
||||||
|
then "-" ^ (Real.toString (~num))
|
||||||
|
else Real.toString num
|
||||||
|
|
||||||
|
type json_to_string = json -> string
|
||||||
|
val rec json_to_string: json_to_string = fn json =>
|
||||||
|
let
|
||||||
|
fun concat strs = concat_with (",", strs)
|
||||||
|
|
||||||
|
fun convert f json = json |> foldr f [] |> concat
|
||||||
|
|
||||||
|
fun array elem all = json_to_string elem :: all
|
||||||
|
|
||||||
|
fun object (key, value) all =
|
||||||
|
(quote_string key ^ ":" ^ json_to_string value) :: all
|
||||||
|
in
|
||||||
|
case json of
|
||||||
|
Num num => real_to_string_for_json num
|
||||||
|
| String str => quote_string str
|
||||||
|
| False => "false"
|
||||||
|
| True => "true"
|
||||||
|
| Null => "null"
|
||||||
|
| Array json => "[" ^ convert array json ^ "]"
|
||||||
|
| Object json => "{" ^ convert object json ^ "}"
|
||||||
|
end
|
||||||
|
|
||||||
|
type (''a, 'b) assoc = ''a * (''a * 'b) list -> 'b option
|
||||||
|
val rec assoc = fn (needle, lst) =>
|
||||||
|
case lst of
|
||||||
|
[] => NONE
|
||||||
|
| (key, value) :: tail =>
|
||||||
|
if key = needle
|
||||||
|
then SOME value
|
||||||
|
else assoc (needle, tail)
|
||||||
|
|
||||||
|
type count_occurrences = (string list * exn) -> (string * int) list
|
||||||
|
val rec count_occurrences: count_occurrences = fn (strs, exn) =>
|
||||||
|
let
|
||||||
|
fun repetitons str lst reps order acc =
|
||||||
|
case lst of
|
||||||
|
[] => acc @ [(str, reps)]
|
||||||
|
| head :: tail => case strcmp (str, head) of
|
||||||
|
EQUAL => repetitons str tail (reps + 1) order acc
|
||||||
|
| new_order => if order <> EQUAL andalso new_order <> order
|
||||||
|
then raise exn
|
||||||
|
else repetitons head tail 1 new_order (acc @ [(str, reps)])
|
||||||
|
in
|
||||||
|
case strs of
|
||||||
|
[] => []
|
||||||
|
| head :: tail => repetitons head tail 1 EQUAL []
|
||||||
|
end
|
122
sml/week3_2020/json_test.sml
Normal file
122
sml/week3_2020/json_test.sml
Normal file
|
@ -0,0 +1,122 @@
|
||||||
|
use "test.sml";
|
||||||
|
use "operators.sml";
|
||||||
|
use "json.sml";
|
||||||
|
|
||||||
|
val () =
|
||||||
|
case make_silly_json 1 of
|
||||||
|
Array [Object [("b", True), ("n", (Num _))]] =>
|
||||||
|
assert true "make_silly_json: pass"
|
||||||
|
| _ =>
|
||||||
|
assert false "make_silly_json"
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ concat_with (":", []) = ""
|
||||||
|
$ "concat_with: [] = ''"
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ concat_with (":", ["a", "b"]) = "a:b"
|
||||||
|
$ "concat_with: ['a', 'b']) = 'a:b'"
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ concat_with (":", ["a", "b", "c"]) = "a:b:c"
|
||||||
|
$ "concat_with: ['a', 'b', 'c']) = 'a:b:c'"
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ concat_with (":", ["a"]) = "a"
|
||||||
|
$ "concat_with: ['a']) = 'a'"
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ quote_string "a" = "\"a\""
|
||||||
|
$ "quote_string: a = \"a\""
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ real_to_string_for_json 1.0 = "1.0"
|
||||||
|
$ "real_to_string_for_json: 1.0"
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ real_to_string_for_json ~1.0 = "-1.0"
|
||||||
|
$ "real_to_string_for_json: ~1.0"
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ json_to_string (String "a") = "\"a\""
|
||||||
|
$ "json_to_string: String a = a"
|
||||||
|
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ json_to_string (Array [String "a", String "b"]) = "[\"a\",\"b\"]"
|
||||||
|
$ "json_to_string: Array [String \"a\", String \"b\"]"
|
||||||
|
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ json_to_string False = "false"
|
||||||
|
$ "json_to_string: False"
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ json_to_string (Num 1.2) = "1.2"
|
||||||
|
$ "json_to_string: Num 1.2"
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ json_to_string (Object []) = "{}"
|
||||||
|
$ "json_to_string: Object []"
|
||||||
|
|
||||||
|
val () = print (json_to_string (Object [("b", True), ("n", (Num 0.1))]))
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ json_to_string (Object [("b", True), ("n", (Num 0.1))]) = "{\"b\":true,\"n\":0.1}"
|
||||||
|
$ "json_to_string: Object [(\"b\", True), (\"n\", (Num 0.1))]"
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ assoc ("key", []) = NONE
|
||||||
|
$ "assoc: key []"
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ assoc ("key", [("key", "value")]) = SOME "value"
|
||||||
|
$ "assoc: key [(key, value)]"
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ count_occurrences ([], NotSorted) = []
|
||||||
|
$ "count_occurrences: [] = []"
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ count_occurrences (["a"], NotSorted) = [("a", 1)]
|
||||||
|
$ "count_occurrences: ['a'] = [('a', 1)]"
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ count_occurrences (["a", "b"], NotSorted) = [("a", 1), ("b", 1)]
|
||||||
|
$ "count_occurrences: ['a', 'b'] = [('a', 1), ('b', 1)]"
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ count_occurrences (["a", "a", "b"], NotSorted) = [("a", 2), ("b", 1)]
|
||||||
|
$ "count_occurrences: ['a', 'a', 'b'] = [('a', 2), ('b', 1)]"
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ count_occurrences (["b", "a", "a"], NotSorted) = [("b", 1), ("a", 2)]
|
||||||
|
$ "count_occurrences: ['b', 'a', 'a'] = [('b', 1), ('a', 2)]"
|
||||||
|
|
||||||
|
val [] =
|
||||||
|
count_occurrences (["a", "a", "b", "a"], NotSorted)
|
||||||
|
handle NotSorted =>
|
||||||
|
assert true "count_occurrences: raises on unsorted list"
|
||||||
|
|> (fn _ => [])
|
||||||
|
|
||||||
|
val () = complete ()
|
32
sml/week3_2020/list.sml
Normal file
32
sml/week3_2020/list.sml
Normal file
|
@ -0,0 +1,32 @@
|
||||||
|
use "operators.sml";
|
||||||
|
|
||||||
|
fun cons head tail = head :: tail
|
||||||
|
|
||||||
|
fun foldl f acc lst =
|
||||||
|
case lst of
|
||||||
|
[] => acc
|
||||||
|
| head :: tail => foldl f (f head acc) tail
|
||||||
|
|
||||||
|
fun reverse lst = foldl cons [] lst
|
||||||
|
|
||||||
|
(* wrong definition, fold doesn't always returns array *)
|
||||||
|
fun foldr f acc = foldl f acc >> reverse
|
||||||
|
|
||||||
|
fun map f = foldr (f >> cons) []
|
||||||
|
|
||||||
|
fun filter predicate lst =
|
||||||
|
let
|
||||||
|
fun f elm acc = if predicate elm then elm :: acc else acc
|
||||||
|
in
|
||||||
|
foldr f [] lst
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
fun empty lst = lst = []
|
||||||
|
|
||||||
|
(* not efficient but works *)
|
||||||
|
fun exists elem lst =
|
||||||
|
lst
|
||||||
|
|> filter (fn needle => elem = needle)
|
||||||
|
|> empty
|
||||||
|
|> not
|
21
sml/week3_2020/operators.sml
Normal file
21
sml/week3_2020/operators.sml
Normal file
|
@ -0,0 +1,21 @@
|
||||||
|
(*
|
||||||
|
Pipe operator.
|
||||||
|
Simply to write code like "data |> fun" instead "fun data".
|
||||||
|
Then you can "pipe" results to functions via partial application:
|
||||||
|
|
||||||
|
fun square a b = a * b
|
||||||
|
fun sum a b = a + b
|
||||||
|
|
||||||
|
10 |> sum 10 |> square 2 // 40
|
||||||
|
*)
|
||||||
|
fun op |> (x, f) = f x
|
||||||
|
|
||||||
|
(* apply operator *)
|
||||||
|
fun op $ (f, x) = f x
|
||||||
|
|
||||||
|
(* composition operator *)
|
||||||
|
fun op >> (f, g) x = g(f(x))
|
||||||
|
|
||||||
|
infix |>
|
||||||
|
infix $
|
||||||
|
infix >>
|
17
sml/week3_2020/test.sml
Normal file
17
sml/week3_2020/test.sml
Normal file
|
@ -0,0 +1,17 @@
|
||||||
|
fun assert condition message =
|
||||||
|
if condition
|
||||||
|
then
|
||||||
|
print (message ^ "\n")
|
||||||
|
else
|
||||||
|
let
|
||||||
|
val () = print ("Assert error: " ^ message ^ "\n")
|
||||||
|
in
|
||||||
|
OS.Process.exit OS.Process.failure
|
||||||
|
end
|
||||||
|
|
||||||
|
fun complete () =
|
||||||
|
let
|
||||||
|
val () = print "All tests passed!"
|
||||||
|
in
|
||||||
|
OS.Process.exit OS.Process.success
|
||||||
|
end
|
BIN
sml/week4/assigment.pdf
Normal file
BIN
sml/week4/assigment.pdf
Normal file
Binary file not shown.
123
sml/week4/hw3.sml
Normal file
123
sml/week4/hw3.sml
Normal file
|
@ -0,0 +1,123 @@
|
||||||
|
use "operators.sml";
|
||||||
|
use "list.sml";
|
||||||
|
|
||||||
|
datatype pattern =
|
||||||
|
Wildcard
|
||||||
|
| Variable of string
|
||||||
|
| UnitP
|
||||||
|
| ConstP of int
|
||||||
|
| TupleP of pattern list
|
||||||
|
| ConstructorP of string * pattern
|
||||||
|
|
||||||
|
datatype valu =
|
||||||
|
Const of int
|
||||||
|
| Unit
|
||||||
|
| Tuple of valu list
|
||||||
|
| Constructor of string * valu
|
||||||
|
|
||||||
|
exception NoAnswer
|
||||||
|
|
||||||
|
fun first str = String.sub (str, 0)
|
||||||
|
val only_capitals = filter (first >> Char.isUpper)
|
||||||
|
|
||||||
|
val size = String.size
|
||||||
|
fun choose f a b = if f a b then a else b
|
||||||
|
fun biggest a b = size a > size b
|
||||||
|
fun bigger_or_equal a b = size a >= size b
|
||||||
|
|
||||||
|
val longest_string1 = foldl (choose biggest) ""
|
||||||
|
|
||||||
|
val longest_string2 = foldl (choose bigger_or_equal) ""
|
||||||
|
|
||||||
|
fun longest_string_helper f =
|
||||||
|
let
|
||||||
|
val longest_string3 = longest_string1
|
||||||
|
val longest_string4 = longest_string2
|
||||||
|
in
|
||||||
|
if f (0, 0)
|
||||||
|
then longest_string4
|
||||||
|
else longest_string3
|
||||||
|
end
|
||||||
|
|
||||||
|
val longest_capitalized = only_capitals >> longest_string2
|
||||||
|
|
||||||
|
val rev_string = String.explode >> List.rev >> String.implode
|
||||||
|
|
||||||
|
fun first_answer f lst =
|
||||||
|
case lst of
|
||||||
|
[] => raise NoAnswer
|
||||||
|
| head :: tail =>
|
||||||
|
case f head of
|
||||||
|
NONE => first_answer f tail
|
||||||
|
| SOME answer => answer
|
||||||
|
|
||||||
|
fun all_answers
|
||||||
|
(f: ('a -> 'b list option))
|
||||||
|
(lst: 'a list)
|
||||||
|
: 'b list option =
|
||||||
|
let
|
||||||
|
fun collect lst acc =
|
||||||
|
case lst of
|
||||||
|
[] => SOME acc
|
||||||
|
| head :: tail =>
|
||||||
|
case f head of
|
||||||
|
NONE => NONE
|
||||||
|
| SOME lst => collect tail (acc @ lst)
|
||||||
|
in
|
||||||
|
collect lst []
|
||||||
|
end
|
||||||
|
|
||||||
|
fun sum a b = a + b
|
||||||
|
(* functions below are too similar to leave them as is.
|
||||||
|
Find a way how to extract reapiting code
|
||||||
|
*)
|
||||||
|
fun count_wildcards (p: pattern) : int =
|
||||||
|
case p of
|
||||||
|
Wildcard => 1
|
||||||
|
| TupleP lst => foldl (count_wildcards >> sum) 0 lst
|
||||||
|
| ConstructorP (_, pattern) => count_wildcards pattern
|
||||||
|
| _ => 0
|
||||||
|
|
||||||
|
fun collect_variables (p: pattern) : string list =
|
||||||
|
case p of
|
||||||
|
Variable str => [str]
|
||||||
|
| TupleP lst => foldl (collect_variables >> append) [] lst
|
||||||
|
| ConstructorP (_, pattern) => collect_variables pattern
|
||||||
|
| _ => []
|
||||||
|
|
||||||
|
fun count_variable_lengths (p: pattern) : int =
|
||||||
|
p |> collect_variables |> foldl (size >> sum) 0
|
||||||
|
|
||||||
|
fun count_wild_and_variable_lengths (p: pattern) : int =
|
||||||
|
count_wildcards p + count_variable_lengths p
|
||||||
|
|
||||||
|
fun count_some_var (var, pattern) =
|
||||||
|
case pattern of
|
||||||
|
Variable v => if v = var then 1 else 0
|
||||||
|
| TupleP lst => foldl (fn p => fn acc => acc + count_some_var (var, p)) 0 lst
|
||||||
|
| ConstructorP (_, pattern) => count_some_var (var, pattern)
|
||||||
|
| _ => 0
|
||||||
|
|
||||||
|
fun check_pat (p: pattern) : bool =
|
||||||
|
p
|
||||||
|
|> collect_variables
|
||||||
|
|> sort bigger_or_equal
|
||||||
|
|> distinct
|
||||||
|
|
||||||
|
fun match (v: valu, p: pattern) : (string * valu) list option =
|
||||||
|
case (p, v) of
|
||||||
|
(Wildcard, _) => SOME []
|
||||||
|
| (Variable a, v) => SOME [(a, v)]
|
||||||
|
| (UnitP, Unit) => SOME []
|
||||||
|
| (ConstP c1, Const c2) => if c1 = c2 then SOME [] else NONE
|
||||||
|
| (TupleP ps, Tuple vs) => (vs, ps) |> ListPair.zip |> all_answers match
|
||||||
|
| (ConstructorP (s1, p), Constructor (s2, v)) =>
|
||||||
|
if s1 = s2 then match (v, p) else NONE
|
||||||
|
| _ => NONE
|
||||||
|
|
||||||
|
fun first_match
|
||||||
|
(v: valu)
|
||||||
|
(patterns: pattern list) :
|
||||||
|
(string * valu) list option =
|
||||||
|
SOME $ first_answer (fn p => match (v, p)) patterns
|
||||||
|
handle NoAnswer => NONE
|
197
sml/week4/hw3_test.sml
Normal file
197
sml/week4/hw3_test.sml
Normal file
|
@ -0,0 +1,197 @@
|
||||||
|
use "test.sml";
|
||||||
|
use "hw3.sml";
|
||||||
|
|
||||||
|
fun comp a b = a <= b
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ sort comp [1, 2] = [1, 2]
|
||||||
|
$ "sort: sorting"
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ sort comp [1, 2, 1, 0, 4, 5, 2] = [0, 1, 1, 2, 2, 4, 5]
|
||||||
|
$ "sort: sorting x2"
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ only_capitals ["Alpha", "beta"] = ["Alpha"]
|
||||||
|
$ "only_capitals: filter strings"
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ longest_string1 ["alpha", "betta"] = "alpha"
|
||||||
|
$ "longest_string1: finds longest string"
|
||||||
|
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ longest_string1 [] = ""
|
||||||
|
$ "longest_string1: empty syting on empty list"
|
||||||
|
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ longest_string2 ["alpha", "betta"] = "betta"
|
||||||
|
$ "longest_string2: on ties it returns the string closest to the end"
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ longest_string_helper (op >) ["alpha", "betta"] = "alpha"
|
||||||
|
$ "longest_string_helper: a > b = longest_string1"
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ longest_string_helper (op >=) ["alpha", "betta"] = "betta"
|
||||||
|
$ "longest_string_helper: a >= b = longest_string2"
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ longest_capitalized ["Alpha", "bettaaaa"] = "Alpha"
|
||||||
|
$ "longest_capitalized: longest capitalized string"
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ rev_string "string" = "gnirts"
|
||||||
|
$ "rev_string: reverses string"
|
||||||
|
|
||||||
|
val NONE =
|
||||||
|
first_answer (fn elm => NONE) []
|
||||||
|
handle NoAnswer =>
|
||||||
|
assert true "first_answer: rises on on empty lst"
|
||||||
|
|> (fn _ => NONE)
|
||||||
|
|
||||||
|
val NONE =
|
||||||
|
first_answer (fn elm => NONE) ["elm"]
|
||||||
|
handle NoAnswer =>
|
||||||
|
assert true "first_answer: rises on miss"
|
||||||
|
|> (fn _ => NONE)
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ first_answer (fn elm => SOME elm) ["elm"] = "elm"
|
||||||
|
$ "first_answer: returns first answer"
|
||||||
|
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ first_answer
|
||||||
|
(fn elm => if elm = "second" then SOME elm else NONE)
|
||||||
|
["elm", "second"] = "second"
|
||||||
|
$ "first_answer: returns some answer"
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ all_answers (fn elm => SOME elm) [] = SOME []
|
||||||
|
$ "all_answers: returns SOME [] on []"
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ all_answers (fn elm => SOME [elm]) ["a", "b"] = SOME ["a", "b"]
|
||||||
|
$ "all_answers: returns all answers"
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ all_answers
|
||||||
|
(fn elm => if elm = "a" then SOME [elm] else NONE)
|
||||||
|
["a", "b"] = NONE
|
||||||
|
$ "all_answers: NONE on at least one NONE"
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ count_wildcards Wildcard = 1
|
||||||
|
$ "count_wildcards: Wildcard"
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ count_wildcards (TupleP [Wildcard, Wildcard]) = 2
|
||||||
|
$ "count_wildcards: TupleP"
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ count_wildcards (ConstructorP ("wild", Wildcard)) = 1
|
||||||
|
$ "count_wildcards: ConstructorP"
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ count_wild_and_variable_lengths (TupleP [Wildcard, Variable "var"]) = 4
|
||||||
|
$ "count_wild_and_variable_lengths: correct length"
|
||||||
|
|
||||||
|
val () =
|
||||||
|
let
|
||||||
|
val input = (
|
||||||
|
"var",
|
||||||
|
TupleP [
|
||||||
|
Wildcard,
|
||||||
|
Variable "var",
|
||||||
|
ConstructorP (
|
||||||
|
"cons",
|
||||||
|
Variable "var")])
|
||||||
|
val expected = 2
|
||||||
|
in
|
||||||
|
assert
|
||||||
|
$ count_some_var input = expected
|
||||||
|
$ "count_some_var: count vars"
|
||||||
|
end
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ check_pat (TupleP [Variable "a", Variable "b"]) = true
|
||||||
|
$ "check_pat: true on distinct"
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ check_pat (TupleP [Variable "a",ConstructorP ("cons", Variable "a")]) = false
|
||||||
|
$ "check_pat: false on same"
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ match (Unit, Wildcard) = SOME []
|
||||||
|
$ "match: SOME [] on wildcard"
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ match (Unit, Variable "var") = SOME [("var", Unit)]
|
||||||
|
$ "match: match with var"
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ match (Unit, UnitP) = SOME []
|
||||||
|
$ "match: match with unit"
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ match (Const 3, ConstP 3) = SOME []
|
||||||
|
$ "match: match with const"
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ match (Tuple [Const 3], TupleP [Variable "var"]) = SOME [("var", Const 3)]
|
||||||
|
$ "match: match with tuple"
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ match (Tuple [Const 3], TupleP [Variable "var"]) = SOME [("var", Const 3)]
|
||||||
|
$ "match: match with tuple"
|
||||||
|
|
||||||
|
val () =
|
||||||
|
let
|
||||||
|
val arg = (Constructor ("c", Unit), ConstructorP ("c", Variable "var"))
|
||||||
|
val expect = SOME [("var", Unit)]
|
||||||
|
in
|
||||||
|
assert
|
||||||
|
$ match arg = expect
|
||||||
|
$ "match: match with Constructor"
|
||||||
|
end
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ first_match Unit [ConstP 17, Variable "v"] = SOME [("v", Unit)]
|
||||||
|
$ "first_match: finds match"
|
||||||
|
|
||||||
|
val () =
|
||||||
|
assert
|
||||||
|
$ first_match Unit [ConstP 17] = NONE
|
||||||
|
$ "first_match: handles exeption"
|
||||||
|
|
||||||
|
val () = complete ()
|
60
sml/week4/list.sml
Normal file
60
sml/week4/list.sml
Normal file
|
@ -0,0 +1,60 @@
|
||||||
|
use "operators.sml";
|
||||||
|
|
||||||
|
fun cons head tail = head :: tail
|
||||||
|
|
||||||
|
fun append a b = a @ b
|
||||||
|
|
||||||
|
fun foldl f acc lst =
|
||||||
|
case lst of
|
||||||
|
[] => acc
|
||||||
|
| head :: tail => foldl f (f head acc) tail
|
||||||
|
|
||||||
|
fun reverse lst = foldl cons [] lst
|
||||||
|
|
||||||
|
fun sort' f lst =
|
||||||
|
case lst of
|
||||||
|
[] => []
|
||||||
|
| [one] => [one]
|
||||||
|
| first :: second :: rest =>
|
||||||
|
if f first second
|
||||||
|
then first :: sort' f (second :: rest)
|
||||||
|
else second :: sort' f (first :: rest)
|
||||||
|
|
||||||
|
(* only for sorted lists *)
|
||||||
|
fun distinct lst =
|
||||||
|
case lst of
|
||||||
|
[] => true
|
||||||
|
| [_] => true
|
||||||
|
| first :: second :: rest =>
|
||||||
|
if first = second
|
||||||
|
then false
|
||||||
|
else distinct (second :: rest)
|
||||||
|
|
||||||
|
(* simple recursive convergence *)
|
||||||
|
fun fix f g x =
|
||||||
|
if f g x = x
|
||||||
|
then x
|
||||||
|
else fix f g (f g x)
|
||||||
|
|
||||||
|
(* naive bubble sort *)
|
||||||
|
fun sort f x = fix sort' f x
|
||||||
|
|
||||||
|
fun foldr f acc lst = lst |> reverse |> foldl f acc
|
||||||
|
|
||||||
|
fun map f = foldr (f >> cons) []
|
||||||
|
|
||||||
|
fun filter predicate lst =
|
||||||
|
let
|
||||||
|
fun f elm acc = if predicate elm then elm :: acc else acc
|
||||||
|
in
|
||||||
|
foldr f [] lst
|
||||||
|
end
|
||||||
|
|
||||||
|
fun empty lst = lst = []
|
||||||
|
|
||||||
|
(* not efficient but works *)
|
||||||
|
fun exists elem lst =
|
||||||
|
lst
|
||||||
|
|> filter (fn needle => elem = needle)
|
||||||
|
|> empty
|
||||||
|
|> not
|
21
sml/week4/operators.sml
Normal file
21
sml/week4/operators.sml
Normal file
|
@ -0,0 +1,21 @@
|
||||||
|
(*
|
||||||
|
Pipe operator.
|
||||||
|
Simply to write code like "data |> fun" instead "fun data".
|
||||||
|
Then you can "pipe" results to functions via partial application:
|
||||||
|
|
||||||
|
fun square a b = a * b
|
||||||
|
fun sum a b = a + b
|
||||||
|
|
||||||
|
10 |> sum 10 |> square 2 // 40
|
||||||
|
*)
|
||||||
|
fun op |> (x, f) = f x
|
||||||
|
|
||||||
|
(* apply operator *)
|
||||||
|
fun op $ (f, x) = f x
|
||||||
|
|
||||||
|
(* composition operator *)
|
||||||
|
fun op >> (f, g) x = g(f(x))
|
||||||
|
|
||||||
|
infix |>
|
||||||
|
infix $
|
||||||
|
infix >>
|
17
sml/week4/test.sml
Normal file
17
sml/week4/test.sml
Normal file
|
@ -0,0 +1,17 @@
|
||||||
|
fun assert condition message =
|
||||||
|
if condition
|
||||||
|
then
|
||||||
|
print (message ^ "\n")
|
||||||
|
else
|
||||||
|
let
|
||||||
|
val () = print ("Assert error: " ^ message ^ "\n")
|
||||||
|
in
|
||||||
|
OS.Process.exit OS.Process.failure
|
||||||
|
end
|
||||||
|
|
||||||
|
fun complete () =
|
||||||
|
let
|
||||||
|
val () = print "All tests passed!"
|
||||||
|
in
|
||||||
|
OS.Process.exit OS.Process.success
|
||||||
|
end
|
Loading…
Reference in a new issue