Was actually done last week; now just made the last few changes to Makefile.
| [-] | 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 | ---------- |
| [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 | -- | -- | ---------- | ---------- |
-straight_line_program_interpreter
-tree
-tree.dot
+_build/
+*.byte
+*.dot
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 $< > $@
-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
(* 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
-include Tree_sig.S
+include Tree.S
--- /dev/null
+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
+++ /dev/null
-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
-
-include Tree_sig.S
+include Tree.S