Refactor tree representation · anil.recoil.org/ocaml-forester@4ddb528

+1 -2

lib/compiler/Config_error.ml

+16 -24

lib/compiler/Driver.ml

··· 31 31 let () = 32 32 let@ tree_dir = List.iter @~ paths in 33 33 assert (Eio.Path.is_directory tree_dir); 34 - let@ tree_src = Seq.iter @~ Phases.load tree_dir in 35 - let lsp_uri = Lsp.Text_document.documentUri tree_src in 34 + let@ tree = Seq.iter @~ Phases.load tree_dir in 35 + let lsp_uri = Tree.lsp_uri tree in 36 36 let uri = URI_scheme.lsp_uri_to_uri ~base:forest.config.url lsp_uri in 37 37 URI.Tbl.replace forest.resolver uri (Lsp.Uri.to_path lsp_uri); 38 - forest.={uri} <- Document tree_src 38 + forest.={uri} <- Tree tree 39 39 (*lsp_documents ;*) 40 40 (*Logs.debug (fun m -> m "loaded %d trees" (Seq.length lsp_documents))*) 41 41 in ··· 43 43 | Parse_all -> 44 44 let errors, codes = Phases.parse forest in 45 45 let () = 46 - let@ code = List.iter @~ codes in 47 - let@ uri = Option.iter @~ Tree.(identity_to_uri code.identity) in 48 - forest.={uri} <- Parsed code; 46 + let@ uri, code = List.iter @~ codes in 47 + forest.={uri} <- Tree code; 49 48 forest.?{uri} <- [] 50 49 in 51 50 if List.length errors = 0 then 52 51 assert (Seq.for_all Tree.is_parsed (URI.Tbl.to_seq_values forest.index)); 53 52 let () = 54 - let@ error = List.iter @~ errors in 55 - let@ uri = 56 - Option.iter 57 - @~ Option.map 58 - (URI_scheme.lsp_uri_to_uri ~base:forest.config.url) 59 - (Phases.guess_uri error.range) 60 - in 53 + let@ uri, error = List.iter @~ errors in 61 54 forest.?{uri} <- [Error.parse_error error] 62 55 in 63 56 ( report 64 - ~errors:(List.map Error.parse_error errors) 57 + ~errors:(List.map (snd >>> Error.parse_error) errors) 65 58 ~and_then:Build_import_graph, 66 59 forest ) 67 60 | Build_import_graph -> ··· 78 71 | None -> assert false 79 72 | Some code -> 80 73 let result, errors = Phases.expand forest code in 81 - forest.={uri} <- Expanded result; 74 + forest.={uri} <- Tree result; 82 75 (report ~errors ~and_then:(Eval uri), forest) 83 76 end 84 77 | Eval_all -> ··· 126 119 (Done, forest) 127 120 | Load_tree path -> 128 121 let doc = Imports.load_tree path in 129 - Logs.debug (fun m -> m "%s" (Lsp.Text_document.text doc)); 130 - let lsp_uri = Lsp.Text_document.documentUri doc in 122 + let lsp_uri = Tree.lsp_uri doc in 131 123 let uri = URI_scheme.lsp_uri_to_uri ~base:forest.config.url lsp_uri in 132 - forest.={uri} <- Document doc; 124 + forest.={uri} <- Tree doc; 133 125 (Parse lsp_uri, forest) 134 126 | Parse uri -> 135 127 Logs.debug (fun m -> m "Reparsing"); 136 128 let uri = URI_scheme.lsp_uri_to_uri ~base:forest.config.url uri in 137 129 begin match Option.bind forest.={uri} Tree.to_doc with 138 130 | Some doc -> begin 139 - match Parse.parse_document ~config:forest.config doc with 131 + match Parse.parse_document doc with 140 132 | Ok code -> 141 - forest.={uri} <- Parsed code; 133 + forest.={uri} <- Tree code; 142 134 forest.?{uri} <- []; 143 - Imports.fixup code forest; 135 + Imports.fixup ~uri code forest; 144 136 (Expand uri, forest) 145 137 | Error parse_error -> 146 138 let errors = [Error.parse_error parse_error] in ··· 148 140 (report ~errors ~and_then:Done, forest) 149 141 end 150 142 | None -> ( 151 - match Imports.resolve_uri_to_code forest uri with 143 + match Imports.resolve_uri_to_code ~forest uri with 152 144 | Ok code -> 153 - Imports.fixup code forest; 154 - forest.={uri} <- Parsed code; 145 + Imports.fixup ~uri code forest; 146 + forest.={uri} <- Tree code; 155 147 (Expand uri, forest) 156 148 | Error errors -> (Report_errors (errors, Expand uri), forest)) 157 149 end

+34 -11

lib/compiler/Error.ml

··· 81 81 ~none:[] 82 82 83 83 let render_type_error ~range Eval_error.{got; expected} = 84 + let show_value : Value.t -> string = function 85 + | Value.Content _ -> "content" 86 + | Value.Clo (_, _, _) -> "a function" 87 + | Value.Dx_prop _ -> "a datalog proposition" 88 + | Value.Dx_sequent _ -> "a datalog sequent" 89 + | Value.Dx_query _ -> "a datalog query" 90 + | Value.Dx_var _ -> "a datalog variable" 91 + | Value.Dx_const _ -> "a datalog constant" 92 + | Value.Sym _ -> "a symbol" 93 + | Value.Obj _ -> "an object" 94 + in 84 95 let labels = 85 96 range 86 97 |> Option.fold ~none:[] ~some:(fun range -> 87 98 match got with 88 - | Some (Value.Clo _) -> 99 + | Some (Clo _) -> 89 100 [ 90 101 Label.createf ~range ~priority:Primary 91 102 "This is a function. Did you forget to provide some arguments?"; 92 103 ] 93 - | Some got -> 104 + | Some (Obj _) -> 94 105 [ 95 - Label.createf ~range ~priority:Primary "this value is of type %a" 96 - Value.pp got; 106 + Label.createf ~range ~priority:Primary 107 + "This is an object. Did you forget to bind this object to an \ 108 + identifier?"; 97 109 ] 110 + | Some got -> 111 + [Label.createf ~range ~priority:Primary "this is %s" (show_value got)] 98 112 | None -> []) 99 113 in 114 + let got_note = 115 + match range with 116 + | None -> 117 + Option.fold got 118 + ~some:(fun got -> [Message.createf "this is %s" (show_value got)]) 119 + ~none:[] 120 + | Some _ -> [] 121 + in 100 122 let notes = 101 123 match expected with 102 124 | [] -> [] ··· 109 131 ] 110 132 in 111 133 let msg = Message.createf "mismatched type" in 112 - Diagnostic.create Error ~code:`Type_error ~labels ~notes msg 134 + Diagnostic.create Error ~code:`Type_error ~labels ~notes:(got_note @ notes) 135 + msg 113 136 114 137 (* 115 138 Diagnostic.Label.createf ~range ~priority:Diagnostic.Priority.Primary ··· 173 196 Diagnostic.createf ~code:`Config_error Error "directory %s does not exist" s 174 197 | Missing_file s -> 175 198 Diagnostic.createf ~code:`Config_error Error "file %s does not exist" s 176 - | Todo -> Diagnostic.createf Error "todo" 177 199 178 200 let render_latex_error ({range; msg} : latex_error) = 179 201 Diagnostic.create Error ··· 221 243 | Io_error error -> render_io_error error 222 244 | Configuration_error error -> render_config_error error 223 245 | LaTeX_error error -> render_latex_error error 224 - | Duplicate_tree _uri -> Diagnostic.createf Error "todo" 246 + | Duplicate_tree uri -> 247 + Diagnostic.createf Error "duplicate tree %a" URI.pp uri 225 248 | Broken_link link -> render_broken_link link 226 249 | Broken_transclusion t -> render_broken_transclusion t 227 250 | Unlinked_attribution_warning w -> render_unlinked_attribution_warning w 228 - | Failed_to_load_foreign_blob _ -> failwith "todo" 229 - | Failed_to_parse_foreign_blob _ -> failwith "todo" 230 - | Failed_to_add_edge (_, _) -> failwith "todo" 231 - | Unknown_error _ -> failwith "todo" 251 + | Failed_to_load_foreign_blob _ -> failwith "failed to load foreign blob" 252 + | Failed_to_parse_foreign_blob _ -> failwith "failed to parse foreign bob" 253 + | Failed_to_add_edge (_, _) -> failwith "failed to add edge" 254 + | Unknown_error _ -> failwith "unknown error" 232 255 233 256 (* 234 257 let corrected = "\\tag/content" in

+8 -7

lib/compiler/Eval.ml

··· 375 375 | Some addr -> Some (URI.named_uri ~base:env.config.url addr) 376 376 | None -> None 377 377 in 378 - let* subtree = eval_tree_inner ~env ?uri nodes in 378 + let* subtree = eval_tree_inner ~env ~range ?uri nodes in 379 379 let frontmatter = env.frontmatter in 380 380 let subtree = 381 381 { ··· 727 727 match c with 728 728 | Content content when T.strip_whitespace content = T.Content [] -> ok v 729 729 | v' -> 730 - let expected = [] in 730 + let expected = [Content] in 731 731 let got = Some v' in 732 732 type_error ~got ~expected ~range 733 733 end ··· 765 765 and emit_content_node ~env ~range content = 766 766 emit_content_nodes ~env ~range [content] 767 767 768 - and eval_tree_inner ~env ?(uri : URI.t option) (syn : Syn.t) : 768 + and eval_tree_inner ~env ~range ?(uri : URI.t option) (syn : Syn.t) : 769 769 (T.content T.article, _) result = 770 770 let attribution_is_author attr = 771 771 match T.(attr.role) with T.Author -> true | _ -> false ··· 782 782 let env = {env with frontmatter = ref frontmatter} in 783 783 let* mainmatter = 784 784 let* value = eval_tape ~env syn in 785 - extract_content {value; range = None} 785 + extract_content {value; range} 786 786 in 787 787 let frontmatter = env.frontmatter.contents in 788 788 let backmatter = ··· 794 794 config:Config.t -> 795 795 uri:URI.t -> 796 796 source_path:string option -> 797 - Syn.t -> 797 + Tree.(expanded tree) -> 798 798 eval_result option * Error.t list = 799 - fun ~config ~uri ~source_path tree -> 799 + fun ~config ~uri ~source_path {tree = {nodes; _}; source; _} -> 800 800 let res = ref None in 801 801 let errors = 802 802 let@ () = Error.collect in 803 803 let fm = T.default_frontmatter ~uri ?source_path () in 804 804 let env = initial_eval_env config (ref fm) in 805 - match eval_tree_inner ~env ~uri tree with 805 + let range = Option.map Range.(fun source -> total ~source) source in 806 + match eval_tree_inner ~range ~env ~uri nodes with 806 807 | Error error -> Error.yield_eval_error error 807 808 | Ok main -> 808 809 let side = env.emitted_trees |> Stack.to_seq |> List.of_seq in

+8 -6

lib/compiler/Expand.ml

··· 1082 1082 let initial_visible_trie : (Syn.resolver_data, Range.t option) Trie.t = 1083 1083 Yuujinchou.Trie.of_seq builtins 1084 1084 1085 - let expand_tree_inner ~forest (code : Tree.code) : Tree.syn = 1085 + let expand_tree_inner ~forest (code : Tree.(parsed tree)) : Tree.(expanded tree) 1086 + = 1086 1087 let@ () = Sc.section [] in 1087 - let nodes = expand_eff ~forest code.nodes in 1088 - let exports = Sc.get_export () in 1089 - Tree.{nodes; identity = code.identity; code; units = exports} 1088 + let nodes = expand_eff ~forest Tree.(nodes code) in 1089 + let units = Sc.get_export () in 1090 + let tree : Tree.expanded = {nodes; code = Tree.nodes code; units} in 1091 + Tree.{tree; source = code.source; phase = Expanded} 1090 1092 1091 - let expand_tree ~(forest : State.t) (code : Tree.code) : Tree.syn * Error.t list 1092 - = 1093 + let expand_tree ~(forest : State.t) (code : Tree.(parsed tree)) : 1094 + Tree.(expanded tree) * Error.t list = 1093 1095 let result = ref None in 1094 1096 let errors = 1095 1097 let@ () = Error.collect in

+2 -1

lib/compiler/Expand.mli

··· 21 21 22 22 val expand : forest:State.t -> Code.t -> Syn.t 23 23 24 - val expand_tree : forest:State.t -> Tree.code -> Tree.syn * Error.t list 24 + val expand_tree : 25 + forest:State.t -> Tree.(parsed tree) -> Tree.(expanded tree) * Error.t list 25 26 26 27 type 'a Effect.t += Entered_range : Range.t option -> unit Effect.t 27 28

+49 -52

lib/compiler/Imports.ml

··· 18 18 mutable errors: Error.t list; 19 19 } 20 20 21 - let load_tree path = 21 + let load_tree path : Tree.(loaded tree) = 22 22 let content = Eio.Path.load path in 23 23 let path_str = Eio.Path.native_exn path in 24 24 assert (not @@ Filename.is_relative path_str); 25 25 let uri = Lsp.Uri.of_path path_str in 26 - Lsp.Text_document.make ~position_encoding:`UTF8 27 - {textDocument = {languageId = "forester"; text = content; uri; version = 1}} 26 + let doc = 27 + Lsp.Text_document.make ~position_encoding:`UTF8 28 + { 29 + textDocument = 30 + {languageId = "forester"; text = content; uri; version = 1}; 31 + } 32 + in 33 + {phase = Loaded; tree = doc; source = Some (`File path_str)} 28 34 29 35 (* Only add edge if both vertices are already present*) 30 36 let add_edge g v w = ··· 34 40 ok @@ Forest_graph.add_edge g v w 35 41 with Assert_failure _ -> error @@ Error.failed_to_add_edge v w 36 42 37 - let resolve_uri_to_code (forest : State.t) (uri : URI.t) : 38 - (Tree.code, Error.t list) Result.t = 43 + let resolve_uri_to_code ~(forest : State.t) (uri : URI.t) : 44 + (Tree.(parsed tree), Error.t list) Result.t = 39 45 let errors, dirs = 40 46 Pair.map_fst (List.map Error.io_error) 41 47 @@ Eio_util.paths_of_dirs ~env:forest.env forest.config.trees ··· 52 58 | Some path -> 53 59 let doc = load_tree Eio.Path.(forest.env#fs / path) in 54 60 Result.map_error (Error.parse_error >>> List.singleton) 55 - @@ Parse.parse_document ~config:forest.config doc 61 + @@ Parse.parse_document doc.tree 56 62 | None -> begin 57 63 match Dir_scanner.find_tree dirs uri with 58 64 | Some path -> ··· 60 66 URI.Tbl.add forest.resolver uri native; 61 67 let doc = load_tree path in 62 68 Result.map_error (Error.parse_error >>> List.singleton) 63 - @@ Parse.parse_document ~config:forest.config doc 69 + @@ Parse.parse_document doc.tree 64 70 | None -> assert false 65 71 end 66 72 end 67 73 68 - let rec analyse_tree ~env (tree : Tree.code) = 69 - let@ root = Option.iter @~ identity_to_uri tree.identity in 70 - let code = tree.nodes in 74 + let rec analyse_tree ~env ~uri code = 75 + let@ root = Option.iter @~ uri in 71 76 Forest_graph.add_vertex env.graph (T.Uri_vertex root); 72 77 analyse_code ~env ~root code 73 78 ··· 84 89 Forest_graph.add_vertex env.graph dependency; 85 90 assert (Result.is_ok @@ add_edge env.graph dependency target); 86 91 if env.follow then begin 87 - match resolve_uri_to_code env.forest dep_uri with 88 - | Ok code -> analyse_tree ~env code 92 + match resolve_uri_to_code ~forest:env.forest dep_uri with 93 + | Ok code -> analyse_tree ~env ~uri:(Some dep_uri) Tree.(nodes code) 89 94 | Error error -> env.errors <- List.append error env.errors 90 95 end 91 96 | Subtree (addr, nodes) -> 92 - let identity = 93 - match addr with 94 - | None -> Anonymous 95 - | Some string -> URI (URI.named_uri ~base:config.url string) 96 - in 97 - analyse_tree ~env 98 - {identity; origin = Subtree {parent = URI root}; nodes; timestamp = None} 97 + let uri = Option.map (URI.named_uri ~base:config.url) addr in 98 + analyse_tree ~env ~uri nodes 99 99 | Scope code 100 100 | Namespace (_, code) 101 101 | Group (_, code) ··· 128 128 | Error _ -> 129 129 () 130 130 131 - let dependencies tree forest = 131 + let dependencies ~uri tree forest = 132 132 let env = 133 133 {forest; follow = true; graph = Forest_graph.create (); errors = []} 134 134 in 135 - analyse_tree ~env tree; 135 + analyse_tree ~env ~uri tree; 136 136 env.graph 137 137 138 - let fixup (tree : Tree.code) (forest : State.t) = 139 - Logs.debug (fun m -> m "updating imports for %a" pp_identity tree.identity); 138 + let fixup ~uri (tree : Tree.(parsed tree)) (forest : State.t) = 139 + Logs.debug (fun m -> m "updating imports for %a" URI.pp uri); 140 140 let graph = forest.import_graph in 141 - match tree.identity with 142 - | Anonymous -> assert false 143 - | URI uri -> 144 - let this_vertex = T.Uri_vertex uri in 145 - let old_deps = 141 + let this_vertex = T.Uri_vertex uri in 142 + let old_deps = 143 + Vertex_set.of_list @@ Forest_graph.immediate_dependencies graph this_vertex 144 + in 145 + let new_deps = 146 + let env = {forest; follow = false; graph; errors = []} in 147 + begin 148 + analyse_tree ~env ~uri:(Some uri) Tree.(nodes tree); 146 149 Vertex_set.of_list 147 - @@ Forest_graph.immediate_dependencies graph this_vertex 148 - in 149 - let new_deps = 150 - let env = {forest; follow = false; graph; errors = []} in 151 - begin 152 - analyse_tree ~env tree; 153 - Vertex_set.of_list 154 - @@ Forest_graph.immediate_dependencies env.graph this_vertex 155 - end 156 - in 157 - let unchanged_deps = Vertex_set.inter new_deps old_deps in 158 - let added_deps = Vertex_set.diff new_deps unchanged_deps in 159 - let removed_deps = Vertex_set.diff old_deps unchanged_deps in 160 - Logs.debug (fun m -> 161 - m "added %d dependencies" (Vertex_set.cardinal added_deps)); 162 - Logs.debug (fun m -> 163 - m "removed %d dependencies" (Vertex_set.cardinal removed_deps)); 164 - Vertex_set.iter 165 - (fun v -> Forest_graph.remove_edge graph v this_vertex) 166 - removed_deps; 167 - Vertex_set.iter 168 - (fun v -> Forest_graph.add_edge graph v this_vertex) 169 - added_deps 150 + @@ Forest_graph.immediate_dependencies env.graph this_vertex 151 + end 152 + in 153 + let unchanged_deps = Vertex_set.inter new_deps old_deps in 154 + let added_deps = Vertex_set.diff new_deps unchanged_deps in 155 + let removed_deps = Vertex_set.diff old_deps unchanged_deps in 156 + Logs.debug (fun m -> 157 + m "added %d dependencies" (Vertex_set.cardinal added_deps)); 158 + Logs.debug (fun m -> 159 + m "removed %d dependencies" (Vertex_set.cardinal removed_deps)); 160 + Vertex_set.iter 161 + (fun v -> Forest_graph.remove_edge graph v this_vertex) 162 + removed_deps; 163 + Vertex_set.iter 164 + (fun v -> Forest_graph.add_edge graph v this_vertex) 165 + added_deps 170 166 171 167 let _minimal_dependency_graph : addr:URI.t -> Forest_graph.t = 172 168 fun ~addr -> ··· 185 181 let env = 186 182 {forest; follow = false; graph = Forest_graph.create (); errors = []} 187 183 in 188 - State.get_all_code ~forest:env.forest |> Seq.iter (analyse_tree ~env); 184 + State.get_all_code ~forest:env.forest 185 + |> Seq.iter (fun (uri, code) -> analyse_tree ~uri:(Some uri) ~env code); 189 186 (env.errors, env.graph)

+4 -4

lib/compiler/Imports.mli

··· 13 13 mutable errors: Error.t list; 14 14 } 15 15 16 - val load_tree : Eio.Fs.dir_ty Eio.Path.t -> Lsp.Text_document.t 16 + val load_tree : Eio.Fs.dir_ty Eio.Path.t -> Tree.(loaded tree) 17 17 val build : State.t -> Error.t list * Forest_graph.t 18 - val dependencies : Tree.code -> State.t -> Forest_graph.t 18 + val dependencies : uri:URI.t option -> Code.t -> State.t -> Forest_graph.t 19 19 val resolve_uri_to_code : 20 - State.t -> Forest.key -> (Tree.code, Error.t list) Result.t 21 - val fixup : Tree.code -> State.t -> unit 20 + forest:State.t -> URI.t -> (Tree.(parsed tree), Error.t list) Result.t 21 + val fixup : uri:URI.t -> Tree.(parsed tree) -> State.t -> unit

+39 -42

lib/compiler/Phases.ml

··· 24 24 Dir_scanner.scan_directory tree_dir |> Seq.map Imports.load_tree 25 25 26 26 let parse (forest : State.t) = 27 - let trees = forest.index |> URI.Tbl.to_seq_values |> List.of_seq in 28 - let results = 29 - let@ tree = List.filter_map @~ trees in 27 + let trees = forest.index |> URI.Tbl.to_seq |> List.of_seq in 28 + let@ uri, result = 29 + List.partition_map 30 + @~ 31 + let@ uri, Tree tree = List.filter_map @~ trees in 30 32 match tree with 31 - | Document doc -> Some (Parse.parse_document ~config:forest.config doc) 32 - | Parsed _ | Expanded _ | Resource _ -> None 33 + | {phase; tree; _} -> begin 34 + match phase with 35 + | Parsed | Expanded | Evaluated -> None 36 + | Loaded -> begin Some (uri, Parse.parse_document tree) end 37 + end 33 38 in 34 - let@ result = List.partition_map @~ results in 35 - match result with Ok t -> Right t | Error d -> Left d 39 + match result with Ok tree -> Right (uri, tree) | Error e -> Left (uri, e) 36 40 37 41 let reparse (doc : Lsp.Text_document.t) (forest : State.t) = 38 42 Logs.debug (fun m -> m "reparsing"); ··· 40 44 URI_scheme.lsp_uri_to_uri ~base:forest.config.url 41 45 @@ Lsp.Text_document.documentUri doc 42 46 in 43 - begin match Parse.parse_document ~config:forest.config doc with 47 + begin match Parse.parse_document doc with 44 48 | Ok code -> 45 - forest.={uri} <- Parsed code; 46 - Imports.fixup code forest 49 + forest.={uri} <- Tree code; 50 + Imports.fixup ~uri code forest 47 51 | Error d -> forest.?{uri} <- [Error.parse_error d] 48 - end; 49 - forest 52 + end 50 53 51 54 let build_import_graph ~(forest : State.t) : _ * _ = Imports.build forest 52 55 ··· 65 68 | Some tree -> 66 69 let expanded, errors = Expand.expand_tree ~forest tree in 67 70 diagnostics := errors @ !diagnostics; 68 - forest.={uri} <- Expanded expanded; 71 + forest.={uri} <- Tree expanded; 69 72 forest.?{uri} <- errors 70 73 | None -> 71 74 Logs.debug (fun m -> m "expanding: no source code for %a" URI.pp uri); ··· 100 103 match guess_uri (Error.tex_range tex_error) with 101 104 | None -> assert false 102 105 | Some uri -> 103 - let uri = Tree.of_lsp_uri ~base:forest.config.url uri in 106 + let uri = URI_scheme.lsp_uri_to_uri ~base:forest.config.url uri in 104 107 forest.?{uri} <- [Error.of_tex_error tex_error] 105 108 end 106 109 end 107 110 108 111 let eval (forest : State.t) = 109 - let expanded_trees = 110 - State.get_all_unevaluated ~forest 111 - |> Seq.filter Tree.is_expanded 112 - |> List.of_seq 113 - in 112 + let expanded_trees = State.get_all_expanded ~forest |> List.of_seq in 114 113 let errors, results = 115 - let@ expanded = List.partition_map @~ expanded_trees in 116 - let tree = Option.get @@ Tree.to_syn expanded in 117 - match identity_to_uri tree.identity with 118 - | None -> left [Error.cant_eval_anonymous_tree] 119 - | Some uri -> 120 - let source_path = 121 - if forest.dev then URI.Tbl.find_opt forest.resolver uri else None 122 - in 123 - right Eval.(eval_tree ~config:forest.config ~source_path ~uri tree.nodes) 114 + let@ uri, tree = List.partition_map @~ expanded_trees in 115 + let source_path = 116 + if forest.dev then URI.Tbl.find_opt forest.resolver uri else None 117 + in 118 + right Eval.(eval_tree ~config:forest.config ~source_path ~uri tree) 124 119 in 125 120 let results, additional_errors = 126 121 let organize = ··· 133 128 let eval_only (uri : URI.t) (forest : State.t) = 134 129 match forest.={uri} with 135 130 | None -> assert false 136 - | Some (Document _) -> assert false 137 - | Some (Parsed _) | Some (Resource _) -> assert false 138 - | Some (Expanded expanded) -> 139 - let source_path = 140 - if forest.dev then URI.Tbl.find_opt forest.resolver uri else None 141 - in 142 - (* TODO: run jobs. *) 143 - let result, errors = 144 - Eval.eval_tree ~config:forest.config ~source_path ~uri expanded.nodes 145 - in 146 - forest.?{uri} <- errors; 147 - let@ {articles; _} = Option.iter @~ result in 148 - let@ article = List.iter @~ articles in 149 - State.plant_resource ~forest (Article article) 131 + | Some (Tree ({phase; _} as t)) -> begin 132 + match phase with 133 + | Loaded | Parsed | Evaluated -> assert false 134 + | Expanded -> 135 + let source_path = 136 + if forest.dev then URI.Tbl.find_opt forest.resolver uri else None 137 + in 138 + (* TODO: run jobs. *) 139 + let result, errors = 140 + Eval.eval_tree ~config:forest.config ~source_path ~uri t 141 + in 142 + forest.?{uri} <- errors; 143 + let@ {articles; _} = Option.iter @~ result in 144 + let@ article = List.iter @~ articles in 145 + State.plant_resource ~forest (Article article) 146 + end 150 147 151 148 let implant ~(forest : State.t) (foreign : Config.foreign) = 152 149 let* path =

+57 -92

lib/compiler/State.ml

··· 7 7 open Forester_core 8 8 open Tree 9 9 open Forester_core 10 - open Grace 11 10 12 11 open struct 13 12 module T = Types ··· 76 75 match state.={uri} with 77 76 | None -> URI.Tbl.replace state.index uri tree 78 77 | Some existing -> 79 - if Tree.origin tree <> Tree.origin existing then 78 + if 79 + Option.(compare Grace.Source.compare) 80 + (Tree.source tree) (Tree.source existing) 81 + = 0 82 + && Tree.(equal_phases tree existing) 83 + then 80 84 let () = state.?{uri} <- [Error.duplicate_tree ~uri] in 81 85 URI.Tbl.replace state.index uri tree 82 86 else URI.Tbl.replace state.index uri tree ··· 86 90 let ( ./{} ) state uri = 87 91 Option.bind (URI.Tbl.find_opt state.index uri) Tree.get_units 88 92 93 + (* 89 94 (* updating units*) 90 95 let ( ./{}<- ) state uri units : _ result = 91 96 match URI.Tbl.find_opt state.index uri with ··· 100 105 | Some (Expanded expanded) -> 101 106 ok @@ URI.Tbl.replace state.index uri (Expanded {expanded with units}) 102 107 | Some (Resource _) -> Ok () 108 + *) 103 109 104 110 (* @ for article/resource *) 105 111 let ( .@{} ) state uri = 106 112 match URI.Tbl.find_opt state.index uri with 107 - | Some (Document _) -> None 108 - | Some (Parsed _) | Some (Expanded _) | None -> None 109 - | Some (Resource res) -> Some res.resource 113 + | Some (Tree {phase = Evaluated; tree; _}) -> Some tree.resource 114 + | _ -> None 110 115 end 111 116 112 117 open Syntax ··· 121 126 forest.index |> URI.Tbl.to_seq_values |> Seq.filter is_unparsed 122 127 123 128 let get_all_code ~forest = 124 - forest.index |> URI.Tbl.to_seq_values |> Seq.filter_map to_code 129 + forest.index |> URI.Tbl.to_seq 130 + |> Seq.filter_map (fun (uri, code) -> 131 + match to_code code with 132 + | None -> None 133 + | Some code -> Some (uri, nodes code)) 125 134 126 135 let get_all_unexpanded ~forest = 127 136 forest.index |> URI.Tbl.to_seq_values |> Seq.filter is_unexpanded 128 137 129 138 let get_all_expanded ~forest = 130 - forest.index |> URI.Tbl.to_seq_values |> Seq.filter_map to_syn 139 + forest.index |> URI.Tbl.to_seq 140 + |> Seq.filter_map (fun (uri, tree) -> 141 + match to_syn tree with None -> None | Some tree -> Some (uri, tree)) 131 142 132 143 let get_all_unevaluated ~forest = 133 - forest.index |> URI.Tbl.to_seq_values |> Seq.filter is_unevaluated 144 + forest.index |> URI.Tbl.to_seq 145 + |> Seq.filter_map (fun (uri, tree) -> 146 + if is_unevaluated tree then Some (uri, tree) else None) 134 147 135 148 let get_all_articles : t -> T.content T.article Seq.t = 136 149 fun state -> state.index |> URI.Tbl.to_seq_values |> Seq.filter_map to_article ··· 151 164 let get_article : forest:t -> URI.t -> T.content T.article option = 152 165 fun ~forest uri -> 153 166 match URI.Tbl.find_opt forest.index uri with 154 - | None | Some (Document _) | Some (Parsed _) | Some (Expanded _) -> None 155 - | Some (Resource {resource; _}) -> ( 156 - match resource with T.Article a -> Some a | _ -> None) 167 + | None -> None 168 + | Some tree -> Tree.to_article tree 169 + 170 + let resolve ~forest ~uri = URI.Tbl.find_opt forest.resolver uri 157 171 158 172 let section_symbol = "§" 159 173 ··· 260 274 | None -> Not_found {suggestion = URI.Tbl.find_opt forest.suggestions uri} 261 275 )) 262 276 263 - let plant_resource ?(route_locally = true) ?(include_in_manifest = true) 264 - resource ~forest = 277 + let plant_resource : 278 + ?route_locally:bool -> 279 + ?include_in_manifest:bool -> 280 + T.content T.resource -> 281 + forest:t -> 282 + unit = 283 + fun ?(route_locally = true) ?(include_in_manifest = true) resource ~forest -> 265 284 let module Graphs = (val forest.graphs) in 266 285 Forest.analyse_resource forest.graphs resource; 267 286 let@ uri = Option.iter @~ T.uri_for_resource resource in 287 + Logs.debug (fun m -> m "planting resource %a" URI.pp uri); 268 288 let uri = URI.canonicalise uri in 269 289 (* Seems dodgy if this isn't already canonical! *) 270 290 Graphs.register_uri uri; ··· 279 299 match forest.={uri} with 280 300 | None -> 281 301 forest.={uri} <- 282 - Resource {resource; expanded = None; route_locally; include_in_manifest} 283 - | Some (Tree.Expanded syn) -> 284 - forest.={uri} <- 285 - Resource 286 - {resource; expanded = Some syn; route_locally; include_in_manifest} 287 - | _ -> 288 - forest.={uri} <- 289 - Resource {resource; expanded = None; route_locally; include_in_manifest} 290 - 291 - let serialize_graphs : (module Forest_graphs.S) -> 'a = 292 - fun s -> 293 - let module Graphs = (val s) in 294 - Graphs.dl_db 295 - 296 - let batch_write : t -> _ = function 297 - | {import_graph; _} -> 298 - (* let dl_db = serialize_graphs graphs in *) 299 - let open Cache in 300 - let module Gmap = Forest_graph.Map (Cache.Dependecy_graph) in 301 - let tbl = Dependency_tbl.create 100 in 302 - let now = Unix.time () in 303 - let g = 304 - import_graph 305 - |> Gmap.map @@ function 306 - | T.Content_vertex _ -> 307 - (*Import graph has no content vertices*) 308 - assert false 309 - | T.Uri_vertex uri -> 310 - let item = Item.Tree uri in 311 - Dependency_tbl.add tbl item 312 - Item.{timestamp = Some now; color = Green}; 313 - item 314 - in 315 - {Cache.empty with graph = g; tbl} 316 - 317 - let reconstruct = 318 - fun ~env:_ ~(_config : Config.t) paths cache -> 319 - match cache with 320 - | {search_index = _; _} -> 321 - (* let init = Phases.init ~env ~config ~dev: true in *) 322 - (* let graphs = Forest_graphs.init dl_db in *) 323 - paths 324 - |> Seq.iter (fun _path -> 325 - (* let uri = URI_scheme.path_to_uri ~base: config.url (Eio.Path.native_exn path) in *) 326 - (* match URI.Tbl.find_opt forest uri with *) 327 - (* | None -> () *) 328 - (* | Some tree -> *) 329 - (* match check_timestamp path tree.timestamp with *) 330 - (* | _ -> () *) 331 - ()) 332 - 333 - let rec lsp_uri_of_uri (uri : URI.t) (forest : t) : Lsp.Uri.t option = 334 - let@ tree = Option.bind @@ find_opt forest uri in 335 - lsp_uri_of_tree tree forest 336 - 337 - and lsp_uri_of_tree (tree : Tree.t) (forest : t) : Lsp.Uri.t option = 338 - match tree with 339 - | Document doc -> Some (Lsp.Text_document.documentUri doc) 340 - | Parsed code -> lsp_uri_of_origin code.origin forest 341 - | Expanded syn -> lsp_uri_of_identity syn.identity forest 342 - | Resource evaluated -> lsp_uri_of_resource evaluated.resource 343 - 344 - and lsp_uri_of_resource (resource : resource) : Lsp.Uri.t option = 345 - match resource with 346 - | Article article -> 347 - Option.map Lsp.Uri.of_string article.frontmatter.source_path 348 - | Asset _ | Syndication _ -> None 349 - 350 - and lsp_uri_of_origin (origin : origin) (forest : t) : Lsp.Uri.t option = 351 - match origin with 352 - | Physical document -> Some (Lsp.Text_document.documentUri document) 353 - | Subtree {parent} -> lsp_uri_of_identity parent forest 354 - | Undefined -> None 355 - 356 - and lsp_uri_of_identity (identity : identity) (forest : t) : Lsp.Uri.t option = 357 - match identity with URI uri -> lsp_uri_of_uri uri forest | Anonymous -> None 358 - 359 - let source_path_of_uri uri forest = 360 - Option.map Lsp.Uri.to_path @@ lsp_uri_of_uri uri forest 302 + Tree 303 + { 304 + phase = Evaluated; 305 + tree = {resource; route_locally; include_in_manifest; expanded = None}; 306 + source = None; 307 + } 308 + | Some (Tree {phase; tree; source}) -> begin 309 + match phase with 310 + | Expanded -> 311 + forest.={uri} <- 312 + Tree 313 + { 314 + phase = Evaluated; 315 + tree = 316 + { 317 + resource; 318 + route_locally; 319 + include_in_manifest; 320 + expanded = Some tree; 321 + }; 322 + source; 323 + } 324 + | Loaded | Evaluated | Parsed -> assert false 325 + end

+13 -6

lib/compiler/test/Test_expansion.ml

··· 30 30 @@ 31 31 let@ code = Result.map @~ parse_string_no_loc src in 32 32 S.run ~init_visible:Expand.initial_visible_trie @@ fun () -> 33 - Expand.expand ~forest code 33 + let nodes = Expand.expand ~forest code in 34 + ({tree = {nodes; code; units = Trie.empty}; phase = Expanded; source = None} 35 + : Tree.(expanded tree)) 34 36 35 37 let render ~forest expanded = 36 38 let result, _ = ··· 46 48 (fun article -> 47 49 let@ uri = Option.iter @~ T.(article.frontmatter.uri) in 48 50 forest.={uri} <- 49 - Resource 51 + Tree 50 52 { 51 - resource = Article article; 52 - expanded = None; 53 - route_locally = true; 54 - include_in_manifest = true; 53 + phase = Evaluated; 54 + source = None; 55 + tree = 56 + { 57 + resource = Article article; 58 + expanded = None; 59 + route_locally = true; 60 + include_in_manifest = true; 61 + }; 55 62 }) 56 63 articles 57 64 in

+2 -1

lib/core/Base.ml

··· 20 20 21 21 let identity_to_uri = function URI uri -> Some uri | Anonymous -> None 22 22 23 - type origin = 23 + (* TODO: Just replace this with Grace's source type *) 24 + type _origin = 24 25 | Physical of 25 26 (Lsp.Text_document.t 26 27 [@printer

+2

lib/core/Base.mli

··· 42 42 val show_identity : identity -> string 43 43 val identity_to_uri : identity -> URI.t option 44 44 45 + (* 45 46 type origin = 46 47 | Physical of Lsp.Text_document.t 47 48 | Subtree of {parent: identity} ··· 49 50 50 51 val pp_origin : Format.formatter -> origin -> unit 51 52 val show_origin : origin -> string 53 + *) 52 54 val visibility_t : visibility Repr.t 53 55 type mode = Static | Dynamic

+11 -2

lib/core/Range.ml

··· 10 10 11 11 type t = Range.t 12 12 13 + let total ~source = 14 + let eos_index = Byte_index.of_int @@ Source.length source in 15 + create ~source Byte_index.initial eos_index 16 + 13 17 let t = 14 18 let module T = struct 15 19 let byte_index = ··· 53 57 end in 54 58 T.repr 55 59 56 - type 'a located = {value: 'a; range: t option} 60 + type 'a really_located = {value: 'a; range: t} 61 + type 'a located = {value: 'a; range: t option} [@@deriving show] 62 + 63 + let builtin = 64 + initial 65 + (`Reader {id = 0; length = 0; name = None; unsafe_get = (fun _ -> ' ')}) 57 66 58 67 let unloc a = {value = a; range = None} 59 68 let get_value {value; _} = value 60 69 61 - let pp_located pp_arg fmt (x : 'a located) = pp_arg fmt x.value 70 + (*let pp_located pp_arg fmt (x : 'a located) = pp_arg fmt x.value*) 62 71 let map : type a b. (a -> b) -> a located -> b located = 63 72 fun f node -> {node with value = f node.value} 64 73

+139 -105

lib/core/Tree.ml

··· 4 4 * SPDX-License-Identifier: GPL-3.0-or-later 5 5 *) 6 6 7 - open Grace 8 7 open Forester_prelude 9 8 10 9 open struct ··· 15 14 16 15 type exports = (R.P.data, Grace.Range.t option) Trie.t 17 16 18 - type code = { 19 - nodes: Code.t; 20 - identity: identity; 21 - origin: origin; 22 - (* document: Lsp.Text_document.t; [@opaque] *) 23 - timestamp: float option; 24 - } 25 - [@@deriving show] 17 + type loaded = Lsp.Text_document.t 18 + type parsed = Code.t 26 19 27 - type syn = { 28 - nodes: Syn.t; 29 - code: code; 30 - identity: identity; 31 - units: exports; [@opaque] 32 - } 20 + type expanded = {nodes: Syn.t; code: Code.t; units: exports [@opaque]} 33 21 [@@deriving show] 34 22 35 23 type evaluated = { 36 24 resource: T.content T.resource; 37 25 route_locally: bool; 38 26 include_in_manifest: bool; 39 - expanded: syn option; 27 + expanded: expanded option; 40 28 } 41 29 [@@deriving show] 42 30 43 - type t = 44 - | Document of (Lsp.Text_document.t[@opaque]) 45 - | Parsed of code 46 - | Expanded of syn 47 - | Resource of evaluated 48 - [@@deriving show] 31 + type 'a tag = 32 + | Loaded : loaded tag 33 + | Parsed : parsed tag 34 + | Expanded : expanded tag 35 + | Evaluated : evaluated tag 49 36 50 - let origin = function 51 - | Document doc -> Physical doc 52 - | Parsed parsed -> parsed.origin 53 - | Expanded expanded -> expanded.code.origin 54 - | Resource resource -> ( 55 - match resource.expanded with 56 - | None -> Undefined 57 - | Some expanded -> expanded.code.origin) 37 + type 'a tree = {phase: 'a tag; tree: 'a; source: Grace.Source.t option} 58 38 59 - let show_phase = function 60 - | Document _ -> "document" 61 - | Parsed _ -> "parsed" 62 - | Expanded _ -> "expanded" 63 - | Resource _ -> "resource" 39 + type t = Tree : 'a tree -> t 64 40 65 - let of_lsp_uri ~base uri = URI_scheme.lsp_uri_to_uri ~base uri 41 + let source : t -> Grace.Source.t option = function 42 + | Tree {phase; tree; source} -> source 66 43 67 - (* IDK if subtrees should resolve to their parent document*) 68 - let to_doc : t -> Lsp.Text_document.t option = function 69 - | Document doc -> Some doc 70 - | Resource {expanded; _} -> begin 71 - match expanded with 72 - | None -> None 73 - | Some {code; _} -> ( 74 - match code.origin with 75 - | Physical doc -> Some doc 76 - | Subtree _ -> None 77 - | Undefined -> None) 44 + let equal_phases = 45 + fun (Tree {phase = phase1; _}) (Tree {phase = phase2; _}) -> 46 + match (phase1, phase2) with 47 + | Loaded, Loaded -> true 48 + | Parsed, Parsed -> true 49 + | Expanded, Expanded -> true 50 + | Evaluated, Evaluated -> true 51 + | _ -> false 52 + 53 + let lsp_uri : loaded tree -> Lsp.Uri.t = function 54 + | {phase; tree; source} -> Lsp.Text_document.documentUri tree 55 + 56 + let to_doc : t -> loaded option = function 57 + | Tree {phase; tree; source} -> begin 58 + match phase with 59 + | Loaded -> Some tree 60 + | Parsed -> None 61 + | Expanded -> None 62 + | Evaluated -> None 78 63 end 79 - | Parsed {origin; _} | Expanded {code = {origin; _}; _} -> ( 80 - match origin with 81 - | Physical doc -> Some doc 82 - | Subtree _ -> None 83 - | Undefined -> None) 64 + 65 + let of_code : source:Grace.Source.t -> Code.t -> Code.t tree = 66 + fun ~source nodes -> {phase = Parsed; tree = nodes; source = Some source} 67 + 68 + let of_doc : Lsp.Text_document.t -> loaded tree = 69 + fun doc -> 70 + let uri = Lsp.Text_document.documentUri doc in 71 + let path = Lsp.Uri.to_path uri in 72 + {phase = Loaded; tree = doc; source = Some (`File path)} 73 + 74 + let of_syn ~source syn = {phase = Expanded; tree = syn; source} 75 + let of_resource ~source resource = {phase = Evaluated; tree = resource; source} 76 + 77 + let show_phase = function 78 + | Loaded -> "loaded" 79 + | Parsed -> "parsed" 80 + | Expanded -> "expanded" 81 + | Evaluated -> "evaluated" 84 82 85 83 let to_resource : t -> T.content T.resource option = function 86 - | Document _ | Parsed _ | Expanded _ -> None 87 - | Resource {resource; _} -> Some resource 84 + | Tree {phase; tree; _} -> begin 85 + match phase with 86 + | Loaded -> None 87 + | Parsed -> None 88 + | Expanded -> None 89 + | Evaluated -> Some tree.resource 90 + end 88 91 89 92 let to_evaluated : t -> evaluated option = function 90 - | Document _ | Parsed _ | Expanded _ -> None 91 - | Resource evaluated -> Some evaluated 93 + | Tree {phase; tree; _} -> begin 94 + match phase with 95 + | Loaded | Parsed | Expanded -> None 96 + | Evaluated -> Some tree 97 + end 92 98 93 99 let to_article : t -> T.content T.article option = function 94 - | Document _ | Parsed _ | Expanded _ -> None 95 - | Resource {resource; _} -> ( 96 - match resource with T.Article a -> Some a | _ -> None) 100 + | Tree {phase; tree; _} -> begin 101 + match phase with 102 + | Loaded | Parsed | Expanded -> None 103 + | Evaluated -> begin 104 + match tree.resource with T.Article a -> Some a | _ -> None 105 + end 106 + end 97 107 98 108 let get_frontmatter : t -> T.content T.frontmatter option = function 99 - | Resource {resource = Types.Article {frontmatter; _}; _} -> Some frontmatter 100 - | _ -> None 109 + | Tree {phase; tree; _} -> begin 110 + match phase with 111 + | Evaluated -> begin 112 + match tree with 113 + | {resource = Types.Article {frontmatter; _}; _} -> Some frontmatter 114 + | _ -> None 115 + end 116 + | _ -> None 117 + end 101 118 102 - let to_code : t -> code option = function 103 - | Document _doc -> 104 - (* Logs.debug (fun m -> m "tried to get code of unparsed document %s" (Lsp.Uri.to_string @@ Lsp.Text_document.documentUri doc)); *) 105 - (* assert false *) 106 - None 107 - | Parsed code -> Some code 108 - | Resource {expanded; _} -> begin 109 - match expanded with None -> None | Some {code; _} -> Some code 119 + let to_code : t -> Code.t tree option = function 120 + | Tree ({phase; tree; source} as t) -> begin 121 + match phase with 122 + | Loaded -> None 123 + | Parsed -> Some t 124 + | Evaluated -> begin 125 + match tree.expanded with 126 + | None -> None 127 + | Some tree -> Some {phase = Parsed; tree = tree.code; source} 128 + end 129 + | Expanded -> Some {phase = Parsed; tree = tree.code; source} 110 130 end 111 - | Expanded {code; _} -> Some code 112 131 113 - let to_syn : t -> syn option = function 114 - | Document _ -> None 115 - | Parsed _ -> None 116 - | Expanded syn -> Some syn 117 - | Resource {expanded; _} -> expanded 132 + let nodes : Code.t tree -> Code.t = function {tree; _} -> tree 118 133 119 - let get_units : t -> exports option = 120 - fun item -> 121 - match item with 122 - | Document _ -> None 123 - | Parsed _ -> None 124 - | Expanded {units; _} -> Some units 125 - | Resource {expanded; _} -> ( 126 - match expanded with Some {units; _} -> Some units | None -> None) 134 + let to_syn : t -> expanded tree option = function 135 + | Tree {phase; tree; source} -> begin 136 + match phase with 137 + | Loaded -> None 138 + | Parsed -> None 139 + | Expanded -> Some {phase = Expanded; tree; source} 140 + | Evaluated -> ( 141 + match tree.expanded with 142 + | Some expanded -> Some {tree = expanded; phase = Expanded; source} 143 + | None -> None) 144 + end 127 145 128 - let is_unparsed = function Document _ -> true | _ -> false 129 - let is_parsed t = not @@ is_unparsed t 146 + let get_units : t -> exports option = function 147 + | Tree {phase; tree; _} -> ( 148 + match phase with 149 + | Loaded -> None 150 + | Parsed -> None 151 + | Expanded -> Some tree.units 152 + | Evaluated -> begin 153 + match tree.expanded with Some {units; _} -> Some units | None -> None 154 + end) 155 + 156 + let is_unparsed = function 157 + | Tree {phase; _} -> begin match phase with Loaded -> true | _ -> false end 158 + 159 + let is_parsed tree = not @@ is_unparsed tree 130 160 131 161 let is_unexpanded = function 132 - | Document _ | Parsed _ -> true 133 - | Expanded _ | Resource _ -> false 162 + | Tree {phase; _} -> begin 163 + match phase with Loaded | Parsed -> true | Expanded | Evaluated -> false 164 + end 134 165 135 - let is_expanded : t -> bool = function 136 - | Document _ | Parsed _ -> false 137 - | Expanded _ -> true 138 - | Resource {expanded; _} -> Option.is_some expanded 166 + let is_expanded tree = not @@ is_unexpanded tree 139 167 140 168 let is_unevaluated = function 141 - | Document _ | Parsed _ | Expanded _ -> true 142 - | Resource _ -> false 169 + | Tree {phase; _} -> begin 170 + match phase with Loaded | Parsed | Expanded -> true | Evaluated -> false 171 + end 143 172 144 - let is_asset = function 145 - | Document _ | Parsed _ | Expanded _ -> false 146 - | Resource {resource; _} -> ( 147 - match resource with T.Asset _ -> true | _ -> false) 173 + let is_asset : t -> bool = function 174 + | Tree {phase; tree; _} -> begin 175 + match phase with 176 + | Loaded | Parsed | Expanded -> false 177 + | Evaluated -> begin 178 + match tree.resource with T.Asset _ -> true | _ -> false 179 + end 180 + end 148 181 149 - let update_units : t -> exports -> (t, [`Internal_error] Diagnostic.t) result = 150 - fun item units -> 151 - match item with 152 - | Document _ | Parsed _ -> 182 + let update_units : type a. 183 + a tree -> exports -> (a tree, [`Internal_error] Diagnostic.t) result = 184 + fun ({phase; tree; _} as t) units -> 185 + match phase with 186 + | Loaded | Parsed -> 153 187 error 154 188 @@ Diagnostic.createf Error ~code:`Internal_error 155 189 "can't update units for this item. It has not been expanded yet" 156 - | Expanded e -> ok @@ Expanded {e with units} 157 - | Resource ({expanded; _} as e) -> ( 158 - match expanded with 190 + | Expanded -> ok @@ {t with tree = {tree with units}} 191 + | Evaluated -> ( 192 + match tree.expanded with 159 193 | None -> 160 194 error 161 195 @@ Diagnostic.createf Error ~code:`Internal_error 162 196 "can't update units for this item. It is not a tree." 163 197 | Some expanded -> 164 - ok @@ Resource {e with expanded = Some {expanded with units}}) 198 + ok @@ {t with tree = {tree with expanded = Some {expanded with units}}})

+1 -1

lib/frontend/Legacy_xml_client.ml

··· 48 48 49 49 let range ~env = 50 50 let@ uri = Option.bind env.uri in 51 - let@ path = Option.map @~ State.source_path_of_uri uri env.forest in 51 + let@ path = Option.map @~ URI.Tbl.find_opt env.forest.resolver uri in 52 52 Range.initial (`File path) 53 53 54 54 let render_xml_qname qname =

+19 -14

lib/frontend/test/Test_transclusion.ml

··· 32 32 let uri = URI.named_uri ~base:config.url "transcludee" in 33 33 let index = URI.Tbl.create 10 in 34 34 URI.Tbl.add index uri 35 - @@ Tree.Resource 35 + @@ Tree.Tree 36 36 { 37 - resource = 38 - T.Article 39 - { 40 - frontmatter = 41 - T.default_frontmatter 42 - ~uri:(URI.of_string_exn "forest://test/transcludee") 43 - ~title:(T.Content [Text "I am being transcluded"]) (); 44 - mainmatter = Content [Text "Hello"]; 45 - backmatter = Content []; 46 - }; 47 - expanded = None; 48 - route_locally = true; 49 - include_in_manifest = true; 37 + phase = Evaluated; 38 + source = None; 39 + tree = 40 + { 41 + resource = 42 + T.Article 43 + { 44 + frontmatter = 45 + T.default_frontmatter 46 + ~uri:(URI.of_string_exn "forest://test/transcludee") 47 + ~title:(T.Content [Text "I am being transcluded"]) (); 48 + mainmatter = Content [Text "Hello"]; 49 + backmatter = Content []; 50 + }; 51 + expanded = None; 52 + route_locally = true; 53 + include_in_manifest = true; 54 + }; 50 55 }; 51 56 let forest = {(State.make ~env ~config ~dev:false ()) with index} in 52 57 let print_transclusion : T.transclusion -> unit =

+2 -2

lib/language_server/Analysis.ml

··· 120 120 in 121 121 match Tree.to_code tree with 122 122 | None -> None 123 - | Some code -> go ~position code.nodes 123 + | Some code -> go ~position @@ Tree.nodes code 124 124 125 125 let get_enclosing_syn_group ~position tree = 126 126 let rec go ~position nodes = ··· 139 139 in 140 140 match Tree.to_syn tree with 141 141 | None -> None 142 - | Some syn -> go ~position syn.nodes 142 + | Some syn -> go ~position syn.tree.nodes 143 143 144 144 let enclosing_group_start ~position 145 145 ~(enclosing_group :

+2 -2

lib/language_server/Call_hierarchy.ml

··· 81 81 let uri = 82 82 URI_scheme.lsp_uri_to_uri ~base:forest.config.url textDocument.uri 83 83 in 84 - match Imports.resolve_uri_to_code forest uri with 84 + match Imports.resolve_uri_to_code ~forest uri with 85 85 | Error _ -> None 86 86 | Ok tree -> 87 87 let item = 88 - match Analysis.node_at_code ~position tree.nodes with 88 + match Analysis.node_at_code ~position (Tree.nodes tree) with 89 89 | None -> None 90 90 | Some {range = _; value} -> ( 91 91 match value with

+9 -17

lib/language_server/Completion.ml

··· 137 137 Option.bind @@ Analysis.enclosing_group_start ~enclosing_group ~position t 138 138 in 139 139 let@ code = Option.bind code_opt in 140 - Analysis.parent_or_prev_at_code ~position code.nodes 140 + Analysis.parent_or_prev_at_code ~position @@ Tree.nodes code 141 141 in 142 142 let syn_context = 143 143 let enclosing_group = Analysis.get_enclosing_syn_group in ··· 145 145 Option.bind @@ Analysis.enclosing_group_start ~enclosing_group ~position t 146 146 in 147 147 let@ syn = Option.bind syn_opt in 148 - Analysis.parent_or_prev_at_syn ~position syn.nodes 148 + Analysis.parent_or_prev_at_syn ~position syn.tree.nodes 149 149 in 150 150 completions 151 151 |> List.fold_left ··· 315 315 ] 316 316 317 317 let visible_completions ~(forest : State.t) ~(position : L.Position.t) : 318 - Tree.code option -> L.CompletionItem.t list = function 319 - | None -> 320 - List.append syntax_completions 321 - @@ 322 - let@ path, _ = 323 - List.map @~ List.of_seq @@ Trie.to_seq Expand.initial_visible_trie 324 - in 325 - L.CompletionItem.create ~insertText:"todo" ~label:(String.concat "/" path) 326 - () 327 - | Some {nodes; _} -> 328 - Analysis.get_visible ~position ~forest nodes 329 - |> Trie.to_seq |> List.of_seq |> List.filter_map make 330 - |> List.append syntax_completions 318 + Tree.parsed -> L.CompletionItem.t list = 319 + fun nodes -> 320 + Analysis.get_visible ~position ~forest nodes 321 + |> Trie.to_seq |> List.of_seq |> List.filter_map make 322 + |> List.append syntax_completions 331 323 332 324 let date_completions () : L.CompletionItem.t list = 333 325 let now = Human_datetime.now () in ··· 348 340 let base = config.url in 349 341 let uri = URI_scheme.lsp_uri_to_uri ~base uri in 350 342 let* tree = forest.={uri} in 351 - let code = Tree.to_code tree in 343 + let* code = Tree.to_code tree in 352 344 let completion_types = completion_types ~position tree in 353 345 let items = 354 346 let@ completion = List.concat_map @~ S.to_list completion_types in ··· 356 348 | Addrs -> addr_completions ~forest 357 349 | New_addr -> new_addr_completions ~forest 358 350 | Assets -> asset_completions ~config 359 - | Visible -> visible_completions ~forest ~position code 351 + | Visible -> visible_completions ~forest ~position @@ Tree.nodes code 360 352 | Date -> date_completions () 361 353 in 362 354 Logs.debug (fun m -> m "items: %d" (List.length items));

+1 -1

lib/language_server/Definitions.ml

··· 20 20 URI_scheme.lsp_uri_to_uri ~base:forest.config.url params.textDocument.uri 21 21 in 22 22 let@ tree = Option.bind forest.={uri} in 23 - let@ {nodes; _} = Option.bind @@ Tree.to_code tree in 23 + let@ nodes = Option.bind Tree.(Option.map nodes @@ to_code tree) in 24 24 let@ {value = str; _} = 25 25 Option.bind @@ Analysis.addr_at ~position:params.position nodes 26 26 in

+5 -4

lib/language_server/Did_change.ml

··· 29 29 (Lsp.Uri.to_string lsp_uri)); 30 30 assert false 31 31 | Some doc -> 32 - let new_doc = 33 - Lsp.Text_document.apply_content_changes doc params.contentChanges 32 + let updated = 33 + Tree.of_doc 34 + @@ Lsp.Text_document.apply_content_changes doc params.contentChanges 34 35 in 35 - forest.={uri} <- Document new_doc; 36 + forest.={uri} <- Tree updated; 36 37 Lsp_state.modify (fun ({forest; _} as lsp_state) -> 37 38 let new_forest = Driver.run_until_done (Action.Parse lsp_uri) forest in 38 39 {lsp_state with forest = new_forest}); 39 - Diagnostics.compute new_doc 40 + Diagnostics.compute updated.tree

+1 -1

lib/language_server/Did_create_files.ml

··· 23 23 let uri = URI_scheme.lsp_uri_to_uri ~base:forest.config.url lsp_uri in 24 24 let path = Eio.Path.(env#fs / L.DocumentUri.to_path lsp_uri) in 25 25 let doc = Imports.load_tree path in 26 - forest.={uri} <- Document doc 26 + forest.={uri} <- Tree doc 27 27 end; 28 28 let new_forest = Driver.run_until_done Parse_all forest in 29 29 {lsp_state with forest = new_forest}

+3 -1

lib/language_server/Did_open.ml

··· 15 15 16 16 let compute (params : L.DidOpenTextDocumentParams.t) = 17 17 let lsp_uri = params.textDocument.uri in 18 + let path = Lsp.Uri.to_path lsp_uri in 18 19 let Lsp_state.{forest; _} = Lsp_state.get () in 19 20 let document = Lsp.Text_document.make ~position_encoding:`UTF16 params in 20 21 let uri = URI_scheme.lsp_uri_to_uri ~base:forest.config.url lsp_uri in 21 - forest.={uri} <- Document document; 22 + forest.={uri} <- 23 + Tree {tree = document; source = Some (`File path); phase = Loaded}; 22 24 Lsp_state.modify (fun ({forest; _} as lsp_state) -> 23 25 let new_forest = Driver.run_until_done (Action.Parse lsp_uri) forest in 24 26 {lsp_state with forest = new_forest});

+1 -1

lib/language_server/Document_link.ml

··· 31 31 match Option.bind forest.={uri} Tree.to_code with 32 32 | None -> [] 33 33 | Some tree -> ( 34 - let@ Range.{range; value} = List.filter_map @~ tree.nodes in 34 + let@ Range.{range; value} = List.filter_map @~ Tree.nodes tree in 35 35 match value with 36 36 | Code.Group (Squares, [{value = Text addr; _}]) 37 37 | Code.Group (Parens, [{value = Text addr; _}])

+2 -2

lib/language_server/Document_symbols.ml

··· 24 24 @@ URI_scheme.lsp_uri_to_uri ~base:forest.config.url uri 25 25 with 26 26 | None -> assert false 27 - | Some {nodes; _} -> 27 + | Some {tree; _} -> 28 28 let symbols : L.DocumentSymbol.t list = 29 - let@ {range; value} = List.filter_map @~ nodes in 29 + let@ {range; value} = List.filter_map @~ tree in 30 30 let open Code in 31 31 let* range = Option.map Lsp_shims.lsp_range_of_range range in 32 32 let selectionRange = range in

+1 -1

lib/language_server/Highlight.ml

··· 19 19 URI_scheme.lsp_uri_to_uri ~base:forest.config.url params.textDocument.uri 20 20 in 21 21 let@ tree = Option.map @~ State.get_code forest uri in 22 - let@ Range.{range; value} = List.filter_map @~ tree.nodes in 22 + let@ Range.{range; value} = List.filter_map @~ Tree.nodes tree in 23 23 let@ range = Option.map @~ range in 24 24 let range = Lsp_shims.lsp_range_of_range range in 25 25 let kind =

+1 -1

lib/language_server/Hover.ml

··· 35 35 URI.pp uri 36 36 *) 37 37 | Some tree -> ( 38 - let* {nodes; _} = Tree.to_code tree in 38 + let* nodes = Tree.(Option.map nodes @@ to_code tree) in 39 39 let* node = Analysis.node_at_code ~position nodes in 40 40 let tree_under_cursor = 41 41 let* {value = addr; _} = Analysis.extract_addr node in

+3 -1

lib/language_server/Inlay_hint.ml

··· 52 52 let uri = 53 53 URI_scheme.lsp_uri_to_uri ~base:config.url params.textDocument.uri 54 54 in 55 - let@ {nodes; _} = Option.map @~ Option.bind forest.={uri} Tree.to_syn in 55 + let@ {tree = {nodes; _}; _} = 56 + Option.map @~ Option.bind forest.={uri} Tree.to_syn 57 + in 56 58 extract_inlayable_hints ~config ~forest nodes

+4 -4

lib/language_server/Semantic_tokens.ml

··· 270 270 let uri = URI_scheme.lsp_uri_to_uri ~base:forest.config.url identifier.uri in 271 271 Result.to_option 272 272 @@ 273 - let@ {nodes; _} = Result.map @~ Imports.resolve_uri_to_code forest uri in 274 - let tokens = tokens nodes in 273 + let@ tree = Result.map @~ Imports.resolve_uri_to_code ~forest uri in 274 + let tokens = tokens @@ Tree.nodes tree in 275 275 Format.( 276 276 Eio.traceln "%a" 277 277 (pp_print_list ~pp_sep:(fun out () -> fprintf out "; ") pp_token) ··· 288 288 in 289 289 Result.to_option 290 290 @@ 291 - let@ tree = Result.map @~ Imports.resolve_uri_to_code forest uri in 292 - semantic_tokens_delta tree.nodes 291 + let@ tree = Result.map @~ Imports.resolve_uri_to_code ~forest uri in 292 + semantic_tokens_delta @@ Tree.nodes tree 293 293 294 294 let on_full_request (params : L.SemanticTokensParams.t) : 295 295 L.SemanticTokens.t option =

+1 -1

lib/language_server/Workspace_symbols.ml

··· 110 110 let@ file_symbol = 111 111 List.concat_map @~ Option.to_list 112 112 @@ 113 - let@ source_path = Option.map @~ State.source_path_of_uri uri forest in 113 + let@ source_path = Option.map @~ State.resolve ~forest ~uri in 114 114 let lsp_uri = Lsp.Uri.of_string source_path in 115 115 let location = 116 116 L.Location.

+4 -8

lib/parser/Parse.ml

··· 51 51 lexbuf.lex_curr_p <- {lexbuf.lex_curr_p with pos_fname = filename}; 52 52 parse (`File filename) lexbuf 53 53 54 - let parse_document ~(config : Config.t) doc = 54 + let parse_document doc : (Tree.(parsed tree), _) result = 55 55 let uri = Lsp.Text_document.documentUri doc in 56 56 let path = Lsp.Uri.to_path uri in 57 57 let text = Lsp.Text_document.text doc in ··· 59 59 lexbuf.lex_curr_p <- {lexbuf.lex_curr_p with pos_fname = path}; 60 60 parse (`String {content = text; name = Some path}) lexbuf 61 61 |> Result.map (fun nodes -> 62 - Tree. 63 - { 64 - nodes; 65 - origin = Physical doc; 66 - identity = URI (URI_scheme.path_to_uri ~base:config.url path); 67 - timestamp = Some (Unix.time ()); 68 - }) 62 + let source = `File path in 63 + (*let identity = URI (URI_scheme.path_to_uri ~base:config.url path) *) 64 + Tree.of_code ~source nodes) 69 65 70 66 let parse_file filename = 71 67 let ch = open_in filename in

+1 -2

lib/parser/Parse.mli

··· 10 10 11 11 val parse : Grace.Source.t -> Lexing.lexbuf -> (Code.t, error) Result.t 12 12 13 - val parse_document : 14 - config:Config.t -> Lsp.Text_document.t -> (Tree.code, error) result 13 + val parse_document : Lsp.Text_document.t -> (Code.t Tree.tree, error) result 15 14 16 15 val parse_file : string -> (Code.t, error) result

+11 -4

lib/search/Search_engine.ml

··· 26 26 List.filter_map 27 27 (fun (_, uri) -> 28 28 match URI.Tbl.find_opt forest.index uri with 29 - | Some (Resource {resource = T.Article a; _}) -> 30 - Some (uri, Index.BM_25.score a terms forest.search_index) 31 - | None -> assert false 32 - | _ -> None) 29 + | Some (Tree {phase; tree; source}) -> begin 30 + match phase with 31 + | Evaluated -> begin 32 + match tree.resource with 33 + | T.Article a -> 34 + Some (uri, Index.BM_25.score a terms forest.search_index) 35 + | T.Asset _ | T.Syndication _ -> None 36 + end 37 + | Loaded | Parsed | Expanded -> None 38 + end 39 + | None -> assert false) 33 40 matches 34 41 in 35 42 List.sort

-15

test/Prelude.ml

··· 65 65 raw_trees; 66 66 kont tmp 67 67 68 - let mk_tree ~uri ~code ~expanded = 69 - Tree.Expanded 70 - { 71 - nodes = expanded; 72 - identity = URI uri; 73 - units = Trie.empty; 74 - code = 75 - { 76 - nodes = code; 77 - identity = URI uri; 78 - origin = Subtree {parent = Anonymous}; 79 - timestamp = None; 80 - }; 81 - } 82 - 83 68 type test_env = { 84 69 dirs: Eio.Fs.dir_ty Eio.Path.t list; 85 70 config: Config.t;

+9

test/Print_code.ml

··· 1 + open Forester_parser 2 + open Forester_core 3 + 4 + let () = 5 + let filename = Sys.argv.(1) in 6 + let result = Parse.parse_file filename in 7 + match result with 8 + | Ok code -> Format.printf "%a@." Code.pp code 9 + | Error _ -> assert false

+15

test/Print_syn.ml

··· 1 + open Forester_core 2 + open Forester_parser 3 + open Forester_compiler 4 + 5 + let () = 6 + let@ env = Eio_main.run in 7 + let filename = Sys.argv.(1) in 8 + let result = Parse.parse_file filename in 9 + let forest = State.make ~env ~dev:true ~config:Config.(default ()) () in 10 + match result with 11 + | Ok code -> 12 + let tree = Tree.of_code ~source:(`File filename) code in 13 + let Tree.{tree; _}, _ = Expand.(expand_tree ~forest tree) in 14 + Format.printf "%a@." Syn.pp tree.nodes 15 + | Error _ -> assert false

+18

test/dune

··· 4 4 5 5 (library 6 6 (name Forester_test) 7 + (modules Forester_test Prelude Testables) 7 8 (public_name forester.test) 8 9 (preprocess 9 10 (pps ppx_deriving.show ppx_yojson_conv)) ··· 31 32 (cram 32 33 (deps 33 34 %{bin:forester} 35 + %{bin:print-syn} 36 + %{bin:print-code} 34 37 (glob_files_rec forests/*))) 38 + 39 + (executables 40 + (names Print_syn Print_code) 41 + (public_names print-syn print-code) 42 + (modules Print_syn Print_code) 43 + (preprocess 44 + (pps ppx_deriving.show)) 45 + (libraries 46 + grace 47 + eio 48 + eio_main 49 + eio.unix 50 + forester.core 51 + forester.parser 52 + forester.compiler))

Configure Feed

Configure Feed