change some variables names so its more readable

This commit is contained in:
Mylloon 2022-12-27 17:07:24 +01:00
parent 9ab686c96e
commit fa06482e72
Signed by: Anri
GPG key ID: A82D63DFF8D1317F
7 changed files with 63 additions and 55 deletions

View file

@ -24,12 +24,12 @@ let rec compile_expr env = function
| Val v -> compile_value v
| Var v -> [ Lw (V0, Env.find v env) ]
| Call (f, args) ->
let ca =
let compiled_args =
List.map
(fun a -> compile_expr env a @ [ Addi (SP, SP, -4); Sw (V0, Mem (SP, 0)) ])
args
in
List.flatten ca
List.flatten compiled_args
@ (if Env.mem f Baselib.builtins
then Env.find f Baselib.builtins
else [ Jal (puf ^ f) ])

View file

@ -1,9 +1,9 @@
open Ast
open Lexing
exception LexerError of char
exception LexerErrorC of char
exception LexerErrorS of string
exception SemanticsError of string * Lexing.position
exception SyntaxError of string
let err msg pos =
Printf.eprintf

View file

@ -41,12 +41,12 @@ rule token = parse
| "<=" { Lsle }
| "<" { Lslt }
| "!=" { Lsne }
| '&' { Land }
| '|' { Lor }
| "&&" { Land }
| "||" { Lor }
| '"' { read_string (Buffer.create 16) lexbuf }
| ident as i { Lvar i }
| '#' { comment lexbuf }
| _ as c { raise (LexerError c) }
| _ as c { raise (LexerErrorC c) }
and comment = parse
| eof { Lend }
@ -59,5 +59,5 @@ and read_string buffer = parse
| [^ '"' '\\']+ { Buffer.add_string buffer (Lexing.lexeme lexbuf)
; read_string buffer lexbuf
}
| _ as c { raise (LexerError c) }
| eof { raise (SyntaxError "String is not terminated") }
| _ as c { raise (LexerErrorC c) }
| eof { raise (LexerErrorS "String is not terminated") }

View file

@ -16,9 +16,9 @@ let () =
let asm = Compiler.compile (Simplifier.simplify ast) in
Mips.emit Stdlib.stdout asm
with
| LexerError c ->
| LexerErrorC c ->
err (Printf.sprintf "Unrecognized char \"%c\"" c) (Lexing.lexeme_start_p buf)
| SyntaxError s -> err (Printf.sprintf "%s" s) (Lexing.lexeme_start_p buf)
| LexerErrorS s -> err (Printf.sprintf "%s" s) (Lexing.lexeme_start_p buf)
| Parser.Error -> err "Syntax error" (Lexing.lexeme_start_p buf)
| SemanticsError (msg, pos) -> err msg pos
;;

View file

@ -27,7 +27,7 @@
prog:
/* Liste des définitions de fonction */
| i = def ; b = prog { i @ b }
| f = def ; b = prog { f @ b }
/* Fin de programme */
| Lend { [] }
@ -43,8 +43,8 @@ def:
}
arg:
/* type a */
| t = Ltype ; a = Lvar { Arg { type_t = t ; name = a } }
/* type v */
| t = Ltype ; v = Lvar { Arg { type_t = t ; name = v } }
block:
/* { */
@ -63,19 +63,19 @@ instr:
/* return; */
| Lreturn ; Lsc {
[ Return { expr = Val { value = Void ; pos = $startpos }
[ Return { expr = Val { value = Void ; pos = $startpos($2) }
; pos = $startpos } ]
}
/* type v; */
| t = Ltype ; v = Lvar ; Lsc {
[ Decl { name = v ; type_t = t ; pos = $startpos(t) } ]
[ Decl { name = v ; type_t = t ; pos = $startpos } ]
}
/* 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) } ]
{ [ Decl { name = v ; type_t = t ; pos = $startpos(v) }
; Assign { var = v ; expr = e ; pos = $startpos($3) } ]
}
/* v = e; */
@ -106,27 +106,27 @@ instr:
expr:
/* -int */
| Lsub ; n = Lint {
Val { value = Int (-n) ; pos = $startpos(n) }
Val { value = Int (-n) ; pos = $startpos }
}
/* int */
| n = Lint {
Val { value = Int (n) ; pos = $startpos(n) }
Val { value = Int (n) ; pos = $startpos }
}
/* bool */
| b = Lbool {
Val { value = Bool (b) ; pos = $startpos(b) }
Val { value = Bool (b) ; pos = $startpos }
}
/* string */
| s = Lstr {
Val { value = Str (s) ; pos = $startpos(s) }
Val { value = Str (s) ; pos = $startpos }
}
/* Variable */
| v = Lvar {
Var { name = v ; pos = $startpos(v) }
Var { name = v ; pos = $startpos }
}
/* e + e */
@ -185,17 +185,17 @@ expr:
}
/* e && e */
| a = expr ; Land ; Land ; b = expr {
| a = expr ; Land ; b = expr {
Call { func = "%and" ; args = [ a ; b ] ; pos = $startpos($2) }
}
/* e || e */
| a = expr ; Lor ; Lor ; b = expr {
| a = expr ; Lor ; b = expr {
Call { func = "%or" ; args = [ a ; b ] ; pos = $startpos($2) }
}
/* function(...) */
| f = Lvar ; Lpardeb ; a = separated_list(Lcomma, expr) ; Lparfin {
Call { func = f ; args = a ; pos = $startpos(a) }
Call { func = f ; args = a ; pos = $startpos }
}
;

View file

@ -13,9 +13,10 @@ let analyze_value = function
let rec analyze_expr env ua t = function
| Syntax.Val v ->
let v2, new_t = analyze_value v.value in
if (not (List.mem new_t t)) && not (List.mem Magic_t t) then errt t [ new_t ] v.pos;
Val v2, new_t
let checked_value, new_t = analyze_value v.value in
if not (List.exists (fun t2 -> List.mem t2 [ new_t; Magic_t ]) t)
then errt t [ new_t ] v.pos;
Val checked_value, new_t
| Syntax.Var v ->
if not (Env.mem v.name env)
then raise (SemanticsError ("Unbound variable \"" ^ v.name ^ "\"", v.pos));
@ -27,33 +28,34 @@ let rec analyze_expr env ua t = function
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 (not (List.mem ret_t t)) && not (List.mem Magic_t t) then errt [ ret_t ] t c.pos;
if List.length tl != List.length c.args
| Func_t (ret_t, t_list) ->
if not (List.exists (fun t2 -> List.mem t2 [ ret_t; Magic_t ]) t)
then errt [ ret_t ] t c.pos;
if List.length t_list != List.length c.args
then
raise
(SemanticsError
( Printf.sprintf
"Function \"%s\" expects %d arguments but %d was given"
c.func
(List.length tl)
(List.length t_list)
(List.length c.args)
, c.pos ));
let args =
List.map2
(fun tt e ->
let e2, t2 = analyze_expr env ua [ tt ] e in
if t2 = tt
(fun t2 e ->
let e2, new_t = analyze_expr env ua [ t2 ] e in
if new_t = t2
then e2
else
errt
[ tt ]
[ t2 ]
[ new_t ]
(match e with
| Syntax.Val v -> v.pos
| Syntax.Var v -> v.pos
| Syntax.Call c -> c.pos))
tl
t_list
c.args
in
Call (c.func, args), ret_t
@ -65,11 +67,11 @@ let rec analyze_instr env ua ret_t = function
| Syntax.Assign a ->
if not (Env.mem a.var env)
then raise (SemanticsError ("Unbound variable \"" ^ a.var ^ "\"", a.pos));
let ae, _ = 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 checked_expr, _ = analyze_expr env ua [ Env.find a.var env ] a.expr in
Assign (a.var, checked_expr), env, List.filter (fun x -> x <> a.var) ua
| Syntax.Do d ->
let ae, _ = analyze_expr env ua [ Magic_t ] d.expr in
Do ae, env, []
let checked_expr, _ = analyze_expr env ua [ Magic_t ] d.expr in
Do checked_expr, env, []
| Syntax.Cond c ->
let cond, _ = analyze_expr env ua [ Bool_t; Int_t ] c.expr in
let if_b, _ = analyze_block env ua Magic_t c.pos c.if_b in
@ -80,8 +82,8 @@ let rec analyze_instr env ua ret_t = function
let block, _ = analyze_block env ua Magic_t l.pos l.block in
Loop (cond, block), env, []
| Syntax.Return r ->
let ae, _ = analyze_expr env ua [ ret_t ] r.expr in
Return ae, env, []
let checked_expr, _ = analyze_expr env ua [ ret_t ] r.expr in
Return checked_expr, env, []
and analyze_block env ua ret_t pos = function
| [] ->
@ -89,12 +91,12 @@ and analyze_block env ua ret_t pos = function
then warn "Non-void function without return" pos;
[], ua
| instr :: new_block ->
let new_instr, new_env, ua1 = analyze_instr env ua ret_t instr in
let new_instr, new_env, new_ua = analyze_instr env ua ret_t instr in
(match new_instr with
| Return _ -> [ new_instr ], ua1
| Return _ -> [ new_instr ], new_ua
| _ ->
let new_block, ua2 = analyze_block new_env ua1 ret_t pos new_block in
new_instr :: new_block, ua2)
let new_block, new_ua2 = analyze_block new_env new_ua ret_t pos new_block in
new_instr :: new_block, new_ua2)
;;
let analyze_func env ua = function
@ -138,14 +140,20 @@ let analyze_func env ua = function
env )
;;
let rec analyze_prog env ua b default = function
let rec analyze_prog env ua default = function
| [] ->
if b
if fst default
then []
else raise (SemanticsError ("No " ^ default ^ " function", Lexing.dummy_pos))
else raise (SemanticsError ("No " ^ snd default ^ " function", Lexing.dummy_pos))
| fn :: suite ->
let fn, new_env = analyze_func env ua fn in
fn :: analyze_prog new_env ua (if b then b else Env.mem default new_env) default suite
let main_lbl = snd default in
fn
:: analyze_prog
new_env
ua
(if fst default then default else Env.mem main_lbl new_env, main_lbl)
suite
;;
let analyze parsed = analyze_prog _types_ [] false "main" parsed
let analyze parsed = analyze_prog _types_ [] (false, "main") parsed

View file

@ -2,7 +2,7 @@ open Ast
open Baselib
let collect_constant_strings code =
let counter = ref (-1) in
let counter = ref 0 in
let env = ref Env.empty in
let ccs_value = function
| V1.Void -> V2.Void, []
@ -12,9 +12,9 @@ let collect_constant_strings code =
(match Env.find_opt s !env with
| Some lbl -> V2.Data lbl, [ lbl, Mips.Asciiz s ]
| None ->
incr counter;
let lbl = "str" ^ string_of_int !counter in
env := Env.add s lbl !env;
incr counter;
V2.Data lbl, [ lbl, Mips.Asciiz s ])
in
let rec ccs_expr = function