diff --git a/src/ast.ml b/src/ast.ml index 5491e59..ffa3ef1 100644 --- a/src/ast.ml +++ b/src/ast.ml @@ -48,16 +48,19 @@ type t_expression = | EConst of full_ty * const | ETuple of full_ty * (t_expression list) | EApp of full_ty * t_node * t_expression - | EAuto of full_ty * t_state * t_state list (* initial state and transitions *) and t_varlist = full_ty * (t_var list) -and t_equation = t_varlist * t_expression +and t_equation = t_varlist * t_expression and t_eqlist = t_equation list and t_state = | State of ident * t_eqlist * t_expression * ident +and t_automaton = t_state * t_state list + +and t_autolist = t_automaton list + and t_node = { n_name : ident; @@ -65,6 +68,7 @@ and t_node = n_outputs: t_varlist; n_local_vars: t_varlist; n_equations: t_eqlist; + n_automata: t_autolist; n_inputs_type : full_ty; n_outputs_type : full_ty; } diff --git a/src/main.ml b/src/main.ml index d8b5089..3a442ce 100644 --- a/src/main.ml +++ b/src/main.ml @@ -64,6 +64,7 @@ let _ = let inchan = open_in !source_file in try begin + let _ = Parsing.set_trace true in let res = Parser.main Lexer.token (Lexing.from_channel inchan) in close_in inchan; res end diff --git a/src/parser.mly b/src/parser.mly index ba06788..1fae9a5 100644 --- a/src/parser.mly +++ b/src/parser.mly @@ -7,7 +7,7 @@ let defined_nodes : (ident, t_node) Hashtbl.t = Hashtbl.create Config.maxvar - let defined_vars : (ident, t_var * bool) Hashtbl.t = Hashtbl.create Config.maxvar + let defined_vars : (ident, t_var) Hashtbl.t = Hashtbl.create Config.maxvar let fetch_node (n: ident) = match Hashtbl.find_opt defined_nodes n with @@ -21,8 +21,9 @@ | None -> raise (MyParsingError ("The var "^n^" does not exist.", current_location())) - | Some (var, _) -> var + | Some var -> var + (* let fetch_var_def (n: ident) : t_var = match Hashtbl.find_opt defined_vars n with | None -> @@ -34,6 +35,7 @@ current_location())) | Some (var, false) -> (Hashtbl.replace defined_vars n (var, true) ; var) + *) let concat_varlist (t1, e1) (t2, e2) = (t1 @ t2, e1 @ e2) @@ -179,8 +181,9 @@ node_content: IDENT LPAREN in_params RPAREN RETURNS LPAREN out_params RPAREN OPTIONAL_SEMICOL local_params - LET equations TEL OPTIONAL_SEMICOL + LET node_body TEL OPTIONAL_SEMICOL { let node_name = $1 in + let (eqs, aut) = $12 in let (t_in, e_in) = $3 in let (t_out, e_out) = $7 in let n: t_node = @@ -188,11 +191,17 @@ node_content: n_inputs = (t_in, e_in); n_outputs = (t_out, e_out); n_local_vars = $10; - n_equations = $12; + n_equations = eqs; + n_automata = aut; n_inputs_type = t_in; n_outputs_type = t_out; } in Hashtbl.add defined_nodes node_name n; n }; +node_body: + | /* empty */ { ([], []) } + | equations node_body { let (eq, aut) = $2 in ($1@eq, aut) } + | automaton node_body { let (eq, aut) = $2 in (eq, $1::aut) } + OPTIONAL_SEMICOL: | /* empty */ {} | SEMICOL {} @@ -227,13 +236,13 @@ param: match typ with | TBool -> List.map (fun s -> - Hashtbl.add defined_vars s (BVar s, false); BVar s) idents + Hashtbl.add defined_vars s (BVar s); BVar s) idents | TReal -> List.map (fun s -> - Hashtbl.add defined_vars s (RVar s, false); RVar s) idents + Hashtbl.add defined_vars s (RVar s); RVar s) idents | TInt -> List.map (fun s -> - Hashtbl.add defined_vars s (IVar s, false); IVar s) idents) } + Hashtbl.add defined_vars s (IVar s); IVar s) idents) } ; ident_comma_list: @@ -247,22 +256,25 @@ equations: ; equation: - pattern EQUAL expr + | pattern EQUAL expr { let (t_patt, patt) = $1 in let expr = $3 in let texpr = type_exp expr in if t_patt = texpr then ((t_patt, patt), expr) else (raise (MyParsingError ("The equation does not type check!", current_location()))) }; +automaton: + | AUTOMAT transition_list { (List.hd $2, $2)} +; pattern: | IDENT - { let v = fetch_var_def $1 in (type_var v, [v]) } + { let v = fetch_var $1 in (type_var v, [v]) } | LPAREN ident_comma_list_patt RPAREN { $2 }; ident_comma_list_patt: - | IDENT { make_ident (fetch_var_def $1) } - | IDENT COMMA ident_comma_list_patt { add_ident (fetch_var_def $1) $3 } + | IDENT { make_ident (fetch_var $1) } + | IDENT COMMA ident_comma_list_patt { add_ident (fetch_var $1) $3 } expr: /* Note: EQUAL does not follow the nomenclature CMP_, ... */ @@ -368,6 +380,8 @@ expr: else raise (MyParsingError ("The application does not type check!", current_location())) } + + /* Automaton */ ; expr_comma_list: @@ -392,10 +406,6 @@ ident_comma_list: | IDENT COMMA ident_comma_list { $1 :: $3 } ; -automaton: - AUTOMAT transition_list { bloop(); EAuto( [], List.hd $2, $2 ) } -; - transition: | CASE IDENT BO_arrow DO equations DONE { State($2, $5, EConst([TBool], CBool(true)), $2) } @@ -406,4 +416,5 @@ transition: transition_list: | transition { [$1] } | transition transition_list { $1 :: $2 } + | /* empty */ {raise(MyParsingError("Empty automaton", current_location()))} ; diff --git a/src/passes.ml b/src/passes.ml index 0d46f62..9e2fdc1 100644 --- a/src/passes.ml +++ b/src/passes.ml @@ -19,6 +19,7 @@ let equation_pass f ast: t_nodelist option = n_outputs = node.n_outputs; n_local_vars = node.n_local_vars; n_equations = eqs; + n_automata = node.n_automata; n_inputs_type = node.n_inputs_type; n_outputs_type = node.n_outputs_type; } diff --git a/src/pp.ml b/src/pp.ml index cf817ef..35105c3 100644 --- a/src/pp.ml +++ b/src/pp.ml @@ -51,28 +51,6 @@ let pp_expression = (pp_expression_list prefix) (ETuple (tt, exprs)) | _ -> raise (MyTypeError "This exception should not have been raised.") in - let rec pp_equations prefix fmt equations = - match equations with - | [] -> () - | (patt, expr) :: eqs -> - Format.fprintf fmt "\t\t∗ Equation of type : %a\n\t\t left side: %a\n\t\t right side:\n%a\n%a" - debug_type_pp (Utils.type_exp expr) - pp_varlist patt - (pp_expression_aux prefix) expr - (pp_equations prefix) eqs - in - let rec pp_state_list prefix fmt states = - match states with - | [] -> () - | State(name, actions, condition, next)::q -> - Format.fprintf fmt "%s|%s->DO\n%a%sUNTIL\n%aTHEN%s" - prefix - name - (pp_equations prefix) actions - prefix - (pp_expression_aux (upd_prefix prefix)) condition - next - in match expression with | EWhen (_, e1, e2) -> begin @@ -152,9 +130,6 @@ let pp_expression = | ETuple _ -> Format.fprintf fmt "\t\t\t%sTuple\n%a" prefix (pp_expression_list prefix) expression - | EAuto (_, _, states) -> - Format.fprintf fmt "\t\t\t%sAutomaton\n%a" prefix - (pp_state_list prefix) states; in pp_expression_aux "" diff --git a/src/test.node b/src/test.node index af937b1..5b65c18 100644 --- a/src/test.node +++ b/src/test.node @@ -11,3 +11,10 @@ let o = (not (not (l1 = l2))) and (l1 = l2) and true; tel +node auto (i: int) returns (o : int); +let + automaton + | Incr -> do o = (pre o) + 1; done + | Decr -> do o = (pre o) - 1; done +tel +