Small fixes to the compilation processes.
*Locations should be pretty damn good now. *Mlsc is up to date, still need a scoping pass (to be posted soon)
This commit is contained in:
Léonard Gérard
Léonard Gérard
parent
e3a03806e4
commit
418b961293
11 changed files with 183 additions and 171 deletions
|
|
@ -98,31 +98,33 @@ let output_location oc (Loc(p1,p2)) =
|
|||
else
|
||||
Printf.fprintf oc "File \"%s\", line %d, characters %d-%d:\n" f1 l1 n1 n2;
|
||||
(* Output source code *)
|
||||
let ic = open_in f1 in
|
||||
try
|
||||
let ic = open_in f1 in
|
||||
|
||||
if l1 == l2 then (
|
||||
(* Only one line : copy full line and underline *)
|
||||
seek_in ic lp1;
|
||||
copy_lines 1 ic oc ">";
|
||||
underline_line ic oc '^' lp1 n1 n2 )
|
||||
else (
|
||||
underline_line ic oc '.' lp1 0 n1; (* dots until n1 *)
|
||||
seek_in ic np1;
|
||||
(* copy the end of the line l1 after the dots *)
|
||||
copy_lines 1 ic oc "";
|
||||
if l2 - l1 <= 8 then
|
||||
(* copy the 6 or less middle lines *)
|
||||
copy_lines (l2-l1-1) ic oc ">"
|
||||
if l1 == l2 then (
|
||||
(* Only one line : copy full line and underline *)
|
||||
seek_in ic lp1;
|
||||
copy_lines 1 ic oc ">";
|
||||
underline_line ic oc '^' lp1 n1 n2 )
|
||||
else (
|
||||
(* sum up the middle lines to 6 *)
|
||||
copy_lines 3 ic oc ">";
|
||||
output_string oc "..........\n";
|
||||
skip_lines (l2-l1-7) ic; (* skip middle lines *)
|
||||
copy_lines 3 ic oc ">"
|
||||
);
|
||||
output_string oc ">";
|
||||
copy_chunk lp2 np2 ic oc; (* copy interesting begining of l2 *)
|
||||
);
|
||||
underline_line ic oc '.' lp1 0 n1; (* dots until n1 *)
|
||||
seek_in ic np1;
|
||||
(* copy the end of the line l1 after the dots *)
|
||||
copy_lines 1 ic oc "";
|
||||
if l2 - l1 <= 8 then
|
||||
(* copy the 6 or less middle lines *)
|
||||
copy_lines (l2-l1-1) ic oc ">"
|
||||
else (
|
||||
(* sum up the middle lines to 6 *)
|
||||
copy_lines 3 ic oc ">";
|
||||
output_string oc "..........\n";
|
||||
skip_lines (l2-l1-7) ic; (* skip middle lines *)
|
||||
copy_lines 3 ic oc ">"
|
||||
);
|
||||
output_string oc ">";
|
||||
copy_chunk lp2 np2 ic oc; (* copy interesting begining of l2 *)
|
||||
)
|
||||
with Sys_error _ -> ();
|
||||
output_char oc '\n'
|
||||
end;
|
||||
|
||||
|
|
|
|||
|
|
@ -29,10 +29,11 @@ let check_implementation modname filename =
|
|||
|
||||
(* Parsing of the file *)
|
||||
let p = parse_implementation lexbuf in
|
||||
comment "Parsing";
|
||||
|
||||
(* Convert the parse tree to Heptagon AST *)
|
||||
let p = Hept_scoping.translate_program p in
|
||||
comment "Parsing";
|
||||
comment "Scoping";
|
||||
pp p;
|
||||
|
||||
(* Call the compiler*)
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
(* Organization : Demons, LRI, University of Paris-Sud, Orsay *)
|
||||
(* *)
|
||||
(**************************************************************************)
|
||||
(* the internal representation *)
|
||||
|
||||
|
||||
open Names
|
||||
open Location
|
||||
|
|
|
|||
|
|
@ -11,7 +11,7 @@
|
|||
open Misc
|
||||
open Location
|
||||
open Compiler_utils
|
||||
open Hept_compiler
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
@ -35,27 +35,31 @@ let compile_impl modname filename =
|
|||
init_compiler modname;
|
||||
add_include (Filename.dirname filename);
|
||||
|
||||
(* Set pretty printer to the Heptagon one *)
|
||||
let pp = Hept_compiler.pp in
|
||||
|
||||
(* Parsing of the file *)
|
||||
let p = parse_implementation lexbuf in
|
||||
let p = Hept_compiler.parse_implementation lexbuf in
|
||||
let p = { p with Hept_parsetree.p_modname = modname } in
|
||||
comment "Parsing";
|
||||
|
||||
(* Convert the parse tree to Heptagon AST *)
|
||||
let p = Hept_scoping.translate_program p in
|
||||
comment "Parsing";
|
||||
|
||||
comment "Scoping";
|
||||
pp p;
|
||||
|
||||
(* Process the Heptagon AST *)
|
||||
let p = Hept_compiler.compile_impl pp p in
|
||||
Modules.write itc;
|
||||
|
||||
(* Set pretty printer to the Minils one *)
|
||||
let pp = Mls_compiler.pp in
|
||||
|
||||
(* Compile Heptagon to MiniLS *)
|
||||
let p = Hept2mls.program p in
|
||||
|
||||
let pp = Mls_printer.print stdout in
|
||||
comment "Translation into MiniLs";
|
||||
Mls_printer.print mlsc p;
|
||||
if !Misc.verbose then pp p;
|
||||
comment "Translation into MiniLs";
|
||||
pp p;
|
||||
|
||||
(* Process the MiniLS AST *)
|
||||
let p = Mls_compiler.compile pp p in
|
||||
|
|
@ -91,7 +95,7 @@ let main () =
|
|||
"-noinit", Arg.Clear init, doc_noinit;
|
||||
"-fti", Arg.Set full_type_info, doc_full_type_info;
|
||||
]
|
||||
(compile compile_impl)
|
||||
(Hept_compiler.compile compile_impl)
|
||||
errmsg;
|
||||
with
|
||||
| Misc.Error -> exit 2;;
|
||||
|
|
|
|||
|
|
@ -19,13 +19,13 @@ open Location
|
|||
open Printf
|
||||
|
||||
(** Error Kind *)
|
||||
type err_kind = | Etypeclash of ct * ct
|
||||
type error_kind = | Etypeclash of ct * ct
|
||||
|
||||
let err_message exp = function
|
||||
let error_message loc = function
|
||||
| Etypeclash (actual_ct, expected_ct) ->
|
||||
Printf.eprintf "%aClock Clash: this expression has clock %a, \n\
|
||||
but is expected to have clock %a.\n"
|
||||
print_exp exp
|
||||
output_location loc
|
||||
print_clock actual_ct
|
||||
print_clock expected_ct;
|
||||
raise Error
|
||||
|
|
@ -93,7 +93,9 @@ and typing_op op args h e ck = match op, args with
|
|||
and expect h expected_ty e =
|
||||
let actual_ty = typing h e in
|
||||
try unify actual_ty expected_ty
|
||||
with | Unify -> err_message e (Etypeclash (actual_ty, expected_ty))
|
||||
with
|
||||
| Unify -> eprintf "e %a : " print_exp e;
|
||||
error_message e.e_loc (Etypeclash (actual_ty, expected_ty))
|
||||
|
||||
and typing_c_e_list h ck_c n c_e_list =
|
||||
let rec typrec =
|
||||
|
|
@ -109,15 +111,15 @@ let rec typing_pat h =
|
|||
| Etuplepat pat_list -> Cprod (List.map (typing_pat h) pat_list)
|
||||
|
||||
let typing_eqs h eq_list = (*TODO FIXME*)
|
||||
let typing_eq { eq_lhs = pat; eq_rhs = e } = match e.e_desc with
|
||||
| _ -> let ty_pat = typing_pat h pat in
|
||||
(try expect h ty_pat e with
|
||||
| Error -> (* DEBUG *)
|
||||
Printf.eprintf "Complete expression: %a\nClock pattern: %a\n"
|
||||
Mls_printer.print_exp e
|
||||
Mls_printer.print_clock ty_pat;
|
||||
raise Error) in
|
||||
List.iter typing_eq eq_list
|
||||
let typing_eq { eq_lhs = pat; eq_rhs = e } =
|
||||
let ty_pat = typing_pat h pat in
|
||||
(try expect h ty_pat e with
|
||||
| Error -> (* DEBUG *)
|
||||
Printf.eprintf "Complete expression: %a\nClock pattern: %a\n"
|
||||
Mls_printer.print_exp e
|
||||
Mls_printer.print_clock ty_pat;
|
||||
raise Error)
|
||||
in List.iter typing_eq eq_list
|
||||
|
||||
let build h dec =
|
||||
List.fold_left (fun h { v_ident = n } -> Env.add n (new_var ()) h) h dec
|
||||
|
|
|
|||
|
|
@ -25,17 +25,17 @@ type target =
|
|||
let write_object_file p =
|
||||
let filename = (filename_of_name p.Minils.p_modname)^".epo" in
|
||||
let epoc = open_out_bin filename in
|
||||
comment "Generating of object file";
|
||||
output_value epoc p;
|
||||
close_out epoc
|
||||
close_out epoc;
|
||||
comment "Generating of object file"
|
||||
|
||||
(** Writes a .epo file for program [p]. *)
|
||||
let write_obc_file p =
|
||||
let obc_name = (filename_of_name p.Obc.p_modname)^".obc" in
|
||||
let obc = open_out obc_name in
|
||||
comment "Generation of Obc code";
|
||||
Obc_printer.print obc p;
|
||||
close_out obc
|
||||
close_out obc;
|
||||
comment "Generation of Obc code"
|
||||
|
||||
let targets = [ "c", Obc_no_params Cmain.program;
|
||||
"obc", Obc write_obc_file;
|
||||
|
|
|
|||
|
|
@ -7,11 +7,14 @@
|
|||
(* *)
|
||||
(**************************************************************************)
|
||||
open Misc
|
||||
open Location
|
||||
open Compiler_utils
|
||||
|
||||
let pp p = if !verbose then Mls_printer.print stdout p
|
||||
|
||||
let compile pp p =
|
||||
(* Clocking *)
|
||||
let p = do_silent_pass Clocking.program "Clocking" p true in
|
||||
let p = do_pass Clocking.program "Clocking" p pp false in
|
||||
|
||||
(* Check that the dataflow code is well initialized *)
|
||||
(*let p = do_silent_pass Init.program "Initialization check" p !init in *)
|
||||
|
|
|
|||
|
|
@ -12,22 +12,18 @@ open Location
|
|||
open Compiler_utils
|
||||
open Mls2seq
|
||||
|
||||
let pp = Mls_printer.print stdout
|
||||
|
||||
|
||||
let parse parsing_fun lexing_fun lexbuf =
|
||||
try
|
||||
parsing_fun lexing_fun lexbuf
|
||||
with
|
||||
| Mls_lexer.Lexical_error(err, pos1, pos2) ->
|
||||
lexical_error err (Loc(pos1, pos2))
|
||||
| Mls_lexer.Lexical_error(err, loc) ->
|
||||
lexical_error err loc
|
||||
| Mls_parser.Error ->
|
||||
let pos1 = Lexing.lexeme_start lexbuf
|
||||
and pos2 = Lexing.lexeme_end lexbuf in
|
||||
let pos1 = Lexing.lexeme_start_p lexbuf
|
||||
and pos2 = Lexing.lexeme_end_p lexbuf in
|
||||
let l = Loc(pos1,pos2) in
|
||||
syntax_error l
|
||||
|
||||
|
||||
let parse_implementation lexbuf =
|
||||
parse Mls_parser.program Mls_lexer.token lexbuf
|
||||
|
||||
|
|
@ -38,7 +34,7 @@ let compile_impl modname filename =
|
|||
and mls_norm_name = filename ^ "_norm.mls"
|
||||
and obc_name = filename ^ ".obc" in
|
||||
|
||||
let ic, lexbuf = lexbuf_from_file source_name in
|
||||
let ic, lexbuf = lexbuf_from_file source_name
|
||||
and mlsnc = open_out mls_norm_name
|
||||
and obc = open_out obc_name in
|
||||
|
||||
|
|
@ -51,32 +47,20 @@ let compile_impl modname filename =
|
|||
try
|
||||
init_compiler modname;
|
||||
|
||||
(* Parsing of the file *)
|
||||
let p = parse_implementation lexbuf in
|
||||
if !verbose
|
||||
then begin
|
||||
comment "Parsing";
|
||||
pp p
|
||||
end;
|
||||
(* Set pretty printer to the Minils one *)
|
||||
let pp = Mls_compiler.pp in
|
||||
|
||||
(* Call the compiler*)
|
||||
(* Parsing of the file *)
|
||||
let p = Mls_compiler.parse_implementation lexbuf in
|
||||
let p = { p with Minils.p_modname = modname } in
|
||||
comment "Parsing";
|
||||
pp p;
|
||||
|
||||
(* Process the MiniLS AST *)
|
||||
let p = Mls_compiler.compile pp p in
|
||||
|
||||
if !verbose
|
||||
then begin
|
||||
comment "Checking"
|
||||
end;
|
||||
|
||||
(* Producing Object-based code *)
|
||||
let o = Mls2obc.program p in
|
||||
if !verbose then comment "Translation into Object-based code";
|
||||
Obc_printer.print obc o;
|
||||
|
||||
let pp = Obc_printer.print stdout in
|
||||
if !verbose then pp o;
|
||||
|
||||
(* Translation into dataflow and sequential languages *)
|
||||
targets filename p o !target_languages;
|
||||
(* Generate the sequential code *)
|
||||
Mls2seq.program p;
|
||||
|
||||
close_all_files ()
|
||||
|
||||
|
|
@ -97,12 +81,12 @@ let main () =
|
|||
Arg.parse
|
||||
[
|
||||
"-v", Arg.Set verbose, doc_verbose;
|
||||
"-assert", Arg.String add_assert, doc_assert;
|
||||
"-version", Arg.Unit show_version, doc_version;
|
||||
"-i", Arg.Set print_types, doc_print_types;
|
||||
"-I", Arg.String add_include, doc_include;
|
||||
"-where", Arg.Unit locate_stdlib, doc_locate_stdlib;
|
||||
"-stdlib", Arg.String set_stdlib, doc_stdlib;
|
||||
"-c", Arg.Set create_object_file, doc_object_file;
|
||||
"-s", Arg.String set_simulation_node, doc_sim;
|
||||
"-nopervasives", Arg.Unit set_no_pervasives, doc_no_pervasives;
|
||||
"-target", Arg.String add_target_language, doc_target;
|
||||
|
|
|
|||
|
|
@ -69,7 +69,7 @@ and print_exp_tuple ff l =
|
|||
fprintf ff "@[<2>%a@]" (print_list_r print_exp "("","")") l
|
||||
|
||||
and print_vd_tuple ff l =
|
||||
fprintf ff "@[<2>%a@]" (print_list_r print_vd "("","")") l
|
||||
fprintf ff "@[<2>%a@]" (print_list_r print_vd "("";"")") l
|
||||
|
||||
and print_index ff idx =
|
||||
fprintf ff "@[<2>%a@]" (print_list print_static_exp "[""][""]") idx
|
||||
|
|
@ -79,7 +79,8 @@ and print_dyn_index ff idx =
|
|||
|
||||
and print_exp ff e =
|
||||
if !Misc.full_type_info then
|
||||
fprintf ff "%a : %a" print_exp_desc e.e_desc print_type e.e_ty
|
||||
fprintf ff "(%a : %a :: %a)"
|
||||
print_exp_desc e.e_desc print_type e.e_ty print_ck e.e_ck
|
||||
else fprintf ff "%a" print_exp_desc e.e_desc
|
||||
|
||||
and print_every ff reset =
|
||||
|
|
|
|||
|
|
@ -2,6 +2,7 @@
|
|||
|
||||
|
||||
{
|
||||
open Location
|
||||
open Lexing
|
||||
open Mls_parser
|
||||
|
||||
|
|
@ -11,7 +12,7 @@ type lexical_error =
|
|||
| Bad_char_constant
|
||||
| Unterminated_string;;
|
||||
|
||||
exception Lexical_error of lexical_error * int * int;;
|
||||
exception Lexical_error of lexical_error * location;;
|
||||
|
||||
let comment_depth = ref 0
|
||||
|
||||
|
|
@ -34,6 +35,7 @@ List.iter (fun (str,tok) -> Hashtbl.add keyword_table str tok) [
|
|||
"not", NOT;
|
||||
"open", OPEN;
|
||||
"reset", RESET;
|
||||
"const", CONST;
|
||||
"if", IF;
|
||||
"then", THEN;
|
||||
"else", ELSE;
|
||||
|
|
@ -102,11 +104,13 @@ let char_for_decimal_code lexbuf i =
|
|||
(int_of_char(Lexing.lexeme_char lexbuf (i+2)) - 48) in
|
||||
char_of_int(c land 0xFF)
|
||||
|
||||
|
||||
}
|
||||
|
||||
let newline = '\n' | '\r' '\n'
|
||||
|
||||
rule token = parse
|
||||
| [' ' '\010' '\013' '\009' '\012'] + { token lexbuf }
|
||||
| newline { new_line lexbuf; token lexbuf }
|
||||
| [' ' '\t'] + { token lexbuf }
|
||||
| "." {DOT}
|
||||
| ".." {DOTDOT}
|
||||
| "(" {LPAREN}
|
||||
|
|
@ -145,26 +149,25 @@ rule token = parse
|
|||
{ INT (int_of_string(Lexing.lexeme lexbuf)) }
|
||||
| '-'? ['0'-'9']+ ('.' ['0'-'9']*)? (['e' 'E'] ['+' '-']? ['0'-'9']+)?
|
||||
{ FLOAT (float_of_string(Lexing.lexeme lexbuf)) }
|
||||
| "(*@ " (['A'-'Z' 'a'-'z']('_' ? ['A'-'Z' 'a'-'z' ''' '0'-'9']) * as id)
|
||||
(* | "(*@ " (['A'-'Z' 'a'-'z']('_' ? ['A'-'Z' 'a'-'z' ''' '0'-'9']) * as id)
|
||||
{
|
||||
reset_string_buffer();
|
||||
let pragma_start = lexbuf.lex_start_pos + lexbuf.lex_abs_pos in
|
||||
begin try
|
||||
pragma lexbuf
|
||||
with Lexical_error(Unterminated_comment, _, pragma_end) ->
|
||||
raise(Lexical_error(Unterminated_comment, pragma_start, pragma_end))
|
||||
end;
|
||||
lexbuf.lex_start_pos <- pragma_start - lexbuf.lex_abs_pos;
|
||||
PRAGMA(id,get_stored_string())
|
||||
}
|
||||
let l1 = lexbuf.lex_curr_p in
|
||||
begin try
|
||||
pragma lexbuf
|
||||
with Lexical_error(Unterminated_comment, Loc(_, l2)) ->
|
||||
raise(Lexical_error(Unterminated_comment, Loc (l1, l2)))
|
||||
end;
|
||||
PRAGMA(id,get_stored_string())
|
||||
}*)
|
||||
| "(*"
|
||||
{ let comment_start = lexbuf.lex_start_pos + lexbuf.lex_abs_pos in
|
||||
{ let comment_start = lexbuf.lex_curr_p in
|
||||
comment_depth := 1;
|
||||
begin try
|
||||
comment lexbuf
|
||||
with Lexical_error(Unterminated_comment, _, comment_end) ->
|
||||
with Lexical_error(Unterminated_comment, (Loc (_, comment_end))) ->
|
||||
raise(Lexical_error(Unterminated_comment,
|
||||
comment_start, comment_end))
|
||||
Loc (comment_start, comment_end)))
|
||||
end;
|
||||
token lexbuf }
|
||||
| ['!' '?' '~']
|
||||
|
|
@ -193,29 +196,30 @@ rule token = parse
|
|||
{ INFIX3(Lexing.lexeme lexbuf) }
|
||||
| eof {EOF}
|
||||
| _ {raise (Lexical_error (Illegal_character,
|
||||
Lexing.lexeme_start lexbuf,
|
||||
Lexing.lexeme_end lexbuf))}
|
||||
Loc (Lexing.lexeme_start_p lexbuf,
|
||||
Lexing.lexeme_end_p lexbuf)))}
|
||||
|
||||
and pragma = parse
|
||||
"(*"
|
||||
{ let comment_start = lexbuf.lex_start_pos + lexbuf.lex_abs_pos in
|
||||
| newline { new_line lexbuf; pragma lexbuf }
|
||||
| "(*"
|
||||
{ let comment_start = lexbuf.lex_curr_p in
|
||||
comment_depth := 1;
|
||||
begin try
|
||||
comment lexbuf
|
||||
with Lexical_error(Unterminated_comment, _, comment_end) ->
|
||||
with Lexical_error(Unterminated_comment, Loc (_, comment_end)) ->
|
||||
raise(Lexical_error(Unterminated_comment,
|
||||
comment_start, comment_end))
|
||||
Loc (comment_start, comment_end)))
|
||||
end;
|
||||
pragma lexbuf }
|
||||
| "@*)"
|
||||
{ }
|
||||
| eof
|
||||
{ raise(Lexical_error(Unterminated_comment,0,
|
||||
Lexing.lexeme_start lexbuf)) }
|
||||
{ raise(Lexical_error(Unterminated_comment, Loc (dummy_pos,
|
||||
Lexing.lexeme_start_p lexbuf))) }
|
||||
|
||||
| _
|
||||
{ store_string_char(Lexing.lexeme_char lexbuf 0);
|
||||
pragma lexbuf }
|
||||
pragma lexbuf }
|
||||
|
||||
and comment = parse
|
||||
"(*"
|
||||
|
|
@ -223,13 +227,14 @@ and comment = parse
|
|||
| "*)"
|
||||
{ comment_depth := pred !comment_depth;
|
||||
if !comment_depth > 0 then comment lexbuf }
|
||||
| "\""
|
||||
| "\""
|
||||
{ reset_string_buffer();
|
||||
let string_start = lexbuf.lex_start_pos + lexbuf.lex_abs_pos in
|
||||
let string_start = lexbuf.lex_curr_p in
|
||||
begin try
|
||||
string lexbuf
|
||||
with Lexical_error(Unterminated_string, _, string_end) ->
|
||||
raise(Lexical_error(Unterminated_string, string_start, string_end))
|
||||
with Lexical_error(Unterminated_string, Loc (_, string_end)) ->
|
||||
raise(Lexical_error
|
||||
(Unterminated_string, Loc (string_start, string_end)))
|
||||
end;
|
||||
comment lexbuf }
|
||||
| "''"
|
||||
|
|
@ -241,8 +246,8 @@ and comment = parse
|
|||
| "'" '\\' ['0'-'9'] ['0'-'9'] ['0'-'9'] "'"
|
||||
{ comment lexbuf }
|
||||
| eof
|
||||
{ raise(Lexical_error(Unterminated_comment,0,
|
||||
Lexing.lexeme_start lexbuf)) }
|
||||
{ raise(Lexical_error(Unterminated_comment, Loc(dummy_pos,
|
||||
Lexing.lexeme_start_p lexbuf))) }
|
||||
| _
|
||||
{ comment lexbuf }
|
||||
|
||||
|
|
@ -258,10 +263,11 @@ and string = parse
|
|||
{ store_string_char(char_for_decimal_code lexbuf 1);
|
||||
string lexbuf }
|
||||
| eof
|
||||
{ raise (Lexical_error
|
||||
(Unterminated_string, 0, Lexing.lexeme_start lexbuf)) }
|
||||
{ raise (Lexical_error(Unterminated_string, Loc (dummy_pos,
|
||||
Lexing.lexeme_start_p lexbuf))) }
|
||||
| _
|
||||
{ store_string_char(Lexing.lexeme_char lexbuf 0);
|
||||
string lexbuf }
|
||||
|
||||
(* eof *)
|
||||
|
||||
|
|
|
|||
|
|
@ -12,13 +12,12 @@ open Mls_utils
|
|||
%}
|
||||
|
||||
%token DOT LPAREN RPAREN LBRACE RBRACE COLON SEMICOL
|
||||
%token EQUAL EQUALEQUAL BARBAR COMMA BAR LET TEL
|
||||
%token EQUAL EQUALEQUAL BARBAR COMMA BAR LET TEL CONST
|
||||
%token <string> CONSTRUCTOR
|
||||
%token <string> NAME
|
||||
%token <int> INT
|
||||
%token <float> FLOAT
|
||||
%token <bool> BOOL
|
||||
%token <string * string> PRAGMA
|
||||
%token TYPE NODE RETURNS VAR OPEN
|
||||
%token FBY PRE WHEN
|
||||
%token OR STAR NOT
|
||||
|
|
@ -46,6 +45,7 @@ open Mls_utils
|
|||
%token EOF
|
||||
|
||||
%right AROBASE
|
||||
%nonassoc DEFAULT
|
||||
%left ELSE
|
||||
%left OR
|
||||
%left AMPERSAND
|
||||
|
|
@ -83,18 +83,17 @@ localize(x): y=x { y, (Loc($startpos(y),$endpos(y))) }
|
|||
|
||||
|
||||
program:
|
||||
| pragma_headers open_modules type_decs node_decs EOF /*TODO const decs */
|
||||
{{ p_pragmas = List.rev $1;
|
||||
p_opened = List.rev $2;
|
||||
p_types = $3;
|
||||
p_nodes = $4;
|
||||
p_consts = []}} /*TODO consts dans program*/
|
||||
|
||||
pragma_headers: l=list(PRAGMA) {l}
|
||||
| o=open_modules c=const_decs t=type_decs n=node_decs EOF
|
||||
{ mk_program o t n c }
|
||||
|
||||
open_modules: l=list(opens) {l}
|
||||
opens: OPEN c=CONSTRUCTOR {c}
|
||||
|
||||
const_decs: c=list(const_dec) {c}
|
||||
const_dec:
|
||||
| CONST n=NAME COLON t=type_ident EQUAL e=const
|
||||
{ mk_const_dec n t e (Loc($startpos,$endpos)) }
|
||||
|
||||
name: n=NAME | LPAREN n=infix_ RPAREN | LPAREN n=prefix_ RPAREN { n }
|
||||
ident: n=name { ident_of_name n }
|
||||
|
||||
|
|
@ -121,10 +120,13 @@ node_dec:
|
|||
|
||||
args_t: SEMICOL p=args {p}
|
||||
args:
|
||||
| /* empty */ {[]}
|
||||
| /* empty */ { [] }
|
||||
| h=var t=loption(args_t) {h@t}
|
||||
|
||||
loc_vars_t: SEMICOL h=var t=loc_vars_t {h@t}
|
||||
loc_vars_t:
|
||||
| /*empty */ { [] }
|
||||
| SEMICOL { [] }
|
||||
| SEMICOL h=var t=loc_vars_t {h@t}
|
||||
loc_vars_h: VAR h=var t=loc_vars_t {h@t}
|
||||
loc_vars: l=loption(loc_vars_h) {l}
|
||||
|
||||
|
|
@ -142,13 +144,18 @@ pat:
|
|||
longname: l=qualified(name) {l} /* qualified var (not a constructor) */
|
||||
|
||||
constructor: /* of type longname */
|
||||
| ln=qualified(CONSTRUCTOR) {ln}
|
||||
| ln=qualified(CONSTRUCTOR) { ln }
|
||||
| b=BOOL { Name(if b then "true" else "false") }
|
||||
|
||||
const:
|
||||
| INT { Cint($1) }
|
||||
| FLOAT { Cfloat($1) }
|
||||
| constructor { Cconstr($1) }
|
||||
field:
|
||||
| ln=longname { mk_static_exp ~loc:(Loc($startpos,$endpos)) (Sconstructor ln)}
|
||||
|
||||
const : c=_const { mk_static_exp ~loc:(Loc ($startpos,$endpos)) c }
|
||||
_const:
|
||||
| i=INT { Sint i }
|
||||
| f=FLOAT { Sfloat f }
|
||||
| c=constructor { Sconstructor c }
|
||||
| t=tuple(const) { Stuple t }
|
||||
|
||||
exps: LPAREN e=slist(COMMA, exp) RPAREN {e}
|
||||
|
||||
|
|
@ -157,49 +164,50 @@ field_exp: longname EQUAL exp { ($1, $3) }
|
|||
simple_exp:
|
||||
| e=_simple_exp {mk_exp e ~loc:(Loc ($startpos,$endpos)) }
|
||||
_simple_exp:
|
||||
| NAME { Evar (ident_of_name $1) }
|
||||
| s=structure(field_exp) { Estruct s }
|
||||
| t=tuple(exp) { Eapp(mk_op ~op_kind:Etuple, t, None) }
|
||||
| LPAREN e=_exp RPAREN { e }
|
||||
| n=NAME { Evar (ident_of_name n) }
|
||||
| s=structure(field_exp) { Estruct s }
|
||||
| t=tuple(exp) { Eapp(mk_app Etuple, t, None) }
|
||||
| LBRACKET es=slist(COMMA, exp) RBRACKET { Eapp(mk_app Earray, es, None) }
|
||||
| LPAREN e=_exp RPAREN { e }
|
||||
|
||||
|
||||
exp:
|
||||
| e=simple_exp { e }
|
||||
| e=_exp { mk_exp e ~loc:(Loc ($startpos,$endpos)) }
|
||||
_exp:
|
||||
| e=simple_exp { e }
|
||||
| c=const { Econst c }
|
||||
| const FBY exp { Efby(Some($1),$3) }
|
||||
| v=const FBY e=exp { Efby(Some(v), e) }
|
||||
| PRE exp { Efby(None,$2) }
|
||||
| op=funop a=exps r=reset { Ecall(op, a, r) }
|
||||
| op=funapp a=exps r=reset { Eapp(op, a, r) }
|
||||
| e1=exp i_op=infix e2=exp
|
||||
{ Eapp(mk_op ~op_kind:Efun i_op, [e1; e2], None) }
|
||||
{ Eapp(mk_app (Efun i_op), [e1; e2], None) }
|
||||
| p_op=prefix e=exp %prec prefixs
|
||||
{ Eapp(mk_op ~op_kind:Efun p_op, [e], None) }
|
||||
| IF e1=exp THEN e2=exp ELSE e3=exp { Eifthenelse(e1, e2, e3) }
|
||||
| e=simple_exp DOT m=longname { Efield(e, m) }
|
||||
| e=exp WHEN c=constructor LPAREN n=ident RPAREN
|
||||
{ Ewhen(e, c, n) }
|
||||
| MERGE n=ident h=handlers { Emerge(n, h) }
|
||||
| LPAREN r=exp WITH DOT ln=longname EQUAL nv=exp
|
||||
{ Efield_update(ln, r, nv) }
|
||||
| op=array_op { Earray_op op }
|
||||
| LBRACKET es=slist(COMMA, exp) RBRACKET { Earray es }
|
||||
|
||||
array_op:
|
||||
| e=exp POWER p=e_param { Erepeat(p, e) }
|
||||
| e=simple_exp i=indexes(e_param) { Eselect(i, e) }
|
||||
| e=exp i=indexes(exp) DEFAULT d=exp { Eselect_dyn(i, e ,d) }
|
||||
| LPAREN e=exp WITH i=indexes(e_param) EQUAL nv=exp { Eupdate(i, e, nv) }
|
||||
{ Eapp(mk_app (Efun p_op), [e], None) }
|
||||
| IF e1=exp THEN e2=exp ELSE e3=exp
|
||||
{ Eapp( mk_app Eifthenelse, [e1; e2; e3], None) }
|
||||
| e=simple_exp DOT f=field
|
||||
{ Eapp( mk_app ~params:[f] Efield, [e], None) }
|
||||
| e=exp WHEN c=constructor LPAREN n=ident RPAREN { Ewhen(e, c, n) }
|
||||
| MERGE n=ident h=handlers { Emerge(n, h) }
|
||||
| LPAREN r=exp WITH DOT f=field EQUAL nv=exp
|
||||
{ Eapp(mk_app ~params:[f] Efield_update, [r; nv], None) }
|
||||
| e=exp POWER p=e_param
|
||||
{ Eapp(mk_app ~params:[p] Earray_fill, [e], None) }
|
||||
| e=simple_exp i=indexes(exp) /* not e_params to solve conflicts */
|
||||
{ Eapp(mk_app ~params:(List.map static_exp_of_exp i) Eselect, [e], None) }
|
||||
| e=simple_exp i=indexes(exp) DEFAULT d=exp
|
||||
{ Eapp(mk_app Eselect_dyn, [e; d]@i, None) }
|
||||
| LPAREN e=exp WITH i=indexes(e_param) EQUAL nv=exp
|
||||
{ Eapp(mk_app ~params:i Eupdate, [e; nv], None) }
|
||||
| e=simple_exp LBRACKET i1=e_param DOTDOT i2=e_param RBRACKET
|
||||
{ Eselect_slice(i1, i2, e) }
|
||||
| e1=exp AROBASE e2=exp { Econcat(e1,e2) }
|
||||
| LPAREN f=iterator LPAREN op=funop RPAREN
|
||||
{ Eapp(mk_app ~params:[i1; i2] Eselect_slice, [e], None) }
|
||||
| e1=exp AROBASE e2=exp { Eapp(mk_app Econcat, [e1;e2], None) }
|
||||
| LPAREN f=iterator LPAREN op=funapp RPAREN
|
||||
DOUBLE_LESS p=e_param DOUBLE_GREATER
|
||||
RPAREN a=exps r=reset { Eiterator(f,op,p,a,r) }
|
||||
RPAREN a=exps r=reset { Eiterator(f,op,p,a,r) }
|
||||
|
||||
/* Static indexes [p1][p2]... */
|
||||
indexes(param): is=nonempty_list(index(param)) { is }
|
||||
indexes(param): is=nonempty_list(index(param)) { is }
|
||||
index(param): LBRACKET p=param RBRACKET { p }
|
||||
|
||||
|
||||
|
|
@ -217,10 +225,11 @@ iterator:
|
|||
|
||||
reset: r=option(RESET,ident) { r }
|
||||
|
||||
funop: ln=longname p=params(e_param) { mk_op ~op_kind:Enode ~op_params:p ln }
|
||||
/* TODO : Scoping to deal with node and fun ! */
|
||||
funapp: ln=longname p=params(e_param) { mk_app ~params:p (Enode ln) }
|
||||
|
||||
|
||||
e_param: e=exp { static_exp_of_exp e }
|
||||
/* inline so that precendance of POWER is respected in exp */
|
||||
%inline e_param: e=exp { static_exp_of_exp e }
|
||||
n_param: n=NAME { mk_param n }
|
||||
params(param):
|
||||
| /*empty*/ { [] }
|
||||
|
|
@ -237,8 +246,8 @@ params(param):
|
|||
| AMPERSAND { "&" } | AMPERAMPER { "&&" }
|
||||
| OR { "or" } | BARBAR { "||" }
|
||||
|
||||
prefix: op=prefix_ { Name(op) }
|
||||
prefix_:
|
||||
%inline prefix: op=prefix_ { Name(op) }
|
||||
%inline prefix_:
|
||||
| op = PREFIX { op }
|
||||
| NOT { "not" }
|
||||
| op = SUBTRACTIVE { "~" ^ op } /*TODO test 3 * -2 and co */
|
||||
|
|
|
|||
Loading…
Reference in a new issue