Skip to content

Commit

Permalink
fix for faill-uses6/7/8.mc (#2)
Browse files Browse the repository at this point in the history
  • Loading branch information
@gabryon99
gabryon99 committed Dec 22, 2021
1 parent 1c52d6b commit 6ca3d28
Show file tree
Hide file tree
Showing 5 changed files with 105 additions and 48 deletions.
1 change: 1 addition & 0 deletions lib/ast.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -124,6 +124,7 @@ and connection = Link of identifier * identifier * identifier * identifier
and 'a definition =
| ComponentDef of 'a component_decl
| InterfaceDef of 'a interface_decl
| ConnectionDef of connection list

and 'a compilation_unit =
| CompilationUnit of {
Expand Down
6 changes: 6 additions & 0 deletions lib/mcomp_stdlib.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -15,5 +15,11 @@ let list_remove element l =
| h::t -> if h = element then aux acc t else aux (h::acc) t
in aux [] l

let list_are_disjoint l1 l2 =
let rec aux = function
| [] -> true
| h::t -> not(List.mem h l2) && aux t in
aux l1

let name_mangle id typ =
Printf.sprintf "%s$%s" id (show_typ typ)
18 changes: 10 additions & 8 deletions lib/parser.mly
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,12 +6,13 @@
(* Define a new operator `@>` used to attach the location as an annotation for an annotated node. *)
let (@>) a b = Ast.make_node a (Location.to_code_position b)

let build_compilation_unit decls connections =
let rec aux interfaces components = function
let build_compilation_unit decls =
let rec aux interfaces components connections = function
| [] -> Ast.CompilationUnit({interfaces = interfaces; components = components; connections = connections})
| (Ast.InterfaceDef(iface_node))::t -> aux (iface_node::interfaces) components t
| (Ast.ComponentDef(comp_node))::t -> aux interfaces (comp_node::components) t
in aux [] [] decls
| (Ast.InterfaceDef(iface_node))::t -> aux (iface_node::interfaces) components connections t
| (Ast.ComponentDef(comp_node))::t -> aux interfaces (comp_node::components) connections t
| (Ast.ConnectionDef(conns)::t) -> aux interfaces components (conns@connections) t
in aux [] [] [] decls
%}

/* Token declarations */
Expand Down Expand Up @@ -110,12 +111,13 @@

/* Grammar Specification */
compilation_unit:
| decls = top_decl* conns = flatten(connections*) EOF { build_compilation_unit decls conns }
| decls = top_decl* EOF { build_compilation_unit decls }
;

top_decl:
| interface { Ast.InterfaceDef($1) }
| component { Ast.ComponentDef($1) }
| interface { Ast.InterfaceDef($1) }
| component { Ast.ComponentDef($1) }
| connections { Ast.ConnectionDef($1) }
;

interface:
Expand Down
10 changes: 9 additions & 1 deletion lib/scanner.mll
View file
Original file line number Diff line number Diff line change
Expand Up @@ -90,6 +90,11 @@ rule next_token = parse
}
| ['''] { character ' ' lexbuf }

| ['0'-'9']+identifier {
(* TODO: what about identifier not starting with _ or [a-zA-Z]*)
raise (Lexing_error((Location.to_lexeme_position lexbuf), "Invalid identifier. Identifier must be start with an _ or a letter!"))
}

(* Logical operators *)
| ['!'] { L_NOT }
| "&&" { L_AND_AND }
Expand Down Expand Up @@ -135,7 +140,7 @@ rule next_token = parse

| eof { EOF }

| _ as c { Printf.printf "Unmatched: %c\n" c; raise (Lexing_error((Location.to_lexeme_position lexbuf), "Unrecognized token!")) }
| _ { raise (Lexing_error((Location.to_lexeme_position lexbuf), "Unrecognized token!")) }

and single_line_comment = parse
| "\r\n"
Expand All @@ -153,6 +158,9 @@ and character c = parse
| ['\\']['n'] { character '\n' lexbuf}
| ['\\']['t'] { character '\t' lexbuf}
| ['\\']['r'] { character '\r' lexbuf}
| ['\\']['b'] { character '\b' lexbuf}
| ['\\']['''] { character '\'' lexbuf}
| ['\\']['"'] { character '\"' lexbuf}
| [^'''] as c { character c lexbuf }
| _ { raise (Lexing_error((Location.to_lexeme_position lexbuf), "Unrecognized character!"))}

Expand Down
118 changes: 79 additions & 39 deletions lib/semantic_analysis.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -157,43 +157,49 @@ let first_pass ast global_table =
raise (Semantic_error(loc, "Double field variable declerations!"))
end
in
(* Create components attribute... *)
let cattr = {id = cname; loc = loc; typ = Ast.TComponent(cname)} in

(* Check if the provides list has the prelude interface *)
if List.mem "Prelude" provides then
raise (Semantic_error(loc, "The Prelude interface cannot be provided by any component!"))
else
(* Create a symbol table containing interface references provided by the component *)
let cprov = Symbol_table.begin_block (Symbol_table.empty_table) in
let cprov = visit_prov_uses cprov "provides" provides in
(* Create a symbol table containing interface references provided by the component *)
let cuses = Symbol_table.begin_block (Symbol_table.empty_table) in
let cuses = visit_prov_uses cuses "uses" (List.cons "Prelude" uses) in
(*
A component must implement all the members defined in the interfaces it provides,
so from the defined_interfaces map filter the interfaces provided by the component...
*)
(* Build component symbol table containing all the definitions inside a component (fields/functions) *)
let csym_tbl = Symbol_table.begin_block (Symbol_table.empty_table) in
let csym_tbl = visit_member_definitions csym_tbl definitions in
(* Create a new symbol for the component and push it inside the symbol table *)
let csym = SComponent({cattr = cattr; csym_tbl = csym_tbl; cprov = cprov; cuses = cuses; cconnect = StrMap.empty}) in
try
visit_components (Symbol_table.add_entry cname csym global_table) tail
with Symbol_table.DuplicateEntry(_) ->
(* Check for duplicated symbol identifier *)
begin
let dup_sym = Symbol_table.lookup cname global_table in (* A MissingEntry exception cannot be thrown since the name is contained inside the table already *)
match dup_sym with
| SInterface(_) ->
let msg = Printf.sprintf "Component name not valid since it seems that an interface named` %s` already exists." cname in
raise (Semantic_error(loc, msg))
| SComponent(_) ->
let msg = Printf.sprintf "Duplicated component name. It seems that a component named` %s` already exists." cname in
raise (Semantic_error(loc, msg))
| _ -> ignore ()
end
(* Let's ensure provides and uses lists are disjoint *)
if not (Mcomp_stdlib.list_are_disjoint provides uses) then
raise (Semantic_error(loc, "Uses and provides lists are not disjoint!"))
else
(* Create components attribute... *)
let cattr = {id = cname; loc = loc; typ = Ast.TComponent(cname)} in
(* Create a symbol table containing interface references provided by the component *)
let cprov = Symbol_table.begin_block (Symbol_table.empty_table) in
let cprov = visit_prov_uses cprov "provides" provides in
let cuses = Symbol_table.begin_block (Symbol_table.empty_table) in
let cuses = visit_prov_uses cuses "uses" (List.cons "Prelude" uses) in
(*
A component must implement all the members defined in the interfaces it provides,
so from the defined_interfaces map filter the interfaces provided by the component...
*)
(* Build component symbol table containing all the definitions inside a component (fields/functions) *)
let csym_tbl = Symbol_table.begin_block (Symbol_table.empty_table) in
let csym_tbl = visit_member_definitions csym_tbl definitions in
(* Create a new symbol for the component and push it inside the symbol table *)
let csym = SComponent({cattr = cattr; csym_tbl = csym_tbl; cprov = cprov; cuses = cuses; cconnect = StrMap.empty}) in
try
visit_components (Symbol_table.add_entry cname csym global_table) tail
with Symbol_table.DuplicateEntry(_) ->
(* Check for duplicated symbol identifier *)
begin
let dup_sym = Symbol_table.lookup cname global_table in (* A MissingEntry exception cannot be thrown since the name is contained inside the table already *)
match dup_sym with
| SInterface(_) ->
let msg = Printf.sprintf "Component name not valid since it seems that an interface named` %s` already exists." cname in
raise (Semantic_error(loc, msg))
| SComponent(_) ->
let msg = Printf.sprintf "Duplicated component name. It seems that a component named` %s` already exists." cname in
raise (Semantic_error(loc, msg))
| _ -> ignore ()
end
in
let rec find_interface name = function
| [] -> None
| ({Ast.node = (Ast.InterfaceDecl({iname; _}) as iface); _})::tail -> if iname = name then Some iface else find_interface name tail
in
let rec check_component_provides global_table interfaces = function
| [] -> global_table
Expand All @@ -202,10 +208,6 @@ let first_pass ast global_table =
let loc = annotated_node.Ast.annot in
match node with
| Ast.ComponentDecl({cname; provides; _}) ->
let rec find_interface name = function
| [] -> None
| ({Ast.node = (Ast.InterfaceDecl({iname; _}) as iface); _})::tail -> if iname = name then Some iface else find_interface name tail
in
let cysm_tbl = (match Symbol_table.lookup cname global_table with SComponent({csym_tbl; _}) -> csym_tbl | _ -> ignore ()) in
let interfaces_nodes = List.map (fun iname -> find_interface iname interfaces) provides in
let _ = List.iter(fun i ->
Expand Down Expand Up @@ -251,6 +253,43 @@ let first_pass ast global_table =
) interfaces_nodes in
check_component_provides global_table interfaces tail
in
let rec check_component_uses global_table interfaces = function
| [] -> global_table
| annotated_node::tail ->
let node = annotated_node.Ast.node in
let loc = annotated_node.Ast.annot in
match node with
| Ast.ComponentDecl({cname; uses; _}) ->
if List.mem "App" uses then
raise (Semantic_error(loc, "The App interface cannot be used, just provided once!"))
else
(* Get the component symbol table *)
let cysm_tbl = (match Symbol_table.lookup cname global_table with SComponent({csym_tbl; _}) -> csym_tbl | _ -> ignore ()) in
(* Get a list of interfaces nodes from uses list *)
let interfaces_nodes = List.map (fun iname -> find_interface iname interfaces) uses in
(* Check if the component define function member coming by the interfaces *)
let _ = List.iter(fun iface_node ->
match iface_node with
| None -> ()
| Some iface ->
(* Get the interface name and decleration from th interface node *)
let (iname, ideclarations) = (match (iface) with Ast.InterfaceDecl({iname; declarations}) -> (iname, declarations)) in
(* For each decleration node, check if the function is defined inside the component symbol table *)
List.iter(fun imember ->
match imember.Ast.node with
| Ast.FunDecl({Ast.fname; _}) ->
begin
try
let _ = Symbol_table.lookup fname cysm_tbl in
let msg = Printf.sprintf "Invalid function identifier `%s` since the component uses `%s` interface which declares the function!" fname iname in
raise (Semantic_error(loc, msg))
with Symbol_table.MissingEntry(_) -> ()
end
| _ -> () (* Field member are ignored! *)
) ideclarations
) interfaces_nodes in
check_component_uses global_table interfaces tail
in
let rec check_main_components global_table app_provided = function
| [] ->
if not app_provided then
Expand All @@ -263,7 +302,7 @@ let first_pass ast global_table =
match node with
| Ast.ComponentDecl({provides; _}) ->
(* does the component provide the App interface? *)
let temp = List.exists ((=) "App") provides in
let temp = List.mem "App" provides in
if app_provided && temp then
let msg = "There was already a component providing the `App` interface." in
raise (Semantic_error(loc, msg))
Expand All @@ -289,6 +328,7 @@ let first_pass ast global_table =
| _ -> ignore ()) in
begin
try
(* TODO: check for interface compatibility issues *)
let (c1_sym_cuses, c1_sym_cconect) = (match c1_sym with SComponent({cuses; cconnect; _}) -> (cuses, cconnect) | _ -> ignore ()) in
let c2_sym_cprov = (match c2_sym with SComponent({cprov;_}) -> cprov | _ -> ignore ()) in
let _ = Symbol_table.lookup i1 c1_sym_cuses in
Expand All @@ -315,12 +355,12 @@ let first_pass ast global_table =
let global_table = visit_components global_table components in
(* Perform some checks *)
let global_table = check_component_provides global_table interfaces components in
let global_table = check_component_uses global_table interfaces components in
let global_table = check_main_components global_table false components in
(* At the end, perform linking *)
let global_table = link_connect_block global_table connections in
global_table


let _check_local_decl_type annotated_node =
let node = annotated_node.Ast.node in
let loc = annotated_node.Ast.annot in
Expand Down

0 comments on commit 6ca3d28

Please sign in to comment.