Add code for lecture 6
Signed-off-by: jmug <u.g.a.mariano@gmail.com>
This commit is contained in:
parent
9556695bed
commit
993c9e885f
17 changed files with 1463 additions and 0 deletions
13
lec06/.devcontainer/.zshrc
Executable file
13
lec06/.devcontainer/.zshrc
Executable file
|
|
@ -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"
|
||||
|
||||
57
lec06/.devcontainer/Dockerfile
Normal file
57
lec06/.devcontainer/Dockerfile
Normal file
|
|
@ -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`
|
||||
|
||||
30
lec06/.devcontainer/devcontainer.json
Normal file
30
lec06/.devcontainer/devcontainer.json
Normal file
|
|
@ -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"
|
||||
}
|
||||
17
lec06/.devcontainer/hack.sh
Normal file
17
lec06/.devcontainer/hack.sh
Normal file
|
|
@ -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
|
||||
19
lec06/Makefile
Normal file
19
lec06/Makefile
Normal file
|
|
@ -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
|
||||
|
||||
50
lec06/code/dune
Normal file
50
lec06/code/dune
Normal file
|
|
@ -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)))
|
||||
152
lec06/code/ir1.ml
Normal file
152
lec06/code/ir1.ml
Normal file
|
|
@ -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
|
||||
|
||||
|
||||
172
lec06/code/ir2.ml
Normal file
172
lec06/code/ir2.ml
Normal file
|
|
@ -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
|
||||
|
||||
341
lec06/code/ir3.ml
Normal file
341
lec06/code/ir3.ml
Normal file
|
|
@ -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
|
||||
|
||||
|
||||
91
lec06/code/ir4.ml
Normal file
91
lec06/code/ir4.ml
Normal file
|
|
@ -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
|
||||
|
||||
|
||||
|
||||
94
lec06/code/ir5.ml
Normal file
94
lec06/code/ir5.ml
Normal file
|
|
@ -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
|
||||
|
||||
|
||||
|
||||
404
lec06/code/ir_by_hand.ml
Normal file
404
lec06/code/ir_by_hand.ml
Normal file
|
|
@ -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 ()
|
||||
}
|
||||
*)
|
||||
|
||||
|
||||
7
lec06/code/main1.ml
Normal file
7
lec06/code/main1.ml
Normal file
|
|
@ -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
|
||||
7
lec06/code/main2.ml
Normal file
7
lec06/code/main2.ml
Normal file
|
|
@ -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
|
||||
8
lec06/code/main3.ml
Normal file
8
lec06/code/main3.ml
Normal file
|
|
@ -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
|
||||
1
lec06/dune-project
Normal file
1
lec06/dune-project
Normal file
|
|
@ -0,0 +1 @@
|
|||
(lang dune 2.9)
|
||||
0
lec06/main.opam
Normal file
0
lec06/main.opam
Normal file
Loading…
Add table
Add a link
Reference in a new issue