backup
This commit is contained in:
fiplox
commit
0119a154bf
|
|
@ -0,0 +1,3 @@
|
|||
_build/
|
||||
*.byte
|
||||
*.~*
|
||||
|
|
@ -0,0 +1,51 @@
|
|||
# MiniC
|
||||
|
||||
## Fonctionnalités
|
||||
|
||||
* Declaration des types de bases (int, char, float, bool)
|
||||
* Declaration des fonctions
|
||||
* Conditions if, else, else if
|
||||
* Boucle while
|
||||
* Fonctions natives :
|
||||
* `_add`
|
||||
* `_sub`
|
||||
* `_mul`
|
||||
* `_div`
|
||||
* `_add`
|
||||
* `_sub`
|
||||
* `_mul`
|
||||
* `_div`
|
||||
* `_xor`
|
||||
* `_or `
|
||||
* `_and`
|
||||
* `_seq`
|
||||
* `_sne`
|
||||
* `_sge`
|
||||
* `_sgt`
|
||||
* `_sle`
|
||||
* `_slt`
|
||||
* `_mod`
|
||||
* `_neg`
|
||||
* `_not`
|
||||
* `puts`
|
||||
* `puti`
|
||||
* `geti`
|
||||
|
||||
## Tests
|
||||
|
||||
### Test game (not really)
|
||||
```sh
|
||||
$ ocamlbuild -use-menhir test.byte
|
||||
$ ./test.byte tests/game.test > t.s
|
||||
$ spim t.s
|
||||
(spim) load "t.s"
|
||||
(spim) run
|
||||
```
|
||||
|
||||
### Autres tests (sans user input)
|
||||
```sh
|
||||
$ ./build.sh newt
|
||||
```
|
||||
```sh
|
||||
$ ./build.sh puiss
|
||||
```
|
||||
|
|
@ -0,0 +1,209 @@
|
|||
type type_t =
|
||||
| Int_t
|
||||
| Float_t
|
||||
| Char_t
|
||||
| Str_t
|
||||
| Void_t
|
||||
| Bool_t
|
||||
| Func_t of type_t * type_t list
|
||||
| Point_t of type_t
|
||||
(* | Array_t of int * type_t *)
|
||||
|
||||
let rec string_of_type_t t =
|
||||
match t with
|
||||
| Int_t -> "int"
|
||||
| Float_t -> "float"
|
||||
| Char_t -> "char"
|
||||
| Str_t -> "string"
|
||||
| Void_t -> "void"
|
||||
| Bool_t -> "bool"
|
||||
(* | Array_t (n, t) -> string_of_type_t t *)
|
||||
| Point_t t -> string_of_type_t t
|
||||
| Func_t (r, a) ->
|
||||
(if List.length a > 1 then "(" else "")
|
||||
^ String.concat ", " (List.map string_of_type_t a)
|
||||
^ (if List.length a > 1 then ")" else "")
|
||||
^ " -> "
|
||||
^ string_of_type_t r
|
||||
;;
|
||||
|
||||
module Syntax = struct
|
||||
type ident = string
|
||||
|
||||
type expr =
|
||||
| Int of
|
||||
{ value : int
|
||||
; pos : Lexing.position
|
||||
}
|
||||
| Float of
|
||||
{ value : float
|
||||
; pos : Lexing.position
|
||||
}
|
||||
| Char of
|
||||
{ value : string
|
||||
; pos : Lexing.position
|
||||
}
|
||||
| Str of
|
||||
{ value : string
|
||||
; pos : Lexing.position
|
||||
}
|
||||
(* | Array of *)
|
||||
(* { value : expr list *)
|
||||
(* ; cap : int option *)
|
||||
(* ; pos : Lexing.position *)
|
||||
(* } *)
|
||||
| Bool of
|
||||
{ value : bool
|
||||
; pos : Lexing.position
|
||||
}
|
||||
| Var of
|
||||
{ name : ident
|
||||
; pos : Lexing.position
|
||||
}
|
||||
| Call of
|
||||
{ func : ident
|
||||
; args : expr list
|
||||
; pos : Lexing.position
|
||||
}
|
||||
|
||||
type instr =
|
||||
| Assign of
|
||||
{ var : ident
|
||||
; expr : expr
|
||||
; pos : Lexing.position
|
||||
}
|
||||
| Decl of
|
||||
{ var : ident
|
||||
; typ : type_t
|
||||
; pos : Lexing.position
|
||||
}
|
||||
| Expr of
|
||||
{ expr : expr
|
||||
; pos : Lexing.position
|
||||
}
|
||||
| Return of
|
||||
{ expr : expr
|
||||
; pos : Lexing.position
|
||||
}
|
||||
| Cond of
|
||||
{ expr : expr
|
||||
; blockt : block
|
||||
; blockf : block
|
||||
; pos : Lexing.position
|
||||
}
|
||||
| Loop of
|
||||
{ expr : expr
|
||||
; block : block
|
||||
; pos : Lexing.position
|
||||
}
|
||||
|
||||
and block = instr list
|
||||
|
||||
type def =
|
||||
| Func of
|
||||
{ typ : type_t
|
||||
; name : ident
|
||||
; args : (type_t * ident) list
|
||||
; block : block
|
||||
; pos : Lexing.position
|
||||
}
|
||||
|
||||
type prog = def list
|
||||
end
|
||||
|
||||
module IR = struct
|
||||
type ident = string
|
||||
|
||||
type expr =
|
||||
| Int of int
|
||||
| Float of float
|
||||
| Char of char
|
||||
| Str of string
|
||||
| Void
|
||||
| Bool of bool
|
||||
(* | Array of int * expr list *)
|
||||
| Var of ident
|
||||
| Call of ident * expr list
|
||||
|
||||
type instr =
|
||||
| Decl of ident
|
||||
| Expr of expr
|
||||
| Assign of ident * expr
|
||||
| Return of expr
|
||||
| Cond of expr * block * block
|
||||
| Loop of expr * block
|
||||
|
||||
and block = instr list
|
||||
|
||||
type def = Func of ident * ident list * block
|
||||
type prog = def list
|
||||
|
||||
let string_of_ir ast =
|
||||
let rec fmt_e = function
|
||||
| Int n -> "Int " ^ string_of_int n
|
||||
| Float n -> "Float " ^ string_of_float n
|
||||
| Char c -> "Char " ^ String.make 1 c
|
||||
| Str s -> "Str \"" ^ s ^ "\""
|
||||
(* | Array (n, e) -> "Array (" ^ string_of_int n ^ ", " ^ String.concat " ; " (List.map fmt_e e) ^ ")" *)
|
||||
| Void -> "Void"
|
||||
| Bool b -> "Bool " ^ string_of_bool b
|
||||
| Var v -> "Var \"" ^ v ^ "\""
|
||||
| Call (f, a) ->
|
||||
"Call (\"" ^ f ^ "\", [ " ^ String.concat " ; " (List.map fmt_e a) ^ " ])"
|
||||
and fmt_i = function
|
||||
| Decl v -> "Decl \"" ^ v ^ "\""
|
||||
| Assign (v, e) -> "Assign (\"" ^ v ^ "\", " ^ fmt_e e ^ ")"
|
||||
| Expr e -> "Expr (" ^ fmt_e e ^ ")"
|
||||
| Return e -> "Return (" ^ fmt_e e ^ ")"
|
||||
| Cond (e, bt, bf) -> "Cond (" ^ fmt_e e ^ ", " ^ fmt_b bt ^ "\n, " ^ fmt_b bf ^ ")"
|
||||
| Loop (e, b) -> "Loop (" ^ fmt_e e ^ ",\n" ^ fmt_b b ^ ")"
|
||||
and fmt_b b = "\t[ " ^ String.concat "\n\t; " (List.map fmt_i b) ^ " ]"
|
||||
and fmt_arg a = "\"" ^ a ^ "\""
|
||||
and fmt_d = function
|
||||
| Func (name, args, b) ->
|
||||
"[ Func (\""
|
||||
^ name
|
||||
^ "\", "
|
||||
^ "[ "
|
||||
^ String.concat " ; " (List.map fmt_arg args)
|
||||
^ " ],\n"
|
||||
^ fmt_b b
|
||||
^ ")"
|
||||
^ "]"
|
||||
and fmt_p p = "[\n " ^ String.concat "\n " (List.map fmt_d p) ^ "\n]" in
|
||||
fmt_p ast
|
||||
;;
|
||||
end
|
||||
|
||||
module IR2 = struct
|
||||
type ident = string
|
||||
|
||||
type value =
|
||||
| Nil
|
||||
| Bool of bool
|
||||
| Int of int
|
||||
| Float of float
|
||||
| Char of char
|
||||
| Data of string
|
||||
|
||||
type expr =
|
||||
| Value of value
|
||||
| Var of ident
|
||||
| Call of ident * expr list
|
||||
|
||||
(* type lvalue = *)
|
||||
(* | LVar of ident *)
|
||||
(* | LAddr of expr *)
|
||||
type instr =
|
||||
| Decl of ident
|
||||
| Return of expr
|
||||
| Expr of expr
|
||||
| Assign of expr * expr
|
||||
| Cond of expr * block * block
|
||||
| Loop of expr * block
|
||||
|
||||
and block = instr list
|
||||
|
||||
type def = Func of ident * ident list * block
|
||||
type prog = def list
|
||||
end
|
||||
|
|
@ -0,0 +1,188 @@
|
|||
open Ast
|
||||
module Env = Map.Make (String)
|
||||
|
||||
let native_func_names =
|
||||
[ "_add"
|
||||
; "_sub"
|
||||
; "_mul"
|
||||
; "_div"
|
||||
; "_adds"
|
||||
; "_subs"
|
||||
; "_muls"
|
||||
; "_divs"
|
||||
; "_xor"
|
||||
; "_or"
|
||||
; "_and"
|
||||
; "_seq"
|
||||
; "_sne"
|
||||
; "_sge"
|
||||
; "_sgt"
|
||||
; "_sle"
|
||||
; "_slt"
|
||||
; "_mod"
|
||||
; "_neg"
|
||||
; "_not"
|
||||
; "puts"
|
||||
; "puti"
|
||||
; "geti"
|
||||
]
|
||||
;;
|
||||
|
||||
let native_asmdx = Func_t (Int_t, [ Int_t; Int_t ])
|
||||
let native_asmdfloat = Func_t (Float_t, [ Float_t; Float_t ])
|
||||
let native_eq = Func_t (Int_t, [ Int_t; Int_t ])
|
||||
let native_not = Func_t (Int_t, [ Int_t ])
|
||||
let native_neg = Func_t (Int_t, [ Int_t ])
|
||||
let native_puts = Func_t (Void_t, [ Str_t ])
|
||||
let native_puti = Func_t (Void_t, [ Int_t ])
|
||||
let native_geti = Func_t (Int_t, [])
|
||||
|
||||
let native_funcs =
|
||||
[ native_asmdx (* "_add" *)
|
||||
; native_asmdx (* "_sub" *)
|
||||
; native_asmdx (* "_mul" *)
|
||||
; native_asmdx (* "_div" *)
|
||||
; native_asmdfloat (* "_adds" *)
|
||||
; native_asmdfloat (* "_subs" *)
|
||||
; native_asmdfloat (* "_muls" *)
|
||||
; native_asmdfloat (* "_divs" *)
|
||||
; native_asmdx (* "_xor" *)
|
||||
; native_asmdx (* "_or" *)
|
||||
; native_asmdx (* "_and" *)
|
||||
; native_eq (* "_seq" *)
|
||||
; native_eq (* "_sne" *)
|
||||
; native_eq (* "_sge" *)
|
||||
; native_eq (* "_sgt" *)
|
||||
; native_eq (* "_sle" *)
|
||||
; native_eq (* "_slt" *)
|
||||
; native_asmdx (* "_mod" *)
|
||||
; native_neg (* "_neg" *)
|
||||
; native_not (* "_not" *)
|
||||
; native_puts (* "puts" *)
|
||||
; native_puti (* "puti" *)
|
||||
; native_geti (* "geti" *)
|
||||
]
|
||||
;;
|
||||
|
||||
let add_funcs env name func = Env.add name func env
|
||||
let _baselib_ = List.fold_left2 add_funcs Env.empty native_func_names native_funcs
|
||||
|
||||
open Mips
|
||||
|
||||
let builtins =
|
||||
[ Label "_add"
|
||||
; Lw (T0, Mem (SP, 0))
|
||||
; Lw (T1, Mem (SP, 4))
|
||||
; Add (V0, T0, T1)
|
||||
; Jr RA
|
||||
; Label "_sub"
|
||||
; Lw (T0, Mem (SP, 0))
|
||||
; Lw (T1, Mem (SP, 4))
|
||||
; Sub (V0, T0, T1)
|
||||
; Jr RA
|
||||
; Label "_div"
|
||||
; Lw (T0, Mem (SP, 0))
|
||||
; Lw (T1, Mem (SP, 4))
|
||||
; Div (V0, T0, T1)
|
||||
; Jr RA
|
||||
; Label "_mul"
|
||||
; Lw (T0, Mem (SP, 0))
|
||||
; Lw (T1, Mem (SP, 4))
|
||||
; Mul (V0, T0, T1)
|
||||
; Jr RA
|
||||
; Label "_adds"
|
||||
; Ls (F1, Mem (SP, 0))
|
||||
; Ls (F2, Mem (SP, 4))
|
||||
; Adds (F0, F1, F2)
|
||||
; Jr RA
|
||||
; Label "_subs"
|
||||
; Ls (F1, Mem (SP, 0))
|
||||
; Ls (F2, Mem (SP, 4))
|
||||
; Subs (F0, F1, F2)
|
||||
; Jr RA
|
||||
; Label "_divs"
|
||||
; Ls (F1, Mem (SP, 0))
|
||||
; Ls (F2, Mem (SP, 4))
|
||||
; Divs (F0, F1, F2)
|
||||
; Jr RA
|
||||
; Label "_muls"
|
||||
; Ls (F1, Mem (SP, 0))
|
||||
; Ls (F2, Mem (SP, 4))
|
||||
; Muls (F0, F1, F2)
|
||||
; Jr RA
|
||||
; Label "_xor"
|
||||
; Lw (T0, Mem (SP, 0))
|
||||
; Lw (T1, Mem (SP, 4))
|
||||
; Xor (V0, T0, T1)
|
||||
; Jr RA
|
||||
; Label "_or"
|
||||
; Lw (T0, Mem (SP, 0))
|
||||
; Lw (T1, Mem (SP, 4))
|
||||
; Or (V0, T0, T1)
|
||||
; Jr RA
|
||||
; Label "_and"
|
||||
; Lw (T0, Mem (SP, 0))
|
||||
; Lw (T1, Mem (SP, 4))
|
||||
; And (V0, T0, T1)
|
||||
; Jr RA
|
||||
; Label "_seq"
|
||||
; Lw (T0, Mem (SP, 0))
|
||||
; Lw (T1, Mem (SP, 4))
|
||||
; Seq (V0, T0, T1)
|
||||
; Jr RA
|
||||
; Label "_sne"
|
||||
; Lw (T0, Mem (SP, 0))
|
||||
; Lw (T1, Mem (SP, 4))
|
||||
; Sne (V0, T0, T1)
|
||||
; Jr RA
|
||||
; Label "_sge"
|
||||
; Lw (T0, Mem (SP, 0))
|
||||
; Lw (T1, Mem (SP, 4))
|
||||
; Sge (V0, T0, T1)
|
||||
; Jr RA
|
||||
; Label "_sgt"
|
||||
; Lw (T0, Mem (SP, 0))
|
||||
; Lw (T1, Mem (SP, 4))
|
||||
; Sgt (V0, T0, T1)
|
||||
; Jr RA
|
||||
; Label "_sle"
|
||||
; Lw (T0, Mem (SP, 0))
|
||||
; Lw (T1, Mem (SP, 4))
|
||||
; Sle (V0, T0, T1)
|
||||
; Jr RA
|
||||
; Label "_slt"
|
||||
; Lw (T0, Mem (SP, 0))
|
||||
; Lw (T1, Mem (SP, 4))
|
||||
; Slt (V0, T0, T1)
|
||||
; Jr RA
|
||||
; Label "_mod"
|
||||
; Lw (T0, Mem (SP, 0))
|
||||
; Lw (T1, Mem (SP, 4))
|
||||
; Div (V0, T0, T1)
|
||||
; Mfhi V0
|
||||
; Jr RA
|
||||
; Label "_not"
|
||||
; Lw (T0, Mem (SP, 0))
|
||||
; Seq (V0, T0, Zero)
|
||||
; Jr RA
|
||||
; Label "_neg"
|
||||
; Lw (T0, Mem (SP, 0))
|
||||
; Sub (V0, T0, Zero)
|
||||
; Jr RA
|
||||
; Label "puti"
|
||||
; Lw (A0, Mem (SP, 0))
|
||||
; Li (V0, Syscall.print_int)
|
||||
; Syscall
|
||||
; Jr RA
|
||||
; Label "geti"
|
||||
; Lw (A0, Mem (SP, 0))
|
||||
; Li (V0, Syscall.read_int)
|
||||
; Syscall
|
||||
; Jr RA
|
||||
; Label "puts"
|
||||
; Lw (A0, Mem (SP, 0))
|
||||
; Li (V0, Syscall.print_str)
|
||||
; Syscall
|
||||
; Jr RA
|
||||
]
|
||||
;;
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
#!/usr/bin/env sh
|
||||
|
||||
ocamlbuild -use-menhir test.byte
|
||||
./test.byte tests/$1.test > t.s
|
||||
# echo 'load "t.s"' | spim
|
||||
# spim
|
||||
cat <<EOF | spim
|
||||
load "t.s"
|
||||
run
|
||||
EOF
|
||||
|
|
@ -0,0 +1,140 @@
|
|||
open Mips
|
||||
open Ast.IR2
|
||||
module Env = Map.Make (String)
|
||||
|
||||
type cinfo =
|
||||
{ code : Mips.instr list
|
||||
; env : Mips.loc Env.t
|
||||
; fpo : int
|
||||
; counter : int
|
||||
; return : string
|
||||
}
|
||||
|
||||
let compile_v = function
|
||||
| Nil -> [ Li (V0, 0) ]
|
||||
| Bool b -> [ Li (V0, if b then 1 else 0) ]
|
||||
| Int n -> [ Li (V0, n) ]
|
||||
| Float f -> [ Lis (F0, f) ]
|
||||
| Char c -> [ Li (V0, int_of_char c) ]
|
||||
| Data l -> [ La (V0, Lbl l) ]
|
||||
|
||||
|
||||
let rec compile_expr e env =
|
||||
match e with
|
||||
| Value v -> compile_v v
|
||||
| Var v -> [ Lw (V0, Env.find v env) ]
|
||||
| Call (f, args) ->
|
||||
let ca =
|
||||
List.map
|
||||
(fun a -> compile_expr a env @ [ Addi (SP, SP, -4); Sw (V0, Mem (SP, 0)) ])
|
||||
args
|
||||
in
|
||||
List.flatten ca @ [ Jal f; Addi (SP, SP, 4 * List.length args) ]
|
||||
;;
|
||||
|
||||
let rec compile_instr i info =
|
||||
match i with
|
||||
| Decl v ->
|
||||
{ info with env = Env.add v (Mem (FP, -info.fpo)) info.env; fpo = info.fpo + 4 }
|
||||
| Return e ->
|
||||
{ info with code = info.code @ compile_expr e info.env @ [ B info.return ] }
|
||||
| Expr e -> { info with code = info.code @ compile_expr e info.env }
|
||||
| Assign (lv, e) ->
|
||||
{ info with
|
||||
code =
|
||||
(info.code
|
||||
@ compile_expr e info.env
|
||||
@
|
||||
match lv with
|
||||
| Var v -> [ Sw (V0, Env.find v info.env) ]
|
||||
| _ -> failwith "WTF???")
|
||||
}
|
||||
(* | LVar v -> [ Sw (V0, Env.find v info.env) ] *)
|
||||
(* | LAddr a -> [] *)
|
||||
(* @ [ Addi (SP, SP, -4) *)
|
||||
(* ; Sw (V0, Mem (SP, 0)) ] *)
|
||||
(* @ compile_expr a info.env *)
|
||||
(* @ [ Lw (T0, Mem (SP, 0)) *)
|
||||
(* ; Addi (SP, SP, 4) *)
|
||||
(* ; Sw (T0, Mem (V0, 0)) ]) } *)
|
||||
| Cond (c, t, e) ->
|
||||
let uniq = string_of_int info.counter in
|
||||
let ct = compile_block t { info with code = []
|
||||
; counter = info.counter + 1 } in
|
||||
let ce = compile_block e { info with code = []
|
||||
; counter = ct.counter } in
|
||||
{ info with
|
||||
code = info.code
|
||||
@ compile_expr c info.env
|
||||
@ [ Beqz (V0, "else" ^ uniq) ]
|
||||
@ ct.code
|
||||
@ [ B ("endif" ^ uniq)
|
||||
; Label ("else" ^ uniq) ]
|
||||
@ ce.code
|
||||
@ [ Label ("endif" ^ uniq) ]
|
||||
; counter = ce.counter }
|
||||
| Loop (c, t) ->
|
||||
let uniq = string_of_int info.counter in
|
||||
let ct = compile_block t { info with code = []
|
||||
; counter = info.counter + 1 } in
|
||||
{ info with
|
||||
code = info.code
|
||||
@ [ Label ("loop" ^ uniq) ]
|
||||
@ compile_expr c info.env
|
||||
@ [ Beqz (V0, "endloop" ^ uniq) ]
|
||||
@ ct.code
|
||||
@ [ J ("loop" ^ uniq) ]
|
||||
@ [ Label ("endloop" ^ uniq) ]
|
||||
; counter = ct.counter }
|
||||
|
||||
and compile_block b info =
|
||||
match b with
|
||||
| [] -> info
|
||||
| i :: r -> compile_block r (compile_instr i info)
|
||||
;;
|
||||
|
||||
let compile_def (Func (name, args, b)) counter =
|
||||
let cb =
|
||||
compile_block
|
||||
b
|
||||
{ code = []
|
||||
; env =
|
||||
List.fold_left
|
||||
(fun e (i, a) -> Env.add a (Mem (FP, 4 * i)) e)
|
||||
Env.empty
|
||||
(List.mapi (fun i a -> i + 1, a) args)
|
||||
; fpo = 8
|
||||
; counter = counter + 1
|
||||
; return = "ret" ^ string_of_int counter
|
||||
}
|
||||
in
|
||||
( cb.counter
|
||||
, []
|
||||
@ [ Label name
|
||||
; Addi (SP, SP, -cb.fpo)
|
||||
; Sw (RA, Mem (SP, cb.fpo - 4))
|
||||
; Sw (FP, Mem (SP, cb.fpo - 8))
|
||||
; Addi (FP, SP, cb.fpo - 4)
|
||||
]
|
||||
@ cb.code
|
||||
@ [ Label cb.return
|
||||
; Addi (SP, SP, cb.fpo)
|
||||
; Lw (RA, Mem (FP, 0))
|
||||
; Lw (FP, Mem (FP, -4))
|
||||
; Jr RA
|
||||
] )
|
||||
;;
|
||||
|
||||
let rec compile_prog p counter =
|
||||
match p with
|
||||
| [] -> []
|
||||
| d :: r ->
|
||||
let new_counter, cd = compile_def d counter in
|
||||
cd @ compile_prog r new_counter
|
||||
;;
|
||||
|
||||
let compile (code, data) =
|
||||
{ text = Baselib.builtins @ compile_prog code 0
|
||||
; data = List.map (fun (l, s) -> l, Asciiz s) data
|
||||
}
|
||||
;;
|
||||
|
|
@ -0,0 +1,92 @@
|
|||
{
|
||||
open Lexing
|
||||
open Parser
|
||||
|
||||
exception Error of char
|
||||
exception ErrorStr of string
|
||||
let keywords =
|
||||
[
|
||||
("void", Lvoid_kw);
|
||||
("int", Lint_kw);
|
||||
("char", Lchar_kw);
|
||||
("float", Lfloat_kw);
|
||||
("bool", Lbool_kw);
|
||||
("return", Lreturn);
|
||||
("puts", Lputs);
|
||||
("puti", Lputi);
|
||||
("geti", Lgeti);
|
||||
("if", Lif);
|
||||
("else", Lelse);
|
||||
(* ("for", Lfor); *)
|
||||
(* ("do", Ldo); *)
|
||||
("while", Lwhile);
|
||||
(* ("break", Lbreak); *)
|
||||
(* ("continue", Lcontinue) *)
|
||||
]
|
||||
let find_kw s =
|
||||
match List.assoc_opt s keywords with
|
||||
| Some kw -> kw
|
||||
| None -> Lvar s
|
||||
}
|
||||
|
||||
let alpha = ['a'-'z' 'A'-'Z']
|
||||
let num = ['0'-'9']
|
||||
let numf = (num)+ '.' (num)+
|
||||
let identifier = alpha (alpha | num | '-' | '_')*
|
||||
let character = (_ | '\\'['a' 'b' 't' 'n' 'v' 'f' 'r' '0' '\\' '''])
|
||||
let boo = ("true" | "false")
|
||||
|
||||
|
||||
rule token = parse
|
||||
| eof { Lend }
|
||||
| [ ' ' '\t' ] { token lexbuf }
|
||||
| '\n' { Lexing.new_line lexbuf; token lexbuf }
|
||||
| "//" { comment lexbuf }
|
||||
| "/*" { multiline_comment lexbuf }
|
||||
| ('-')? numf as n { Lfloat (float_of_string n) }
|
||||
| ('-')? num+ as n { Lint (int_of_string n) }
|
||||
| boo as b { Lbool (bool_of_string b) }
|
||||
| "'" character"'" as c { Lchar c }
|
||||
| '"' { Lstr (str lexbuf) }
|
||||
| "(" { Lopar }
|
||||
| ")" { Lcpar }
|
||||
(* | "[" { Lob } *)
|
||||
(* | "]" { Lcb } *)
|
||||
| ";" { Lsc }
|
||||
| "*" { Lmul }
|
||||
| "+" { Ladd }
|
||||
| "/" { Ldiv }
|
||||
| "%" { Lmod }
|
||||
| "^" { Lxor }
|
||||
| "&" { Land }
|
||||
| "|" { Lor }
|
||||
| "-" { Lsub }
|
||||
| "=" { Lassign }
|
||||
| "==" { Leq }
|
||||
| "!=" { Lneq }
|
||||
| ">=" { Lge }
|
||||
| ">" { Lgt }
|
||||
| "<=" { Lle }
|
||||
| "<" { Llt }
|
||||
| "," { Lcomma }
|
||||
| "{" { Lobr }
|
||||
| "}" { Lcbr }
|
||||
| "!" { Lnot }
|
||||
| identifier as i { find_kw i }
|
||||
| _ as c { raise (Error c) }
|
||||
|
||||
and comment = parse
|
||||
| eof { Lend }
|
||||
| '\n' { Lexing.new_line lexbuf; token lexbuf }
|
||||
| _ { comment lexbuf }
|
||||
|
||||
and multiline_comment = parse
|
||||
| eof { Lend }
|
||||
| '\n' { Lexing.new_line lexbuf; multiline_comment lexbuf }
|
||||
| "*/" { token lexbuf }
|
||||
| _ { multiline_comment lexbuf }
|
||||
|
||||
and str = parse
|
||||
| eof { raise (ErrorStr "Unexpected EOF") }
|
||||
| '"' { "" }
|
||||
| _ as c { (String.make 1 c) ^ (str lexbuf) }
|
||||
|
|
@ -0,0 +1,147 @@
|
|||
type reg =
|
||||
| Zero
|
||||
| SP
|
||||
| RA
|
||||
| FP
|
||||
| V0
|
||||
| F0
|
||||
| F1
|
||||
| F2
|
||||
| A0
|
||||
| A1
|
||||
| T0
|
||||
| T1
|
||||
(* | FF *)
|
||||
|
||||
type label = string
|
||||
|
||||
type loc =
|
||||
| Lbl of label
|
||||
| Mem of reg * int
|
||||
|
||||
type instr =
|
||||
| Label of label
|
||||
| Li of reg * int
|
||||
| Lis of reg * float
|
||||
| La of reg * loc
|
||||
| Sw of reg * loc
|
||||
| Lw of reg * loc
|
||||
| Ls of reg * loc
|
||||
| Sb of reg * loc
|
||||
| Lb of reg * loc
|
||||
| Move of reg * reg
|
||||
| Addi of reg * reg * int
|
||||
| Add of reg * reg * reg
|
||||
| Sub of reg * reg * reg
|
||||
| Div of reg * reg * reg
|
||||
| Mflo of reg
|
||||
| Mfhi of reg
|
||||
| Xor of reg * reg * reg
|
||||
| Or of reg * reg * reg
|
||||
| Nor of reg * reg * reg
|
||||
| And of reg * reg * reg
|
||||
| Mul of reg * reg * reg
|
||||
| Seq of reg * reg * reg
|
||||
| Sne of reg * reg * reg
|
||||
| Sge of reg * reg * reg
|
||||
| Sgt of reg * reg * reg
|
||||
| Sle of reg * reg * reg
|
||||
| Slt of reg * reg * reg
|
||||
| Adds of reg * reg * reg
|
||||
| Subs of reg * reg * reg
|
||||
| Muls of reg * reg * reg
|
||||
| Divs of reg * reg * reg
|
||||
| Andi of reg * reg * int
|
||||
| Not of reg * reg
|
||||
| Syscall
|
||||
| B of label
|
||||
| Beqz of reg * label
|
||||
| Jal of label
|
||||
| Jr of reg
|
||||
| J of label
|
||||
|
||||
type directive =
|
||||
| Asciiz of string
|
||||
|
||||
type decl = label * directive
|
||||
|
||||
type asm = { text: instr list ; data: decl list }
|
||||
|
||||
module Syscall = struct
|
||||
let print_int = 1
|
||||
let print_str = 4
|
||||
let read_int = 5
|
||||
let read_str = 8
|
||||
let sbrk = 9
|
||||
end
|
||||
|
||||
let ps = Printf.sprintf (* alias raccourci *)
|
||||
|
||||
let fmt_reg = function
|
||||
| Zero -> "$zero"
|
||||
| SP -> "$sp"
|
||||
| FP -> "$fp"
|
||||
| RA -> "$ra"
|
||||
| V0 -> "$v0"
|
||||
| F0 -> "$f0"
|
||||
| F1 -> "$f1"
|
||||
| F2 -> "$f2"
|
||||
| A0 -> "$a0"
|
||||
| A1 -> "$a1"
|
||||
| T0 -> "$t0"
|
||||
| T1 -> "$t1"
|
||||
(* | FF -> "0x00ff" *)
|
||||
|
||||
let fmt_loc = function
|
||||
| Lbl (l) -> l
|
||||
| Mem (r, o) -> ps "%d(%s)" o (fmt_reg r)
|
||||
|
||||
let fmt_instr = function
|
||||
| Label (l) -> ps "%s:" l
|
||||
| Li (r, i) -> ps " li %s, %d" (fmt_reg r) i
|
||||
| Lis (r, i) -> ps " li.s %s, %f" (fmt_reg r) i
|
||||
| La (r, a) -> ps " la %s, %s" (fmt_reg r) (fmt_loc a)
|
||||
| Sw (r, a) -> ps " sw %s, %s" (fmt_reg r) (fmt_loc a)
|
||||
| Lw (r, a) -> ps " lw %s, %s" (fmt_reg r) (fmt_loc a)
|
||||
| Ls (r, a) -> ps " l.s %s, %s" (fmt_reg r) (fmt_loc a)
|
||||
| Sb (r, a) -> ps " sb %s, %s" (fmt_reg r) (fmt_loc a)
|
||||
| Lb (r, a) -> ps " lb %s, %s" (fmt_reg r) (fmt_loc a)
|
||||
| Move (rd, rs) -> ps " move %s, %s" (fmt_reg rd) (fmt_reg rs)
|
||||
| Addi (rd, rs, i) -> ps " addi %s, %s, %d" (fmt_reg rd) (fmt_reg rs) i
|
||||
| Add (rd, rs, rt) -> ps " add %s, %s, %s" (fmt_reg rd) (fmt_reg rs) (fmt_reg rt)
|
||||
| Sub (rd, rs, rt) -> ps " sub %s, %s, %s" (fmt_reg rd)(fmt_reg rt) (fmt_reg rs)
|
||||
| Div (rd, rs, rt) -> ps " div %s, %s, %s" (fmt_reg rd) (fmt_reg rt) (fmt_reg rs)
|
||||
| Mflo rd -> ps " mflo %s" (fmt_reg rd)
|
||||
| Mfhi rd -> ps " mfhi %s" (fmt_reg rd)
|
||||
| Xor (rd, rs, rt) -> ps " xor %s, %s, %s" (fmt_reg rd) (fmt_reg rs) (fmt_reg rt)
|
||||
| Or (rd, rs, rt) -> ps " or %s, %s, %s" (fmt_reg rd) (fmt_reg rs) (fmt_reg rt)
|
||||
| Nor (rd, rs, rt) -> ps " nor %s, %s, %s" (fmt_reg rd) (fmt_reg rs) (fmt_reg rt)
|
||||
| And (rd, rs, rt) -> ps " and %s, %s, %s" (fmt_reg rd) (fmt_reg rs) (fmt_reg rt)
|
||||
| Mul (rd, rs, rt) -> ps " mul %s, %s, %s" (fmt_reg rd) (fmt_reg rs) (fmt_reg rt)
|
||||
| Seq (rd, rs, rt) -> ps " seq %s, %s, %s" (fmt_reg rd) (fmt_reg rs) (fmt_reg rt)
|
||||
| Sne (rd, rs, rt) -> ps " sne %s, %s, %s" (fmt_reg rd) (fmt_reg rs) (fmt_reg rt)
|
||||
| Sge (rd, rt, rs) -> ps " sge %s, %s, %s" (fmt_reg rd) (fmt_reg rs) (fmt_reg rt)
|
||||
| Sgt (rd, rt, rs) -> ps " sgt %s, %s, %s" (fmt_reg rd) (fmt_reg rs) (fmt_reg rt)
|
||||
| Sle (rd, rt, rs) -> ps " sle %s, %s, %s" (fmt_reg rd) (fmt_reg rs) (fmt_reg rt)
|
||||
| Slt (rd, rt, rs) -> ps " slt %s, %s, %s" (fmt_reg rd) (fmt_reg rs) (fmt_reg rt)
|
||||
| Adds (rd, rt, rs) -> ps " add.s %s, %s, %s" (fmt_reg rd) (fmt_reg rs) (fmt_reg rt)
|
||||
| Subs (rd, rt, rs) -> ps " sub.s %s, %s, %s" (fmt_reg rd) (fmt_reg rs) (fmt_reg rt)
|
||||
| Muls (rd, rt, rs) -> ps " mul.s %s, %s, %s" (fmt_reg rd) (fmt_reg rs) (fmt_reg rt)
|
||||
| Divs (rd, rt, rs) -> ps " div.s %s, %s, %s" (fmt_reg rd) (fmt_reg rs) (fmt_reg rt)
|
||||
| Andi (rd, rs, i) -> ps " and %s, %s, %d" (fmt_reg rd) (fmt_reg rs) i
|
||||
| Not (rd, rs) -> ps " not %s, %s" (fmt_reg rd) (fmt_reg rs)
|
||||
| Syscall -> ps " syscall"
|
||||
| B (l) -> ps " b %s" l
|
||||
| Beqz (r, l) -> ps " beqz %s, %s" (fmt_reg r) l
|
||||
| Jal (l) -> ps " jal %s" l
|
||||
| Jr (r) -> ps " jr %s" (fmt_reg r)
|
||||
| J (l) -> ps " j %s" l
|
||||
|
||||
let fmt_dir = function
|
||||
| Asciiz (s) -> ps ".asciiz \"%s\"" s
|
||||
|
||||
let print_asm oc asm =
|
||||
Printf.fprintf oc ".text\n.globl main\n" ;
|
||||
List.iter (fun i -> Printf.fprintf oc "%s\n" (fmt_instr i)) asm.text ;
|
||||
Printf.fprintf oc "\n.data\n" ;
|
||||
List.iter (fun (l, d) -> Printf.fprintf oc "%s: %s\n" l (fmt_dir d)) asm.data
|
||||
|
|
@ -0,0 +1,217 @@
|
|||
%{
|
||||
open Ast
|
||||
open Ast.Syntax
|
||||
%}
|
||||
|
||||
%token <int> Lint
|
||||
%token <float> Lfloat
|
||||
%token <string> Lvar
|
||||
%token <string> Lchar
|
||||
%token <string> Lstr
|
||||
%token <bool> Lbool
|
||||
%token Lint_kw Lfloat_kw Lchar_kw Lvoid_kw Lbool_kw
|
||||
%token Ladd Lsub Lmul Ldiv Lmod Lxor Lor Land Leq Lneq Lge Lgt Lle Llt Lnot
|
||||
%token Lopar Lcpar Lputs Lputi Lgeti
|
||||
%token Lreturn Lassign Lsc Lend Lif Lelse Lwhile
|
||||
%token Lcomma Lobr Lcbr (* Lob Lcb *)
|
||||
|
||||
%left Ladd Lsub
|
||||
%left Lmul Ldiv
|
||||
%left Lmod Lxor Lor Land
|
||||
%left Leq Lneq Lge Lgt Lle Llt Lnot
|
||||
%left Lputs Lputi Lgeti Lrand
|
||||
|
||||
%start prog
|
||||
|
||||
%type <Ast.Syntax.prog> prog
|
||||
|
||||
%%
|
||||
|
||||
prog:
|
||||
| d = def; p = prog {
|
||||
d :: p
|
||||
}
|
||||
| Lend { [] }
|
||||
;
|
||||
|
||||
def:
|
||||
| t = typ; id = Lvar; Lopar; a = args; Lcpar; Lobr; b = block; Lcbr {
|
||||
Func { typ = t; name = id; args = a; block = b; pos = $startpos(t) }
|
||||
}
|
||||
;
|
||||
|
||||
arg:
|
||||
| t = typ; id = Lvar {
|
||||
t, id
|
||||
}
|
||||
;
|
||||
|
||||
args:
|
||||
| { [] }
|
||||
| a = arg { a :: [] }
|
||||
| a = arg; Lcomma; r = args {
|
||||
a :: r
|
||||
}
|
||||
;
|
||||
|
||||
block:
|
||||
| { [] }
|
||||
| Lreturn; e = expr; Lsc; b = block {
|
||||
Return { expr = e; pos = $startpos($1) }
|
||||
:: b
|
||||
}
|
||||
| v = Lvar; Lassign; e = expr; Lsc; b = block {
|
||||
Assign { var = v; expr = e; pos = $startpos($2) }
|
||||
:: b
|
||||
}
|
||||
| t = typ; v = Lvar; Lsc; b = block {
|
||||
Decl { var = v; typ = t; pos = $startpos(t) }
|
||||
:: b
|
||||
}
|
||||
| t = typ; Lmul; v = Lvar; Lsc; b = block {
|
||||
Decl { var = v; typ = Point_t(t); pos = $startpos(t) }
|
||||
:: b
|
||||
}
|
||||
| t = typ; v = Lvar; Lassign; e = expr; Lsc; b = block {
|
||||
Decl { var = v; typ = t; pos = $startpos(t) }
|
||||
:: Assign { var = v; expr = e; pos = $startpos($3) }
|
||||
:: b
|
||||
}
|
||||
| e = expr; Lsc; b = block {
|
||||
Expr { expr = e; pos = $startpos(e) }
|
||||
:: b
|
||||
}
|
||||
| Lwhile; e = expr; Lobr; bl = block; Lcbr; b = block {
|
||||
Loop { expr = e; block = bl; pos = $startpos($1) }
|
||||
:: b
|
||||
}
|
||||
| c = cond; b = block {
|
||||
c :: b
|
||||
}
|
||||
;
|
||||
|
||||
cond:
|
||||
| Lif; e = expr; Lobr; bt = block; Lcbr {
|
||||
Cond { expr = e; blockt = bt; blockf = []; pos = $startpos($1) }
|
||||
}
|
||||
| Lif; e = expr; Lobr; bt = block; Lcbr; Lelse; Lobr; be = block; Lcbr {
|
||||
Cond { expr = e; blockt = bt; blockf = be; pos = $startpos($1) }
|
||||
}
|
||||
| Lif; e = expr; Lobr; bt = block; Lcbr; Lelse; bf = cond {
|
||||
Cond { expr = e; blockt = bt; blockf = [bf]; pos = $startpos($1) }
|
||||
}
|
||||
;
|
||||
|
||||
|
||||
par:
|
||||
| { [] }
|
||||
| e = expr {
|
||||
e :: []
|
||||
}
|
||||
| e = expr; Lcomma; p = par {
|
||||
e :: p
|
||||
}
|
||||
|
||||
expr:
|
||||
| Lopar; e = expr; Lcpar {
|
||||
e
|
||||
}
|
||||
| n = Lfloat {
|
||||
Float { value = n; pos = $startpos(n) }
|
||||
}
|
||||
| c = Lchar {
|
||||
Char { value = c; pos = $startpos(c) }
|
||||
}
|
||||
| s = Lstr {
|
||||
Str { value = s; pos = $startpos(s) }
|
||||
}
|
||||
| n = Lint {
|
||||
Int { value = n; pos = $startpos(n) }
|
||||
}
|
||||
| b = Lbool {
|
||||
Bool { value = b; pos = $startpos(b) }
|
||||
}
|
||||
| v = Lvar {
|
||||
Var { name = v; pos = $startpos(v) }
|
||||
}
|
||||
| id = Lvar; Lopar; p = par; Lcpar; {
|
||||
Call { func = id; args = p; pos = $startpos(id) }
|
||||
}
|
||||
| Lnot; a = expr; {
|
||||
Call { func = "_not"; args = [ a ]; pos = $startpos($1) }
|
||||
}
|
||||
| Lsub; a = expr; {
|
||||
Call { func = "_neg"; args = [ a ]; pos = $startpos($1) }
|
||||
}
|
||||
| a = expr; Lmul; b = expr {
|
||||
Call { func = "_mul"; args = [ a ; b ]; pos = $startpos($2) }
|
||||
}
|
||||
| a = expr; Ladd; b = expr {
|
||||
Call { func = "_add"; args = [ a ; b ]; pos = $startpos($2) }
|
||||
}
|
||||
| a = expr; Lsub; b = expr {
|
||||
Call { func = "_sub"; args = [ a ; b ]; pos = $startpos($2) }
|
||||
}
|
||||
| a = expr; Ldiv; b = expr {
|
||||
Call { func = "_div"; args = [ a ; b ]; pos = $startpos($2) }
|
||||
}
|
||||
| a = expr; Lmod; b = expr {
|
||||
Call { func = "_mod"; args = [ a ; b ]; pos = $startpos($2) }
|
||||
}
|
||||
| a = expr; n = nat; b = expr {
|
||||
Call { func = n; args = [ a ; b ]; pos = $startpos(n) }
|
||||
}
|
||||
| n = nat; Lopar; e = expr; Lcpar; {
|
||||
Call { func = n; args = [ e ]; pos = $startpos(n) }
|
||||
}
|
||||
| n = nat; Lopar; Lcpar; {
|
||||
Call { func = n; args = [ ]; pos = $startpos(n) }
|
||||
}
|
||||
;
|
||||
|
||||
nat:
|
||||
| Lxor {
|
||||
"_xor"
|
||||
}
|
||||
| Lor {
|
||||
"_or"
|
||||
}
|
||||
| Land {
|
||||
"_and"
|
||||
}
|
||||
| Lputs {
|
||||
"puts"
|
||||
}
|
||||
| Lputi {
|
||||
"puti"
|
||||
}
|
||||
| Lgeti {
|
||||
"geti"
|
||||
}
|
||||
| Lneq {
|
||||
"_sne"
|
||||
}
|
||||
| Leq {
|
||||
"_seq"
|
||||
}
|
||||
| Lge {
|
||||
"_sge"
|
||||
}
|
||||
| Lgt {
|
||||
"_sgt"
|
||||
}
|
||||
| Lle {
|
||||
"_sle"
|
||||
}
|
||||
| Llt {
|
||||
"_slt"
|
||||
}
|
||||
;
|
||||
|
||||
typ:
|
||||
| Lint_kw { Int_t }
|
||||
| Lchar_kw { Char_t }
|
||||
| Lfloat_kw { Float_t }
|
||||
| Lbool_kw { Bool_t }
|
||||
| Lvoid_kw { Void_t }
|
||||
;
|
||||
|
|
@ -0,0 +1,157 @@
|
|||
open Ast
|
||||
open Ast.IR
|
||||
open Baselib
|
||||
|
||||
exception Error of string * Lexing.position
|
||||
|
||||
(* fonctions d'aide à la gestion des erreurs *)
|
||||
|
||||
let expr_pos expr =
|
||||
match expr with
|
||||
| Syntax.Int n -> n.pos
|
||||
| Syntax.Float n -> n.pos
|
||||
| Syntax.Char c -> c.pos
|
||||
| Syntax.Str s -> s.pos
|
||||
| Syntax.Bool b -> b.pos
|
||||
| Syntax.Var v -> v.pos
|
||||
| Syntax.Call c -> c.pos
|
||||
;;
|
||||
|
||||
let errt expected given pos =
|
||||
raise
|
||||
(Error
|
||||
( Printf.sprintf
|
||||
"expected %s but given %s"
|
||||
(string_of_type_t expected)
|
||||
(string_of_type_t given)
|
||||
, pos ))
|
||||
;;
|
||||
|
||||
(* analyse sémantique *)
|
||||
|
||||
let rec analyze_expr expr env =
|
||||
match expr with
|
||||
| Syntax.Int n -> Int n.value, Int_t
|
||||
| Syntax.Float n -> Float n.value, Float_t (* TODO: Should be Float_t *)
|
||||
| Syntax.Char c -> Char c.value.[0], Char_t
|
||||
| Syntax.Str s -> Str s.value, Str_t
|
||||
| Syntax.Bool b -> Bool b.value, Bool_t
|
||||
| Syntax.Var va ->
|
||||
(match Env.find_opt va.name env with
|
||||
| Some v -> Var va.name, v
|
||||
| _ -> raise (Error (Printf.sprintf "unbound variable '%s'" va.name, va.pos)))
|
||||
| Syntax.Call c ->
|
||||
(match Env.find_opt c.func env with
|
||||
| Some (Func_t (rt, at)) ->
|
||||
if List.length at != List.length c.args
|
||||
then
|
||||
raise
|
||||
(Error
|
||||
( Printf.sprintf
|
||||
"expected %d arguments but given %d"
|
||||
(List.length at)
|
||||
(List.length c.args)
|
||||
, c.pos ));
|
||||
let args =
|
||||
List.map2
|
||||
(fun eat a ->
|
||||
let aa, at = analyze_expr a env in
|
||||
if at = eat then aa else errt eat at (expr_pos a))
|
||||
at
|
||||
c.args
|
||||
in
|
||||
Call (c.func, args), rt
|
||||
| Some _ -> raise (Error (Printf.sprintf "'%s' is not a function" c.func, c.pos))
|
||||
| None -> raise (Error (Printf.sprintf "undefined function '%s'" c.func, c.pos)))
|
||||
;;
|
||||
|
||||
let rec analyze_instr instr env =
|
||||
match instr with
|
||||
| Syntax.Assign a ->
|
||||
let t =
|
||||
match Env.find_opt a.var env with
|
||||
| Some ty -> ty
|
||||
| _ -> raise (Error (Printf.sprintf "undeclared variable '%s'" a.var, a.pos))
|
||||
in
|
||||
let ae, et = analyze_expr a.expr env in
|
||||
if t = et
|
||||
then Assign (a.var, ae), Env.add a.var et env
|
||||
else
|
||||
raise
|
||||
(Error
|
||||
( Printf.sprintf
|
||||
"changing type of variable '%s' %s -> %s"
|
||||
a.var
|
||||
(string_of_type_t t)
|
||||
(string_of_type_t et)
|
||||
, a.pos ))
|
||||
| Syntax.Decl d ->
|
||||
if Env.mem d.var env
|
||||
then raise (Error (Printf.sprintf "redefinition of '%s'" d.var, d.pos))
|
||||
else Decl d.var, Env.add d.var d.typ env
|
||||
| Syntax.Expr e ->
|
||||
let ae, t = analyze_expr e.expr env in
|
||||
Expr ae, env
|
||||
| Syntax.Return r ->
|
||||
let ae, _ = analyze_expr r.expr env in
|
||||
Return ae, env
|
||||
| Syntax.Cond c ->
|
||||
let ae, et = analyze_expr c.expr env in
|
||||
if et <> Int_t && et <> Bool_t
|
||||
then raise (Error (Printf.sprintf "not a boolean expression", c.pos))
|
||||
else (
|
||||
let abt, nenv = analyze_block c.blockt env in
|
||||
let abf, new_env = analyze_block c.blockf nenv in
|
||||
Cond (ae, abt, abf), new_env)
|
||||
| Syntax.Loop l ->
|
||||
let ae, et = analyze_expr l.expr env in
|
||||
if et <> Int_t && et <> Bool_t
|
||||
then raise (Error (Printf.sprintf "not a boolean expression", l.pos))
|
||||
else (
|
||||
let ab, nenv = analyze_block l.block env in
|
||||
Loop (ae, ab), nenv)
|
||||
|
||||
and analyze_block block env =
|
||||
match block with
|
||||
| [] -> [], env
|
||||
| instr :: rest ->
|
||||
let ai, new_env = analyze_instr instr env in
|
||||
let ab, nenv = analyze_block rest new_env in
|
||||
ai :: ab, nenv
|
||||
;;
|
||||
|
||||
let rec add_arg_env args env =
|
||||
match args with
|
||||
| [] -> env
|
||||
| (ty, arg) :: rest -> add_arg_env rest (Env.add arg ty env)
|
||||
;;
|
||||
|
||||
let rec analyze_def def env =
|
||||
match def with
|
||||
| Syntax.Func f ->
|
||||
if Env.mem f.name env
|
||||
then raise (Error (Printf.sprintf "redefinition of function '%s'" f.name, f.pos))
|
||||
else (
|
||||
let at, args = List.split f.args in
|
||||
let nenv = add_arg_env f.args (Env.add f.name (Func_t (f.typ, at)) env) in
|
||||
let b, new_env = analyze_block f.block nenv in
|
||||
Func (f.name, args, b), Env.add f.name (Func_t (f.typ, at)) env)
|
||||
;;
|
||||
|
||||
let print_env key v = print_endline (key ^ " " ^ string_of_type_t v)
|
||||
|
||||
let rec analyze_prog defs env =
|
||||
match defs with
|
||||
| [] -> [], env
|
||||
| def :: rest ->
|
||||
let ad, new_env = analyze_def def env in
|
||||
let ap, nenv = analyze_prog rest new_env in
|
||||
ad :: ap, nenv
|
||||
;;
|
||||
|
||||
let analyze parsed =
|
||||
let a, env = analyze_prog parsed Baselib._baselib_ in
|
||||
(* Env.iter print_env env; *)
|
||||
(* print_endline ("a" ^ " " ^ (string_of_type_t (Env.find "a" env))); *)
|
||||
a
|
||||
;;
|
||||
|
|
@ -0,0 +1,77 @@
|
|||
open Ast
|
||||
module Env = Map.Make (String)
|
||||
|
||||
let collect_constant_strings code =
|
||||
let counter = ref 0 in
|
||||
let env = ref Env.empty in
|
||||
let rec ccs_expr = function
|
||||
| IR.Void -> IR2.Value (IR2.Nil), []
|
||||
| IR.Bool b -> IR2.Value (IR2.Bool b), []
|
||||
| IR.Int n -> IR2.Value (IR2.Int n), []
|
||||
| IR.Char c -> IR2.Value (IR2.Char c), []
|
||||
| IR.Float f -> IR2.Value (IR2.Float f), []
|
||||
| IR.Str s ->
|
||||
(match Env.find_opt s !env with
|
||||
| Some l -> IR2.Value (IR2.Data l), []
|
||||
| None ->
|
||||
incr counter;
|
||||
let l = "str" ^ string_of_int !counter in
|
||||
env := Env.add s l !env;
|
||||
IR2.Value (IR2.Data l), [ l, s ])
|
||||
| IR.Var v -> IR2.Var v, []
|
||||
| IR.Call (f, args) ->
|
||||
let args2 = List.map ccs_expr args in
|
||||
let ccs = List.flatten (List.map (fun (_, s) -> s) args2) in
|
||||
IR2.Call (f, List.map (fun (e, _) -> e) args2), ccs
|
||||
in
|
||||
(* let ccs_lvalue = function *)
|
||||
(* | IR.LVar v -> *)
|
||||
(* IR2.LVar v, [] *)
|
||||
(* | IR.LAddr a -> *)
|
||||
(* let a2, ccs = ccs_expr a in *)
|
||||
(* IR2.LAddr a2, ccs *)
|
||||
(* in *)
|
||||
let rec ccs_instr = function
|
||||
| IR.Decl v -> IR2.Decl v, []
|
||||
| IR.Return e ->
|
||||
let e2, ccs = ccs_expr e in
|
||||
IR2.Return e2, ccs
|
||||
| IR.Expr e ->
|
||||
let e2, ccs = ccs_expr e in
|
||||
IR2.Expr e2, ccs
|
||||
| IR.Assign (lv, e) ->
|
||||
let lv2, ccs_lv = ccs_expr (IR.Var lv) in
|
||||
let e2, ccs_e = ccs_expr e in
|
||||
IR2.Assign (lv2, e2), List.flatten [ ccs_lv; ccs_e ]
|
||||
| IR.Cond (t, y, n) ->
|
||||
let t2, ccs_t = ccs_expr t in
|
||||
let y2, ccs_y = ccs_block y in
|
||||
let n2, ccs_n = ccs_block n in
|
||||
IR2.Cond (t2, y2, n2), List.flatten [ ccs_t; ccs_y; ccs_n ]
|
||||
| IR.Loop (e, b) ->
|
||||
let e2, ccs_e = ccs_expr e in
|
||||
let b2, ccs_b = ccs_block b in
|
||||
IR2.Loop (e2, b2), List.flatten [ ccs_e; ccs_b ]
|
||||
and ccs_block = function
|
||||
| [] -> [], []
|
||||
| i :: r ->
|
||||
let i2, ccs_i = ccs_instr i in
|
||||
let r2, ccs_r = ccs_block r in
|
||||
i2 :: r2, List.flatten [ ccs_i; ccs_r ]
|
||||
in
|
||||
let ccs_def = function
|
||||
| IR.Func (name, args, body) ->
|
||||
let body2, ccs = ccs_block body in
|
||||
IR2.Func (name, args, body2), ccs
|
||||
in
|
||||
let rec ccs_prog = function
|
||||
| [] -> [], []
|
||||
| d :: r ->
|
||||
let d2, ccs_d = ccs_def d in
|
||||
let r2, ccs_r = ccs_prog r in
|
||||
d2 :: r2, List.flatten [ ccs_d; ccs_r ]
|
||||
in
|
||||
ccs_prog code
|
||||
;;
|
||||
|
||||
let simplify code = collect_constant_strings code
|
||||
|
|
@ -0,0 +1,39 @@
|
|||
(* ocamlbuild -use-menhir test.byte *)
|
||||
|
||||
open Lexing
|
||||
open Ast
|
||||
open Ast.IR
|
||||
|
||||
let err msg pos =
|
||||
Printf.eprintf
|
||||
"Error on line %d col %d: %s.\n"
|
||||
pos.pos_lnum
|
||||
(pos.pos_cnum - pos.pos_bol)
|
||||
msg;
|
||||
exit 1
|
||||
;;
|
||||
|
||||
let () =
|
||||
if Array.length Sys.argv != 2
|
||||
then (
|
||||
Printf.eprintf "Usage: %s <file>\n" Sys.argv.(0);
|
||||
exit 1);
|
||||
let f = open_in Sys.argv.(1) in
|
||||
let buf = Lexing.from_channel f in
|
||||
try
|
||||
let parsed = Parser.prog Lexer.token buf in
|
||||
close_in f;
|
||||
let ast = Semantics.analyze parsed in
|
||||
let simplified = Simplifier.simplify ast in
|
||||
(* print_endline (IR.string_of_ir ast); *)
|
||||
let compiled = Compiler.compile simplified in
|
||||
Mips.print_asm Stdlib.stdout compiled
|
||||
(* print_endline (IR.string_of_ir ast) *)
|
||||
with
|
||||
| Match_failure (m, _, _) -> Printf.eprintf "Vous devez compléter le module %s.\n" m
|
||||
| Lexer.Error c ->
|
||||
err (Printf.sprintf "unrecognized char '%c'" c) (Lexing.lexeme_start_p buf)
|
||||
| Parser.Error -> err "syntax error" (Lexing.lexeme_start_p buf)
|
||||
| Semantics.Error (msg, pos) -> err msg pos
|
||||
| _ -> failwith "WTF?"
|
||||
;;
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
1312
|
||||
# fichier vide
|
||||
|
|
@ -0,0 +1 @@
|
|||
return 1312;
|
||||
|
|
@ -0,0 +1,7 @@
|
|||
char a = 'A';
|
||||
a = 'B';
|
||||
char b;
|
||||
b = 'a';
|
||||
/* b = 1; // it should fail */
|
||||
int c = 1 + 10;
|
||||
return a;
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
int main(int argc, char argv)
|
||||
{
|
||||
int c = 1;
|
||||
return 0;
|
||||
}
|
||||
|
||||
int add(int a, int b)
|
||||
{
|
||||
/* int d = c; // should fail */
|
||||
return a + b;
|
||||
}
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
int add(int a, int b)
|
||||
{
|
||||
return a + b;
|
||||
}
|
||||
|
||||
int main()
|
||||
{
|
||||
int a = 12;
|
||||
return a;
|
||||
}
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
int add(int a, int b)
|
||||
{
|
||||
return a + b;
|
||||
}
|
||||
|
||||
int main()
|
||||
{
|
||||
int a; // test of scope
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
|
@ -0,0 +1,15 @@
|
|||
int foo(int a, int b)
|
||||
{
|
||||
return a + b;
|
||||
}
|
||||
|
||||
int main()
|
||||
{
|
||||
int a = 1;
|
||||
int b = 2;
|
||||
foo(a, b);
|
||||
int c = foo(a,b);
|
||||
bool f = true;
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
|
@ -0,0 +1,12 @@
|
|||
int foo(int a, int b)
|
||||
{
|
||||
return a + b;
|
||||
}
|
||||
|
||||
int main()
|
||||
{
|
||||
int a = geti();
|
||||
int b = geti();
|
||||
puti(foo(a, b));
|
||||
return 0;
|
||||
}
|
||||
|
|
@ -0,0 +1,13 @@
|
|||
int add_int(int a, int b)
|
||||
{
|
||||
return a + b;
|
||||
}
|
||||
|
||||
int main()
|
||||
{
|
||||
int a = 2;
|
||||
int b = 2;
|
||||
|
||||
puti(a + 5 * b);
|
||||
return 0;
|
||||
}
|
||||
|
|
@ -0,0 +1,12 @@
|
|||
int main()
|
||||
{
|
||||
int a = 3;
|
||||
int b = 4;
|
||||
if (a == b) {
|
||||
puts("true");
|
||||
} else {
|
||||
puts("false");
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
|
@ -0,0 +1,24 @@
|
|||
int main()
|
||||
{
|
||||
int b = 5;
|
||||
char a = 'a';
|
||||
bool c = true;
|
||||
float fp = 123.123;
|
||||
while (c) {
|
||||
b = b - 1;
|
||||
puti(b);
|
||||
puts("\n");
|
||||
if (b <= 0) {
|
||||
c = false;
|
||||
} else if (b == 1) {
|
||||
puts("elif1\n");
|
||||
} else if (b == 2) {
|
||||
puts("elif2\n");
|
||||
} else if (b == 3) {
|
||||
puts("elif3\n");
|
||||
}
|
||||
}
|
||||
puts("false\n");
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
|
@ -0,0 +1,12 @@
|
|||
int main()
|
||||
{
|
||||
int a = -1;
|
||||
if (1) {
|
||||
puts("yep\n");
|
||||
puti(-(a + 1));
|
||||
puts("\n");
|
||||
}
|
||||
puti(!0);
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
|
@ -0,0 +1 @@
|
|||
return 21 * 2;
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
int main()
|
||||
{
|
||||
if (!1) {
|
||||
puts("1\n");
|
||||
}
|
||||
if (!0) {
|
||||
puts("2\n");
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
|
@ -0,0 +1 @@
|
|||
x = 42;
|
||||
|
|
@ -0,0 +1,7 @@
|
|||
x = -42;
|
||||
/*rsiaters
|
||||
iaresnies
|
||||
arisetn
|
||||
airsetn
|
||||
*/
|
||||
return x;
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
x = 500 + 150 + 6;
|
||||
y = x * 2;
|
||||
return y;
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
x = 2 * (2 + 6) + 2;
|
||||
y = x * 2;
|
||||
return y;
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
x = 2.0 * (2.2 + 6.1) + 2.1;
|
||||
#y = x * 2;
|
||||
return x;
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
x = 'A';
|
||||
x = '\'';
|
||||
return x;
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
a = "Hello, world!";
|
||||
b = "";
|
||||
return a;
|
||||
|
|
@ -0,0 +1,23 @@
|
|||
// NOTE: DO NOT TEST WITH build.sh because geti (input)
|
||||
void guessing_game(int n)
|
||||
{
|
||||
int x = 4; // no syscall for rand in spim -_-
|
||||
int res = -1;
|
||||
while (res != x) {
|
||||
puts("Guess the number\n");
|
||||
res = geti();
|
||||
if (res < x) {
|
||||
puts("Too little\n");
|
||||
} else if (res > x) {
|
||||
puts("Too big\n");
|
||||
}
|
||||
}
|
||||
puts("Bravo, you guessed!\n");
|
||||
}
|
||||
|
||||
int main()
|
||||
{
|
||||
puts("Hello, enter a max for guessing game\n");
|
||||
guessing_game(10);
|
||||
return 0;
|
||||
}
|
||||
|
|
@ -0,0 +1,18 @@
|
|||
int fact(int n)
|
||||
{
|
||||
int result;
|
||||
if (n == 0) {
|
||||
result = 1;
|
||||
} else {
|
||||
result = n * fact((n - 1));
|
||||
}
|
||||
return result;
|
||||
}
|
||||
|
||||
int main()
|
||||
{
|
||||
puts("\n");
|
||||
puti(fact(12));
|
||||
puts("\n");
|
||||
return 0;
|
||||
}
|
||||
|
|
@ -0,0 +1,23 @@
|
|||
int puiss(int n, int x)
|
||||
{
|
||||
int res = 1;
|
||||
if (n == 0) {
|
||||
return res;
|
||||
}
|
||||
if (n == 1) {
|
||||
return x;
|
||||
}
|
||||
while (n > 0) {
|
||||
res = res * x;
|
||||
n = n - 1;
|
||||
}
|
||||
return res;
|
||||
}
|
||||
|
||||
int main()
|
||||
{
|
||||
int x = 3;
|
||||
int n = 5;
|
||||
puti(puiss(x,n)); // 3 ^ 5
|
||||
return 0;
|
||||
}
|
||||
|
|
@ -0,0 +1,7 @@
|
|||
int main()
|
||||
{
|
||||
if (1) {
|
||||
puts("Hello, world!");
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
Loading…
Reference in New Issue