Paris8/compilateurMIPS
Archived
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

wip

Browse source
This commit is contained in:
Mylloon 2022-12-16 13:01:48 +01:00
parent dc2122e5f8
commit b7d092e03e
Signed by: Anri
GPG key ID: A82D63DFF8D1317F
11 changed files with 124 additions and 28 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

24
ast.ml
View file

@ -5,17 +5,19 @@ type type_t =
| Bool_t
| Str_t
| Func_t of type_t * type_t list
| Ptr_t of type_t
type ident = string
module Syntax = struct
type ident = string
type value =
| Void
| Int of int
| Bool of bool
| Str of string
| Ptr of expr
type expr =
and expr =
| Val of
{ value : value
; pos : Lexing.position
@ -30,6 +32,10 @@ module Syntax = struct
; pos : Lexing.position
}
type lval =
| Name of ident
| Addr of expr
type instr =
| Decl of
{ name : ident
@ -37,7 +43,7 @@ module Syntax = struct
; pos : Lexing.position
}
| Assign of
{ var : ident
{ lval : lval
; expr : expr
; pos : Lexing.position
}
@ -93,6 +99,7 @@ module V1 = struct
| Int of int
| Bool of bool
| Str of string
| Ptr of int
end
module V2 = struct
@ -101,19 +108,22 @@ module V2 = struct
| Int of int
| Bool of bool
| Data of string
| Ptr of int
end
module IR (P : Parameters) = struct
type ident = string
type expr =
| Val of P.value
| Var of ident
| Call of ident * expr list
type lval =
| Name of ident
| Addr of expr
type instr =
| Decl of ident
| Assign of ident * expr
| Assign of lval * expr
| Do of expr
| Cond of expr * block * block
| Loop of expr * block

4
baselib.ml
View file

@ -16,6 +16,8 @@ let _types_ =
; "puti", Func_t (Void_t, [ Int_t ])
; "puts", Func_t (Void_t, [ Str_t ])
; "geti", Func_t (Int_t, [])
; "alloc", Func_t (Ptr_t Magic_t, [ Int_t ])
; "%deref", Func_t (Magic_t, [ Ptr_t Magic_t ])
])
;;
@ -54,5 +56,7 @@ let builtins uniq =
; "puti", [ Lw (A0, Mem (SP, 0)); Li (V0, Syscall.print_int); Syscall ]
; "puts", [ Lw (A0, Mem (SP, 0)); Li (V0, Syscall.print_str); Syscall ]
; "geti", [ Lw (A0, Mem (SP, 0)); Li (V0, Syscall.read_int); Syscall ]
; "alloc", [ Lw (A0, Mem (SP, 0)); Li (V0, Syscall.sbrk); Syscall ]
; "%deref", [ Lw (T0, Mem (SP, 0)); Lw (A0, Mem (T0, 0)); Syscall ]
]
;;

14
compiler.ml
View file

@ -19,6 +19,7 @@ let compile_value = function
| Int n -> [ Li (V0, n) ]
| Bool b -> [ Li (V0, if b then 1 else 0) ]
| Data l -> [ La (V0, Lbl l) ]
| Ptr p -> [ Li (V0, p) ]
;;
let rec compile_expr env = function
@ -47,9 +48,18 @@ let rec compile_expr env = function
let rec compile_instr info = function
| Decl v ->
{ info with env = Env.add v (Mem (FP, -info.fpo)) info.env; fpo = info.fpo + 4 }
| Assign (v, e) ->
| Assign (lv, e) ->
{ info with
asm = info.asm @ compile_expr info.env e @ [ Sw (V0, Env.find v info.env) ]
asm =
(info.asm
@ compile_expr info.env e
@
match lv with
| Name v -> [ Sw (V0, Env.find v info.env) ]
| Addr e ->
[ Addi (SP, SP, -4); Sw (V0, Mem (SP, 0)) ]
@ compile_expr info.env e
@ [ Lw (T0, Mem (SP, 0)); Addi (SP, SP, 4); Sw (T0, Mem (V0, 0)) ])
}
| Cond (e, ib, eb) ->
let uniq = string_of_int info.cnt in

1
errors.ml
View file

@ -26,6 +26,7 @@ let rec string_of_type_t = function
^ (if List.length a > 1 then ")" else "")
^ " -> "
^ string_of_type_t r
| Ptr_t t -> "*" ^ string_of_type_t t
;;
let errt expected given pos =

2
lexer.mll
View file

@ -32,7 +32,7 @@ rule token = parse
| ';' { Lsc }
| '+' { Ladd }
| '-' { Lsub }
| '*' { Lmul }
| '*' { Lstar }
| '/' { Ldiv }
| '<' { Lsmaller }
| '>' { Lbigger }

2
main.ml
View file

@ -10,7 +10,7 @@ let () =
try
let parsed = Parser.prog Lexer.token buf in
close_in f;
(* Test.debug_parser Stdlib.stderr parsed; *)
Test.debug_parser Stdlib.stderr parsed;
let ast = Semantics.analyze parsed in
(* Test.debug_semantics Stdlib.stderr ast; *)
let asm = Compiler.compile (Simplifier.simplify ast) in

32
parser.mly
View file

@ -11,10 +11,10 @@
%token Lend Lassign Lsc Lreturn
%token Lbracedeb Lbracefin
%token Lpardeb Lparfin Lcomma
%token Ladd Lsub Lmul Ldiv Lbigger Lsmaller Leq Lneq
%token Ladd Lsub Lstar Ldiv Lbigger Lsmaller Leq Lneq
%token Lif Lelse Lwhile
%left Ladd Lsub Lmul Ldiv Lbigger Lsmaller Leq Lneq
%left Ladd Lsub Lstar Ldiv Lbigger Lsmaller Leq Lneq
%left Lbracedeb Lparfin Lbracefin Lreturn
%left Ltype Lbool Lint Lvar Lstr
@ -94,20 +94,37 @@ instr:
; pos = $startpos } ]
}
/* type *v; */
| t = Ltype ; Lstar ; v = Lvar ; Lsc {
[ Decl { name = v ; type_t = Ptr_t t ; pos = $startpos(t) } ]
}
/* type v; */
| t = Ltype ; v = Lvar ; Lsc {
[ Decl { name = v ; type_t = t ; pos = $startpos(t) } ]
}
/* type *v = e; */
| t = Ltype ; Lstar ; v = Lvar ; Lassign ; e = expr ; Lsc
{ [ Decl { name = v ; type_t = Ptr_t t ; pos = $startpos(t) }
; Assign { lval = Name v ; expr = e ; pos = $startpos(v) } ]
}
/* type v = e; */
| t = Ltype ; v = Lvar ; Lassign ; e = expr ; Lsc
{ [ Decl { name = v ; type_t = t ; pos = $startpos(t) }
; Assign { var = v ; expr = e ; pos = $startpos(v) } ]
; Assign { lval = Name v ; expr = e ; pos = $startpos(v) } ]
}
/* *v = e; */
| Lstar; v = Lvar ; Lassign ; e = expr ; Lsc {
[ Assign { lval = Addr (Var { name = v ; pos = $startpos(v) })
; expr = e
; pos = $startpos(e) } ]
}
/* v = e; */
| v = Lvar ; Lassign ; e = expr ; Lsc {
[ Assign { var = v ; expr = e ; pos = $startpos($2) } ]
[ Assign { lval = Name v ; expr = e ; pos = $startpos($2) } ]
}
/* e; */
@ -162,7 +179,7 @@ expr:
}
/* e * e */
| a = expr ; Lmul ; b = expr {
| a = expr ; Lstar ; b = expr {
Call { func = "%mul" ; args = [ a ; b ] ; pos = $startpos($2) }
}
@ -191,6 +208,11 @@ expr:
Call { func = "%neq" ; args = [ a ; b ] ; pos = $startpos($2) }
}
/* *e */
| Lstar; a = expr {
Call { func = "%deref" ; args = [ a ] ; pos = $startpos }
}
/* function(a */
| f = Lvar ; Lpardeb ; a = args_expr {
Call { func = f ; args = a ; pos = $startpos(a) }

36
semantics.ml
View file

@ -4,31 +4,38 @@ open Ast.V1
open Baselib
open Errors
let analyze_value = function
let rec analyze_value = function
| Syntax.Void -> Void, Void_t
| Syntax.Int n -> Int n, Int_t
| Syntax.Bool b -> Bool b, Bool_t
| Syntax.Str s -> Str s, Str_t
| Syntax.Ptr v ->
let v2, t = analyze_value v in
Ptr 0, Ptr_t t
;;
let rec analyze_expr env ua t = function
| Syntax.Val v ->
let v2, new_t = analyze_value v.value in
if new_t != t && t != Magic_t then errt t new_t v.pos;
(match t with
| Ptr_t t2 -> if new_t != t && t2 != Magic_t then errt t new_t v.pos
| _ -> if new_t != t && t != Magic_t then errt t new_t v.pos);
Val v2, new_t
| Syntax.Var v ->
if not (Env.mem v.name env)
then raise (SemanticsError ("Unbound variable \"" ^ v.name ^ "\"", v.pos));
if List.mem v.name ua then warn ("Unassigned variable \"" ^ v.name ^ "\"") v.pos;
let new_t = Env.find v.name env in
if new_t != t then errt t new_t v.pos;
if new_t != t && t != Magic_t then errt t new_t v.pos;
Var v.name, new_t
| Syntax.Call c ->
if not (Env.mem c.func env)
then raise (SemanticsError ("Unbound function \"" ^ c.func ^ "\"", c.pos));
(match Env.find c.func env with
| Func_t (ret_t, tl) ->
if ret_t != t && t != Magic_t then errt ret_t t c.pos;
(match ret_t with
| Ptr_t t2 -> if ret_t != t && t2 != Magic_t then errt ret_t t c.pos
| _ -> if ret_t != t && t != Magic_t then errt ret_t t c.pos);
if List.length tl != List.length c.args
then
raise
@ -63,10 +70,23 @@ let rec analyze_expr env ua t = function
let rec analyze_instr env ua ret_t = function
| Syntax.Decl d -> Decl d.name, Env.add d.name d.type_t env, [ d.name ] @ ua
| Syntax.Assign a ->
if not (Env.mem a.var env)
then raise (SemanticsError ("Unbound variable \"" ^ a.var ^ "\"", a.pos));
let ae, et = analyze_expr env ua (Env.find a.var env) a.expr in
Assign (a.var, ae), env, List.filter (fun x -> x <> a.var) ua
let var, t =
match a.lval with
| Name i -> i, Env.find i env
| Addr e ->
let ae, t = analyze_expr env ua Magic_t e in
(match ae with
| Var v ->
( v
, (match t with
| Ptr_t t -> t
| _ -> raise (SemanticsError ("Something went wrong", a.pos))) )
| _ -> raise (SemanticsError ("Can't assign to this address", a.pos)))
in
if not (Env.mem var env)
then raise (SemanticsError ("Unbound variable \"" ^ var ^ "\"", a.pos));
let ae, et = analyze_expr env ua t a.expr in
Assign (Name var, ae), env, List.filter (fun x -> x <> var) ua
| Syntax.Do d ->
let ae, _ = analyze_expr env ua Magic_t d.expr in
Do ae, env, []

14
simplifier.ml
View file

@ -4,7 +4,7 @@ open Baselib
let collect_constant_strings code =
let counter = ref (-1) in
let env = ref Env.empty in
let ccs_value = function
let rec ccs_value = function
| V1.Void -> V2.Void, []
| V1.Bool b -> V2.Bool b, []
| V1.Int n -> V2.Int n, []
@ -16,6 +16,9 @@ let collect_constant_strings code =
let lbl = "str" ^ string_of_int !counter in
env := Env.add s lbl !env;
V2.Data lbl, [ lbl, Mips.Asciiz s ])
| V1.Ptr p ->
let v2, ccs = ccs_value p in
V2.Ptr v2, [] @ ccs
in
let rec ccs_expr = function
| IR1.Val v ->
@ -26,11 +29,18 @@ let collect_constant_strings code =
let args2 = List.map ccs_expr args in
IR2.Call (fn, List.map fst args2), List.flatten (List.map snd args2)
in
let ccs_lval = function
| IR1.Name v -> IR2.Name v, []
| IR1.Addr e ->
let e2, ccs = ccs_expr e in
IR2.Addr e2, ccs
in
let rec ccs_instr = function
| IR1.Decl v -> IR2.Decl v, []
| IR1.Assign (lv, e) ->
let lv2, ccs2 = ccs_lval lv in
let e2, ccs = ccs_expr e in
IR2.Assign (lv, e2), ccs
IR2.Assign (lv2, e2), ccs @ ccs2
| IR1.Do e ->
let e2, ccs = ccs_expr e in
IR2.Do e2, ccs

16
test.ml
View file

@ -9,14 +9,18 @@ let debug_parser oc parsed =
| Syntax.Int d -> "Int " ^ string_of_int d
| Syntax.Bool d -> "Bool " ^ string_of_bool d
| Syntax.Str s -> "Str \"" ^ s ^ "\""
| Syntax.Ptr t -> "*" ^ fmt_v t
and fmt_e = function
| Syntax.Val d -> "Val (" ^ fmt_v d.value ^ ")"
| Syntax.Var d -> "Var \"" ^ d.name ^ "\""
| Syntax.Call d ->
"Call (\"" ^ d.func ^ "\", [ " ^ String.concat " ; " (List.map fmt_e d.args) ^ " ])"
and fmt_lv = function
| Syntax.Name n -> "Name(\"" ^ n ^ "\")"
| Syntax.Addr e -> "Addr(" ^ fmt_e e ^ ")"
and fmt_i = function
| Syntax.Decl d -> "Decl(" ^ string_of_type_t d.type_t ^ ") \"" ^ d.name ^ "\""
| Syntax.Assign d -> "Assign (\"" ^ d.var ^ "\", " ^ fmt_e d.expr ^ ")"
| Syntax.Assign d -> "Assign (" ^ fmt_lv d.lval ^ ", " ^ fmt_e d.expr ^ ")"
| Syntax.Do d -> "Do (" ^ fmt_e d.expr ^ ")"
| Syntax.Cond c ->
"Cond (" ^ fmt_e c.expr ^ ", " ^ fmt_b c.if_b ^ ", " ^ fmt_b c.else_b ^ ")"
@ -50,6 +54,7 @@ let debug_semantics oc ast =
| Int n -> "Int " ^ string_of_int n
| Bool b -> "Bool " ^ string_of_bool b
| Str s -> "Str \"" ^ s ^ "\""
| Ptr p -> "Ptr of " ^ fmt_v p
and fmt_e = function
| Val v -> "Val (" ^ fmt_v v ^ ")"
| Var v -> "Var \"" ^ v ^ "\""
@ -57,7 +62,14 @@ let debug_semantics oc ast =
"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 ^ ")"
| Assign (lv, e) ->
"Assign (\""
^ (match lv with
| Name v -> v
| Addr e -> fmt_e e)
^ "\", "
^ fmt_e e
^ ")"
| Do e -> "Do (" ^ fmt_e e ^ ")"
| Cond (c, i, e) -> "Cond (" ^ fmt_e c ^ ", " ^ fmt_b i ^ ", " ^ fmt_b e ^ ")"
| Loop (c, b) -> "Loop (" ^ fmt_e c ^ ", " ^ fmt_b b ^ ")"

7
tests/34_alloc.test Normal file
View file

@ -0,0 +1,7 @@
void main () {
int *a = alloc(8);
*a = 4;
puti(a);
puts(" - ");
puti(*a);
}