From 60656567c13675751c9c93fc1c227284c0a50681 Mon Sep 17 00:00:00 2001 From: Gregory Date: Wed, 1 Jul 2020 23:48:56 +0300 Subject: [PATCH] up to 12 --- sml/week4/hw3.sml | 76 ++++++++++++++++++++++++++++- sml/week4/hw3_test.sml | 107 +++++++++++++++++++++++++++++++++++++++++ sml/week4/list.sml | 31 +++++++++++- 3 files changed, 210 insertions(+), 4 deletions(-) diff --git a/sml/week4/hw3.sml b/sml/week4/hw3.sml index 6386fb5..73de887 100644 --- a/sml/week4/hw3.sml +++ b/sml/week4/hw3.sml @@ -1,6 +1,20 @@ 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) @@ -37,7 +51,10 @@ fun first_answer f lst = NONE => first_answer f tail | SOME answer => answer -fun all_answers (f: ('a -> 'b list option)) lst: 'b list option = +fun all_answers + (f: ('a -> 'b list option)) + (lst: 'a list) + : 'b list option = let fun collect lst acc = case lst of @@ -48,4 +65,59 @@ fun all_answers (f: ('a -> 'b list option)) lst: 'b list option = | SOME lst => collect tail (acc @ lst) in collect lst [] - end \ No newline at end of file + 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 \ No newline at end of file diff --git a/sml/week4/hw3_test.sml b/sml/week4/hw3_test.sml index 6c15dff..02d8b5c 100644 --- a/sml/week4/hw3_test.sml +++ b/sml/week4/hw3_test.sml @@ -1,6 +1,17 @@ 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 @@ -86,5 +97,101 @@ val () = ["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 () \ No newline at end of file diff --git a/sml/week4/list.sml b/sml/week4/list.sml index 5173380..1766560 100644 --- a/sml/week4/list.sml +++ b/sml/week4/list.sml @@ -11,8 +11,35 @@ fun foldl f acc lst = fun reverse lst = foldl cons [] lst -(* wrong implementation *) -fun foldr f acc = foldl f acc >> reverse +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) []