Add code for lecture 6

Signed-off-by: jmug <u.g.a.mariano@gmail.com>

lec06/.devcontainer/.zshrc

@@ -0,0 +1,13 @@
+autoload -U colors && colors
+precmd() {
+   drawline=""
+   for i in {1..$COLUMNS}; drawline=" $drawline"
+   drawline="%U${drawline}%u"
+   PS1="%F{252}${drawline}
+%B%F{124}%n:%~>%b%f "
+}
+
+eval $(opam env)
+
+alias ls="ls --color"
+

lec06/.devcontainer/Dockerfile

@@ -0,0 +1,57 @@
+FROM ubuntu:20.04
+
+## BEGIN: RUNS AS ROOT
+
+# Create a user
+
+ARG USERNAME=cis3410
+ARG USER_UID=1000
+ARG USER_GID=$USER_UID
+
+RUN groupadd --gid $USER_GID $USERNAME \
+    && useradd --uid $USER_UID --gid $USER_GID -m $USERNAME --shell /bin/zsh \
+    #
+    # [Optional] Add sudo support. Omit if you don't need to install software after connecting.
+    && apt-get update -y \
+    && apt-get install -y sudo \
+    && echo $USERNAME ALL=\(root\) NOPASSWD:ALL > /etc/sudoers.d/$USERNAME \
+    && chmod 0440 /etc/sudoers.d/$USERNAME
+
+## Hack needs root permissions
+
+# See hack.sh
+COPY hack.sh /tmp/hack.sh
+RUN chmod +x /tmp/hack.sh
+RUN /tmp/hack.sh
+
+RUN apt-get install -y build-essential
+RUN apt-get install -y m4
+RUN apt-get install -y opam
+RUN apt-get install -y clang
+RUN apt-get install -y time
+RUN apt-get install -y zip
+RUN apt-get install -y zsh
+
+## Set up user environmnent
+COPY .zshrc /home/$USERNAME/
+
+
+## Run in usermode
+
+# [Optional] Set the default user. Omit if you want to keep the default as root.
+USER $USERNAME
+
+RUN mkdir -p /home/$USERNAME/.local/state/
+RUN touch /home/$USERNAME/.local/state/utop-history
+
+# Configure opam/ocaml
+RUN opam init -y --disable-sandboxing --compiler=4.14.1
+RUN opam switch 4.14.1
+RUN opam install -y dune
+RUN opam install -y num
+RUN opam install -y menhir
+RUN opam install -y utop
+RUN opam install -y ocamlformat
+RUN opam install -y ocaml-lsp-server
+RUN eval `opam config env`
+

lec06/.devcontainer/devcontainer.json

@@ -0,0 +1,30 @@
+// For format details, see https://aka.ms/devcontainer.json. For config options, see the
+// README at: https://github.com/devcontainers/templates/tree/main/src/ubuntu
+{
+	"name": "Ubuntu",
+	// Or use a Dockerfile or Docker Compose file. More info: https://containers.dev/guide/dockerfile
+	"build": { 
+		"dockerfile": "Dockerfile"
+	},
+	// Features to add to the dev container. More info: https://containers.dev/features.
+	// "features": {},
+
+	// Use 'forwardPorts' to make a list of ports inside the container available locally.
+	// "forwardPorts": [],
+
+	// Use 'postCreateCommand' to run commands after the container is created.
+	// "postCreateCommand": "uname -a",
+
+	// Configure tool-specific properties.
+	"customizations": {
+		"vscode": {
+			"extensions": [
+				"ocamllabs.ocaml-platform",
+				"allanblanchard.ocp-indent"
+			]
+		}
+	}
+
+	// Uncomment to connect as root instead. More info: https://aka.ms/dev-containers-non-root.
+	// "remoteUser": "root"
+}

lec06/.devcontainer/hack.sh

@@ -0,0 +1,17 @@
+#!/usr/bin/env bash
+
+### HACK - workaround ubuntu libc6 version number bug see: https://forum.odroid.com/viewtopic.php?p=344373
+
+mv /bin/uname /bin/uname.orig
+tee -a /bin/uname <<EOF
+#!/bin/bash
+if [[ \$1 == "-r" ]]; then
+echo '4.9.250';
+exit
+else
+uname.orig \$1
+fi
+EOF
+
+chmod 755 /bin/uname
+### END HACK

lec06/Makefile

@@ -0,0 +1,19 @@
+.PHONY: all clean utop 
+
+all: main1.exe main2.exe main3.exe
+debug: all main1.cma main2.cma main3.cma
+
+
+%.exe: code/main1.ml code/main2.ml code/main3.ml code/ir1.ml code/ir2.ml code/ir3.ml code/ir4.ml code/ir5.ml code/ir_by_hand.ml
+	dune build
+	cp code/$@ .
+
+.FORCE:
+
+clean:
+	dune clean
+	rm -rf main1.exe main2.exe main3.exe
+
+utop: main1.exe main2.exe main3.exe
+	dune utop
+

lec06/code/dune

@@ -0,0 +1,50 @@
+(env
+ (dev
+  (flags
+   (:standard -w "+a-4-7-9-27-29-30-32..42-44-45-48-50-60-66..70")
+   ))) 
+
+(library
+ (name ir_by_hand)
+ (modules ir_by_hand))
+
+(library
+ (name ir1)
+ (modules ir1))
+
+(library
+ (name ir2)
+ (modules ir2))
+
+(library
+ (name ir3)
+ (modules ir3))
+
+ (library
+ (name ir4)
+ (modules ir4))
+
+(library
+ (name i5)
+ (modules ir5))
+
+(executable
+ (public_name main1)
+ (name main1)
+ (modules main1)
+ (libraries ir1)
+ (promote (until-clean)))
+
+(executable
+ (public_name main2)
+ (name main2)
+ (modules main2)
+ (libraries ir2)
+ (promote (until-clean)))
+
+(executable
+ (public_name main3)
+ (name main3)
+ (modules main3)
+ (libraries ir3)
+ (promote (until-clean)))

lec06/code/ir1.ml

@@ -0,0 +1,152 @@
+(* source language ---------------------------------------------------------- *)
+
+type var = string
+module SRC = struct
+
+  (* An object language: a simple datatype of 64-bit integer expressions *)
+  type exp =
+    | Var of var          (* string representing an object-language variable *)
+    | Const of int64      (* a constant int64 value *)
+    | Add of exp * exp    (* sum of two expressions *)
+    | Mul of exp * exp    (* product of two expressions *)
+    | Neg of exp          (* negation of an expression *)
+
+
+  (* The global context of available variables and their (immutable) values. *)
+  let globals : (var * int64) list =
+    [
+      "X1", 1L
+    ; "X2", 2L
+    ; "X3", 3L
+    ; "X4", 4L
+    ; "X5", 5L
+    ; "X6", 6L
+    ; "X7", 7L
+    ; "X8", 8L
+    ]
+
+  (* 
+        (1 + X4) + (3 + (X1 * 5) )
+  *)
+  let example : exp =
+    Add(Add(Const 1L, Var "X4"),
+        Add(Const 3L, Mul(Var "X1",
+                         Const 5L)))
+  
+  (* Note: a "well-formed" SRC expression uses only variables found in the global
+     context. (We omit the "scope checker" here.)*)                         
+end
+
+
+
+
+
+(* simple let language intermediate representation -------------------------- *)
+module IR = struct
+  (* Unique identifiers for temporaries. *)
+  type uid = int
+
+  (* "gensym" -- generate a new unique identifier *)
+  let mk_uid : unit -> uid =
+    let ctr = ref 0 in
+    fun () -> 
+      ctr := !ctr + 1;
+      !ctr
+
+  (* syntactic values / operands *)
+  type opn = 
+    | Id of uid
+    | Const of int64
+    | Var of var
+
+  (* binary operations *)
+  type bop =
+    | Add
+    | Mul
+             
+  (* instructions *)
+  (* note that there is no nesting of operations! *)
+  type insn =
+    | Let of uid * bop * opn * opn
+
+  type program = {
+    globals: (var * int64) list;
+    insns: insn list;
+    ret: opn
+  }
+
+
+  (* Pretty printing *)
+  let pp_uid u = Printf.sprintf "tmp%d" u
+  let pp_var x = Printf.sprintf "var%s" x
+  let pp_int64 c = (Int64.to_string c)^"L"
+
+  let pp_opn = function 
+    | Id u    -> pp_uid u
+    | Const c -> pp_int64 c
+    | Var x   -> pp_var x
+
+  let pp_bop = function
+    | Add -> "add"
+    | Mul -> "mul"
+
+  let pp_insn = function
+    | Let (u, bop, op1, op2) ->
+      Printf.sprintf "let %s = %s %s %s"
+        (pp_uid u) (pp_bop bop) (pp_opn op1) (pp_opn op2)
+
+  let pp_global = function (x,c) ->
+    Printf.sprintf "let %s = %s" (pp_var x) (pp_int64 c)
+
+  let pp_program {globals; insns; ret} =
+    Printf.sprintf "%s\n;;\n%s in\n  ret %s"
+    (String.concat "\n" (List.map pp_global globals)) 
+    (String.concat " in\n" (List.map pp_insn insns)) 
+    (pp_opn ret)
+
+
+  module MLMeaning = struct
+    let add = Int64.add
+    let mul = Int64.mul
+    let ret x = x
+  end
+  
+end
+
+
+
+
+
+module Compile = struct
+  open SRC
+
+  (* Expressions produce answers, so the result of compiling an expression
+     is a list of instructions and an operand that will contain the final
+     result of comping the expression. 
+
+     - we can share the code common to binary operations.
+  *)
+  
+  let rec compile_exp (e:exp) : (IR.insn list) * IR.opn =
+    let compile_bop bop e1 e2 = 
+        let ins1, ret1 = compile_exp e1 in
+        let ins2, ret2 = compile_exp e2 in
+        let ret = IR.mk_uid () in
+        ins1 @ ins2 @ IR.[Let (ret, bop, ret1, ret2)], IR.Id ret
+    in
+    begin match e with
+      | Var x       -> [], IR.Var x
+      | Const c     -> [], IR.Const c
+      | Add(e1, e2) -> compile_bop IR.Add e1 e2
+      | Mul(e1, e2) -> compile_bop IR.Mul e1 e2
+      | Neg(e1)     -> compile_bop IR.Mul e1 (Const(-1L))
+    end
+  
+  let compile (e:exp) : IR.program =
+    let globals = SRC.globals in
+    let insns, ret = compile_exp e in
+    IR.{ globals; insns; ret }
+
+end
+
+

lec06/code/ir2.ml

@@ -0,0 +1,172 @@
+(* source language ---------------------------------------------------------- *)
+
+(* This variant of the language treats variables as mutable.
+   Their interpretation in ML has type "int64 ref"
+*)
+
+type var = string
+module SRC = struct
+
+  (* Abstract syntax of arithmetic expressions *)
+  type exp =
+    | Var of var
+    | Add of exp * exp
+    | Mul of exp * exp
+    | Neg of exp
+    | Const of int64
+
+  (* Abstract syntax of commands *)
+  type cmd =
+    | Skip                       (* skip    *)
+    | Assn of var * exp          (* X := e  *)
+    | Seq  of cmd * cmd          (* c1 ; c2 *)
+
+  (* The global context of available variables and their initial values. *)
+  let globals : (var * int64) list =
+    [
+      "X1", 1L
+    ; "X2", 2L
+    ; "X3", 3L
+    ; "X4", 4L
+    ; "X5", 5L
+    ; "X6", 6L
+    ; "X7", 7L
+    ; "X8", 8L
+    ]
+
+  (* 
+        (1 + X4) + (3 + (X1 * 5) )
+  *)
+  let example : exp =
+    Add(Add(Const 1L, Var "X4"),
+        Add(Const 3L, Mul(Var "X1",
+                         Const 5L)))
+
+  (*
+     X1 := (1 + X4) + (3 + (X1 * 5) ) ;
+     Skip ;
+     X2 := X1 * X1 ;
+  *)
+  let example_cmd : cmd =
+    Seq(Assn("X1", example),
+    Seq(Skip,
+        Assn("X2", Mul(Var "X1", Var "X1"))))
+  
+end
+
+
+module IR = struct
+  (* Unique identifiers for temporaries. *)
+  type uid = int
+
+  (* "gensym" -- generate a new unique identifier *)
+  let mk_uid : unit -> uid =
+    let ctr = ref 0 in
+    fun () -> 
+      ctr := !ctr + 1;
+      !ctr
+
+  (* operands *)
+  type opn = 
+    | Id of uid
+    | Const of int64
+
+  (* binary operations *)
+  type bop =
+    | Add
+    | Mul
+  
+  (* instructions *)
+  (* note that there is no nesting of operations! *)
+  type insn =
+    | Let of uid * bop * opn * opn
+    | Load of uid * var
+    | Store of var * opn
+  
+  type program = {
+    globals: (var * int64) list;
+    insns: insn list
+  }
+
+
+  (* pretty printing *)
+  let pp_uid u = Printf.sprintf "tmp%d" u
+  let pp_var x = Printf.sprintf "var%s" x
+  let pp_int64 c = (Int64.to_string c)^"L"
+
+  let pp_opn = function 
+    | Id u    -> pp_uid u
+    | Const c -> pp_int64 c
+
+  let pp_bop = function
+    | Add -> "add"
+    | Mul -> "mul"
+  
+  let pp_insn = function
+    | Let (u, bop, op1, op2) ->
+      Printf.sprintf "let %s = %s %s %s"
+        (pp_uid u) (pp_bop bop) (pp_opn op1) (pp_opn op2)
+    | Load (u, x) ->
+      Printf.sprintf "let %s = load %s"
+        (pp_uid u) (pp_var x)
+    | Store (x, op) ->
+      Printf.sprintf "let _ = store %s %s"
+        (pp_opn op) (pp_var x)
+  
+  let pp_global = function (x,c) ->
+      Printf.sprintf "let %s = ref %s" (pp_var x) (pp_int64 c)
+
+  let pp_program {globals; insns} =
+    Printf.sprintf "%s\n;;\n%s in\n  ()"
+    (String.concat "\n" (List.map pp_global globals)) 
+    (String.concat " in\n" (List.map pp_insn insns)) 
+  
+
+
+  module MLMeaning = struct
+    let add = Int64.add
+    let mul = Int64.mul
+    let load x = x.contents
+    let store o x = x.contents <- o
+  end
+  
+end
+
+
+module Compile = struct
+  open SRC
+  
+  let rec compile_exp (e:exp) : (IR.insn list) * IR.opn =
+    let compile_bop bop e1 e2 = 
+        let ins1, ret1 = compile_exp e1 in
+        let ins2, ret2 = compile_exp e2 in
+        let ret = IR.mk_uid () in
+        ins1 @ ins2 @ IR.[Let (ret, bop, ret1, ret2)], IR.Id ret
+    in
+    begin match e with
+      | Var x ->
+        let ret = IR.mk_uid () in
+        IR.[Load(ret, x)], IR.Id ret
+      | Const c     -> [], IR.Const c
+      | Add(e1, e2) -> compile_bop IR.Add e1 e2
+      | Mul(e1, e2) -> compile_bop IR.Mul e1 e2
+      | Neg(e1)     -> compile_bop IR.Mul e1 (Const(-1L))
+    end
+
+  let rec compile_cmd (c:cmd) : (IR.insn list) =
+    begin match c with
+      | Skip -> []
+      | Assn(x, e) ->
+        let ins1, ret1 = compile_exp e in
+        ins1 @ IR.[Store(x, ret1)]
+      | Seq(c1, c2) ->
+        (compile_cmd c1) @ (compile_cmd c2)
+    end
+    
+  let compile (c:cmd) : IR.program =
+    let globals = SRC.globals in
+    let insns = compile_cmd c in
+    IR.{ globals; insns }
+
+end
+

lec06/code/ir3.ml

@@ -0,0 +1,341 @@
+(* source language ---------------------------------------------------------- *)
+
+type var = string
+module SRC = struct
+
+  (* Abstract syntax of arithmetic expressions *)
+  type exp =
+    | Var of var
+    | Add of exp * exp
+    | Mul of exp * exp
+    | Neg of exp
+    | Const of int64
+
+  (* Abstract syntax of commands *)
+  type cmd =
+    | Skip
+    | Assn of var * exp
+    | Seq  of cmd * cmd
+    | IfNZ of exp * cmd * cmd
+    | WhileNZ of exp * cmd
+
+ (* The global context of available variables and their initial values. *)
+ let globals : (var * int64) list =
+  [
+    "X1", 1L
+  ; "X2", 2L
+  ; "X3", 3L
+  ; "X4", 4L
+  ; "X5", 5L
+  ; "X6", 6L
+  ; "X7", 7L
+  ; "X8", 8L
+  ]
+
+  (*
+    X2 := X1 + X2;
+    IFNZ X2 THEN
+      X1 := X1 + 1
+    ELSE
+      X2 := X1
+    X2 := X2 * X1
+  *)
+  let example_branch : cmd =
+    let x1 = "X1" in
+    let x2 = "X2" in
+    let vx1 = Var x1 in
+    let vx2 = Var x2 in
+    Seq(Assn(x1, Add(vx1, vx2)),
+        Seq(IfNZ(vx2,
+                 Assn(x1, Add(vx1, Const 1L)),
+                 Assn(x2, vx1)),
+          Assn(x2, Mul(vx2, vx1))
+        ))
+
+
+  (* 
+     X1 := 6;
+     X2 := 1;
+     WhileNZ X1 DO
+       X2 := X2 * X1;
+       X1 := X1 + (-1);
+     DONE
+  *)
+  let factorial : cmd =
+    let x = "X1" in
+    let ans = "X2" in
+    Seq(Assn(x, Const 6L),
+        Seq(Assn(ans, Const 1L),
+            WhileNZ(Var x,
+                    Seq(Assn(ans, Mul(Var ans, Var x)),
+                        Assn(x,   Add(Var x, Const (-1L) ))))))
+      
+  
+end
+
+
+module IR = struct
+  
+  type uid = string     (* Unique identifiers for temporaries. *)
+  type lbl = string
+  
+  (* "gensym" -- generate a new unique identifier *)
+  let mk_uid : string -> uid =
+    let ctr = ref 0 in
+    fun s -> 
+      ctr := !ctr + 1;
+      Printf.sprintf "%s%d" s (!ctr)
+  
+  
+  (* operands *)
+  type opn = 
+    | Id of uid
+    | Const of int64
+
+  (* binary arithmetic operations *)
+  type bop =
+    | Add
+    | Mul
+
+  (* comparison operations *)
+  type cmpop =
+    | Eq
+    | Lt
+  
+  (* instructions *)
+  (* note that there is no nesting of operations! *)
+  type insn =
+    | Let of uid * bop * opn * opn
+    | Load of uid * var
+    | Store of var * opn
+    | ICmp of uid * cmpop * opn * opn
+  
+  type terminator =
+    | Ret 
+    | Br of lbl                (* unconditional branch *)
+    | Cbr of opn * lbl * lbl   (* conditional branch *)
+
+  (* Basic blocks *)
+  type block = { insns: insn list; terminator: terminator }
+
+  (* Control Flow Graph: a pair of an entry block and a set labeled blocks *)
+  type cfg = block * (lbl * block) list
+  
+  type program = { 
+    globals: (var * int64) list; 
+    cfg: cfg 
+  }
+  
+  (* pretty printing *)
+  let pp_uid u = u
+  let pp_var x = Printf.sprintf "var%s" x
+  let pp_int64 c = Printf.sprintf "(%sL)" (Int64.to_string c)
+  let pp_opn = function 
+    | Id u    -> pp_uid u
+    | Const c -> pp_int64 c
+
+  let pp_bop = function
+    | Add -> "add"
+    | Mul -> "mul"
+
+  let pp_cmpop = function
+    | Eq -> "eq"
+    | lt -> "lt"
+  
+  let pp_insn = function
+    | Let (u, bop, op1, op2) ->
+      Printf.sprintf "let %s = %s %s %s"
+        (pp_uid u) (pp_bop bop) (pp_opn op1) (pp_opn op2)
+    | Load (u, x) ->
+      Printf.sprintf "let %s = load %s"
+        (pp_uid u) (pp_var x)
+    | Store (x, op) ->
+      Printf.sprintf "let _ = store %s %s"
+        (pp_opn op) (pp_var x)
+    | ICmp (u, cmpop, op1, op2) ->
+      Printf.sprintf "let %s = icmp %s %s %s"
+        (pp_uid u) (pp_cmpop cmpop) (pp_opn op1) (pp_opn op2)
+
+  let pp_terminator = function
+    | Ret -> "  ret ()"
+    | Br lbl  -> Printf.sprintf "  br %s" lbl
+    | Cbr(op, lbl1, lbl2) -> Printf.sprintf "  cbr %s %s %s" (pp_opn op) lbl1 lbl2
+
+  let pp_block {insns; terminator} =
+    (String.concat " in\n" (List.map pp_insn insns)) ^
+    (if (List.length insns) > 0 then " in\n" else "")
+    ^
+    (pp_terminator terminator)
+
+  let pp_cfg (entry_block, blocks) =
+    (Printf.sprintf "let rec entry () =\n%s" (pp_block entry_block)) ^ "\n\n" ^
+    (String.concat "\n\n"
+       (List.map (fun (lbl,block) -> Printf.sprintf "and %s () =\n%s" lbl (pp_block block)) blocks))
+  
+  let pp_global = function (x,c) ->
+        Printf.sprintf "let %s = ref %s" (pp_var x) (pp_int64 c)
+
+  let pp_program { globals; cfg } =
+    Printf.sprintf "%s\n;;\nlet program () =\n%s\nin entry ()" 
+    (String.concat "\n" (List.map pp_global globals))
+    (pp_cfg cfg)
+
+  module MLMeaning = struct
+    let add = Int64.add
+    let mul = Int64.mul
+    let load (x : int64 ref) = (!x)
+    let store o (x : int64 ref) = x := o
+    let icmp cmpop x y = cmpop x y 
+
+    let eq (x : int64) (y : int64) = x = y
+    let lt x y = x < y
+
+    let ret x = x
+
+    let cbr cnd lbl1 lbl2 =
+      if cnd then lbl1 () else lbl2 ()
+    let br lbl = lbl ()
+  end
+  
+end
+
+module Compile = struct
+  open SRC
+  open IR
+  
+  type elt = 
+    | L of lbl          (* Block labels *)
+    | I of insn         (* LL IR instruction *)
+    | T of terminator   (* Block terminators *)
+
+  type stream = elt list
+
+  (* During generation, we typically emit code so that it is in
+     _reverse_ order when the stream is viewed as a list.  That is,
+     instructions closer to the head of the list are to be executed
+     later in the program.  That is because cons is more efficient than
+     append.
+
+     To help make code generation easier, we define snoc (reverse cons)
+     and reverse append, which let us write code sequences in their
+     natural order.                                                             *)
+  let ( >@ ) x y = y @ x
+  let ( >:: ) x y = y :: x
+
+
+  (* Convert an instruction stream into a control flow graph.
+     - assumes that the instructions are in 'reverse' order of execution.
+  *)
+  let build_cfg (code:stream) : cfg   =
+    let blocks_of_stream (code:stream) =
+      let (insns, term_opt, blks) =  List.fold_left
+	        (fun (insns, term_opt, blks) e ->
+             begin match e with
+               | L l ->
+                 begin match term_opt with
+                   | None ->
+                     if (List.length insns) = 0 then  ([], None, blks)
+                     else failwith @@
+                       Printf.sprintf "build_cfg: block labeled %s has\
+                                       no terminator" l
+
+                   | Some terminator ->
+                     ([], None, (l, {insns; terminator})::blks)
+                 end
+               | T t  -> ([], Some t, blks)
+               | I i  -> (i::insns, term_opt, blks)
+             end)
+          ([], None, []) code
+      in
+      begin match term_opt with
+        | None -> failwith "build_cfg: entry block has no terminator" 
+        | Some terminator ->
+          ({insns; terminator}, blks)
+      end
+    in
+    blocks_of_stream code 
+
+  
+  let rec compile_exp (e:exp) : (insn list) * opn =
+    let compile_bop bop e1 e2 = 
+        let ins1, ret1 = compile_exp e1 in
+        let ins2, ret2 = compile_exp e2 in
+        let ret = mk_uid "tmp" in
+        ins1 >@ ins2 >@ [Let (ret, bop, ret1, ret2)], Id ret
+    in
+    begin match e with
+      | Var x ->
+        let ret = mk_uid "tmp" in
+        [Load(ret, x)], Id ret
+      | Const c -> [], Const c
+      | Add(e1, e2) -> compile_bop Add e1 e2
+      | Mul(e1, e2) -> compile_bop Mul e1 e2
+      | Neg(e1) -> compile_bop Mul e1 (Const(-1L))
+    end
+
+  let lift : (insn list) -> stream = List.map (fun i -> I i) 
+  
+  let rec compile_cmd (c:cmd) : stream =
+    begin match c with
+      | Skip -> []
+
+      | Assn (v, e) ->
+        let (is, op) = compile_exp e in
+        (lift is) >::  I (Store (v, op)) 
+
+      | Seq  (c1, c2) ->
+        (compile_cmd c1) >@ (compile_cmd c2)
+
+      | IfNZ (e, c1, c2) ->
+        let (is, result) = compile_exp e in
+        let c1_insns = compile_cmd c1 in
+        let c2_insns = compile_cmd c2 in
+        let guard = mk_uid "guard" in
+        let nz_branch = mk_uid "nz_branch" in
+        let z_branch = mk_uid "z_branch" in
+        let merge = mk_uid "merge" in
+        (* Compute the guard result *)
+           (lift is)
+           >@ [ I (ICmp (guard, Eq, result, Const 0L)) ]
+           >@ [ T (Cbr (Id guard, z_branch, nz_branch)) ]
+
+           (* guard is non-zero *)
+           >@ [ L nz_branch ]
+           >@ c1_insns
+           >@ [ T (Br merge) ]
+
+
+           (* guard is zero *)
+           >@ [ L z_branch ]
+           >@ c2_insns
+           >@ [ T (Br merge) ]
+
+           >@ [ L merge ]
+
+      | WhileNZ (e, c) ->
+        let (is, result) = compile_exp e in
+        let c_insns = compile_cmd c in
+        let guard = mk_uid "guard" in
+        let entry = mk_uid "entry" in
+        let body =  mk_uid "body" in
+        let exit =  mk_uid "exit" in
+           [ T (Br entry) ]
+        >@ [ L entry ]
+        >@ (lift is)
+        >@ [ I (ICmp (guard, Eq, result, Const 0L)) ]
+        >@ [ T (Cbr (Id guard, exit, body)) ]
+        >@ [ L body ]
+        >@ c_insns
+        >@ [ T (Br entry) ]
+        >@ [ L exit ]
+    end
+    
+  let compile (c:cmd) : IR.program =
+    let globals = SRC.globals in
+    let cfg = build_cfg ((compile_cmd c) >:: T Ret) in 
+    { globals ; cfg }
+    
+
+end
+
+

lec06/code/ir4.ml

@@ -0,0 +1,91 @@
+
+module IR = struct
+  
+  type uid = string     (* Unique identifiers for temporaries. *)
+  type var = string
+  type lbl = string
+  type fn_name = string
+  
+  (* "gensym" -- generate a new unique identifier *)
+  let mk_uid : unit -> uid =
+    let ctr = ref 0 in
+    fun () -> 
+      ctr := !ctr + 1;
+      Printf.sprintf "tmp%d" (!ctr)
+  
+  
+  (* operands *)
+  type opn = 
+    | Id of uid
+    | Const of int64
+
+  (* binary arithmetic operations *)
+  type bop =
+    | Add
+    | Mul
+
+  (* comparison operations *)
+  type cmpop =
+    | Eq
+    | Lt
+  
+  (* instructions *)
+  (* note that there is no nesting of operations! *)
+  type insn =
+    | Let of uid * bop * opn * opn
+    | Load of uid * var
+    | Store of var * opn
+    | ICmp of uid * cmpop * opn * opn
+    | Call of uid * fn_name * (opn list)
+    | Alloca of uid
+  
+  type terminator =
+    | Ret 
+    | Br of lbl                (* unconditional branch *)
+    | Cbr of opn * lbl * lbl   (* conditional branch *)
+
+  (* Basic blocks *)
+  type block = { insns: insn list; terminator: terminator }
+
+  (* Control Flow Graph: a pair of an entry block and a set labeled blocks *)
+  type cfg = block * (lbl * block) list
+
+  (* A function declaration:  (In OCaml syntax: )
+          let f arg1 arg2 arg3 = 
+          let rec entry () = ...
+          and block1 () = ...
+          ...
+          and blockM () = ...
+          in entry ()
+  *)
+  type fdecl = { name: fn_name;  param : uid list; cfg : cfg }
+  
+  type program = {
+    globals : (var * int64) list;
+    fdecls : fdecl list
+  }
+
+  module MLMeaning = struct
+    let add = Int64.add
+    let mul = Int64.mul
+    let load (x : int64 ref) = (!x)
+    let store o (x : int64 ref) = x := o
+    let icmp cmpop x y = cmpop x y 
+
+    let eq (x : int64) (y : int64) = x = y
+    let lt x y = x < y
+
+    let ret x = x
+
+    let cbr cnd lbl1 lbl2 =
+      if cnd then lbl1 () else lbl2 ()
+    let br lbl = lbl ()
+
+    let alloca () = ref 0L
+    let call f x = f x
+  end
+  
+end
+
+
+

lec06/code/ir5.ml

@@ -0,0 +1,94 @@
+(* refactoring -------------------------------------------------------------- *)
+
+
+module IR = struct
+
+  (* unify var and fn_name as 'global identifiers' *)
+  type uid = string     (* Unique identifiers for temporaries. *)
+  type lbl = string
+  type gid = string     (* New!  global value identifiers *)
+  
+  (* "gensym" -- generate a new unique identifier *)
+  let mk_uid : unit -> uid =
+    let ctr = ref 0 in
+    fun () -> 
+      ctr := !ctr + 1;
+      Printf.sprintf "tmp%d" (!ctr)
+  
+  
+  (* operands *)
+  type opn = 
+    | Id of uid
+    | Const of int64
+
+  (* binary arithmetic operations *)
+  type bop =
+    | Add
+    | Mul
+
+  (* comparison operations *)
+  type cmpop =
+    | Eq
+    | Lt
+  
+  (* instructions *)
+  (* note that there is no nesting of operations! *)
+  (* pull out the common 'uid' element from these constructors *)
+  type insn =
+    | Binop of bop * opn * opn     (* Rename let to binop *)
+    | Load of gid
+    | Store of gid * opn
+    | ICmp of cmpop * opn * opn
+    | Call of gid * (opn list)
+    | Alloca 
+  
+  type terminator =
+    | Ret 
+    | Br of lbl                (* unconditional branch *)
+    | Cbr of opn * lbl * lbl   (* conditional branch *)
+
+  (* Basic blocks *)
+  type block = { insns: (uid * insn) list; terminator: terminator }
+
+  (* Control Flow Graph: a pair of an entry block and a set labeled blocks *)
+  type cfg = block * (lbl * block) list
+
+
+  type gdecl =
+    | GInt of int64
+  
+  (* The only real change is to "factor out" the name of the function
+     and unify that concept with the "global identifier" names for
+     gdecl.
+  *)
+  type fdecl = { param : uid list; cfg : cfg }
+  
+  type program = {
+    gdecls : (gid * gdecl) list;
+    fdecls : (gid * fdecl) list;
+  }
+
+  module MLMeaning = struct
+    let add = Int64.add
+    let mul = Int64.mul
+    let load (x : int64 ref) = (!x)
+    let store o (x : int64 ref) = x := o
+    let icmp cmpop x y = cmpop x y 
+
+    let eq (x : int64) (y : int64) = x = y
+    let lt x y = x < y
+
+    let ret x = x
+
+    let cbr cnd lbl1 lbl2 =
+      if cnd then lbl1 () else lbl2 ()
+    let br lbl = lbl ()
+
+    let alloca () = ref 0L
+    let call f x = f x
+  end
+  
+end
+
+
+

lec06/code/ir_by_hand.ml

@@ -0,0 +1,404 @@
+(* IR1 development ---------------------------------------------------------- *)
+
+(* This example corresponds to ir1.  It shows how we can "flatten" nested 
+   expressions into a "let"-only subset of OCaml. 
+
+   See the file ir1.ml for the implementation of this intermediate language.
+*)
+
+(* 
+  Source language: simple arithmetic expressions with top-level immutable 
+  variables X1 .. X8.  (Each initialized so X1 = 1, X2 = 2, etc.)
+
+  example source program:   (1 + X4) + (3 + (X1 * 5) )
+
+  The type translation of a source variable in the pure arithmetic langauge 
+  is just an int64:
+       [[X4]] : int64
+*)
+
+
+let (+.) = Int64.add
+let ( *. ) = Int64.mul
+
+
+
+let varX1 = 17L
+let varX4 = 42L
+let program : int64 =
+  (1L +. varX4) +. (3L +. (varX1 *. 5L))
+
+let program : int64 =
+  let tmp2 = (varX1 *. 5L) in
+  let tmp3 = (3L +. tmp2) in 
+  let tmp1 = (1L +. varX4) in 
+  let tmp4 = tmp1 +. tmp3 in 
+  tmp4
+
+
+(* "denotation" functions encode the source-level operations as ML functions *)
+let add = Int64.add
+let mul = Int64.mul
+let ret x = x           (* ret is there for uniformity *)
+
+(* translation of the source expression into the let language *)
+let program : int64 =
+  let tmp1 = add 1L varX4 in
+  let tmp2 = mul varX1 5L in
+  let tmp3 = add 3L tmp2 in
+  let tmp4 = add tmp1 tmp3 in
+  ret tmp4 
+  
+
+(*   Exercise  *)
+let program : int64 = (3L +. varX1) +. varX4
+
+let program : int64 =
+  let tmp1 = add 3L varX1 in 
+  let tmp2 = add tmp1 varX4 in
+  ret tmp2
+
+
+(* IR2 development ---------------------------------------------------------- *)
+
+(* This example corresponds to ir2.  It shows how we translate imperative
+   features into the IR by extending our 'let' notion.
+
+   See the file ir2.ml for the implementation of this intermediate language.
+*)
+
+
+(*
+  Source language: simple imperative language  with top-level mutable 
+  variables X1 .. X8 and straight-line imperative code with assignment
+  sequencing and skip:
+
+  Example source program:
+
+   X1 := (1 + X4) + (3 + (X1 * 5) ) ;
+   Skip ;
+   X2 := X1 * X1 ;
+
+
+  The type translation of a source variable is now a reference:
+     [[X1]] : int64 ref
+
+  Expressions still denote syntactic values, but commands denote unit 
+  computations:
+     [[exp]] : opn  (syntactic value)
+     [[cmd]] : unit
+*)
+
+
+let varX1 = ref 0L
+let varX2 = ref 0L
+let varX4 = ref 0L
+
+(* "denotation" functions encode the source-level operations as ML functions *)
+let load x = x.contents
+let store o x = x.contents <- o
+
+(* translation of the source expression into the simple imperative language *)
+let program : unit =
+  let tmp0 = load  varX4 in
+  let tmp1 = add   1L tmp0 in
+  let tmp2 = load  varX1 in
+  let tmp3 = mul   tmp2 5L in
+  let tmp4 = add   3L tmp3 in
+  let tmp5 = add   tmp1 tmp4 in
+  let _    = store tmp5 varX1 in
+  let tmp6 = load  varX1 in
+  let tmp7 = load  varX1 in 
+  let tmp8 = mul   tmp6 tmp7 in
+  let _    = store tmp8 varX2 in
+  ()
+
+
+
+
+
+
+
+
+(* IR3 development ---------------------------------------------------------- *)
+
+(* This example corresponds to ir3.  From the low-level view, this IR adds
+   labeled blocks and jumps.  The resulting datastructure is a kind of 
+   control-flow graph.
+
+   From the high-level point of view, we translate control-flow
+   features into stylized OCaml by introducing mutually-recursive "functions"
+   that are always in tail-call position.  Such functions correspond to jumps.
+
+   See the file ir3.ml for the implementation of this intermediate language.
+*)
+
+
+(*  Example source program:
+
+    X2 := X1 + X2;
+    IFNZ X2 THEN {
+      X1 := X1 + 1
+    } ELSE {
+      X2 := X1
+    } ; 
+    X2 := X2 * X1
+
+*)
+
+
+
+(*  (1) Identify the relevant parts of the control flow:
+
+entry:
+    X2 := X1 + X2;
+    IFNZ X2 THEN
+
+branch1:
+      X1 := X1 + 1
+
+    ELSE
+branch2:
+      X2 := X1
+
+merge:
+    X2 := X2 * X1
+
+*)
+
+
+(*  (2) Make control-flow transfers explicit:
+
+entry:
+    X2 := X1 + X2;
+    IFNZ X2 THEN branch1 () ELSE branch2 ()
+
+branch1:
+      X1 := X1 + 1;
+      merge ()
+
+
+branch2:
+      X2 := X1;
+      merge ()
+
+merge:
+    X2 := X2 * X1;
+    ret ()
+*)
+
+
+
+(*  (3) Translate the straight-line code as before.
+  
+entry:
+    let tmp1 = load X1 in
+    let tmp2 = load X2 in
+    let tmp3 = add tmp1 tmp2 in
+    let _ = store tmp3 X2 in
+    let tmp4 = load x2 in
+
+      <<CHOICE: HOW TO HANDLE CONDITIONALS?>> 
+      ** Option 1: fold together conditional test with branch:
+           if nz tmp4 branch1 branch2      
+
+      ** Option 2: add a 'boolean' type to the target language:
+         let tmp5 = icmp eq tmp 0L in    (* Note: tmp5 has type 'bool' *)
+         cbr tmp5 branch1 branch2         
+
+branch1:
+    let tmp5 = load X1 in
+    let tmp6 = add tmp5 1L in
+    let _ = store tmp6 X1 in
+      br merge 
+
+
+branch2:
+    let tmp7 = load X1 in
+    let _ = store tmp 7 X2 in
+      br merge
+
+merge:
+    let tmp8 = load X2 in
+    let tmp9 = load X1 in
+    let tmp10 = mul tmp8 tmp9 in
+    let _ = store tmp10 X2 in
+    ret ()
+*)
+
+let eq (x : int64) (y : int64) = x = y
+let lt x y = x < y
+let icmp cmpop x y = cmpop x y 
+
+let cbr cnd lbl1 lbl2 =
+  if cnd then lbl1 () else lbl2 ()
+
+let br lbl = lbl ()
+
+let program1 () = 
+  let rec entry () =
+    let tmp1 = load varX1 in
+    let tmp2 = load varX2 in
+    let tmp3 = add tmp1 tmp2 in
+    let _    = store tmp3 varX2 in
+    let tmp4 = load varX1 in
+    let tmp5 = icmp eq tmp4 0L in    (* Note: tmp5 has type 'bool' *)
+    cbr tmp5 branch2 branch1         
+      
+  and branch1 () =
+    let tmp5 = load varX1 in
+    let tmp6 = add tmp5 1L in
+    let _    = store tmp6 varX1 in
+    br merge 
+      
+  and branch2 () =
+    let tmp7 = load varX1 in
+    let _    = store tmp7 varX2 in
+    br merge 
+      
+  and merge () =
+    let tmp8  = load varX2 in
+    let tmp9  = load varX1 in
+    let tmp10 = mul tmp8 tmp9 in
+    let _     = store tmp10 varX2 in
+    ret ()
+  in
+  entry ()
+
+
+
+(* One more example: everybody's favorite factorial command: 
+
+     X1 := 6;
+     X2 := 1;
+     WhileNZ X1 DO
+       X2 := X2 * X1;
+       X1 := X1 + (-1);
+     DONE
+*)
+
+let program2 () =
+  let rec entry () =
+    let _ = store 6L varX1 in
+    let _ = store 1L varX2 in
+    br loop 
+
+  and loop () =
+    let tmp1 = load varX1 in
+    let tmp2 = icmp eq 0L tmp1 in
+    cbr tmp2 merge body
+
+  and body () =
+    let tmp3 = load varX2 in
+    let tmp4 = load varX1 in
+    let tmp5 = mul tmp3 tmp4 in
+    let _ = store tmp5 varX2 in
+    let tmp6 = load varX1 in
+    let tmp7 = add tmp6 (-1L) in
+    let _ = store tmp7 varX1 in
+    br loop 
+
+  and merge () =
+    ret ()
+  in
+  entry ()
+    
+
+
+
+(* IR4 development ---------------------------------------------------------- *)
+
+(* What about top-level functions? 
+    - calls
+    - local storage
+*)
+
+(* (Hypothetical) Source:
+
+   int64 square(int64 x) {
+     x = x + 1;
+     return (x * x);
+   }
+
+   void caller() {
+     int x = 3;
+     int y = square(x);
+     print ( y + x );
+   }
+*)
+
+
+
+
+(* Call-by-value or call by reference? *)
+
+(* alloca : unit -> int64 ref *)
+
+let alloca () =
+  ref 0L
+
+let call f x = f x
+let print (x:int64) = Printf.printf "%s\n" (Int64.to_string x)
+
+let square (arg : int64) : int64 =
+  let rec entry () =
+    let tmp_x = alloca () in
+    
+    let _ = store arg tmp_x in
+    let tmp1 = load tmp_x in
+    let tmp2 = load tmp_x in
+    let tmp3 = mul tmp1 tmp2 in
+    ret tmp3
+  in
+  entry()
+
+let caller () : unit =
+  let rec entry () =
+    let tmp_x = alloca () in
+    let _     = store 3L tmp_x in
+    let tmp_y = alloca () in
+    let tmp1 = load tmp_x in
+    let tmp2 = call square tmp1 in
+    let _    = store tmp2 tmp_y in
+    let tmp3 = load tmp_x in
+    let tmp4 = load tmp_y in
+    let tmp5 = add tmp3 tmp4 in
+    let _ = call print tmp5 in
+    ret ()
+  in
+  entry ()
+
+(*
+
+int64 square (arg : int64) {
+entry:
+     %tmp_x = alloca () 
+    
+     _ = store arg %tmp_x 
+     %tmp1 = load %tmp_x 
+     %tmp2 = load %tmp_x 
+     %tmp3 = mul %tmp1 %tmp2 
+    ret %tmp3
+
+}
+
+
+
+
+let caller () : unit =
+  let rec entry () =
+    let tmp_x = alloca () in
+    let _ = store 3L tmp_x in
+    let tmp_y = alloca () in
+    let tmp1 = load tmp_x in
+    let tmp2 = call square tmp1 in
+    let _ = store tmp2 tmp_y in
+    let tmp3 = load tmp_x in
+    let tmp4 = load tmp_y in
+    let tmp5 = add tmp3 tmp4 in
+    let _ = call print tmp5 in
+    ret ()
+}
+*)
+
+

lec06/code/main1.ml

@@ -0,0 +1,7 @@
+open Ir1
+
+let _ = 
+  let p  = SRC.example in
+  let ir = Compile.compile p in
+  let s  = IR.pp_program ir in
+  print_endline s

lec06/code/main2.ml

@@ -0,0 +1,7 @@
+open Ir2
+
+let _ = 
+  let p  = SRC.example_cmd in
+  let ir = Compile.compile p in
+  let s  = IR.pp_program ir in
+  print_endline s

lec06/code/main3.ml

@@ -0,0 +1,8 @@
+open Ir3
+
+(* Also try SRC.factorial *)
+let _ = 
+  let prog = SRC.factorial in
+  let ir = Compile.compile prog in
+  let s  = IR.pp_program ir in
+  print_endline s

lec06/dune-project

@@ -0,0 +1 @@
+(lang dune 2.9)