diff --git a/lec06/.devcontainer/.zshrc b/lec06/.devcontainer/.zshrc new file mode 100755 index 0000000..d38a73f --- /dev/null +++ b/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" + diff --git a/lec06/.devcontainer/Dockerfile b/lec06/.devcontainer/Dockerfile new file mode 100644 index 0000000..dcde5b6 --- /dev/null +++ b/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` + diff --git a/lec06/.devcontainer/devcontainer.json b/lec06/.devcontainer/devcontainer.json new file mode 100644 index 0000000..681efff --- /dev/null +++ b/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" +} diff --git a/lec06/.devcontainer/hack.sh b/lec06/.devcontainer/hack.sh new file mode 100644 index 0000000..b6d2c3f --- /dev/null +++ b/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 < 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 + + diff --git a/lec06/code/ir2.ml b/lec06/code/ir2.ml new file mode 100644 index 0000000..6f6b275 --- /dev/null +++ b/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 + diff --git a/lec06/code/ir3.ml b/lec06/code/ir3.ml new file mode 100644 index 0000000..7beff04 --- /dev/null +++ b/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 + + diff --git a/lec06/code/ir4.ml b/lec06/code/ir4.ml new file mode 100644 index 0000000..1e96f08 --- /dev/null +++ b/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 + + + diff --git a/lec06/code/ir5.ml b/lec06/code/ir5.ml new file mode 100644 index 0000000..ee19c4b --- /dev/null +++ b/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 + + + diff --git a/lec06/code/ir_by_hand.ml b/lec06/code/ir_by_hand.ml new file mode 100644 index 0000000..6e45813 --- /dev/null +++ b/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 + + <> + ** 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 () +} +*) + + diff --git a/lec06/code/main1.ml b/lec06/code/main1.ml new file mode 100644 index 0000000..3018c07 --- /dev/null +++ b/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 diff --git a/lec06/code/main2.ml b/lec06/code/main2.ml new file mode 100644 index 0000000..25a394c --- /dev/null +++ b/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 diff --git a/lec06/code/main3.ml b/lec06/code/main3.ml new file mode 100644 index 0000000..800c832 --- /dev/null +++ b/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 diff --git a/lec06/dune-project b/lec06/dune-project new file mode 100644 index 0000000..c994249 --- /dev/null +++ b/lec06/dune-project @@ -0,0 +1 @@ +(lang dune 2.9) diff --git a/lec06/main.opam b/lec06/main.opam new file mode 100644 index 0000000..e69de29