From f147f54201faa1676369f1657ce9f0a601c7896c Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Thu, 16 Jun 2022 00:27:37 +0200 Subject: [PATCH 1/2] Add Makefile also at toplevel. --- Makefile | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) create mode 100644 Makefile diff --git a/Makefile b/Makefile new file mode 100644 index 000000000..ad87f9a60 --- /dev/null +++ b/Makefile @@ -0,0 +1,17 @@ +SHELL = /bin/bash + +build: + make -C analysis build + +clean: + make -C analysis clean + +clean-deep: + make -C analysis clean-deep + +test: + make -C analysis test + +.DEFAULT_GOAL := build + +.PHONY: build clean clean-deep test From a8ee789d426283fea91c1cea1b666376fbf9297b Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Thu, 16 Jun 2022 00:33:54 +0200 Subject: [PATCH 2/2] Add project-level format. --- analysis/.ocamlformat-ignore | 2 + analysis/Makefile | 5 +- analysis/reanalyze/dune | 2 +- analysis/reanalyze/src/Annotation.ml | 2 - analysis/reanalyze/src/Arnold.ml | 22 - analysis/reanalyze/src/Common.ml | 9 - analysis/reanalyze/src/DeadCommon.ml | 9 - analysis/reanalyze/src/DeadException.ml | 1 - analysis/reanalyze/src/DeadModules.ml | 1 - analysis/reanalyze/src/DeadOptionalArgs.ml | 1 - analysis/reanalyze/src/DeadType.ml | 4 - analysis/reanalyze/src/DeadValue.ml | 2 +- analysis/reanalyze/src/EmitJson.ml | 3 - analysis/reanalyze/src/Exception.ml | 3 +- analysis/reanalyze/src/Exceptions.ml | 7 - analysis/reanalyze/src/Exn.ml | 18 +- analysis/reanalyze/src/Exn.mli | 2 +- analysis/reanalyze/src/Issues.ml | 15 +- analysis/reanalyze/src/Log_.ml | 6 - analysis/reanalyze/src/ModulePath.ml | 4 - analysis/reanalyze/src/Name.ml | 4 +- analysis/reanalyze/src/Name.mli | 6 - analysis/reanalyze/src/Reanalyze.ml | 2 +- analysis/reanalyze/src/RunConfig.ml | 2 - analysis/reanalyze/src/Version.ml | 3 +- .../reanalyze/src/WriteDeadAnnotations.ml | 2 - analysis/src/CompletionBackEnd.ml | 5 +- analysis/src/CompletionFrontEnd.ml | 1 - analysis/src/CreateInterface.ml | 6 +- analysis/src/Files.ml | 1 - analysis/src/FindFiles.ml | 2 - analysis/src/Log.ml | 1 - analysis/src/References.ml | 4 +- analysis/src/Scope.ml | 6 - analysis/src/Uri.ml | 2 - analysis/src/Uri.mli | 5 - analysis/vendor/ext/ext_json_parse.ml | 719 +++++------------- analysis/vendor/ext/ext_json_types.ml | 17 +- analysis/vendor/ext/ext_position.ml | 36 +- analysis/vendor/json/Json.ml | 5 - 40 files changed, 257 insertions(+), 690 deletions(-) create mode 100644 analysis/.ocamlformat-ignore diff --git a/analysis/.ocamlformat-ignore b/analysis/.ocamlformat-ignore new file mode 100644 index 000000000..841c7c180 --- /dev/null +++ b/analysis/.ocamlformat-ignore @@ -0,0 +1,2 @@ +vendor/compiler-libs-406/* +vendor/res_outcome_printer/* diff --git a/analysis/Makefile b/analysis/Makefile index c83b8ef80..683018be3 100644 --- a/analysis/Makefile +++ b/analysis/Makefile @@ -16,6 +16,9 @@ build: build-analysis-binary build-reanalyze build-tests dce: build-analysis-binary opam exec reanalyze.exe -- -dce-cmt _build -suppress vendor +format: + dune build @fmt --auto-promote + test-analysis-binary: build-analysis-binary make -C tests test @@ -35,4 +38,4 @@ clean-deep: .DEFAULT_GOAL := build -.PHONY: build-analysis-binary build-reanalyze build-tests dce clean clean-deep test +.PHONY: build-analysis-binary build-reanalyze build-tests dce clean clean-deep format test diff --git a/analysis/reanalyze/dune b/analysis/reanalyze/dune index 17f7af431..ba3138958 100644 --- a/analysis/reanalyze/dune +++ b/analysis/reanalyze/dune @@ -1 +1 @@ -(dirs src) \ No newline at end of file +(dirs src) diff --git a/analysis/reanalyze/src/Annotation.ml b/analysis/reanalyze/src/Annotation.ml index e53e13cec..3e6429fb4 100644 --- a/analysis/reanalyze/src/Annotation.ml +++ b/analysis/reanalyze/src/Annotation.ml @@ -9,9 +9,7 @@ type attributePayload = | UnrecognizedPayload let tagIsGenType s = s = "genType" || s = "gentype" - let tagIsGenTypeImport s = s = "genType.import" || s = "gentype.import" - let tagIsGenTypeOpaque s = s = "genType.opaque" || s = "gentype.opaque" let tagIsOneOfTheGenTypeAnnotations s = diff --git a/analysis/reanalyze/src/Arnold.ml b/analysis/reanalyze/src/Arnold.ml index 24df58f93..00f3e15c9 100644 --- a/analysis/reanalyze/src/Arnold.ml +++ b/analysis/reanalyze/src/Arnold.ml @@ -14,11 +14,9 @@ end module FunctionArgs = struct type arg = {label : string; functionName : FunctionName.t} - type t = arg list let empty = [] - let argToString {label; functionName} = label ^ ":" ^ functionName let toString functionArgs = @@ -82,17 +80,11 @@ module FunctionCallSet = Set.Make (FunctionCall) module Stats = struct let nCacheChecks = ref 0 - let nCacheHits = ref 0 - let nFiles = ref 0 - let nFunctions = ref 0 - let nHygieneErrors = ref 0 - let nInfiniteLoops = ref 0 - let nRecursiveBlocks = ref 0 let print ppf () = @@ -107,7 +99,6 @@ module Stats = struct Format.fprintf ppf "@]" let dump ~ppf = Format.fprintf ppf "%a@." print () - let newFile () = incr nFiles let newRecursiveFunctions ~numFunctions = @@ -246,7 +237,6 @@ module Trace = struct | _ -> Tseq [t1; t2] let some = Toption Rsome - let none = Toption Rnone let retOptionToString r = @@ -273,21 +263,15 @@ module Values : sig type t val getNone : t -> Progress.t option - val getSome : t -> Progress.t option - val nd : t -> t -> t - val none : progress:Progress.t -> t - val some : progress:Progress.t -> t - val toString : t -> string end = struct type t = {none : Progress.t option; some : Progress.t option} let getNone {none} = none - let getSome {some} = some let toString x = @@ -299,7 +283,6 @@ end = struct |> String.concat ", " let none ~progress = {none = Some progress; some = None} - let some ~progress = {none = None; some = Some progress} let nd (v1 : t) (v2 : t) : t = @@ -384,7 +367,6 @@ end module Command = struct type progress = Progress.t - type retOption = Trace.retOption type t = @@ -450,7 +432,6 @@ end module Kind = struct type t = entry list - and entry = {label : string; k : t} let empty = ([] : t) @@ -502,7 +483,6 @@ module FunctionTable = struct Format.fprintf ppf "@]" let dump tbl = Format.fprintf Format.std_formatter "%a@." print tbl - let initialFunctionDefinition () = {kind = Kind.empty; body = None} let getFunctionDefinition ~functionName (tbl : t) = @@ -1034,7 +1014,6 @@ end module CallStack = struct type frame = {frameNumber : int; pos : Lexing.position} - type t = {tbl : (FunctionCall.t, frame) Hashtbl.t; mutable size : int} let create () = {tbl = Hashtbl.create 1; size = 0} @@ -1072,7 +1051,6 @@ end module Eval = struct type progress = Progress.t - type cache = (FunctionCall.t, State.t) Hashtbl.t let createCache () : cache = Hashtbl.create 1 diff --git a/analysis/reanalyze/src/Common.ml b/analysis/reanalyze/src/Common.ml index 38c9b64e2..187e99ddd 100644 --- a/analysis/reanalyze/src/Common.ml +++ b/analysis/reanalyze/src/Common.ml @@ -1,9 +1,6 @@ let currentSrc = ref "" - let currentModule = ref "" - let currentModuleName = ref ("" |> Name.create) - let runConfig = RunConfig.runConfig (* Location printer: `filename:line: ' *) @@ -16,16 +13,13 @@ let posToString (pos : Lexing.position) = module Cli = struct let debug = ref false - let ci = ref false (** The command was a -cmt variant (e.g. -exception-cmt) *) let cmtCommand = ref false let experimental = ref false - let json = ref false - let write = ref false (* names to be considered live values *) @@ -54,7 +48,6 @@ module FileHash = struct type t = string let hash (x : t) = Hashtbl.hash x - let equal (x : t) y = x = y end) end @@ -167,7 +160,6 @@ module OptionalArgs = struct y.alwaysUsed <- alwaysUsed let iterUnused f x = StringSet.iter f x.unused - let iterAlwaysUsed f x = StringSet.iter (fun s -> f s x.count) x.alwaysUsed end @@ -222,7 +214,6 @@ type missingRaiseInfo = { } type severity = Warning | Error - type deadOptional = WarningUnusedArgument | WarningRedundantOptionalArgument type termination = diff --git a/analysis/reanalyze/src/DeadCommon.ml b/analysis/reanalyze/src/DeadCommon.ml index 4f64f9a95..8bdcd00a8 100644 --- a/analysis/reanalyze/src/DeadCommon.ml +++ b/analysis/reanalyze/src/DeadCommon.ml @@ -11,21 +11,15 @@ end) module Config = struct (* Turn on type analysis *) let analyzeTypes = ref true - let analyzeExternals = ref false - let reportUnderscore = false - let reportTypesDeadOnlyInInterface = false - let recursiveDebug = false - let warnOnCircularDependencies = false end module Current = struct let bindings = ref PosSet.empty - let lastBinding = ref Location.none (** max end position of a value reported dead *) @@ -71,7 +65,6 @@ module ValueReferences = struct let table = (PosHash.create 256 : PosSet.t PosHash.t) let add posTo posFrom = PosHash.addSet table posTo posFrom - let find pos = PosHash.findSet table pos end @@ -80,7 +73,6 @@ module TypeReferences = struct let table = (PosHash.create 256 : PosSet.t PosHash.t) let add posTo posFrom = PosHash.addSet table posTo posFrom - let find pos = PosHash.findSet table pos end @@ -195,7 +187,6 @@ module ProcessDeadAnnotations = struct type annotatedAs = GenType | Dead | Live let positionsAnnotated = PosHash.create 1 - let isAnnotatedDead pos = PosHash.find_opt positionsAnnotated pos = Some Dead let isAnnotatedGenTypeOrLive pos = diff --git a/analysis/reanalyze/src/DeadException.ml b/analysis/reanalyze/src/DeadException.ml index d38d7793d..bfe8a6166 100644 --- a/analysis/reanalyze/src/DeadException.ml +++ b/analysis/reanalyze/src/DeadException.ml @@ -4,7 +4,6 @@ open Common type item = {exceptionPath : Path.t; locFrom : Location.t} let delayedItems = ref [] - let declarations = Hashtbl.create 1 let add ~path ~loc ~(strLoc : Location.t) name = diff --git a/analysis/reanalyze/src/DeadModules.ml b/analysis/reanalyze/src/DeadModules.ml index 3ff13bd72..9b6acb88b 100644 --- a/analysis/reanalyze/src/DeadModules.ml +++ b/analysis/reanalyze/src/DeadModules.ml @@ -1,5 +1,4 @@ let active () = true - let table = Hashtbl.create 1 let markDead ~isType ~loc path = diff --git a/analysis/reanalyze/src/DeadOptionalArgs.ml b/analysis/reanalyze/src/DeadOptionalArgs.ml index 387469e54..f0b8cd1fa 100644 --- a/analysis/reanalyze/src/DeadOptionalArgs.ml +++ b/analysis/reanalyze/src/DeadOptionalArgs.ml @@ -10,7 +10,6 @@ type item = { } let delayedItems = (ref [] : item list ref) - let functionReferences = (ref [] : (Lexing.position * Lexing.position) list ref) let addFunctionReference ~(locFrom : Location.t) ~(locTo : Location.t) = diff --git a/analysis/reanalyze/src/DeadType.ml b/analysis/reanalyze/src/DeadType.ml index 19e052fcd..a38674783 100644 --- a/analysis/reanalyze/src/DeadType.ml +++ b/analysis/reanalyze/src/DeadType.ml @@ -7,9 +7,7 @@ module TypeLabels = struct (* map from type path (for record/variant label) to its location *) let table = (Hashtbl.create 256 : (Path.t, Location.t) Hashtbl.t) - let add path loc = Hashtbl.replace table path loc - let find path = Hashtbl.find_opt table path end @@ -21,9 +19,7 @@ let addTypeReference ~posFrom ~posTo = module TypeDependencies = struct let delayedItems = ref [] - let add loc1 loc2 = delayedItems := (loc1, loc2) :: !delayedItems - let clear () = delayedItems := [] let processTypeDependency diff --git a/analysis/reanalyze/src/DeadValue.ml b/analysis/reanalyze/src/DeadValue.ml index bb91f827a..42c416286 100644 --- a/analysis/reanalyze/src/DeadValue.ml +++ b/analysis/reanalyze/src/DeadValue.ml @@ -137,7 +137,7 @@ let rec collectExpr super self (e : Typedtree.expression) = ~locTo ~path | Texp_let ( (* generated for functions with optional args *) - Nonrecursive, + Nonrecursive, [ { vb_pat = {pat_desc = Tpat_var (idArg, _)}; diff --git a/analysis/reanalyze/src/EmitJson.ml b/analysis/reanalyze/src/EmitJson.ml index e3a59a738..ce8fc783f 100644 --- a/analysis/reanalyze/src/EmitJson.ml +++ b/analysis/reanalyze/src/EmitJson.ml @@ -1,9 +1,6 @@ let items = ref 0 - let start () = Format.fprintf Format.std_formatter "[" - let finish () = Format.fprintf Format.std_formatter "\n]@." - let emitClose () = "\n}" let emitItem ~ppf ~name ~kind ~file ~range ~message = diff --git a/analysis/reanalyze/src/Exception.ml b/analysis/reanalyze/src/Exception.ml index bf3792f87..87e9e1574 100644 --- a/analysis/reanalyze/src/Exception.ml +++ b/analysis/reanalyze/src/Exception.ml @@ -66,7 +66,8 @@ module Event = struct type kind = | Catches of t list (* with | E => ... *) | Call of {callee : Common.Path.t; modulePath : Common.Path.t} (* foo() *) - | DoesNotRaise of t list (* DoesNotRaise(events) where events come from an expression *) + | DoesNotRaise of + t list (* DoesNotRaise(events) where events come from an expression *) | Raises (** raise E *) and t = {exceptions : Exceptions.t; kind : kind; loc : Location.t} diff --git a/analysis/reanalyze/src/Exceptions.ml b/analysis/reanalyze/src/Exceptions.ml index daa60c6c5..06d4d5c18 100644 --- a/analysis/reanalyze/src/Exceptions.ml +++ b/analysis/reanalyze/src/Exceptions.ml @@ -3,19 +3,12 @@ open Common type t = ExnSet.t let add = ExnSet.add - let diff = ExnSet.diff - let empty = ExnSet.empty - let fromList = ExnSet.of_list - let toList = ExnSet.elements - let isEmpty = ExnSet.is_empty - let iter = ExnSet.iter - let union = ExnSet.union let pp ~exnTable ppf exceptions = diff --git a/analysis/reanalyze/src/Exn.ml b/analysis/reanalyze/src/Exn.ml index 956dd7214..65f055d35 100644 --- a/analysis/reanalyze/src/Exn.ml +++ b/analysis/reanalyze/src/Exn.ml @@ -1,35 +1,19 @@ type t = string let compare = String.compare - let decodeError = "DecodeError" - let assertFailure = "Assert_failure" - let divisionByZero = "Division_by_zero" - let endOfFile = "End_of_file" - let exit = "exit" - let failure = "Failure" - let invalidArgument = "Invalid_argument" - let jsExnError = "Js.Exn.Error" - let matchFailure = "Match_failure" - let notFound = "Not_found" - let sysError = "Sys_error" - let fromLid lid = lid |> Longident.flatten |> String.concat "." - let fromString s = s - let toString s = s - let yojsonJsonError = "Yojson.Json_error" - -let yojsonTypeError = "Yojson.Basic.Util.Type_error" \ No newline at end of file +let yojsonTypeError = "Yojson.Basic.Util.Type_error" diff --git a/analysis/reanalyze/src/Exn.mli b/analysis/reanalyze/src/Exn.mli index ba5eee7f1..f59117781 100644 --- a/analysis/reanalyze/src/Exn.mli +++ b/analysis/reanalyze/src/Exn.mli @@ -16,4 +16,4 @@ val notFound : t val sysError : t val toString : t -> string val yojsonJsonError : t -val yojsonTypeError : t \ No newline at end of file +val yojsonTypeError : t diff --git a/analysis/reanalyze/src/Issues.ml b/analysis/reanalyze/src/Issues.ml index 46f1e9d82..d1c1a3ca3 100644 --- a/analysis/reanalyze/src/Issues.ml +++ b/analysis/reanalyze/src/Issues.ml @@ -1,27 +1,14 @@ let errorHygiene = "Error Hygiene" - let errorNotImplemented = "Error Not Implemented" - let errorTermination = "Error Termination" - let exceptionAnalysis = "Exception Analysis" - let incorrectDeadAnnotation = "Incorrect Dead Annotation" - let terminationAnalysisInternal = "Termination Analysis Internal" - let warningDeadAnalysisCycle = "Warning Dead Analysis Cycle" - let warningDeadException = "Warning Dead Exception" - let warningDeadModule = "Warning Dead Module" - let warningDeadType = "Warning Dead Type" - let warningDeadValue = "Warning Dead Value" - let warningDeadValueWithSideEffects = "Warning Dead Value With Side Effects" - let warningRedundantOptionalArgument = "Warning Redundant Optional Argument" - -let warningUnusedArgument = "Warning Unused Argument" \ No newline at end of file +let warningUnusedArgument = "Warning Unused Argument" diff --git a/analysis/reanalyze/src/Log_.ml b/analysis/reanalyze/src/Log_.ml index b5d10511c..6cf0e9775 100644 --- a/analysis/reanalyze/src/Log_.ml +++ b/analysis/reanalyze/src/Log_.ml @@ -2,13 +2,10 @@ open Common module Color = struct let color_enabled = lazy (Unix.isatty Unix.stdout) - let forceColor = ref false - let get_color_enabled () = !forceColor || Lazy.force color_enabled type color = Red | Yellow | Magenta | Cyan - type style = FG of color | Bold | Dim let code_of_style = function @@ -58,7 +55,6 @@ module Color = struct Location.print_loc Format.str_formatter Location.none let error ppf s = Format.fprintf ppf "@{%s@}" s - let info ppf s = Format.fprintf ppf "@{%s@}" s end @@ -200,9 +196,7 @@ let logIssue ~(issue : issue) = module Stats = struct let issues = ref [] - let addIssue (issue : issue) = issues := issue :: !issues - let clear () = issues := [] let getSortedIssues () = diff --git a/analysis/reanalyze/src/ModulePath.ml b/analysis/reanalyze/src/ModulePath.ml index 06363bd45..1a8a816d6 100644 --- a/analysis/reanalyze/src/ModulePath.ml +++ b/analysis/reanalyze/src/ModulePath.ml @@ -5,9 +5,7 @@ module NameMap = Map.Make (Name) type t = {aliases : Path.t NameMap.t; loc : Location.t; path : Path.t} let initial = ({aliases = NameMap.empty; loc = Location.none; path = []} : t) - let current = (ref initial : t ref) - let init () = current := initial let normalizePath ~aliases path = @@ -33,7 +31,5 @@ let addAlias ~name ~path = current := {!current with aliases = NameMap.add name pathNormalized aliases} let resolveAlias path = path |> normalizePath ~aliases:!current.aliases - let getCurrent () = !current - let setCurrent p = current := p diff --git a/analysis/reanalyze/src/Name.ml b/analysis/reanalyze/src/Name.ml index c500c1fce..9b5a8749f 100644 --- a/analysis/reanalyze/src/Name.ml +++ b/analysis/reanalyze/src/Name.ml @@ -6,7 +6,6 @@ let create ?(isInterface = true) s = match isInterface with true -> s | false -> "+" ^ s let isInterface s = try s.[0] <> '+' with Invalid_argument _ -> false - let isUnderscore s = s = "_" || s = "+_" let startsWithUnderscore s = @@ -22,5 +21,4 @@ let toInterface s = try String.sub s 1 (String.length s - 1) with Invalid_argument _ -> s) let toImplementation s = match isInterface s with true -> "+" ^ s | false -> s - -let toString (s:t) = s +let toString (s : t) = s diff --git a/analysis/reanalyze/src/Name.mli b/analysis/reanalyze/src/Name.mli index 824ccf154..3f515e306 100644 --- a/analysis/reanalyze/src/Name.mli +++ b/analysis/reanalyze/src/Name.mli @@ -1,15 +1,9 @@ type t val compare : t -> t -> int - val create : ?isInterface:bool -> string -> t - val isUnderscore : t -> bool - val startsWithUnderscore : t -> bool - val toImplementation : t -> t - val toInterface : t -> t - val toString : t -> string diff --git a/analysis/reanalyze/src/Reanalyze.ml b/analysis/reanalyze/src/Reanalyze.ml index acec5dcbe..e765844f4 100644 --- a/analysis/reanalyze/src/Reanalyze.ml +++ b/analysis/reanalyze/src/Reanalyze.ml @@ -213,4 +213,4 @@ let cli () = [@@raises exit] module RunConfig = RunConfig -module Log_ = Log_ \ No newline at end of file +module Log_ = Log_ diff --git a/analysis/reanalyze/src/RunConfig.ml b/analysis/reanalyze/src/RunConfig.ml index 4d22380f5..3a0fe9675 100644 --- a/analysis/reanalyze/src/RunConfig.ml +++ b/analysis/reanalyze/src/RunConfig.ml @@ -25,7 +25,5 @@ let all () = runConfig.termination <- true let dce () = runConfig.dce <- true - let exception_ () = runConfig.exception_ <- true - let termination () = runConfig.termination <- true diff --git a/analysis/reanalyze/src/Version.ml b/analysis/reanalyze/src/Version.ml index 6004c20b4..4361834b4 100644 --- a/analysis/reanalyze/src/Version.ml +++ b/analysis/reanalyze/src/Version.ml @@ -1,5 +1,4 @@ - (* CREATED BY reanalyze/scripts/bump_version_module.js *) (* DO NOT MODIFY BY HAND, WILL BE AUTOMATICALLY UPDATED BY npm version *) -let version = "2.22.0"; +let version = "2.22.0" diff --git a/analysis/reanalyze/src/WriteDeadAnnotations.ml b/analysis/reanalyze/src/WriteDeadAnnotations.ml index e5db0950c..fe0870505 100644 --- a/analysis/reanalyze/src/WriteDeadAnnotations.ml +++ b/analysis/reanalyze/src/WriteDeadAnnotations.ml @@ -10,7 +10,6 @@ let posLanguage (pos : Lexing.position) = else Ml let deadAnnotation = "dead" - let annotateAtEnd ~pos = match posLanguage pos with Res -> false | Ml -> true let getPosAnnotation decl = @@ -78,7 +77,6 @@ let lineToString {original; declarations} = lineToString_ {original; declarations} let currentFile = ref "" - let currentFileLines = (ref [||] : line array ref) let readFile fileName = diff --git a/analysis/src/CompletionBackEnd.ml b/analysis/src/CompletionBackEnd.ml index a1cc5929f..b0cef663b 100644 --- a/analysis/src/CompletionBackEnd.ml +++ b/analysis/src/CompletionBackEnd.ml @@ -727,7 +727,6 @@ let findAllCompletions ~(env : QueryEnv.t) ~prefix ~exact ~namesUsed module LocalTables = struct type 'a table = (string * (int * int), 'a Declared.t) Hashtbl.t - type namesUsed = (string, unit) Hashtbl.t type t = { @@ -1441,8 +1440,7 @@ Alternatively, use the `@@deprecated` decorator to add a deprecation warning to [Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#expression-deprecated-decorator).|}; ] ); - - ( "doesNotRaise", + ( "doesNotRaise", [ {|The `@doesNotRaise` decorator is for reanalyze, a static analysis tool for ReScript that can perform exception analysis. @@ -1453,7 +1451,6 @@ could potentially raise. [Read more and see examples in the documentation](https://github.com/rescript-association/reanalyze/blob/master/EXCEPTION.md). > Hint: Did you know you can run an interactive code analysis in your project by running the command `> ReScript: Start Code Analyzer`? Try it!|}; ] ); - ( "genType", [ {|The @genType decorator may be used to export ReScript values and types to JavaScript, and import JavaScript values and types into ReScript. It allows seamless integration of compiled ReScript modules in existing TypeScript, Flow, or plain JavaScript codebases, without loosing type information across different type systems. diff --git a/analysis/src/CompletionFrontEnd.ml b/analysis/src/CompletionFrontEnd.ml index 94422817b..00a42eb20 100644 --- a/analysis/src/CompletionFrontEnd.ml +++ b/analysis/src/CompletionFrontEnd.ml @@ -130,7 +130,6 @@ type labelled = { } type label = labelled option - type arg = {label : label; exp : Parsetree.expression} let findNamedArgCompletable ~(args : arg list) ~endPos ~posBeforeCursor diff --git a/analysis/src/CreateInterface.ml b/analysis/src/CreateInterface.ml index 129c2058f..b9af6fac6 100644 --- a/analysis/src/CreateInterface.ml +++ b/analysis/src/CreateInterface.ml @@ -108,10 +108,10 @@ let printSignature ~extractor ~signature = let rec processSignature ~indent (signature : Types.signature) : unit = match signature with | Sig_value - ( makePropsId - (* makeProps *), + ( makePropsId (* makeProps *), {val_loc = makePropsLoc; val_type = makePropsType} ) - :: Sig_value (makeId (* make *), makeValueDesc) :: rest + :: Sig_value (makeId (* make *), makeValueDesc) + :: rest when Ident.name makePropsId = Ident.name makeId ^ "Props" && ((* from implementation *) makePropsLoc.loc_ghost || (* from interface *) makePropsLoc = makeValueDesc.val_loc) diff --git a/analysis/src/Files.ml b/analysis/src/Files.ml index 50eb92388..98cc26cb9 100644 --- a/analysis/src/Files.ml +++ b/analysis/src/Files.ml @@ -51,7 +51,6 @@ let readFile filename = with _ -> None let exists path = match maybeStat path with None -> false | Some _ -> true - let ifExists path = if exists path then Some path else None let readDirectory dir = diff --git a/analysis/src/FindFiles.ml b/analysis/src/FindFiles.ml index 44ea5eff4..316d7776b 100644 --- a/analysis/src/FindFiles.ml +++ b/analysis/src/FindFiles.ml @@ -1,7 +1,5 @@ let ifDebug debug name fn v = if debug then Log.log (name ^ ": " ^ fn v) - let ( /+ ) = Filename.concat - let bind f x = Option.bind x f (* Returns a list of paths, relative to the provided `base` *) diff --git a/analysis/src/Log.ml b/analysis/src/Log.ml index 0d04272e7..5d1fd823c 100644 --- a/analysis/src/Log.ml +++ b/analysis/src/Log.ml @@ -1,3 +1,2 @@ let verbose = ref false - let log msg = if !verbose then print_endline msg diff --git a/analysis/src/References.ml b/analysis/src/References.ml index 2d9446f1d..bfdfb3f3f 100644 --- a/analysis/src/References.ml +++ b/analysis/src/References.ml @@ -1,7 +1,6 @@ open SharedTypes let debugReferences = ref true - let maybeLog m = if !debugReferences then Log.log ("[ref] " ^ m) let checkPos (line, char) @@ -44,7 +43,8 @@ let getLocItem ~full ~pos ~debug = log 3 "heuristic for
"; Some li2 | {locType = Typed ("makeProps", _, _)} - :: ({locType = Typed ("make", _, _)} as li2) :: _ -> + :: ({locType = Typed ("make", _, _)} as li2) + :: _ -> log 4 "heuristic for within fragments: take make as makeProps does not \ work\n\ diff --git a/analysis/src/Scope.ml b/analysis/src/Scope.ml index 9fa5c28a2..2514c50c4 100644 --- a/analysis/src/Scope.ml +++ b/analysis/src/Scope.ml @@ -21,17 +21,11 @@ let itemToString item = [@@live] let create () : t = [] - let addConstructor ~name ~loc x = Constructor (name, loc) :: x - let addField ~name ~loc x = Field (name, loc) :: x - let addModule ~name ~loc x = Module (name, loc) :: x - let addOpen ~lid x = Open (Utils.flattenLongIdent lid @ ["place holder"]) :: x - let addValue ~name ~loc x = Value (name, loc) :: x - let addType ~name ~loc x = Type (name, loc) :: x let iterValuesBeforeFirstOpen f x = diff --git a/analysis/src/Uri.ml b/analysis/src/Uri.ml index f056ed109..3eea23291 100644 --- a/analysis/src/Uri.ml +++ b/analysis/src/Uri.ml @@ -12,9 +12,7 @@ let pathToUri path = "/" ^ String.lowercase_ascii name ^ "%3A")) let fromPath path = {path; uri = pathToUri path} - let isInterface {path} = Filename.check_suffix path "i" - let toPath {path} = path let toTopLevelLoc {path} = diff --git a/analysis/src/Uri.mli b/analysis/src/Uri.mli index 0ab4c64f1..5e8013c06 100644 --- a/analysis/src/Uri.mli +++ b/analysis/src/Uri.mli @@ -1,13 +1,8 @@ type t val fromPath : string -> t - val isInterface : t -> bool - val stripPath : bool ref - val toPath : t -> string - val toString : t -> string - val toTopLevelLoc : t -> Location.t diff --git a/analysis/vendor/ext/ext_json_parse.ml b/analysis/vendor/ext/ext_json_parse.ml index b25b904c0..fc6f38521 100644 --- a/analysis/vendor/ext/ext_json_parse.ml +++ b/analysis/vendor/ext/ext_json_parse.ml @@ -1,72 +1,50 @@ -module StringMap = Map.Make(String) +module StringMap = Map.Make (String) type error = | Illegal_character of char | Unterminated_string | Unterminated_comment | Illegal_escape of string - | Unexpected_token + | Unexpected_token | Expect_comma_or_rbracket | Expect_comma_or_rbrace | Expect_colon - | Expect_string_or_rbrace - | Expect_eof - (* | Trailing_comma_in_obj *) - (* | Trailing_comma_in_array *) + | Expect_string_or_rbrace + | Expect_eof +(* | Trailing_comma_in_obj *) +(* | Trailing_comma_in_array *) +let fprintf = Format.fprintf -let fprintf = Format.fprintf let report_error ppf = function - | Illegal_character c -> - fprintf ppf "Illegal character (%s)" (Char.escaped c) + | Illegal_character c -> fprintf ppf "Illegal character (%s)" (Char.escaped c) | Illegal_escape s -> - fprintf ppf "Illegal backslash escape in string or character (%s)" s - | Unterminated_string -> - fprintf ppf "Unterminated_string" - | Expect_comma_or_rbracket -> - fprintf ppf "Expect_comma_or_rbracket" - | Expect_comma_or_rbrace -> - fprintf ppf "Expect_comma_or_rbrace" - | Expect_colon -> - fprintf ppf "Expect_colon" - | Expect_string_or_rbrace -> - fprintf ppf "Expect_string_or_rbrace" - | Expect_eof -> - fprintf ppf "Expect_eof" - | Unexpected_token - -> - fprintf ppf "Unexpected_token" + fprintf ppf "Illegal backslash escape in string or character (%s)" s + | Unterminated_string -> fprintf ppf "Unterminated_string" + | Expect_comma_or_rbracket -> fprintf ppf "Expect_comma_or_rbracket" + | Expect_comma_or_rbrace -> fprintf ppf "Expect_comma_or_rbrace" + | Expect_colon -> fprintf ppf "Expect_colon" + | Expect_string_or_rbrace -> fprintf ppf "Expect_string_or_rbrace" + | Expect_eof -> fprintf ppf "Expect_eof" + | Unexpected_token -> fprintf ppf "Unexpected_token" (* | Trailing_comma_in_obj *) (* -> fprintf ppf "Trailing_comma_in_obj" *) (* | Trailing_comma_in_array *) (* -> fprintf ppf "Trailing_comma_in_array" *) - | Unterminated_comment - -> fprintf ppf "Unterminated_comment" - + | Unterminated_comment -> fprintf ppf "Unterminated_comment" exception Error of Lexing.position * Lexing.position * error +let () = + Printexc.register_printer (function x -> + (match x with + | Error (loc_start, loc_end, error) -> + Some + (Format.asprintf "@[%a:@ %a@ -@ %a)@]" report_error error + Ext_position.print loc_start Ext_position.print loc_end) + | _ -> None)) -let () = - Printexc.register_printer - (function x -> - match x with - | Error (loc_start,loc_end,error) -> - Some (Format.asprintf - "@[%a:@ %a@ -@ %a)@]" - report_error error - Ext_position.print loc_start - Ext_position.print loc_end - ) - - | _ -> None - ) - - - - - -type token = +type token = | Comma | Eof | False @@ -78,17 +56,15 @@ type token = | Rbrace | Rbracket | String of string - | True - -let error (lexbuf : Lexing.lexbuf) e = - raise (Error (lexbuf.lex_start_p, lexbuf.lex_curr_p, e)) -[@@raises Error] + | True +let error (lexbuf : Lexing.lexbuf) e = + raise (Error (lexbuf.lex_start_p, lexbuf.lex_curr_p, e)) + [@@raises Error] -let lexeme_len (x : Lexing.lexbuf) = - x.lex_curr_pos - x.lex_start_pos +let lexeme_len (x : Lexing.lexbuf) = x.lex_curr_pos - x.lex_start_pos -let update_loc ({ lex_curr_p; _ } as lexbuf : Lexing.lexbuf) diff = +let update_loc ({lex_curr_p; _} as lexbuf : Lexing.lexbuf) diff = lexbuf.lex_curr_p <- { lex_curr_p with @@ -104,508 +80,233 @@ let char_for_backslash = function | c -> c let dec_code c1 c2 c3 = - 100 * (Char.code c1 - 48) + 10 * (Char.code c2 - 48) + (Char.code c3 - 48) + (100 * (Char.code c1 - 48)) + (10 * (Char.code c2 - 48)) + (Char.code c3 - 48) let hex_code c1 c2 = let d1 = Char.code c1 in let val1 = - if d1 >= 97 then d1 - 87 - else if d1 >= 65 then d1 - 55 - else d1 - 48 in + if d1 >= 97 then d1 - 87 else if d1 >= 65 then d1 - 55 else d1 - 48 + in let d2 = Char.code c2 in let val2 = - if d2 >= 97 then d2 - 87 - else if d2 >= 65 then d2 - 55 - else d2 - 48 in - val1 * 16 + val2 + if d2 >= 97 then d2 - 87 else if d2 >= 65 then d2 - 55 else d2 - 48 + in + (val1 * 16) + val2 let lf = '\010' -let __ocaml_lex_tables = { - Lexing.lex_base = - "\000\000\239\255\240\255\241\255\000\000\025\000\011\000\244\255\ - \245\255\246\255\247\255\248\255\249\255\000\000\000\000\000\000\ - \041\000\001\000\254\255\005\000\005\000\253\255\001\000\002\000\ - \252\255\000\000\000\000\003\000\251\255\001\000\003\000\250\255\ - \079\000\089\000\099\000\121\000\131\000\141\000\153\000\163\000\ - \001\000\253\255\254\255\023\000\255\255\006\000\246\255\189\000\ - \248\255\215\000\255\255\249\255\249\000\181\000\252\255\009\000\ - \063\000\075\000\234\000\251\255\032\001\250\255"; - Lexing.lex_backtrk = - "\255\255\255\255\255\255\255\255\013\000\013\000\016\000\255\255\ - \255\255\255\255\255\255\255\255\255\255\016\000\016\000\016\000\ - \016\000\016\000\255\255\000\000\012\000\255\255\255\255\255\255\ - \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ - \255\255\255\255\013\000\255\255\013\000\255\255\013\000\255\255\ - \255\255\255\255\255\255\001\000\255\255\255\255\255\255\008\000\ - \255\255\255\255\255\255\255\255\006\000\006\000\255\255\006\000\ - \001\000\002\000\255\255\255\255\255\255\255\255"; - Lexing.lex_default = - "\001\000\000\000\000\000\000\000\255\255\255\255\255\255\000\000\ - \000\000\000\000\000\000\000\000\000\000\255\255\255\255\255\255\ - \255\255\255\255\000\000\255\255\020\000\000\000\255\255\255\255\ - \000\000\255\255\255\255\255\255\000\000\255\255\255\255\000\000\ - \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ - \042\000\000\000\000\000\255\255\000\000\047\000\000\000\047\000\ - \000\000\051\000\000\000\000\000\255\255\255\255\000\000\255\255\ - \255\255\255\255\255\255\000\000\255\255\000\000"; - Lexing.lex_trans = - "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\019\000\018\000\018\000\019\000\017\000\019\000\255\255\ - \048\000\019\000\255\255\057\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \019\000\000\000\003\000\000\000\000\000\019\000\000\000\000\000\ - \050\000\000\000\000\000\043\000\008\000\006\000\033\000\016\000\ - \004\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\ - \005\000\005\000\007\000\004\000\005\000\005\000\005\000\005\000\ - \005\000\005\000\005\000\005\000\005\000\032\000\044\000\033\000\ - \056\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\ - \005\000\005\000\005\000\021\000\057\000\000\000\000\000\000\000\ - \020\000\000\000\000\000\012\000\000\000\011\000\032\000\056\000\ - \000\000\025\000\049\000\000\000\000\000\032\000\014\000\024\000\ - \028\000\000\000\000\000\057\000\026\000\030\000\013\000\031\000\ - \000\000\000\000\022\000\027\000\015\000\029\000\023\000\000\000\ - \000\000\000\000\039\000\010\000\039\000\009\000\032\000\038\000\ - \038\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\ - \038\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\ - \034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\ - \034\000\034\000\034\000\034\000\034\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\037\000\000\000\037\000\000\000\ - \035\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\ - \036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\ - \036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\ - \036\000\036\000\036\000\036\000\036\000\036\000\036\000\255\255\ - \035\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\ - \038\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\ - \038\000\038\000\038\000\038\000\038\000\000\000\000\000\255\255\ - \000\000\056\000\000\000\000\000\055\000\058\000\058\000\058\000\ - \058\000\058\000\058\000\058\000\058\000\058\000\058\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\054\000\ - \000\000\054\000\000\000\000\000\000\000\000\000\054\000\000\000\ - \002\000\041\000\000\000\000\000\000\000\255\255\046\000\053\000\ - \053\000\053\000\053\000\053\000\053\000\053\000\053\000\053\000\ - \053\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\255\255\059\000\059\000\059\000\059\000\059\000\059\000\ - \059\000\059\000\059\000\059\000\000\000\000\000\000\000\000\000\ - \000\000\060\000\060\000\060\000\060\000\060\000\060\000\060\000\ - \060\000\060\000\060\000\054\000\000\000\000\000\000\000\000\000\ - \000\000\054\000\060\000\060\000\060\000\060\000\060\000\060\000\ - \000\000\000\000\000\000\000\000\000\000\054\000\000\000\000\000\ - \000\000\054\000\000\000\054\000\000\000\000\000\000\000\052\000\ - \061\000\061\000\061\000\061\000\061\000\061\000\061\000\061\000\ - \061\000\061\000\060\000\060\000\060\000\060\000\060\000\060\000\ - \000\000\061\000\061\000\061\000\061\000\061\000\061\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\061\000\061\000\061\000\061\000\061\000\061\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\255\255\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\255\255\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000"; - Lexing.lex_check = - "\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ - \255\255\000\000\000\000\017\000\000\000\000\000\019\000\020\000\ - \045\000\019\000\020\000\055\000\255\255\255\255\255\255\255\255\ - \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ - \000\000\255\255\000\000\255\255\255\255\019\000\255\255\255\255\ - \045\000\255\255\255\255\040\000\000\000\000\000\004\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\006\000\006\000\006\000\006\000\006\000\ - \006\000\006\000\006\000\006\000\006\000\004\000\043\000\005\000\ - \056\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\ - \005\000\005\000\005\000\016\000\057\000\255\255\255\255\255\255\ - \016\000\255\255\255\255\000\000\255\255\000\000\005\000\056\000\ - \255\255\014\000\045\000\255\255\255\255\004\000\000\000\023\000\ - \027\000\255\255\255\255\057\000\025\000\029\000\000\000\030\000\ - \255\255\255\255\015\000\026\000\000\000\013\000\022\000\255\255\ - \255\255\255\255\032\000\000\000\032\000\000\000\005\000\032\000\ - \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\ - \032\000\033\000\033\000\033\000\033\000\033\000\033\000\033\000\ - \033\000\033\000\033\000\034\000\034\000\034\000\034\000\034\000\ - \034\000\034\000\034\000\034\000\034\000\255\255\255\255\255\255\ - \255\255\255\255\255\255\255\255\035\000\255\255\035\000\255\255\ - \034\000\035\000\035\000\035\000\035\000\035\000\035\000\035\000\ - \035\000\035\000\035\000\036\000\036\000\036\000\036\000\036\000\ - \036\000\036\000\036\000\036\000\036\000\037\000\037\000\037\000\ - \037\000\037\000\037\000\037\000\037\000\037\000\037\000\047\000\ - \034\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\ - \038\000\038\000\038\000\039\000\039\000\039\000\039\000\039\000\ - \039\000\039\000\039\000\039\000\039\000\255\255\255\255\047\000\ - \255\255\049\000\255\255\255\255\049\000\053\000\053\000\053\000\ - \053\000\053\000\053\000\053\000\053\000\053\000\053\000\255\255\ - \255\255\255\255\255\255\255\255\255\255\255\255\255\255\049\000\ - \255\255\049\000\255\255\255\255\255\255\255\255\049\000\255\255\ - \000\000\040\000\255\255\255\255\255\255\020\000\045\000\049\000\ - \049\000\049\000\049\000\049\000\049\000\049\000\049\000\049\000\ - \049\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ - \255\255\047\000\058\000\058\000\058\000\058\000\058\000\058\000\ - \058\000\058\000\058\000\058\000\255\255\255\255\255\255\255\255\ - \255\255\052\000\052\000\052\000\052\000\052\000\052\000\052\000\ - \052\000\052\000\052\000\049\000\255\255\255\255\255\255\255\255\ - \255\255\049\000\052\000\052\000\052\000\052\000\052\000\052\000\ - \255\255\255\255\255\255\255\255\255\255\049\000\255\255\255\255\ - \255\255\049\000\255\255\049\000\255\255\255\255\255\255\049\000\ - \060\000\060\000\060\000\060\000\060\000\060\000\060\000\060\000\ - \060\000\060\000\052\000\052\000\052\000\052\000\052\000\052\000\ - \255\255\060\000\060\000\060\000\060\000\060\000\060\000\255\255\ - \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ - \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ - \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ - \255\255\060\000\060\000\060\000\060\000\060\000\060\000\255\255\ - \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ - \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ - \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ - \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ - \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ - \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ - \255\255\255\255\255\255\255\255\255\255\047\000\255\255\255\255\ - \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ - \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ - \255\255\255\255\255\255\255\255\255\255\255\255\255\255\049\000\ - \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ - \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ - \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ - \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ - \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ - \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ - \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ - \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ - \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ - \255\255"; - Lexing.lex_base_code = - ""; - Lexing.lex_backtrk_code = - ""; - Lexing.lex_default_code = - ""; - Lexing.lex_trans_code = - ""; - Lexing.lex_check_code = - ""; - Lexing.lex_code = - ""; -} +let __ocaml_lex_tables = + { + Lexing.lex_base = + "\000\000\239\255\240\255\241\255\000\000\025\000\011\000\244\255\245\255\246\255\247\255\248\255\249\255\000\000\000\000\000\000\041\000\001\000\254\255\005\000\005\000\253\255\001\000\002\000\252\255\000\000\000\000\003\000\251\255\001\000\003\000\250\255\079\000\089\000\099\000\121\000\131\000\141\000\153\000\163\000\001\000\253\255\254\255\023\000\255\255\006\000\246\255\189\000\248\255\215\000\255\255\249\255\249\000\181\000\252\255\009\000\063\000\075\000\234\000\251\255\032\001\250\255"; + Lexing.lex_backtrk = + "\255\255\255\255\255\255\255\255\013\000\013\000\016\000\255\255\255\255\255\255\255\255\255\255\255\255\016\000\016\000\016\000\016\000\016\000\255\255\000\000\012\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\013\000\255\255\013\000\255\255\013\000\255\255\255\255\255\255\255\255\001\000\255\255\255\255\255\255\008\000\255\255\255\255\255\255\255\255\006\000\006\000\255\255\006\000\001\000\002\000\255\255\255\255\255\255\255\255"; + Lexing.lex_default = + "\001\000\000\000\000\000\000\000\255\255\255\255\255\255\000\000\000\000\000\000\000\000\000\000\000\000\255\255\255\255\255\255\255\255\255\255\000\000\255\255\020\000\000\000\255\255\255\255\000\000\255\255\255\255\255\255\000\000\255\255\255\255\000\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\042\000\000\000\000\000\255\255\000\000\047\000\000\000\047\000\000\000\051\000\000\000\000\000\255\255\255\255\000\000\255\255\255\255\255\255\255\255\000\000\255\255\000\000"; + Lexing.lex_trans = + "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\000\018\000\018\000\019\000\017\000\019\000\255\255\048\000\019\000\255\255\057\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\000\000\000\003\000\000\000\000\000\019\000\000\000\000\000\050\000\000\000\000\000\043\000\008\000\006\000\033\000\016\000\004\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\007\000\004\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\032\000\044\000\033\000\056\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\021\000\057\000\000\000\000\000\000\000\020\000\000\000\000\000\012\000\000\000\011\000\032\000\056\000\000\000\025\000\049\000\000\000\000\000\032\000\014\000\024\000\028\000\000\000\000\000\057\000\026\000\030\000\013\000\031\000\000\000\000\000\022\000\027\000\015\000\029\000\023\000\000\000\000\000\000\000\039\000\010\000\039\000\009\000\032\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\037\000\000\000\037\000\000\000\035\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\255\255\035\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\000\000\000\000\255\255\000\000\056\000\000\000\000\000\055\000\058\000\058\000\058\000\058\000\058\000\058\000\058\000\058\000\058\000\058\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\054\000\000\000\054\000\000\000\000\000\000\000\000\000\054\000\000\000\002\000\041\000\000\000\000\000\000\000\255\255\046\000\053\000\053\000\053\000\053\000\053\000\053\000\053\000\053\000\053\000\053\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\255\255\059\000\059\000\059\000\059\000\059\000\059\000\059\000\059\000\059\000\059\000\000\000\000\000\000\000\000\000\000\000\060\000\060\000\060\000\060\000\060\000\060\000\060\000\060\000\060\000\060\000\054\000\000\000\000\000\000\000\000\000\000\000\054\000\060\000\060\000\060\000\060\000\060\000\060\000\000\000\000\000\000\000\000\000\000\000\054\000\000\000\000\000\000\000\054\000\000\000\054\000\000\000\000\000\000\000\052\000\061\000\061\000\061\000\061\000\061\000\061\000\061\000\061\000\061\000\061\000\060\000\060\000\060\000\060\000\060\000\060\000\000\000\061\000\061\000\061\000\061\000\061\000\061\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\061\000\061\000\061\000\061\000\061\000\061\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\255\255\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\255\255\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000"; + Lexing.lex_check = + "\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\000\000\000\000\017\000\000\000\000\000\019\000\020\000\045\000\019\000\020\000\055\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\000\000\255\255\000\000\255\255\255\255\019\000\255\255\255\255\045\000\255\255\255\255\040\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\004\000\043\000\005\000\056\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\016\000\057\000\255\255\255\255\255\255\016\000\255\255\255\255\000\000\255\255\000\000\005\000\056\000\255\255\014\000\045\000\255\255\255\255\004\000\000\000\023\000\027\000\255\255\255\255\057\000\025\000\029\000\000\000\030\000\255\255\255\255\015\000\026\000\000\000\013\000\022\000\255\255\255\255\255\255\032\000\000\000\032\000\000\000\005\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\033\000\033\000\033\000\033\000\033\000\033\000\033\000\033\000\033\000\033\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\035\000\255\255\035\000\255\255\034\000\035\000\035\000\035\000\035\000\035\000\035\000\035\000\035\000\035\000\035\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\037\000\037\000\037\000\037\000\037\000\037\000\037\000\037\000\037\000\037\000\047\000\034\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\038\000\039\000\039\000\039\000\039\000\039\000\039\000\039\000\039\000\039\000\039\000\255\255\255\255\047\000\255\255\049\000\255\255\255\255\049\000\053\000\053\000\053\000\053\000\053\000\053\000\053\000\053\000\053\000\053\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\049\000\255\255\049\000\255\255\255\255\255\255\255\255\049\000\255\255\000\000\040\000\255\255\255\255\255\255\020\000\045\000\049\000\049\000\049\000\049\000\049\000\049\000\049\000\049\000\049\000\049\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\047\000\058\000\058\000\058\000\058\000\058\000\058\000\058\000\058\000\058\000\058\000\255\255\255\255\255\255\255\255\255\255\052\000\052\000\052\000\052\000\052\000\052\000\052\000\052\000\052\000\052\000\049\000\255\255\255\255\255\255\255\255\255\255\049\000\052\000\052\000\052\000\052\000\052\000\052\000\255\255\255\255\255\255\255\255\255\255\049\000\255\255\255\255\255\255\049\000\255\255\049\000\255\255\255\255\255\255\049\000\060\000\060\000\060\000\060\000\060\000\060\000\060\000\060\000\060\000\060\000\052\000\052\000\052\000\052\000\052\000\052\000\255\255\060\000\060\000\060\000\060\000\060\000\060\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\060\000\060\000\060\000\060\000\060\000\060\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\047\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\049\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255"; + Lexing.lex_base_code = ""; + Lexing.lex_backtrk_code = ""; + Lexing.lex_default_code = ""; + Lexing.lex_trans_code = ""; + Lexing.lex_check_code = ""; + Lexing.lex_code = ""; + } + +let rec lex_json buf lexbuf = __ocaml_lex_lex_json_rec buf lexbuf 0 + [@@raises Error] -let rec lex_json buf lexbuf = - __ocaml_lex_lex_json_rec buf lexbuf 0 -[@@raises Error] and __ocaml_lex_lex_json_rec buf lexbuf __ocaml_lex_state = match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf with - | 0 -> - ( lex_json buf lexbuf) - + | 0 -> lex_json buf lexbuf | 1 -> - ( update_loc lexbuf 0; - lex_json buf lexbuf - ) - - | 2 -> - ( comment buf lexbuf) - - | 3 -> - ( True) - - | 4 -> - (False) - - | 5 -> - (Null) - - | 6 -> - (Lbracket) - - | 7 -> - (Rbracket) - - | 8 -> - (Lbrace) - - | 9 -> - (Rbrace) - - | 10 -> - (Comma) - - | 11 -> - (Colon) - - | 12 -> - (lex_json buf lexbuf) - - | 13 -> - ( Number (Lexing.lexeme lexbuf)) - + lex_json buf lexbuf + | 2 -> comment buf lexbuf + | 3 -> True + | 4 -> False + | 5 -> Null + | 6 -> Lbracket + | 7 -> Rbracket + | 8 -> Lbrace + | 9 -> Rbrace + | 10 -> Comma + | 11 -> Colon + | 12 -> lex_json buf lexbuf + | 13 -> Number (Lexing.lexeme lexbuf) | 14 -> - ( - let pos = Lexing.lexeme_start_p lexbuf in - scan_string buf pos lexbuf; - let content = (Buffer.contents buf) in - Buffer.clear buf ; - String content -) - - | 15 -> - (Eof ) - + let pos = Lexing.lexeme_start_p lexbuf in + scan_string buf pos lexbuf; + let content = Buffer.contents buf in + Buffer.clear buf; + String content + | 15 -> Eof | 16 -> -let - c -= Lexing.sub_lexeme_char lexbuf lexbuf.Lexing.lex_start_pos in - ( error lexbuf (Illegal_character c )) + let c = Lexing.sub_lexeme_char lexbuf lexbuf.Lexing.lex_start_pos in + error lexbuf (Illegal_character c) + | __ocaml_lex_state -> + lexbuf.Lexing.refill_buff lexbuf; + __ocaml_lex_lex_json_rec buf lexbuf __ocaml_lex_state + [@@raises Error] - | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; - __ocaml_lex_lex_json_rec buf lexbuf __ocaml_lex_state -[@@raises Error] +and comment buf lexbuf = __ocaml_lex_comment_rec buf lexbuf 40 [@@raises Error] -and comment buf lexbuf = - __ocaml_lex_comment_rec buf lexbuf 40 -[@@raises Error] and __ocaml_lex_comment_rec buf lexbuf __ocaml_lex_state = match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf with - | 0 -> - (lex_json buf lexbuf) - - | 1 -> - (comment buf lexbuf) - - | 2 -> - (error lexbuf Unterminated_comment) - - | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; - __ocaml_lex_comment_rec buf lexbuf __ocaml_lex_state -[@@raises Error] + | 0 -> lex_json buf lexbuf + | 1 -> comment buf lexbuf + | 2 -> error lexbuf Unterminated_comment + | __ocaml_lex_state -> + lexbuf.Lexing.refill_buff lexbuf; + __ocaml_lex_comment_rec buf lexbuf __ocaml_lex_state + [@@raises Error] and scan_string buf start lexbuf = - __ocaml_lex_scan_string_rec buf start lexbuf 45 -[@@raises Error] + __ocaml_lex_scan_string_rec buf start lexbuf 45 + [@@raises Error] + and __ocaml_lex_scan_string_rec buf start lexbuf __ocaml_lex_state = match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf with - | 0 -> - ( () ) - + | 0 -> () | 1 -> - ( - let len = lexeme_len lexbuf - 2 in - update_loc lexbuf len; - - scan_string buf start lexbuf - ) + let len = lexeme_len lexbuf - 2 in + update_loc lexbuf len; + scan_string buf start lexbuf | 2 -> - ( - let len = lexeme_len lexbuf - 3 in - update_loc lexbuf len; - scan_string buf start lexbuf - ) - + let len = lexeme_len lexbuf - 3 in + update_loc lexbuf len; + scan_string buf start lexbuf | 3 -> -let - c -= Lexing.sub_lexeme_char lexbuf (lexbuf.Lexing.lex_start_pos + 1) in - ( - Buffer.add_char buf (char_for_backslash c); - scan_string buf start lexbuf - ) - + let c = Lexing.sub_lexeme_char lexbuf (lexbuf.Lexing.lex_start_pos + 1) in + Buffer.add_char buf (char_for_backslash c); + scan_string buf start lexbuf | 4 -> -let - c1 -= Lexing.sub_lexeme_char lexbuf (lexbuf.Lexing.lex_start_pos + 1) -and - c2 -= Lexing.sub_lexeme_char lexbuf (lexbuf.Lexing.lex_start_pos + 2) -and - c3 -= Lexing.sub_lexeme_char lexbuf (lexbuf.Lexing.lex_start_pos + 3) -and - s -= Lexing.sub_lexeme lexbuf lexbuf.Lexing.lex_start_pos (lexbuf.Lexing.lex_start_pos + 4) in - ( - let v = dec_code c1 c2 c3 in - begin - try Buffer.add_char buf (Char.chr v) with - | _ -> - error lexbuf (Illegal_escape s) - end; - scan_string buf start lexbuf - ) - + let c1 = Lexing.sub_lexeme_char lexbuf (lexbuf.Lexing.lex_start_pos + 1) + and c2 = Lexing.sub_lexeme_char lexbuf (lexbuf.Lexing.lex_start_pos + 2) + and c3 = Lexing.sub_lexeme_char lexbuf (lexbuf.Lexing.lex_start_pos + 3) + and s = + Lexing.sub_lexeme lexbuf lexbuf.Lexing.lex_start_pos + (lexbuf.Lexing.lex_start_pos + 4) + in + let v = dec_code c1 c2 c3 in + (try Buffer.add_char buf (Char.chr v) + with _ -> error lexbuf (Illegal_escape s)); + scan_string buf start lexbuf | 5 -> -let - c1 -= Lexing.sub_lexeme_char lexbuf (lexbuf.Lexing.lex_start_pos + 2) -and - c2 -= Lexing.sub_lexeme_char lexbuf (lexbuf.Lexing.lex_start_pos + 3) in - ( - let v = hex_code c1 c2 in - begin - try Buffer.add_char buf (Char.chr v) with - | _ -> - error lexbuf (Illegal_escape (Char.escaped c2)) - end; - - scan_string buf start lexbuf - ) + let c1 = Lexing.sub_lexeme_char lexbuf (lexbuf.Lexing.lex_start_pos + 2) + and c2 = Lexing.sub_lexeme_char lexbuf (lexbuf.Lexing.lex_start_pos + 3) in + let v = hex_code c1 c2 in + (try Buffer.add_char buf (Char.chr v) + with _ -> error lexbuf (Illegal_escape (Char.escaped c2))); + scan_string buf start lexbuf | 6 -> -let - c -= Lexing.sub_lexeme_char lexbuf (lexbuf.Lexing.lex_start_pos + 1) in - ( - Buffer.add_char buf '\\'; - Buffer.add_char buf c; - - scan_string buf start lexbuf - ) + let c = Lexing.sub_lexeme_char lexbuf (lexbuf.Lexing.lex_start_pos + 1) in + Buffer.add_char buf '\\'; + Buffer.add_char buf c; + scan_string buf start lexbuf | 7 -> - ( - update_loc lexbuf 0; - Buffer.add_char buf lf; - - scan_string buf start lexbuf - ) + update_loc lexbuf 0; + Buffer.add_char buf lf; + scan_string buf start lexbuf | 8 -> - ( - let ofs = lexbuf.lex_start_pos in - let len = lexbuf.lex_curr_pos - ofs in - Buffer.add_substring buf (Bytes.to_string lexbuf.lex_buffer) ofs len; - - scan_string buf start lexbuf - ) - - | 9 -> - ( - error lexbuf Unterminated_string - ) - - | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; - __ocaml_lex_scan_string_rec buf start lexbuf __ocaml_lex_state -[@@raises Error] -;; - - - - - - - + let ofs = lexbuf.lex_start_pos in + let len = lexbuf.lex_curr_pos - ofs in + Buffer.add_substring buf (Bytes.to_string lexbuf.lex_buffer) ofs len; + + scan_string buf start lexbuf + | 9 -> error lexbuf Unterminated_string + | __ocaml_lex_state -> + lexbuf.Lexing.refill_buff lexbuf; + __ocaml_lex_scan_string_rec buf start lexbuf __ocaml_lex_state + [@@raises Error] let parse_json lexbuf = - let buf = Buffer.create 64 in + let buf = Buffer.create 64 in let look_ahead = ref None in - let token () : token = - match !look_ahead with - | None -> - lex_json buf lexbuf - | Some x -> - look_ahead := None ; - x - [@@raises Error] + let token () : token = + match !look_ahead with + | None -> lex_json buf lexbuf + | Some x -> + look_ahead := None; + x + [@@raises Error] in - let push e = look_ahead := Some e in - let rec json (lexbuf : Lexing.lexbuf) : Ext_json_types.t = - match token () with + let push e = look_ahead := Some e in + let rec json (lexbuf : Lexing.lexbuf) : Ext_json_types.t = + match token () with | True -> True lexbuf.lex_start_p | False -> False lexbuf.lex_start_p | Null -> Null lexbuf.lex_start_p - | Number s -> Flo s + | Number s -> Flo s | String s -> Str s - | Lbracket -> parse_array lexbuf.lex_start_p lexbuf.lex_curr_p [] lexbuf + | Lbracket -> parse_array lexbuf.lex_start_p lexbuf.lex_curr_p [] lexbuf | Lbrace -> parse_map lexbuf.lex_start_p StringMap.empty lexbuf - | _ -> error lexbuf Unexpected_token -(* Note if we remove [trailing_comma] support - we should report errors (actually more work), for example - {[ - match token () with - | Rbracket -> - if trailing_comma then - error lexbuf Trailing_comma_in_array - else - ]} - {[ - match token () with - | Rbrace -> - if trailing_comma then - error lexbuf Trailing_comma_in_obj - else - - ]} - *) - [@@raises Error] - - and parse_array loc_start loc_finish acc lexbuf - : Ext_json_types.t = - match token () with - | Rbracket -> - Arr (Array.of_list (acc |> List.rev)) - | x -> - push x ; - let new_one = json lexbuf in - begin match token () with - | Comma -> - parse_array loc_start loc_finish (new_one :: acc) lexbuf - | Rbracket - -> Arr (Array.of_list (new_one::acc |> List.rev)) - | _ -> - error lexbuf Expect_comma_or_rbracket - end - [@@raises Error] - - and parse_map loc_start acc lexbuf : Ext_json_types.t = - match token () with - | Rbrace -> - Obj acc - | String key -> - begin match token () with - | Colon -> + | _ -> error lexbuf Unexpected_token + (* Note if we remove [trailing_comma] support + we should report errors (actually more work), for example + {[ + match token () with + | Rbracket -> + if trailing_comma then + error lexbuf Trailing_comma_in_array + else + ]} + {[ + match token () with + | Rbrace -> + if trailing_comma then + error lexbuf Trailing_comma_in_obj + else + + ]} + *) + [@@raises Error] + and parse_array loc_start loc_finish acc lexbuf : Ext_json_types.t = + match token () with + | Rbracket -> Arr (Array.of_list (acc |> List.rev)) + | x -> ( + push x; + let new_one = json lexbuf in + match token () with + | Comma -> parse_array loc_start loc_finish (new_one :: acc) lexbuf + | Rbracket -> Arr (Array.of_list (new_one :: acc |> List.rev)) + | _ -> error lexbuf Expect_comma_or_rbracket) + [@@raises Error] + and parse_map loc_start acc lexbuf : Ext_json_types.t = + match token () with + | Rbrace -> Obj acc + | String key -> ( + match token () with + | Colon -> ( let value = json lexbuf in - begin match token () with + match token () with | Rbrace -> Obj (StringMap.add key value acc) - | Comma -> - parse_map loc_start (StringMap.add key value acc) lexbuf - | _ -> error lexbuf Expect_comma_or_rbrace - end - | _ -> error lexbuf Expect_colon - end + | Comma -> parse_map loc_start (StringMap.add key value acc) lexbuf + | _ -> error lexbuf Expect_comma_or_rbrace) + | _ -> error lexbuf Expect_colon) | _ -> error lexbuf Expect_string_or_rbrace - [@@raises Error] + [@@raises Error] + in - in - let v = json lexbuf in - match token () with - | Eof -> v - | _ -> error lexbuf Expect_eof -[@@raises Error] + let v = json lexbuf in + match token () with Eof -> v | _ -> error lexbuf Expect_eof + [@@raises Error] -let parse_json_from_file s = - let in_chan = open_in s in +let parse_json_from_file s = + let in_chan = open_in s in match - let lexbuf = - Ext_position.lexbuf_from_channel_with_fname - in_chan s - in + let lexbuf = Ext_position.lexbuf_from_channel_with_fname in_chan s in parse_json lexbuf - with - | exception (Error _ | Invalid_argument _ | Sys_error _) -> close_in_noerr in_chan ; None - | v -> close_in_noerr in_chan; Some(v) + with + | exception (Error _ | Invalid_argument _ | Sys_error _) -> + close_in_noerr in_chan; + None + | v -> + close_in_noerr in_chan; + Some v diff --git a/analysis/vendor/ext/ext_json_types.ml b/analysis/vendor/ext/ext_json_types.ml index 588754b0f..780c2f5e2 100644 --- a/analysis/vendor/ext/ext_json_types.ml +++ b/analysis/vendor/ext/ext_json_types.ml @@ -24,21 +24,18 @@ type loc = Lexing.position type json_str = string +type json_flo = string -type json_flo = string - -module StringMap = Map.Make(String) +module StringMap = Map.Make (String) type json_array = t array - and json_map = t StringMap.t -and t = - | True of loc - | False of loc - | Null of loc +and t = + | True of loc + | False of loc + | Null of loc | Flo of json_flo | Str of json_str - | Arr of json_array + | Arr of json_array | Obj of json_map - \ No newline at end of file diff --git a/analysis/vendor/ext/ext_position.ml b/analysis/vendor/ext/ext_position.ml index c014c3c25..af96c89f6 100644 --- a/analysis/vendor/ext/ext_position.ml +++ b/analysis/vendor/ext/ext_position.ml @@ -22,28 +22,28 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - type t = Lexing.position = { - pos_fname : string ; [@dead] - pos_lnum : int ; - pos_bol : int ; - pos_cnum : int + pos_fname : string; [@dead] + pos_lnum : int; + pos_bol : int; + pos_cnum : int; } let print fmt (pos : t) = - Format.fprintf fmt "(line %d, column %d)" pos.pos_lnum (pos.pos_cnum - pos.pos_bol) - - + Format.fprintf fmt "(line %d, column %d)" pos.pos_lnum + (pos.pos_cnum - pos.pos_bol) -let lexbuf_from_channel_with_fname ic fname = - let x = Lexing.from_function (fun buf n -> input ic buf 0 n) in - let pos : t = { - pos_fname = fname ; - pos_lnum = 1; - pos_bol = 0; - pos_cnum = 0 (* copied from zero_pos*) - } in +let lexbuf_from_channel_with_fname ic fname = + let x = Lexing.from_function (fun buf n -> input ic buf 0 n) in + let pos : t = + { + pos_fname = fname; + pos_lnum = 1; + pos_bol = 0; + pos_cnum = 0 (* copied from zero_pos*); + } + in x.lex_start_p <- pos; - x.lex_curr_p <- pos ; + x.lex_curr_p <- pos; x -[@@raises Invalid_argument] + [@@raises Invalid_argument] diff --git a/analysis/vendor/json/Json.ml b/analysis/vendor/json/Json.ml index 25a21c548..c2bca449d 100644 --- a/analysis/vendor/json/Json.ml +++ b/analysis/vendor/json/Json.ml @@ -461,15 +461,10 @@ let nth n t = | _ -> None let string t = match t with String s -> Some s | _ -> None - let number t = match t with Number s -> Some s | _ -> None - let array t = match t with Array s -> Some s | _ -> None - let obj t = match t with Object s -> Some s | _ -> None - let bool t = match t with True -> Some true | False -> Some false | _ -> None - let null t = match t with Null -> Some () | _ -> None let rec parsePath keyList t =