Update README.

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

README.md

@@ -1,8 +1,10 @@
 # CS153
 
-Following Harvard's CS153 compiler class
+Following Harvard's CS153 compiler class:
+- Link from Harvard: https://canvas.harvard.edu/courses/124796
+- Link from UPenn (past, all homeworks): https://www.seas.upenn.edu/~cis3410/current
+- Link from UPenn (current): https://www.seas.upenn.edu/~cis5521/current/
+- Another alternative link: https://ilyasergey.net/CS4212/
 
-Link from Harvard: https://canvas.harvard.edu/courses/124796
-Link from UPenn (past, all homeworks): https://www.seas.upenn.edu/~cis3410/current
-Link from UPenn (current): https://www.seas.upenn.edu/~cis5521/current/
-Another alternative link: https://ilyasergey.net/CS4212/
+# HW4
+Take a look at the notes for Lec06 (especially ir3 onwards). Professor Chong mentioned that they'd be useful for this homework.

hw2/test/studenttests.ml

@@ -67,6 +67,44 @@ let crack_tests =
 
   ]
 
+let fib_rec n = [ text "fib"
+                          [ Cmpq, [~$1; ~%Rdi]
+                          ; J Eq, [Imm (Lbl "exit1")]
+                          ; Cmpq, [~$2; ~%Rdi]
+                          ; J Eq, [Imm (Lbl "exit2")]
+                          ; Movq, [~$0; ~%R08]
+                          ; Movq, [~$1; ~%R09]
+                          ; Movq, [~$2; ~%R11]
+                          ]
+                    ; text "loop"
+                          [ Cmpq, [~%Rdi; ~%R11]
+                          ; J Eq, [Imm (Lbl "exit")]
+                          ; Movq, [~%R09; ~%R10]
+                          ; Addq, [~%R08; ~%R10]
+                          ; Movq, [~%R09; ~%R08]
+                          ; Movq, [~%R10; ~%R09]
+                          ; Addq, [~$1; ~%R11]
+                          ; Jmp, [Imm (Lbl "loop")]
+                          ]
+                    ; text "exit"
+                          [ Movq, [~%R09; ~%Rax]
+                          ; Retq, []
+                          ]
+                    ; text "exit1"
+                          [ Movq, [~$0; ~%Rax]
+                          ; Retq, []
+                          ]
+                    ; text "exit2"
+                          [ Movq, [~$1; ~%Rax]
+                          ; Retq, []
+                          ]
+                    ; gtext "main"
+                          [ Movq,  [~$n; ~%Rdi]
+                          ; Callq, [~$$"fib"]
+                          ; Retq,  []
+                          ]
+                ]
+
 let provided_tests : suite = [
   
   Test ("My Tests", [
@@ -77,7 +115,9 @@ let provided_tests : suite = [
 
 
   Test ("Student-Provided Big Test for Part III: Score recorded as PartIIITestCase", [
-    
+    ("fib", program_test (fib_rec 7) 8L);
+    ("fib", program_test (fib_rec 8) 13L);
+    ("fib", program_test (fib_rec 9) 21L);
   ]);
 
 ] 

hw3/.gitignore

@@ -0,0 +1,6 @@
+.vscode
+_build
+bin/main.exe
+oatc
+ocamlbin
+*~

hw3/bin/backend.ml

@@ -2,7 +2,6 @@
 
 open Ll
 open X86
-
 module Platform = Util.Platform
 
 (* Overview ----------------------------------------------------------------- *)
@@ -12,19 +11,17 @@ module Platform = Util.Platform
    plan for implementing the compiler is provided on the project web page.
 *)
 
-
 (* helpers ------------------------------------------------------------------ *)
 
 (* Map LL comparison operations to X86 condition codes *)
 let compile_cnd = function
-  | Ll.Eq  -> X86.Eq
-  | Ll.Ne  -> X86.Neq
+  | Ll.Eq -> X86.Eq
+  | Ll.Ne -> X86.Neq
   | Ll.Slt -> X86.Lt
   | Ll.Sle -> X86.Le
   | Ll.Sgt -> X86.Gt
   | Ll.Sge -> X86.Ge
-
-
+;;
 
 (* locals and layout -------------------------------------------------------- *)
 
@@ -56,14 +53,14 @@ type layout = (uid * X86.operand) list
 
 (* A context contains the global type declarations (needed for getelementptr
    calculations) and a stack layout. *)
-type ctxt = { tdecls : (tid * ty) list
-            ; layout : layout
-            }
+type ctxt =
+  { tdecls : (tid * ty) list
+  ; layout : layout
+  }
 
 (* useful for looking up items in tdecls or layouts *)
 let lookup m x = List.assoc x m
 
-
 (* compiling operands  ------------------------------------------------------ *)
 
 (* LLVM IR instructions support several kinds of operands.
@@ -72,17 +69,28 @@ let lookup m x = List.assoc x m
    global addresses that must be computed from a label.  Constants are
    immediately available, and the operand Null is the 64-bit 0 value.
 
-     NOTE: two important facts about global identifiers:
+   NOTE: two important facts about global identifiers:
 
-     (1) You should use (Platform.mangle gid) to obtain a string
-     suitable for naming a global label on your platform (OS X expects
-     "_main" while linux expects "main").
+   (1) You should use (Platform.mangle gid) to obtain a string
+   suitable for naming a global label on your platform (OS X expects
+   "_main" while linux expects "main").
 
-     (2) 64-bit assembly labels are not allowed as immediate operands.
-     That is, the X86 code: movq _gid %rax which looks like it should
-     put the address denoted by _gid into %rax is not allowed.
-     Instead, you need to compute an %rip-relative address using the
-     leaq instruction:   leaq _gid(%rip) %rax.
+   (2) 64-bit assembly labels are not allowed as immediate operands.
+   That is, the X86 code: movq _gid %rax which looks like it should
+   put the address denoted by _gid into %rax is not allowed.
+   Instead, you need to compute an %rip-relative address using the
+   leaq instruction:   leaq _gid(%rip) %rax.
+
+   NOTE(jmug): _gid(%rip) is interpreted as simply _gid ONLY when
+   the register is %rip and is called RIP relative addressing, read
+   more about it here: https://www.cs.unc.edu/~porter/courses/cse506/s16/ref/assembly.html#:~:text=RIP%20relative%20addressing,of%20the%20redundant%20SIB%20form.
+
+   TODO: The section below still reads like giberish,
+   mabye reading the rest of the code/tests will help.
+   Update: This makes sense now, whenever you're adding two numbers together
+   or performing any operations on them, you need them to be in registers.
+   All locals in this compilation strategy are in the stack, so when
+   operating on them we need to move them to registers...
 
    One strategy for compiling instruction operands is to use a
    designated register (or registers) for holding the values being
@@ -91,10 +99,9 @@ let lookup m x = List.assoc x m
    the X86 instruction that moves an LLVM operand into a designated
    destination (usually a register).
 *)
-let compile_operand (ctxt:ctxt) (dest:X86.operand) : Ll.operand -> ins =
-  function _ -> failwith "compile_operand unimplemented"
-
-
+let compile_operand (ctxt : ctxt) (dest : X86.operand) : Ll.operand -> ins = function
+  | _ -> failwith "compile_operand unimplemented"
+;;
 
 (* compiling call  ---------------------------------------------------------- *)
 
@@ -147,9 +154,6 @@ let compile_operand (ctxt:ctxt) (dest:X86.operand) : Ll.operand -> ins =
   ]
 *)
 
-
-
-
 (* compiling getelementptr (gep)  ------------------------------------------- *)
 
 (* The getelementptr instruction computes an address by indexing into
@@ -162,7 +166,7 @@ let compile_operand (ctxt:ctxt) (dest:X86.operand) : Ll.operand -> ins =
 *)
 
 (* [size_ty] maps an LLVMlite type to a size in bytes.
-    (needed for getelementptr)
+   (needed for getelementptr)
 
    - the size of a struct is the sum of the sizes of each component
    - the size of an array of t's with n elements is n * the size of t
@@ -172,11 +176,14 @@ let compile_operand (ctxt:ctxt) (dest:X86.operand) : Ll.operand -> ins =
    - Void, i8, and functions have undefined sizes according to LLVMlite.
      Your function should simply return 0 in those cases
 *)
-let rec size_ty (tdecls:(tid * ty) list) (t:Ll.ty) : int =
-failwith "size_ty not implemented"
-
-
-
+let rec size_ty (tdecls : (tid * ty) list) (t : Ll.ty) : int =
+  match t with
+  | Struct tl -> List.fold_left (fun acc st -> acc + size_ty tdecls st) 0 tl
+  | Array (sz, at) -> sz * size_ty tdecls at
+  | Namedt lb -> size_ty tdecls (lookup tdecls lb)
+  | I1 | I64 | Ptr _ -> 8
+  | Void | I8 | Fun _ -> 0
+;;
 
 (* Generates code that computes a pointer value.
 
@@ -185,28 +192,29 @@ failwith "size_ty not implemented"
    2. the value of op is the base address of the calculation
 
    3. the first index in the path is treated as the index into an array
-     of elements of type t located at the base address
+   of elements of type t located at the base address
 
    4. subsequent indices are interpreted according to the type t:
 
-     - if t is a struct, the index must be a constant n and it
-       picks out the n'th element of the struct. [ NOTE: the offset
+   - if t is a struct, the index must be a constant n and it
+     picks out the n'th element of the struct. [ NOTE: the offset
        within the struct of the n'th element is determined by the
        sizes of the types of the previous elements ]
 
-     - if t is an array, the index can be any operand, and its
-       value determines the offset within the array.
+   - if t is an array, the index can be any operand, and its
+     value determines the offset within the array.
 
-     - if t is any other type, the path is invalid
+   - if t is any other type, the path is invalid
 
    5. if the index is valid, the remainder of the path is computed as
-      in (4), but relative to the type f the sub-element picked out
-      by the path so far
+   in (4), but relative to the type f the sub-element picked out
+   by the path so far
 *)
-let compile_gep (ctxt:ctxt) (op : Ll.ty * Ll.operand) (path: Ll.operand list) : ins list =
-failwith "compile_gep not implemented"
-
-
+let compile_gep (ctxt : ctxt) (op : Ll.ty * Ll.operand) (path : Ll.operand list)
+  : ins list
+  =
+  failwith "compile_gep not implemented"
+;;
 
 (* compiling instructions  -------------------------------------------------- *)
 
@@ -231,16 +239,15 @@ failwith "compile_gep not implemented"
 
    - Bitcast: does nothing interesting at the assembly level
 *)
-let compile_insn (ctxt:ctxt) ((uid:uid), (i:Ll.insn)) : X86.ins list =
-      failwith "compile_insn not implemented"
-
-
+let compile_insn (ctxt : ctxt) ((uid : uid), (i : Ll.insn)) : X86.ins list =
+  failwith "compile_insn not implemented"
+;;
 
 (* compiling terminators  --------------------------------------------------- *)
 
-(* prefix the function name [fn] to a label to ensure that the X86 labels are 
+(* prefix the function name [fn] to a label to ensure that the X86 labels are
    globally unique . *)
-let mk_lbl (fn:string) (l:string) = fn ^ "." ^ l
+let mk_lbl (fn : string) (l : string) = fn ^ "." ^ l
 
 (* Compile block terminators is not too difficult:
 
@@ -254,28 +261,27 @@ let mk_lbl (fn:string) (l:string) = fn ^ "." ^ l
 
    [fn] - the name of the function containing this terminator
 *)
-let compile_terminator (fn:string) (ctxt:ctxt) (t:Ll.terminator) : ins list =
+let compile_terminator (fn : string) (ctxt : ctxt) (t : Ll.terminator) : ins list =
   failwith "compile_terminator not implemented"
-
+;;
 
 (* compiling blocks --------------------------------------------------------- *)
 
-(* We have left this helper function here for you to complete. 
+(* We have left this helper function here for you to complete.
    [fn] - the name of the function containing this block
    [ctxt] - the current context
    [blk]  - LLVM IR code for the block
 *)
-let compile_block (fn:string) (ctxt:ctxt) (blk:Ll.block) : ins list =
+let compile_block (fn : string) (ctxt : ctxt) (blk : Ll.block) : ins list =
   failwith "compile_block not implemented"
+;;
 
 let compile_lbl_block fn lbl ctxt blk : elem =
   Asm.text (mk_lbl fn lbl) (compile_block fn ctxt blk)
-
-
+;;
 
 (* compile_fdecl ------------------------------------------------------------ *)
 
-
 (* Complete this helper function, which computes the location of the nth incoming
    function argument: either in a register or relative to %rbp,
    according to the calling conventions. We will test this function as part of
@@ -286,8 +292,17 @@ let compile_lbl_block fn lbl ctxt blk : elem =
    [ NOTE: the first six arguments are numbered 0 .. 5 ]
 *)
 let arg_loc (n : int) : operand =
-failwith "arg_loc not implemented"
-
+  let n64 = Int64.of_int n in
+  let rbp_offset = Int64.mul 8L (Int64.sub n64 4L) in
+  match n with
+  | 0 -> Reg Rdi
+  | 1 -> Reg Rsi
+  | 2 -> Reg Rdx
+  | 3 -> Reg Rcx
+  | 4 -> Reg R08
+  | 5 -> Reg R09
+  | _ -> Ind3 (Lit rbp_offset, Rbp)
+;;
 
 (* We suggest that you create a helper function that computes the
    stack layout for a given function declaration.
@@ -296,10 +311,28 @@ failwith "arg_loc not implemented"
    - in this (inefficient) compilation strategy, each local id
      is also stored as a stack slot.
    - see the discussion about locals
-
 *)
-let stack_layout (args : uid list) ((block, lbled_blocks):cfg) : layout =
-failwith "stack_layout not implemented"
+let stack_layout (args : uid list) ((block, lbled_blocks) : cfg) : layout =
+  (* offset is in quad unitsf.
+     We start at 0, but rbp already contains a values (rbp of the calling
+     function) so we don't count it as a valid slot, consumers should decrement
+     it before using it.
+  *)
+  let open Int64 in
+  let next_offset =
+    let offset = ref 0 in
+    let next_offset' _ =
+      offset := !offset - 1;
+      !offset
+    in
+    next_offset'
+  in
+  let op_from_offset o = Ind3 (Lit (mul 8L (of_int o)), Rbp) in
+  let layout_args =
+    List.fold_left (fun acc arg -> (arg, op_from_offset (next_offset ())) :: acc) [] args
+  in
+  layout_args
+;;
 
 (* The code for the entry-point of a function must do several things:
 
@@ -317,28 +350,32 @@ failwith "stack_layout not implemented"
    - the function entry code should allocate the stack storage needed
      to hold all of the local stack slots.
 *)
-let compile_fdecl (tdecls:(tid * ty) list) (name:string) ({ f_param; f_cfg; _ }:fdecl) : prog =
-failwith "compile_fdecl unimplemented"
-
-
+let compile_fdecl
+  (tdecls : (tid * ty) list)
+  (name : string)
+  ({ f_param; f_cfg; _ } : fdecl)
+  : prog
+  =
+  failwith "compile_fdecl unimplemented"
+;;
 
 (* compile_gdecl ------------------------------------------------------------ *)
 (* Compile a global value into an X86 global data declaration and map
    a global uid to its associated X86 label.
 *)
 let rec compile_ginit : ginit -> X86.data list = function
-  | GNull     -> [Quad (Lit 0L)]
-  | GGid gid  -> [Quad (Lbl (Platform.mangle gid))]
-  | GInt c    -> [Quad (Lit c)]
-  | GString s -> [Asciz s]
+  | GNull -> [ Quad (Lit 0L) ]
+  | GGid gid -> [ Quad (Lbl (Platform.mangle gid)) ]
+  | GInt c -> [ Quad (Lit c) ]
+  | GString s -> [ Asciz s ]
   | GArray gs | GStruct gs -> List.map compile_gdecl gs |> List.flatten
-  | GBitcast (_t1,g,_t2) -> compile_ginit g
+  | GBitcast (_t1, g, _t2) -> compile_ginit g
 
 and compile_gdecl (_, g) = compile_ginit g
 
-
 (* compile_prog ------------------------------------------------------------- *)
-let compile_prog {tdecls; gdecls; fdecls; _} : X86.prog =
-  let g = fun (lbl, gdecl) -> Asm.data (Platform.mangle lbl) (compile_gdecl gdecl) in
-  let f = fun (name, fdecl) -> compile_fdecl tdecls name fdecl in
-  (List.map g gdecls) @ (List.map f fdecls |> List.flatten)
+let compile_prog { tdecls; gdecls; fdecls; _ } : X86.prog =
+  let g (lbl, gdecl) = Asm.data (Platform.mangle lbl) (compile_gdecl gdecl) in
+  let f (name, fdecl) = compile_fdecl tdecls name fdecl in
+  List.map g gdecls @ (List.map f fdecls |> List.flatten)
+;;

hw3/test/studenttests.ml

@@ -1,12 +1,26 @@
 open Util.Assert
+open X86
+open Ll
+module Backend = Llbackend.Backend
+module Driver = Llbackend.Driver
+open Llbackend.Backend
 open Gradedtests
-    
 
 (* These tests are provided by you -- they will be graded manually *)
 
 (* You should also add additional test cases here to help you   *)
 (* debug your program.                                          *)
 
-let provided_tests : suite = [
-  
-] 
+let arg_loc_tests =
+  [ "arg_loc_0", assert_eqf (fun () -> arg_loc 0) (Reg Rdi)
+  ; "arg_loc_1", assert_eqf (fun () -> arg_loc 1) (Reg Rsi)
+  ; "arg_loc_2", assert_eqf (fun () -> arg_loc 2) (Reg Rdx)
+  ; "arg_loc_3", assert_eqf (fun () -> arg_loc 3) (Reg Rcx)
+  ; "arg_loc_4", assert_eqf (fun () -> arg_loc 4) (Reg R08)
+  ; "arg_loc_5", assert_eqf (fun () -> arg_loc 5) (Reg R09)
+  ; "arg_loc_6", assert_eqf (fun () -> arg_loc 6) (Ind3 (Lit 16L, Rbp))
+  ; "arg_loc_100", assert_eqf (fun () -> arg_loc 100) (Ind3 (Lit 768L, Rbp))
+  ]
+;;
+
+let provided_tests : suite = [ Test ("arg_loc_tests", arg_loc_tests) ]

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)