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 *)
|
||||
type Date = int * int * int
|
||||
|
@ -71,6 +91,7 @@ fun uniqe lst =
|
|||
end
|
||||
|
||||
(* naive sort, will blow up the stack. Can't use pattern matching for now :( *)
|
||||
(* also incorrect *)
|
||||
(* fun sort f lst =
|
||||
case lst of
|
||||
[] => []
|
||||
|
@ -81,7 +102,7 @@ fun uniqe lst =
|
|||
else first :: second :: sort f rest *)
|
||||
|
||||
(* also will blow up the stack *)
|
||||
fun sort f lst =
|
||||
fun sort' f lst =
|
||||
if lst = []
|
||||
then []
|
||||
else
|
||||
|
@ -95,18 +116,25 @@ fun sort f lst =
|
|||
val greater = f first second
|
||||
in
|
||||
if greater
|
||||
then second :: first :: sort f rest
|
||||
else first :: second :: sort f rest
|
||||
then second :: sort' f (first :: rest)
|
||||
else first :: sort' f (second :: rest)
|
||||
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 =
|
||||
let
|
||||
val same_dates = y1 = y2 andalso m1 = m2 andalso d1 = d2
|
||||
val older = y1 <= y2 andalso m1 <= m2 andalso d1 <= d2
|
||||
val first_days = y1 * 360 + m1 * 30 + d1
|
||||
val second_days = y2 * 360 + m2 * 30 + d2
|
||||
in
|
||||
if same_dates
|
||||
then false
|
||||
else older
|
||||
first_days < second_days
|
||||
end
|
||||
|
||||
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"
|
||||
]
|
||||
|
||||
val string_month = get_nth (months, month - 1)
|
||||
val string_month = get_nth (months, month)
|
||||
|
||||
val to_str = Int.toString
|
||||
|
||||
fun pad num =
|
||||
if num < 10
|
||||
then "0" ^ to_str num
|
||||
else to_str num
|
||||
in
|
||||
string_month ^ " " ^ pad day ^ ", " ^ to_str year
|
||||
string_month ^ " " ^ to_str day ^ ", " ^ to_str year
|
||||
end
|
||||
|
||||
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: 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 () =
|
||||
assert
|
||||
(is_older ((1999, 12, 31), (1999, 12, 31)) = false)
|
||||
|
@ -185,7 +190,12 @@ val () =
|
|||
|
||||
val () =
|
||||
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"
|
||||
|
||||
val () =
|
||||
|
@ -258,6 +268,14 @@ val () =
|
|||
assert (oldest dates = expect) "oldest: returns oldest"
|
||||
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 () =
|
||||
let
|
||||
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)
|
||||
else (true orelse found, acc)
|
||||
in
|
||||
case fold filter (false, []) cards of
|
||||
case foldl filter (false, []) cards of
|
||||
(true, filtered) => filtered
|
||||
| (false, _) => raise exp
|
||||
end
|
||||
|
@ -47,10 +47,11 @@ val rec all_same_color: all_same_color = fn cards =>
|
|||
|
||||
type sum_cards = card list -> int
|
||||
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 :) *)
|
||||
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
|
||||
val score: score = fn (cards, goal) =>
|
||||
|
@ -83,5 +84,5 @@ val officiate: officiate = fn (deck, moves, goal) =>
|
|||
|
||||
fun round hand = score (hand, goal)
|
||||
in
|
||||
moves |> fold play (deck, []) |> #2 |> round
|
||||
moves |> foldl play (deck, []) |> #2 |> round
|
||||
end
|
|
@ -212,4 +212,11 @@ val 0 =
|
|||
|> (fn _ => expected)
|
||||
end
|
||||
|
||||
fun by2 a = a * 2
|
||||
|
||||
val () =
|
||||
assert
|
||||
$ map by2 [1, 2, 3] = [2, 4, 6]
|
||||
$ "map test"
|
||||
|
||||
val () = complete ()
|
|
@ -2,23 +2,22 @@ use "operators.sml";
|
|||
|
||||
fun cons head tail = head :: tail
|
||||
|
||||
fun fold f acc lst =
|
||||
fun foldl f acc lst =
|
||||
case lst of
|
||||
[] => acc
|
||||
| head :: tail => fold f (f head acc) tail
|
||||
| head :: tail => foldl f (f head acc) tail
|
||||
|
||||
fun reverse lst =
|
||||
let
|
||||
fun f elm acc = elm :: acc
|
||||
in
|
||||
fold f [] lst
|
||||
end
|
||||
fun reverse lst = foldl cons [] lst
|
||||
|
||||
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
|
||||
lst |> fold f [] |> reverse
|
||||
foldr f [] lst
|
||||
end
|
||||
|
||||
fun empty lst = lst = []
|
||||
|
@ -27,5 +26,5 @@ fun empty lst = lst = []
|
|||
fun exists elem lst =
|
||||
lst
|
||||
|> filter (fn needle => elem = needle)
|
||||
|> empty
|
||||
|> empty
|
||||
|> 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