jeltz
/
heptagon
1
0
Fork 0
Code Issues Pull Requests Releases Activity

mlsc and mls_parsetree etc.

Browse Source
master
Léonard Gérard 14 years ago committed by Léonard Gérard
parent 52f351b0d3
commit 15448fdff9
8 changed files with 149 additions and 145 deletions
Show Stats Download Patch File Download Diff File

1
compiler/main/mls2obc.ml
Unescape Escape View File

@ -365,7 +365,6 @@ and mk_node_call map call_context app loc name_list args =
| Minils.Efun _ -> []
| Minils.Enode _ -> [reinit o]) in
[], si, [obj], [Acall (name_list, o, Mstep, args)]
| _ -> assert false
and translate_iterator map call_context it name_list app loc n x c_list =

9
compiler/minils/main/mls_compiler.ml
Unescape Escape View File

@ -12,9 +12,10 @@ open Compiler_utils
let pp p = if !verbose then Mls_printer.print stdout p
let parse parsing_fun lexing_fun lexbuf =
let parse prog_name parsing_fun lexing_fun lexbuf =
try
parsing_fun lexing_fun lexbuf
let p = parsing_fun lexing_fun lexbuf in
{ p with p_modname = prog_name }
with
| Mls_lexer.Lexical_error(err, loc) ->
lexical_error err loc
@ -24,8 +25,8 @@ let parse parsing_fun lexing_fun lexbuf =
let l = Loc(pos1,pos2) in
syntax_error l
let parse_implementation lexbuf =
parse Mls_parser.program Mls_lexer.token lexbuf
let parse_implementation prog_name lexbuf =
parse prog_name Mls_parser.program Mls_lexer.token lexbuf
let compile pp p =
(* Clocking *)

9
compiler/minils/main/mlsc.ml
Unescape Escape View File

@ -14,7 +14,6 @@ open Mls2seq
let compile_impl modname filename =
(* input and output files *)
(* input and output files *)
let source_name = filename ^ ".mls"
and mls_norm_name = filename ^ "_norm.mls"
@ -37,10 +36,12 @@ let compile_impl modname filename =
let pp = Mls_compiler.pp in
(* Parsing of the file *)
let p = Mls_compiler.parse_implementation lexbuf in
let p =
do_silent_pass Mls_compiler.parse_implementation "Parsing" lexbuf true in
let p = { p with Minils.p_modname = modname } in
comment "Parsing";
pp p;
(* Convert Parse tree to Minils AST *)
let p = Mls_scoping.translate_program "Scoping" p pp true in
(* Process the MiniLS AST *)
let p = Mls_compiler.compile pp p in

12
compiler/minils/minils.ml
Unescape Escape View File

@ -79,6 +79,8 @@ and op =
| Eselect_dyn (** arg1.[arg3...] default arg2 *)
| Eupdate (** [ arg1 with arg3..arg_n = arg2 ] *)
| Econcat (** arg1@@arg2 *)
(*
*)
type pat =
| Etuplepat of pat list
@ -150,11 +152,19 @@ let mk_node
n_params = param;
n_params_constraints = constraints }
let mk_type_dec ?(type_desc = Type_abs) ?(loc = no_location) name =
let mk_type_dec type_desc name loc =
{ t_name = name; t_desc = type_desc; t_loc = loc }
let mk_const_dec id ty e loc =
{ c_name = id; c_type = ty; c_value = e; c_loc = loc }
let mk_app ?(params=[]) ?(unsafe=false) op =
{ a_op = op; a_params = params; a_unsafe = unsafe }
(** The modname field has to be set when known, TODO LG : format_version *)
let mk_program o n t c =
{ p_modname = ""; p_format_version = "";
p_opened = o; p_nodes = n; p_types = t; p_consts = c }
let void = mk_exp (Eapp (mk_app Etuple, [], None))

53
compiler/minils/parsing/mls_lexer.mll
Unescape Escape View File

@ -51,7 +51,8 @@ List.iter (fun (str,tok) -> Hashtbl.add keyword_table str tok) [
"lxor", INFIX2("lxor");
"lsl", INFIX4("lsl");
"lsr", INFIX4("lsr");
"asr", INFIX4("asr")
"asr", INFIX4("asr");
"on", ON;
]
@ -111,31 +112,33 @@ let newline = '\n' | '\r' '\n'
rule token = parse
| newline { new_line lexbuf; token lexbuf }
| [' ' '\t'] + { token lexbuf }
| "." {DOT}
| ".." {DOTDOT}
| "(" {LPAREN}
| ")" {RPAREN}
| "." { DOT }
| ".." { DOTDOt }
| "(" { LPAREN }
| ")" { RPAREN }
| "*" { STAR }
| "{" {LBRACE}
| "}" {RBRACE}
| "[" {LBRACKET}
| "]" {RBRACKET}
| ":" {COLON}
| ";" {SEMICOL}
| "=" {EQUAL}
| "==" {EQUALEQUAL}
| "&" {AMPERSAND}
| "&&" {AMPERAMPER}
| "||" {BARBAR}
| "," {COMMA}
| "->" {ARROW}
| "|" {BAR}
| "-" {SUBTRACTIVE "-"}
| "-." {SUBTRACTIVE "-."}
| "^" {POWER}
| "@" {AROBASE}
| "<<" {DOUBLE_LESS}
| ">>" {DOUBLE_GREATER}
| "{" { LBRACE }
| "}" { RBRACE }
| "[" { LBRACKET }
| "]" { RBRACKET }
| ":" { COLON }
| "::" { COLONCOLON }
| ";" { SEMICOL }
| "=" { EQUAL }
| "==" { EQUALEQUAL }
| "&" { AMPERSAND }
| "&&" { AMPERAMPER }
| "||" { BARBAR }
| "," { COMMA }
| "->" { ARROW }
| "|" { BAR }
| "-" { SUBTRACTIVE "-" }
| "-." { SUBTRACTIVE "-." }
| "_" { UNDERSCORE }
| "^" { POWER }
| "@" { AROBASE }
| "<<" { DOUBLE_LESS }
| ">>" { DOUBLE_GREATER }
| (['A'-'Z']('_' ? ['A'-'Z' 'a'-'z' ''' '0'-'9']) * as id)
{CONSTRUCTOR id}
| (['A'-'Z' 'a'-'z']('_' ? ['A'-'Z' 'a'-'z' ''' '0'-'9']) * as id)

49
compiler/minils/parsing/mls_parser.mly
Unescape Escape View File

@ -4,8 +4,10 @@ open Signature
open Names
open Idents
open Types
open Clocks
open Location
open Minils
open Mls_parsetree
open Mls_utils
@ -32,6 +34,7 @@ open Mls_utils
%token AROBASE
%token WITH
%token DOTDOT
%token BASE UNDERSCORE ON COLONCOLON
%token DEFAULT
%token LBRACKET RBRACKET
%token MAP FOLD MAPFOLD
@ -61,7 +64,7 @@ open Mls_utils
%start program
%type <Minils.program> program
%type <Mls_parsetree.program> program
%%
@ -84,7 +87,7 @@ localize(x): y=x { y, (Loc($startpos(y),$endpos(y))) }
program:
| o=open_modules c=const_decs t=type_decs n=node_decs EOF
{ mk_program o t n c }
{ mk_program o n t c }
open_modules: l=list(opens) {l}
opens: OPEN c=CONSTRUCTOR {c}
@ -104,11 +107,11 @@ type_ident: NAME { Tid(Name($1)) }
type_decs: t=list(type_dec) {t}
type_dec:
| TYPE n=NAME
{ mk_type_dec ~loc:(Loc ($startpos,$endpos)) ~type_desc:Type_abs n }
{ mk_type_dec Type_abs n (Loc ($startpos,$endpos)) }
| TYPE n=NAME EQUAL e=snlist(BAR,NAME)
{ mk_type_dec ~loc:(Loc ($startpos,$endpos)) ~type_desc:(Type_enum e) n }
{ mk_type_dec (Type_enum e) n (Loc ($startpos,$endpos)) }
| TYPE n=NAME EQUAL s=structure(field_type)
{ mk_type_dec ~loc:(Loc ($startpos,$endpos)) ~type_desc:(Type_struct s) n }
{ mk_type_dec (Type_struct s) n (Loc ($startpos,$endpos)) }
node_decs: ns=list(node_dec) {ns}
node_dec:
@ -130,15 +133,30 @@ loc_vars_t:
loc_vars_h: VAR h=var t=loc_vars_t {h@t}
loc_vars: l=loption(loc_vars_h) {l}
ck_base: | UNDERSCORE | BASE {}
ck:
| ck_base { Cbase }
| ck=ck ON c=constructor LPAREN x=NAME RPAREN { Con (ck, c, x) }
ct:
| LPAREN ctl=snlist(STAR,ct) RPAREN { Cprod ctl }
| c=ck { Ck c }
clock_annot:
| /*empty*/ { Cbase }
| COLONCOLON c=ck { c }
var:
| ns=snlist(COMMA, NAME) COLON t=type_ident
{ List.map (fun id -> mk_var_dec (ident_of_name id) t) ns }
| ns=snlist(COMMA, NAME) COLON t=type_ident c=clock_annot
{ List.map (fun n -> mk_var_dec n t c (Loc ($startpos,$endpos))) ns }
equs: LET e=slist(SEMICOL, equ) TEL { e }
equ: p=pat EQUAL e=exp { mk_equation ~loc:(Loc ($startpos,$endpos)) p e }
equ: p=pat EQUAL e=exp { mk_equation p e (Loc ($startpos,$endpos)) }
pat:
| n=NAME {Evarpat (ident_of_name n)}
| n=NAME {Evarpat n}
| LPAREN p=snlist(COMMA, pat) RPAREN {Etuplepat p}
longname: l=qualified(name) {l} /* qualified var (not a constructor) */
@ -147,11 +165,10 @@ constructor: /* of type longname */
| ln=qualified(CONSTRUCTOR) { ln }
| b=BOOL { Name(if b then "true" else "false") }
/* TODO donner un type !! Phase de typing. */
field:
| ln=longname { mk_static_exp ~loc:(Loc($startpos,$endpos)) (Sconstructor ln)}
/* TODO donner un type !! Phase de typing. */
const : c=_const { mk_static_exp ~loc:(Loc ($startpos,$endpos)) c }
_const:
| i=INT { Sint i }
@ -164,7 +181,7 @@ exps: LPAREN e=slist(COMMA, exp) RPAREN {e}
field_exp: longname EQUAL exp { ($1, $3) }
simple_exp:
| e=_simple_exp {mk_exp e ~loc:(Loc ($startpos,$endpos)) }
| e=_simple_exp {mk_exp e (Loc ($startpos,$endpos)) }
_simple_exp:
| n=NAME { Evar (ident_of_name n) }
| s=structure(field_exp) { Estruct s }
@ -175,7 +192,7 @@ _simple_exp:
exp:
| e=simple_exp { e }
| e=_exp { mk_exp e ~loc:(Loc ($startpos,$endpos)) }
| e=_exp { mk_exp e (Loc ($startpos,$endpos)) }
_exp:
| c=const { Econst c }
| v=const FBY e=exp { Efby(Some(v), e) }
@ -196,7 +213,7 @@ _exp:
| 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) }
{ Eapp(mk_app ~params: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
@ -228,10 +245,10 @@ iterator:
reset: r=option(RESET,ident) { r }
/* TODO : Scoping to deal with node and fun ! */
funapp: ln=longname p=params(e_param) { mk_app ~params:p (Enode ln) }
funapp: ln=longname p=params(e_param) { mk_app p (Enode ln) }
/* inline so that precendance of POWER is respected in exp */
%inline e_param: e=exp { static_exp_of_exp e }
%inline e_param: e=exp { e }
n_param: n=NAME { mk_param n }
params(param):
| /*empty*/ { [] }

120
compiler/minils/parsing/mls_parsetree.ml
Unescape Escape View File

@ -7,111 +7,107 @@
(* *)
(**************************************************************************)
open Names
open Location
open Names
open Signature
open Static
open Types
open Minils
open Clocks
type exp = {
e_desc: edesc;
e_loc: location }
type exp =
{ e_desc: desc;
e_loc: location }
and app = { a_op: Minils.op; a_params: exp list }
and desc =
and edesc =
| Econst of static_exp
| Evar of name
| Efby of static_exp option * exp
| Eapp of app * exp list * name option
| Efby of exp option * exp
| Eapp of Minils.app * exp list * name option
| Ewhen of exp * constructor_name * name
| Emerge of name * (constructor_name * exp) list
| Estruct of (field_name * exp) list
| Eiterator of iterator_type * app * static_exp * exp list * name option
| Eiterator of
Minils.iterator_type * app * exp * exp list * name option
and pat =
| Etuplepat of pat list
| Evarpat of name
type eq = {
and eq = {
eq_lhs : pat;
eq_rhs : exp;
eq_loc : location }
and var_dec = {
v_name : name;
v_ident : name;
v_type : ty;
v_clock : ck;
v_loc : location; }
type contract = {
c_assume : exp;
c_enforce : exp;
c_eq : eq list }
v_loc : location }
type node_dec = {
n_name : name;
n_statefull : bool;
n_input : var_dec list;
n_output : var_dec list;
n_contract : contract option;
n_local : var_dec list;
n_equs : eq list;
n_loc : location;
n_params : param list; }
n_name : name;
n_input : var_dec list;
n_output : var_dec list;
n_contract : Minils.contract option;
n_local : var_dec list;
n_equs : eq list;
n_loc : location;
n_params : param list }
type program = {
p_modname : name;
p_format_version : string;
p_opened : name list;
p_types : type_dec list;
p_types : Minils.type_dec list;
p_nodes : node_dec list;
p_consts : const_dec list }
p_consts : Minils.const_dec list }
(* Helper functions to create AST. *)
let mk_exp desc loc =
{ e_desc = desc; e_loc = loc }
(** {Helper functions to build the Parsetree *)
let mk_app op params =
{ a_op = op; a_params = params }
let mk_node
?(input = []) ?(output = []) ?(contract = None) ?(local = []) ?(eq = [])
?(loc = no_location) ?(param = []) ?(constraints = []) ?(pinst = []) name =
{ n_name = name;
n_input = input;
n_output = output;
n_contract = contract;
n_local = local;
n_equs = eq;
n_loc = loc;
n_params = param }
let mk_call ?(params=[]) op exps =
Eapp (mk_app op params, exps)
(** The modname field has to be set when known, TODO LG : format_version *)
let mk_program o n t c =
{ p_modname = ""; p_format_version = "";
p_opened = o; p_nodes = n; p_types = t; p_consts = c }
let mk_op_call ?(params=[]) s exps =
mk_call ~params:params
(Efun (Modname { qual = "Pervasives"; id = s })) exps
let mk_exp desc loc = { e_desc = desc; e_loc = loc }
let mk_iterator_call it ln params n exps =
Eiterator (it, mk_app (Enode ln) params, n, exps)
let mk_app params op = { a_op = op; a_params = params }
let mk_constructor_exp f loc =
mk_exp (Econst (mk_static_exp (Sconstructor f))) loc
let void = mk_exp (Eapp (Minils.mk_app Minils.Etuple, [], None))
let mk_type_dec name desc loc =
{ t_name = name; t_desc = desc; t_loc = loc }
let mk_call ?(unsafe=false) ?(params=[]) reset op exps =
Eapp (Minils.mk_app ~unsafe:unsafe op ~params:params, exps, reset)
let mk_equation desc loc =
{ eq_desc = desc; eq_loc = loc }
let mk_op_call ?(params=[]) s exps =
mk_call ~params:params None
(Minils.Efun (Modname { qual = "Pervasives"; id = s })) exps
let mk_interface_decl desc loc =
{ interf_desc = desc; interf_loc = loc }
let mk_iterator_call it ln params reset n exps =
Eiterator (it, mk_app params (Minils.Enode ln), n, exps, reset)
let mk_var_dec name ty last loc =
{ v_name = name; v_type = ty;
v_last = last; v_loc = loc }
let mk_constructor_exp f loc =
mk_exp (Econst (mk_static_exp (Sconstructor f))) loc
let mk_block locals eqs loc =
{ b_local = locals; b_equs = eqs;
b_loc = loc }
let mk_equation lhs rhs loc =
{ eq_lhs = lhs; eq_rhs = rhs; eq_loc = loc }
let mk_const_dec id ty e loc =
{ c_name = id; c_type = ty; c_value = e;
c_loc = loc }
let mk_var_dec name ty clock loc =
{ v_ident = name; v_type = ty; v_clock = clock; v_loc = loc }
let mk_arg name ty =
{ a_type = ty; a_name = name }

41
compiler/utilities/pp_tools.ml
Unescape Escape View File

@ -56,35 +56,12 @@ let print_type_params ff pl =
print_list_r (fun ff s -> fprintf ff "'%s" s) "("","") " ff pl
(* Map and Set redefinition to allow pretty printing
module type P = sig
type t
val fprint : Format.formatter -> t -> unit
end
module type ELT = sig
type t
val compare : t -> t -> int
val fprint : Format.formatter -> t -> unit
end
module SetMake (Elt : ELT) = struct
module M = Set.Make(Elt)
include M
let fprint ff es =
Format.fprintf ff "@[<hov>{@ ";
iter (fun e -> Format.fprintf ff "%a@ " Elt.fprint e) es;
Format.fprintf ff "}@]";
end
module MapMake (Key : ELT) (Elt : P) = struct
module M = Map.Make(Key)
include M
let fprint prp eem =
Format.fprintf prp "[@[<hv 2>";
iter (fun k m ->
Format.fprintf prp "@ | %a -> %a" Key.fprint k Elt.fprint m) eem;
Format.fprintf prp "@]@ ]";
end
*)
let print_set print_element ff set =
fprintf ff "@[{@ ";
iter (fun e -> fprintf ff "%a@ " print_element e) set;
fprintf ff "}@]"
let print_map print_key print_element ff map =
pfrintf ff "@[<hv 2>[@ ";
iter (fun k x -> fprintf ff "| %a -> %a@ " print_key k print_element x map;
fprintf ff "]@]"

Write Preview
Loading…
Cancel
Save