Commit bb778ca1 authored by Armillon Damien's avatar Armillon Damien
Browse files

use builtins lib

parent 71894415
......@@ -28,4 +28,4 @@ test: main.native
make -C tests
testFun: main.native
make -C tests DIR=custom/*.e
\ No newline at end of file
make -C tests DIR=funcall/*.e
\ No newline at end of file
tokens SYM_EOF SYM_IDENTIFIER<string> SYM_INTEGER<int> SYM_PLUS SYM_MINUS SYM_ASTERISK SYM_DIV SYM_MOD
tokens SYM_LPARENTHESIS SYM_RPARENTHESIS SYM_LBRACE SYM_RBRACE
tokens SYM_ASSIGN SYM_SEMICOLON SYM_RETURN SYM_IF SYM_WHILE SYM_ELSE SYM_COMMA SYM_PRINT
tokens SYM_ASSIGN SYM_SEMICOLON SYM_RETURN SYM_IF SYM_WHILE SYM_ELSE SYM_COMMA
tokens SYM_EQUALITY SYM_NOTEQ SYM_LT SYM_LEQ SYM_GT SYM_GEQ
non-terminals S INSTR INSTRS LINSTRS ELSE EXPR FACTOR
non-terminals LPARAMS REST_PARAMS
......@@ -51,7 +51,6 @@ INSTR -> SYM_IDENTIFIER IN_INSTR {$2 $1}
INSTR -> SYM_IF SYM_LPARENTHESIS EXPR SYM_RPARENTHESIS BLOC ELSE {Node(Tif, $3::$5::$6)}
INSTR -> SYM_WHILE SYM_LPARENTHESIS EXPR SYM_RPARENTHESIS BLOC {Node(Twhile, [$3;$5])}
INSTR -> SYM_RETURN EXPR SYM_SEMICOLON {Node(Treturn, [$2])}
INSTR -> SYM_PRINT SYM_LPARENTHESIS EXPR SYM_RPARENTHESIS SYM_SEMICOLON {Node(Tprint, [$3])}
ELSE -> SYM_ELSE BLOC {[$2]}
ELSE -> {[]}
EXPR -> EQ_EXPR EQ_EXPRS {resolve_associativity $1 $2}
......
......@@ -25,16 +25,23 @@ let rec eval_cfgexpr oc cp st (e: expr) : (int * int Prog.state) res =
| None -> Error (Printf.sprintf "Unknown variable %s\n" s)
end
| Ecall(name,el) ->
let* f = find_function cp name in
let* (params, st) = List.fold_left (fun acc expr ->
let* (expr_list,st) = acc in
let* (new_expr, st) = eval_cfgexpr oc cp st expr in
OK(expr_list@[new_expr], st)
) (OK([],st)) el in
let* (i,st) = eval_cfgfun cp oc st name f params in
match i with
| None -> Error (Printf.sprintf "Error while runing %s" name)
| Some(i) -> OK(i,st)
match find_function cp name with
| OK f ->
let* (i,st) = eval_cfgfun cp oc st name f params in
(match i with
| None -> Error (Printf.sprintf "Error while runing %s" name)
| Some(i) -> OK(i,st))
| Error _ ->
let* ret = do_builtin oc st.mem name params in
(match ret with
| Some n -> OK(n, st)
| None -> OK(0, st))
and eval_cfginstr cp oc st ht (n: int): (int * int state) res =
match Hashtbl.find_option ht n with
......@@ -57,17 +64,32 @@ and eval_cfginstr cp oc st ht (n: int): (int * int state) res =
let* (e, st) = eval_cfgexpr oc cp st e in
Format.fprintf oc "%d\n" e;
eval_cfginstr cp oc st ht succ
| Ccall(name, el, s) ->
let* f = find_function cp name in
| Ccall(name, el, succ) ->
let* (params, st) = List.fold_left (fun acc expr ->
let* (expr_list,st) = acc in
let* (new_expr, st) = eval_cfgexpr oc cp st expr in
OK(expr_list@[new_expr], st)
) (OK([],st)) el in
let* (i,st) = eval_cfgfun cp oc st name f params in
match i with
| None -> Error (Printf.sprintf "Error while runing %s" name)
| Some(i) -> OK(i,st)
match find_function cp name with
| OK f ->
let* f = find_function cp name in
let* (i,st) = eval_cfgfun cp oc st name f params in
(match i with
| None -> Error (Printf.sprintf "Error while runing %s" name)
| Some(i) -> OK(i,st))
| Error _ ->
match find_function cp name with
| OK f ->
let* (res,st) = eval_cfgfun cp oc st name f params in
(match res with
| Some(n) -> OK(n, st)
| None -> Error (Format.sprintf "Error with function %s" name))
| Error _ ->
let* ret = do_builtin oc st.mem name params in
(match ret with
| Some n -> OK(n, st)
| None -> eval_cfginstr cp oc st ht succ)
......
......@@ -91,9 +91,7 @@ let rec make_einstr_of_ast (a: tree) : instr res =
| _ -> []
) in
list_map_res (fun e -> make_eexpr_of_ast e) args_list >>= fun args_expr ->
(match name with
| "print" when List.length args_expr = 1 -> OK(Iprint(List.hd args_expr))
| _ -> OK (Icall(name, args_expr)))
OK (Icall(name, args_expr))
| Node(t, e1::i1::i2) when t = Tif ->
make_eexpr_of_ast e1 >>= fun expr1 ->
......
......@@ -53,12 +53,18 @@ let rec eval_eexpr oc (ep: eprog) st (e : expr) : (int * int Prog.state) res =
let* (expr_l, st) = acc in
let* (arg_expr, st) = eval_eexpr oc ep st expr in
OK(expr_l@[arg_expr], st)
) (OK([], st)) expr_list in
let* f = find_function ep name in
let* (res,st) = eval_efun oc ep st f name args in
match res with
| Some(n) -> OK(n, st)
| None -> Error (Format.sprintf "Error with function %s" name)
) (OK([], st)) expr_list in
match find_function ep name with
| OK f ->
let* (res,st) = eval_efun oc ep st f name args in
(match res with
| Some(n) -> OK(n, st)
| None -> Error (Format.sprintf "Error with function %s" name))
| Error _ ->
let* ret = do_builtin oc st.mem name args in
match ret with
| Some n -> OK(n, st)
| None -> Error (Format.sprintf "Error: %s doesn't return anything" name)
(* [eval_einstr oc st ins] évalue l'instrution [ins] en partant de l'état [st].
......@@ -119,8 +125,11 @@ and eval_einstr oc (ep: eprog) (st: int state) (ins: instr) :
let* (arg_expr, st) = eval_eexpr oc ep st expr in
OK(expr_l@[arg_expr], st)
) (OK([], st)) expr_list in
let* f = find_function ep name in
eval_efun oc ep st f name args
match find_function ep name with
| OK f -> eval_efun oc ep st f name args
| Error _ ->
let* ret = do_builtin oc st.mem name args in
OK (ret, st)
(* [eval_efun oc st f fname vargs] évalue la fonction [f] (dont le nom est
......
......@@ -61,14 +61,18 @@ let rec exec_linear_instr oc lp fname f st (i: rtl_instr) =
end
| Rlabel n -> OK (None, st)
| Rcall (rs,name,regl) ->
let* f' = find_function lp name in
let params = List.map (Hashtbl.find st.regs) regl in
let* (v,st) = exec_linear_fun oc lp st name f' params in
if Option.is_some rs then
match v with
| Some v -> let rs = Option.get rs in Hashtbl.replace st.regs rs v; OK (None,st)
| None ->Error (Printf.sprintf "function %s return nothing can't assign in (%s)" name (print_reg (Option.get rs)))
else OK (None,st)
match find_function lp name with
| OK f' ->
let* (v,st) = exec_linear_fun oc lp st name f' params in
if Option.is_some rs then
match v with
| Some v -> let rs = Option.get rs in Hashtbl.replace st.regs rs v; OK (None,st)
| None ->Error (Printf.sprintf "function %s return nothing can't assign in (%s)" name (print_reg (Option.get rs)))
else OK (None,st)
| Error _ ->
let* ret = do_builtin oc st.mem name params in
OK(ret,st)
and exec_linear_instr_at oc lp fname ({ linearfunbody; } as f) st i =
let l = List.drop_while (fun x -> x <> Rlabel i) linearfunbody in
......
......@@ -78,14 +78,19 @@ let rec exec_rtl_instr oc rp rtlfunname f st (i: rtl_instr) =
end
| Rlabel n -> OK (None, st)
| Rcall (rs,name,regl) ->
let* f' = find_function rp name in
let params = List.map (Hashtbl.find st.regs) regl in
let* (v,st) = exec_rtl_fun oc rp st name f' params in
if Option.is_some rs then
match v with
| Some v -> let rs = Option.get rs in Hashtbl.replace st.regs rs v; OK (None,st)
| None ->Error (Printf.sprintf "function %s return nothing can't assign in (%s)" name (print_reg (Option.get rs)))
else OK (None,st)
match find_function rp name with
| OK f' ->
let* (v,st) = exec_rtl_fun oc rp st name f' params in
if Option.is_some rs then
match v with
| Some v -> let rs = Option.get rs in Hashtbl.replace st.regs rs v; OK (None,st)
| None ->Error (Printf.sprintf "function %s return nothing can't assign in (%s)" name (print_reg (Option.get rs)))
else OK (None,st)
| Error _ ->
let* ret = do_builtin oc st.mem name params in
OK(ret,st)
and exec_rtl_instr_at oc rp rtlfunname ({ rtlfunbody; } as f: rtl_fun) st i =
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment