change some variables names so its more readable
This commit is contained in:
parent
9ab686c96e
commit
fa06482e72
7 changed files with 63 additions and 55 deletions
|
@ -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) ])
|
||||
|
|
|
@ -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
|
||||
|
|
10
lexer.mll
10
lexer.mll
|
@ -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") }
|
||||
|
|
4
main.ml
4
main.ml
|
@ -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
|
||||
;;
|
||||
|
|
30
parser.mly
30
parser.mly
|
@ -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 }
|
||||
}
|
||||
;
|
||||
|
|
62
semantics.ml
62
semantics.ml
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Reference in a new issue