week3_2020 up to assoc

sml/week3_2020/json.sml

@@ -3,21 +3,104 @@ 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 count_occurrences = (string list * exn) -> (string * int) list
+type make_silly_json = int -> json
-val rec count_occurrences = fn (strs, exn) => 
+val make_silly_json: make_silly_json = fn num =>
     let
-        fun repetitons str lst reps order =
+        fun construct num json =
-            case lst of
+            case num of
-            [] => [(str, reps)]
+            0 => json
-            | head :: tail =>
+            | _ => 
-                case strcmp (str, head) of
+                case json of 
-                EQUAL => repetitons str tail (reps + 1) order
+                Array arr => Array $ arr @ [Object [("b", True), ("n", Num $ Real.fromInt num)]]
-                | new_order =>
-                    if order <> EQUAL andalso new_order <> order
-                    then raise exn
-                    else [(str, reps)] @ repetitons head tail 1 new_order
     in
-        case strs of [] => [] | head :: tail => repetitons head tail 1 EQUAL
+        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

sml/week3_2020/json_test.sml

@@ -2,15 +2,91 @@ use "test.sml";
 use "operators.sml";
 use "json.sml";
 
-(* val () =
+val () =
-    assert
+    case make_silly_json 1 of
-    $ repeatings "a" ["a", "a", "b"] (0, [], EQUAL) = (2, ["b"], LESS)
+       Array [Object [("b", True), ("n", (Num _))]] => 
-    $ "repetings 1"
+        assert true "make_silly_json: pass"
+     | _ => 
+        assert false "make_silly_json"
 
 val () =
     assert
-    $ repeatings "c" ["a", "a", "b"] (0, [], EQUAL) = (0, ["a", "a", "b"], GREATER)
+    $ concat_with (":", []) = ""
-    $ "repetings 2" *)
+    $ "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
@@ -27,7 +103,6 @@ val () =
     $ 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)]

sml/week3_2020/list.sml

@@ -9,6 +9,7 @@ fun foldl f acc lst =
 
 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) []