Something went wrong. Try again.
A component based functional template language
Something went wrong. Try again.
5.3 kB · 153 lines
OCaml
at compiler
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154type t = String_set.t String_map.t
let rec collect_expr acc (expr : Pinc_types.Ast.expression) = match expr.expression_desc with | Void | String _ | Char _ | Int _ | Float _ | Bool _ | LowercaseIdentifierExpression _ | ExternalFunction _ -> acc | UppercaseIdentifierExpression name -> String_set.add name acc | Array elems -> Array.fold_left collect_expr acc elems | Record fields -> String_map.fold (fun _ (_, e) a -> collect_expr a e) fields acc | Function { body; _ } -> collect_expr acc body | FunctionCall { function_definition; arguments } -> let acc = collect_expr acc function_definition in List.fold_left collect_expr acc arguments | TagExpression tag -> collect_tag acc tag | ForInExpression { iterable; body; _ } -> let acc = collect_expr acc iterable in collect_expr acc body | TemplateExpression node -> collect_template_node acc node | BlockExpression stmts -> List.fold_left collect_stmt acc stmts | ConditionalExpression { condition; consequent; alternate } -> ( let acc = collect_expr acc condition in let acc = collect_expr acc consequent in match alternate with | None -> acc | Some s -> collect_expr acc s) | UnaryExpression (_, e) -> collect_expr acc e | BinaryExpression (l, _, r) -> let acc = collect_expr acc l in collect_expr acc r
and collect_stmt acc (stmt : Pinc_types.Ast.statement) = match stmt.statement_desc with | BreakStatement | ContinueStatement -> acc | LetGroupStatement let_definitions -> List.fold_left (fun acc (~is_optional:_, ~is_mutable:_, _, e) -> collect_expr acc e) acc let_definitions | LetStatement (_, e, ..) | MutationStatement (_, e) | ExpressionStatement e -> collect_expr acc e
and collect_tag acc (tag : Pinc_types.Ast.tag) = let acc = String_map.fold (fun _ e a -> collect_expr a e) tag.tag_desc.attributes acc in match tag.tag_desc.children with | None -> acc | Some e -> collect_expr acc e
and collect_template_node acc (node : Pinc_types.Ast.template_node) = match node.template_node_desc with | TextTemplateNode _ -> acc | PortalTemplateNode _ -> acc | FragmentTemplateNode fragment_children -> List.fold_left collect_template_node acc fragment_children | ExpressionTemplateNode e -> collect_expr acc e | HtmlTemplateNode { html_tag_attributes; html_tag_children; _ } -> let acc = String_map.fold (fun _ e a -> collect_expr a e) html_tag_attributes acc in List.fold_left collect_template_node acc html_tag_children | ComponentTemplateNode { component_tag_identifier = Uppercase_Id (name, _); component_tag_attributes; component_tag_children; } -> let acc = String_set.add name acc in let acc = String_map.fold (fun _ e a -> collect_expr a e) component_tag_attributes acc in List.fold_left collect_template_node acc component_tag_children;;
let declaration_deps (decl : Pinc_types.Ast.declaration) : String_set.t = let acc = String_map.fold (fun _ e a -> collect_expr a e) decl.declaration_attributes String_set.empty in collect_expr acc decl.declaration_body;;
let cyclic_dependencies (graph : t) = let resolve_status = Hashtbl.create (String_map.cardinal graph) in
let rec aux key dependencies resolved_as_circular path = Hashtbl.replace resolve_status key `Unresolved;
let result = String_set.fold (fun dependency resolved_as_circular -> let path = dependency :: path in match Hashtbl.find_opt resolve_status dependency with | Some `Resolved -> resolved_as_circular | Some `Unresolved -> (key, List.rev path) :: resolved_as_circular | None -> ( match String_map.find_opt dependency graph with | None -> resolved_as_circular | Some dependencies -> aux dependency dependencies resolved_as_circular path )) dependencies resolved_as_circular in
Hashtbl.replace resolve_status key `Resolved; result in
String_map.fold (fun key dependencies acc -> aux key dependencies acc [ key ]) graph [];;
let report_cyclic_dependencies ast deps = List.iter (fun (key, path) -> let declaration = String_map.find key ast in let path = String.concat " -> " path in Pinc_diagnostics.raise_error declaration.Pinc_types.Ast.declaration_loc (Printf.sprintf "Found cyclic dependency in `%s`:\n%s\n%!" key path)) deps;;
let build (ast : Pinc_types.Ast.t) : t = let graph = String_map.map declaration_deps ast in let () = report_cyclic_dependencies ast @@ cyclic_dependencies graph in graph;;
let dependencies_of (graph : t) (name : string) : String_set.t = String_map.find_opt name graph |> Option.value ~default:String_set.empty;;
let transitive_dependencies_of (graph : t) (name : string) : String_set.t = let rec aux acc name = let direct = dependencies_of graph name in
String_set.fold (fun dep acc -> if String_set.mem dep acc then acc else ( let acc = String_set.add dep acc in String_set.union acc (aux acc dep))) direct acc in
aux String_set.empty name;;