|
| 1 | +let filter_by_cursor cursor (loc : Warnings.loc) : bool = |
| 2 | + match cursor with |
| 3 | + | None -> true |
| 4 | + | Some (line, col) -> |
| 5 | + let start = loc.loc_start and end_ = loc.loc_end in |
| 6 | + let line_in = start.pos_lnum <= line && line <= end_.pos_lnum in |
| 7 | + let col_in = |
| 8 | + if start.pos_lnum = end_.pos_lnum then |
| 9 | + start.pos_cnum - start.pos_bol <= col |
| 10 | + && col <= end_.pos_cnum - end_.pos_bol |
| 11 | + else if line = start.pos_lnum then col >= start.pos_cnum - start.pos_bol |
| 12 | + else if line = end_.pos_lnum then col <= end_.pos_cnum - end_.pos_bol |
| 13 | + else true |
| 14 | + in |
| 15 | + line_in && col_in |
| 16 | + |
| 17 | +type filter = Cursor of (int * int) | Loc of Loc.t |
| 18 | + |
| 19 | +let dump ?filter rescript_json cmt_path = |
| 20 | + let uri = Uri.fromPath (Filename.remove_extension cmt_path ^ ".res") in |
| 21 | + let package = |
| 22 | + let uri = Uri.fromPath rescript_json in |
| 23 | + Packages.getPackage ~uri |> Option.get |
| 24 | + in |
| 25 | + let moduleName = |
| 26 | + BuildSystem.namespacedName package.namespace (FindFiles.getName cmt_path) |
| 27 | + in |
| 28 | + match Cmt.fullForCmt ~moduleName ~package ~uri cmt_path with |
| 29 | + | None -> failwith (Format.sprintf "Could not load cmt for %s" cmt_path) |
| 30 | + | Some full -> |
| 31 | + let open SharedTypes in |
| 32 | + let open SharedTypes.Stamps in |
| 33 | + let applyFilter = |
| 34 | + match filter with |
| 35 | + | None -> fun _ -> true |
| 36 | + | Some (Cursor cursor) -> Loc.hasPos ~pos:cursor |
| 37 | + | Some (Loc loc) -> Loc.isInside loc |
| 38 | + in |
| 39 | + (match filter with |
| 40 | + | None -> () |
| 41 | + | Some (Cursor (line, col)) -> |
| 42 | + Printf.printf "Filtering by cursor %d,%d\n" line col |
| 43 | + | Some (Loc loc) -> Printf.printf "Filtering by loc %s\n" (Loc.toString loc)); |
| 44 | + |
| 45 | + Printf.printf "file moduleName: %s\n\n" full.file.moduleName; |
| 46 | + |
| 47 | + let stamps = |
| 48 | + full.file.stamps |> getEntries |
| 49 | + |> List.filter (fun (_, stamp) -> applyFilter (locOfKind stamp)) |
| 50 | + in |
| 51 | + |
| 52 | + let total_stamps = List.length stamps in |
| 53 | + Printf.printf "Found %d stamps:\n%s" total_stamps |
| 54 | + (if total_stamps > 0 then "\n" else ""); |
| 55 | + |
| 56 | + stamps |
| 57 | + |> List.sort (fun (_, a) (_, b) -> |
| 58 | + let aLoc = locOfKind a in |
| 59 | + let bLoc = locOfKind b in |
| 60 | + match compare aLoc.loc_start.pos_lnum bLoc.loc_start.pos_lnum with |
| 61 | + | 0 -> compare aLoc.loc_start.pos_cnum bLoc.loc_start.pos_cnum |
| 62 | + | c -> c) |
| 63 | + |> List.iter (fun (stamp, kind) -> |
| 64 | + match kind with |
| 65 | + | KType t -> |
| 66 | + Printf.printf "%d ktype %s\n" stamp |
| 67 | + (Warnings.loc_to_string t.extentLoc) |
| 68 | + | KValue t -> |
| 69 | + Printf.printf "%d kvalue %s\n" stamp |
| 70 | + (Warnings.loc_to_string t.extentLoc) |
| 71 | + | KModule t -> |
| 72 | + Printf.printf "%d kmodule %s\n" stamp |
| 73 | + (Warnings.loc_to_string t.extentLoc) |
| 74 | + | KConstructor t -> |
| 75 | + Printf.printf "%d kconstructor %s\n" stamp |
| 76 | + (Warnings.loc_to_string t.extentLoc)); |
| 77 | + |
| 78 | + (* dump the structure *) |
| 79 | + let rec dump_structure indent (structure : Module.structure) = |
| 80 | + if indent > 0 then Printf.printf "%s" (String.make indent ' '); |
| 81 | + Printf.printf "Structure %s:\n" structure.name; |
| 82 | + structure.items |> List.iter (dump_structure_item (indent + 2)) |
| 83 | + and dump_structure_item indent item = |
| 84 | + if indent > 0 then Printf.printf "%s" (String.make indent ' '); |
| 85 | + let open Module in |
| 86 | + match item.kind with |
| 87 | + | Value _typedExpr -> |
| 88 | + Printf.printf "Value %s %s\n" item.name |
| 89 | + (Warnings.loc_to_string item.loc) |
| 90 | + | Type _ -> |
| 91 | + Printf.printf "Type %s %s\n" item.name (Warnings.loc_to_string item.loc) |
| 92 | + | Module {type_ = m} -> |
| 93 | + Printf.printf "Module %s %s\n" item.name |
| 94 | + (Warnings.loc_to_string item.loc); |
| 95 | + dump_module indent m |
| 96 | + and dump_module indent (module_ : Module.t) = |
| 97 | + match module_ with |
| 98 | + | Ident path -> Printf.printf "Module (Ident) %s\n" (Path.name path) |
| 99 | + | Structure structure -> dump_structure indent structure |
| 100 | + | Constraint (m1, m2) -> |
| 101 | + dump_module indent m1; |
| 102 | + dump_module indent m2 |
| 103 | + in |
| 104 | + |
| 105 | + print_newline (); |
| 106 | + dump_structure 0 full.file.structure; |
| 107 | + |
| 108 | + (* Dump all locItems (typed nodes) *) |
| 109 | + let locItems = |
| 110 | + match full.extra with |
| 111 | + | {locItems} -> |
| 112 | + locItems |> List.filter (fun locItem -> applyFilter locItem.loc) |
| 113 | + in |
| 114 | + |
| 115 | + Printf.printf "\nFound %d locItems (typed nodes):\n\n" |
| 116 | + (List.length locItems); |
| 117 | + |
| 118 | + locItems |
| 119 | + |> List.sort (fun a b -> |
| 120 | + let aLoc = a.loc.Location.loc_start in |
| 121 | + let bLoc = b.loc.Location.loc_start in |
| 122 | + match compare aLoc.pos_lnum bLoc.pos_lnum with |
| 123 | + | 0 -> compare aLoc.pos_cnum bLoc.pos_cnum |
| 124 | + | c -> c) |
| 125 | + |> List.iter (fun {loc; locType} -> |
| 126 | + let locStr = Warnings.loc_to_string loc in |
| 127 | + let kindStr = SharedTypes.locTypeToString locType in |
| 128 | + Printf.printf "%s %s\n" locStr kindStr) |
0 commit comments