152 lines
3.6 KiB
OCaml
152 lines
3.6 KiB
OCaml
(* 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
|
|
|
|
|