From: Siraaj Khandkar Date: Mon, 30 Apr 2018 15:15:06 +0000 (-0400) Subject: Implement balanced binary tree and refactor X-Git-Url: https://git.xandkar.net/?p=tiger.ml.git;a=commitdiff_plain;h=958f72687df932030c5dfafc7066889982497729 Implement balanced binary tree and refactor Was actually done last week; now just made the last few changes to Makefile. --- diff --git a/README.md b/README.md index 0d2ea06..abe952e 100644 --- a/README.md +++ b/README.md @@ -9,7 +9,7 @@ Project Plan | [-] | 0 | Modern Compiler Implementation in ML | 512 | 28-84 | -- | 2018-04-16 | xxxx-xx-xx | | ====== | ========== | ======================================== | ===== | ======== | ====== | ========== | ========== | | [-] | 1 | - Fundamentals of Compilation | 264 | 14 | -- | 2018-04-16 | ---------- | -| [-] | 1.01 | -- Introduction | 011 | 01 | -- | 2018-04-16 | ---------- | +| [-] | 1.01 | -- Introduction | 011 | 01 | 04 | 2018-04-16 | ---------- | | [x] | 1.01.1 | --- Modules and interfaces | 001 | -- | -- | 2018-04-16 | ---------- | | [x] | 1.01.2 | --- Tools and Software | 002 | -- | -- | 2018-04-16 | ---------- | | [x] | 1.01.3 | --- Data structures for tree languages | 003 | -- | -- | 2018-04-16 | ---------- | @@ -20,7 +20,7 @@ Project Plan | [x] | 1.01.e.1.a | ---- tree member | --- | -- | -- | 2018-04-17 | 2018-04-17 | | [x] | 1.01.e.1.b | ---- tree key/val | --- | -- | -- | 2018-04-18 | 2018-04-18 | | [x] | 1.01.e.1.c | ---- demo unbalanced behaviour | --- | -- | -- | 2018-04-18 | 2018-04-18 | -| [ ] | 1.01.e.1.d | ---- find functional balanced tree | --- | -- | -- | ---------- | ---------- | +| [x] | 1.01.e.1.d | ---- find functional balanced tree | --- | -- | -- | 2018-04-19 | 2018-04-20 | | ------ | ---------- | ---------------------------------------- | ----- | -------- | ------ | ---------- | ---------- | | [ ] | 1.02 | -- Lexical Analysis | 024 | 01 | -- | ---------- | ---------- | | [ ] | 1.02.1 | --- Lexical tokens | 001 | -- | -- | ---------- | ---------- | diff --git a/exercises/ch01/.gitignore b/exercises/ch01/.gitignore index c79448c..85e8b14 100644 --- a/exercises/ch01/.gitignore +++ b/exercises/ch01/.gitignore @@ -1,3 +1,3 @@ -straight_line_program_interpreter -tree -tree.dot +_build/ +*.byte +*.dot diff --git a/exercises/ch01/Makefile b/exercises/ch01/Makefile index fa3761e..8587a04 100644 --- a/exercises/ch01/Makefile +++ b/exercises/ch01/Makefile @@ -4,42 +4,51 @@ OCAMLC_OPTIONS := -w A -warn-error A OCAMLC_BYTE := ocamlc.opt $(OCAMLC_OPTIONS) EXECUTABLES := \ - straight_line_program_interpreter \ - tree + straight_line_program_interpreter \ + tree_demo +EXECUTABLES := $(addsuffix .byte,$(EXECUTABLES)) -.PHONY: build clean demo_unbalanced +SET_MEMBERS := \ + a b c d e f g h i j k l m n o p q r s t u v foo bar kgkvbkvg \ + lkhjlk gfjyfjf fdtrdchfhtr trhfgfch hjlilijhl iygkyugkgkhy -build : $(EXECUTABLES) -%: %.ml %.cmo %.cmi - $(OCAMLC_BYTE) -o $@ $*.cmo +.PHONY: \ + all \ + clean \ + build \ + demos -%.cmi: %.mli - $(OCAMLC_BYTE) -o $@ -c $< +all: + $(MAKE) clean + $(MAKE) build + $(MAKE) demos -%.cmo: %.ml %.cmi - $(OCAMLC_BYTE) -c $< - -tree : tree.ml tree.cmo tree_sig.cmo tree_unbalanced_vanilla.cmo tree_balanced_red_black.cmo - $(OCAMLC_BYTE) -o tree tree_sig.cmo tree_unbalanced_vanilla.cmo tree_balanced_red_black.cmo tree.cmo +clean: + rm -rf ./_build/ + rm -f $(EXECUTABLES) + # There're also tree demo PNGs, but I want to keep them around, for + # referencing without having to build the project. -tree.cmo : tree.ml tree.cmi tree_sig.cmo tree_unbalanced_vanilla.cmo tree_balanced_red_black.cmo - $(OCAMLC_BYTE) -c $< +build: + ocamlbuild $(EXECUTABLES) -tree_balanced_red_black.cmo : tree_balanced_red_black.ml tree_balanced_red_black.cmi tree_sig.cmo - ocamlc.opt -w A -warn-error A-4 -c $< +demos: \ + run_straight_line_program_interpreter \ + tree_demo_unbalanced.png \ + tree_demo_balanced.png -tree_sig.cmo tree_sig.cmi: tree_sig.ml - $(OCAMLC_BYTE) -c $< +run_straight_line_program_interpreter: straight_line_program_interpreter.byte + ./$< -clean: - rm -f $(EXECUTABLES) tree.dot # There's also tree.png, but I'm keeping it. +tree_demo_unbalanced.dot: tree_demo.byte + ./$< unbalanced $(SET_MEMBERS) > $@ -tree.dot: tree - ./tree a b c d e f g h i j k l m n o p q r s t u v foo bar kgkvbkvg lkhjlk gfjyfjf fdtrdchfhtr trhfgfch hjlilijhl iygkyugkgkhy > tree.dot +tree_demo_unbalanced.png: tree_demo_unbalanced.dot + neato -T png $< > $@ -tree.png: tree.dot - neato -T png tree.dot > tree.png +tree_demo_balanced.dot: tree_demo.byte + ./$< balanced $(SET_MEMBERS) > $@ -demo_unbalanced: tree.png - sxiv ./tree.png +tree_demo_balanced.png: tree_demo_balanced.dot + neato -T png $< > $@ diff --git a/exercises/ch01/tree.ml b/exercises/ch01/tree.ml index 04a7255..521b6cf 100644 --- a/exercises/ch01/tree.ml +++ b/exercises/ch01/tree.ml @@ -1,35 +1,13 @@ -module Array = ArrayLabels +module type S = sig + type ('k, 'v) t -module Tree_vanilla = Tree_unbalanced_vanilla -module Tree_redblack = Tree_balanced_red_black + val empty : ('k, 'v) t -let () = - let unbalanced = Tree_vanilla.empty in - let unbalanced = Tree_vanilla.set unbalanced ~k:"k1" ~v:"v1" in - let unbalanced = Tree_vanilla.set unbalanced ~k:"k2" ~v:"v2" in - assert (Tree_vanilla.member unbalanced ~k:"k1"); - assert (Tree_vanilla.member unbalanced ~k:"k2"); - assert (Some "v1" = Tree_vanilla.get unbalanced ~k:"k1"); - assert (Some "v2" = Tree_vanilla.get unbalanced ~k:"k2"); + val set : ('k, 'v) t -> k:'k -> v:'v -> ('k, 'v) t - let balanced = Tree_redblack.empty in - let balanced = Tree_redblack.set balanced ~k:"k1" ~v:"v1" in - let balanced = Tree_redblack.set balanced ~k:"k2" ~v:"v2" in - assert (Tree_redblack.member balanced ~k:"k1"); - assert (Tree_redblack.member balanced ~k:"k2"); - assert (Some "v1" = Tree_redblack.get balanced ~k:"k1"); - assert (Some "v2" = Tree_redblack.get balanced ~k:"k2"); + val get : ('k, 'v) t -> k:'k -> 'v option - (*let unbalanced =*) - (*Array.fold_left (Sys.argv)*) - (*~init:Tree_vanilla.empty*) - (*~f:(fun t k -> Tree_vanilla.set t ~k ~v:())*) - (*in*) - (*print_endline (Tree_vanilla.to_dot unbalanced ~k_to_string:(fun x -> x));*) + val member : ('k, 'v) t -> k:'k -> bool - let balanced = - Array.fold_left (Sys.argv) - ~init:Tree_redblack.empty - ~f:(fun t k -> Tree_redblack.set t ~k ~v:()) - in - print_endline (Tree_redblack.to_dot balanced ~k_to_string:(fun x -> x)) + val to_dot : ('k, 'v) t -> k_to_string:('k -> string) -> string +end diff --git a/exercises/ch01/tree.png b/exercises/ch01/tree.png deleted file mode 100644 index 3d63516..0000000 Binary files a/exercises/ch01/tree.png and /dev/null differ diff --git a/exercises/ch01/tree_balanced_red_black.ml b/exercises/ch01/tree_balanced_red_black.ml index 4036162..b339b52 100644 --- a/exercises/ch01/tree_balanced_red_black.ml +++ b/exercises/ch01/tree_balanced_red_black.ml @@ -14,8 +14,7 @@ let set t ~k ~v = (* LR *) | Node (B, x, Node (R, lx, ll , Node (R, lrx, lrl, lrr)), r ) -> Node (R, lrx, Node (B, lx , ll , lrl), Node (B, x , lrr, r )) (* RL *) | Node (B, x, l , Node (R, rx, Node (R, rlx, rll, rlr), rr )) -> Node (R, rlx, Node (B, x , l , rll), Node (B, rx , rlr, rr )) (* RR *) | Node (B, x, l , Node (R, rx, rl , Node (R, rrx, rrl, rrr))) -> Node (R, rx , Node (B, x , l , rl ), Node (B, rrx, rrl, rrr)) - (* not exhaustive - reconsider *) - | node -> node + | node -> node (* Fragile pattern. Shall we reconsider? *) in let rec set t k v = match t with diff --git a/exercises/ch01/tree_balanced_red_black.mli b/exercises/ch01/tree_balanced_red_black.mli index e0e08ee..c26f49e 100644 --- a/exercises/ch01/tree_balanced_red_black.mli +++ b/exercises/ch01/tree_balanced_red_black.mli @@ -1 +1 @@ -include Tree_sig.S +include Tree.S diff --git a/exercises/ch01/tree_demo.ml b/exercises/ch01/tree_demo.ml new file mode 100644 index 0000000..1d8ec9f --- /dev/null +++ b/exercises/ch01/tree_demo.ml @@ -0,0 +1,23 @@ +module Array = ArrayLabels + +let () = + let (module T : Tree.S) = + match Sys.argv.(1) with + | "balanced" -> (module Tree_balanced_red_black : Tree.S) + | "unbalanced" -> (module Tree_unbalanced_vanilla : Tree.S) + | other -> + failwith ("Expected: \"balanced\" | \"unbalanced\". Got: " ^ other) + in + + let t = T.empty in + let t = T.set t ~k:"k1" ~v:"v1" in + let t = T.set t ~k:"k2" ~v:"v2" in + assert (T.member t ~k:"k1"); + assert (T.member t ~k:"k2"); + assert (Some "v1" = T.get t ~k:"k1"); + assert (Some "v2" = T.get t ~k:"k2"); + Sys.argv + |> Array.sub ~pos:2 ~len:((Array.length Sys.argv) - 2) + |> Array.fold_left ~init:T.empty ~f:(fun t k -> T.set t ~k ~v:()) + |> T.to_dot ~k_to_string:(fun x -> x) + |> print_endline diff --git a/exercises/ch01/tree.mli b/exercises/ch01/tree_demo.mli similarity index 100% rename from exercises/ch01/tree.mli rename to exercises/ch01/tree_demo.mli diff --git a/exercises/ch01/tree_demo_balanced.png b/exercises/ch01/tree_demo_balanced.png new file mode 100644 index 0000000..6791b95 Binary files /dev/null and b/exercises/ch01/tree_demo_balanced.png differ diff --git a/exercises/ch01/tree_demo_unbalanced.png b/exercises/ch01/tree_demo_unbalanced.png new file mode 100644 index 0000000..f758f89 Binary files /dev/null and b/exercises/ch01/tree_demo_unbalanced.png differ diff --git a/exercises/ch01/tree_sig.ml b/exercises/ch01/tree_sig.ml deleted file mode 100644 index 4133a77..0000000 --- a/exercises/ch01/tree_sig.ml +++ /dev/null @@ -1,14 +0,0 @@ -module type S = sig - type ('k, 'v) t - - val empty : ('k, 'v) t - - val set : ('k, 'v) t -> k:'k -> v:'v -> ('k, 'v) t - - val get : ('k, 'v) t -> k:'k -> 'v option - - val member : ('k, 'v) t -> k:'k -> bool - - val to_dot : ('k, 'v) t -> k_to_string:('k -> string) -> string -end - diff --git a/exercises/ch01/tree_unbalanced_vanilla.mli b/exercises/ch01/tree_unbalanced_vanilla.mli index e0e08ee..c26f49e 100644 --- a/exercises/ch01/tree_unbalanced_vanilla.mli +++ b/exercises/ch01/tree_unbalanced_vanilla.mli @@ -1 +1 @@ -include Tree_sig.S +include Tree.S