package vcaml
OCaml bindings for the Neovim API
Install
Dune Dependency
Authors
Maintainers
Sources
vcaml-v0.14.0.tar.gz
sha256=d30d1858696f21cb2863ff1a3c39fc9b12c488aa5328073e300ec852d2716a1e
md5=f667331f1f877114bbfdaaf078159581
doc/src/vcaml.msgpack/parser.ml.html
Source file parser.ml
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290
open Base open Angstrom open Message (* Angstrom does not expose [Let_syntax]. *) module Let_syntax = struct (* Suppress ``unused value'' warnings *) [@@@ocaml.warning "-32"] let return = return let bind x ~f = x >>= f let map x ~f = x >>| f let both x y = return (fun x -> x, y) <*> return x end let with_header_byte c next = let%bind (_ : char) = char c in next ;; let nil = with_header_byte Constants.nil (return Nil) let true_ = with_header_byte Constants.true_ (return (Boolean true)) let false_ = with_header_byte Constants.false_ (return (Boolean false)) let bool = true_ <|> false_ (* See [Constants] for why these are separate functions. Also, see https://github.com/msgpack/msgpack/blob/master/spec.md#formats *) let apply_unmask ~unmask ~value = value land unmask let unmask ~mask ~value = value land lnot mask let check_mask ~mask ~value = let open Int.O in value land mask = mask ;; let positive_fixint = let open Int.O in let%map c = satisfy (fun c -> apply_unmask ~unmask:Constants.positive_fixint_unmask ~value:(Char.to_int c) = Char.to_int c) in Char.to_int c ;; let negative_fixint = let%map c = satisfy (fun c -> check_mask ~mask:Constants.negative_fixint_mask ~value:(Char.to_int c)) in let n = unmask ~mask:Constants.negative_fixint_mask ~value:(Char.to_int c) in (* A negative fixint is stored as a 5-bit two's complement integer. To bit-extend this to be the correct real integer, we set all bits besides the bottom 5. The reason that we use the literal -32 is so that the mask works on 32-bit and 64-bit architectures. 32-bit computer -32: 11111111_11111111_11111111_11100000 64-bit computer -32: 11111111_11111111_11111111_11111111_11111111_11111111_11111111_11100000 *) let top_bits_mask = -32 in n lor top_bits_mask ;; let fixint = positive_fixint <|> negative_fixint let uint8 = with_header_byte Constants.uint8_header any_uint8 let uint16 = with_header_byte Constants.uint16_header BE.any_uint16 (* [Angstrom.BE] does not expose uint32 or uint64... *) let uint32 = let%bind (_ : char) = char Constants.uint32_header in let%map bs = count 2 BE.any_uint16 in (* Because we can't tell angstrom to automatically parse an unsigned 32-bit integer, we instead need to roll our own. A number 0xYYZZ is equal to the sum 0xYY << 16 + 0xZZ and is stored in big endian as YY ZZ. *) List.fold ~f:(fun acc v -> (acc lsl 16) + v) ~init:0 bs ;; let uint64 = let%map v = with_header_byte Constants.uint64_header BE.any_int64 in UInt64 v ;; let int8 = with_header_byte Constants.int8_header any_int8 let int16 = with_header_byte Constants.int16_header BE.any_int16 let int32 = let%bind result = with_header_byte Constants.int32_header BE.any_int32 in match Int32.to_int result with | Some i -> return i (* This will technically fail back to the outlying choice combinators, but that's fine, because the spec is designed such that each of those will fail as well. *) | None -> fail "int32 value too big for native integers!" ;; let int64 = let%map result = with_header_byte Constants.int64_header BE.any_int64 in Int64 result ;; let int = let%map v = choice [ fixint; uint8; uint16; uint32; int8; int16; int32 ] in Integer v ;; let float = with_header_byte Constants.float32_header BE.any_float let double = with_header_byte Constants.float64_header BE.any_double let floating = let%map v = float <|> double in Floating v ;; let fixstr = (* We can't really use [check_mask] here, because the bit pattern for [fixstr] is [101XXXXX], which will also accept [111XXXXX] if we mask naively. *) let%bind c = satisfy (function | '\xa0' .. '\xbf' -> true | _ -> false) in let len = unmask ~mask:Constants.fixstr_mask ~value:(Char.to_int c) in take len ;; let str8 = let%bind len = with_header_byte Constants.str8_header any_uint8 in take len ;; let str16 = let%bind len = with_header_byte Constants.str16_header BE.any_uint16 in take len ;; let str32 = let%bind len = with_header_byte Constants.str32_header BE.any_int32 in match Int32.to_int len with | Some i -> take i | None -> fail "string value is too long!" ;; let str = let%map v = choice [ fixstr; str8; str16; str32 ] in String v ;; let bin8 = let%bind len = with_header_byte Constants.bin8_header any_uint8 in let%map s = take len in Bytes.of_string s ;; let bin16 = let%bind len = with_header_byte Constants.bin16_header BE.any_uint16 in let%map s = take len in Bytes.of_string s ;; let bin32 = let%bind len = with_header_byte Constants.bin32_header BE.any_int32 in match Int32.to_int len with | None -> fail "bytes value is too long!" | Some i -> take i >>| Bytes.of_string ;; let bin = let%map v = choice [ bin8; bin16; bin32 ] in Binary v ;; let fixarray obj_parser = let%bind c = satisfy (function | '\x90' .. '\x9f' -> true | _ -> false) in let len = unmask ~mask:Constants.fixarray_mask ~value:(Char.to_int c) in count len obj_parser ;; let array16 obj_parser = let%bind len = with_header_byte Constants.array16_header BE.any_uint16 in count len obj_parser ;; let array32 obj_parser = let%bind len = with_header_byte Constants.array32_header BE.any_int32 in match Int32.to_int len with | None -> fail "array value is too long!" | Some i -> count i obj_parser ;; let array parser = let%map v = choice [ fixarray parser; array16 parser; array32 parser ] in Array v ;; let pair parser = let%bind a = parser in let%map b = parser in a, b ;; let fixmap obj_parser = let%bind c = satisfy (function | '\x80' .. '\x8f' -> true | _ -> false) in let len = unmask ~mask:Constants.fixmap_mask ~value:(Char.to_int c) in count len (pair obj_parser) ;; let map16 obj_parser = let%bind len = with_header_byte Constants.map16_header BE.any_uint16 in count len (pair obj_parser) ;; let map32 obj_parser = let%bind len = with_header_byte Constants.map32_header BE.any_int32 in match Int32.to_int len with | None -> fail "map value is too long!" | Some i -> count i (pair obj_parser) ;; let map parser = let%map v = choice [ fixmap parser; map16 parser; map32 parser ] in Map v ;; let create_custom ~type_id ~data : custom Angstrom.t = return { type_id; data = Bytes.of_string data } ;; let make_fixext_parser ~header ~len = let%bind type_id = with_header_byte header any_int8 in let%bind data = take len in create_custom ~type_id ~data ;; let fixext1 = make_fixext_parser ~header:Constants.fixext1_header ~len:1 let fixext2 = make_fixext_parser ~header:Constants.fixext2_header ~len:2 let fixext4 = make_fixext_parser ~header:Constants.fixext4_header ~len:4 let fixext8 = make_fixext_parser ~header:Constants.fixext8_header ~len:8 let fixext16 = make_fixext_parser ~header:Constants.fixext16_header ~len:16 let ext8 = let%bind len = with_header_byte Constants.ext8_header any_uint8 in let%bind type_id = any_int8 in let%bind data = take len in create_custom ~type_id ~data ;; let ext16 = let%bind len = with_header_byte Constants.ext16_header BE.any_uint16 in let%bind type_id = any_int8 in let%bind data = take len in create_custom ~type_id ~data ;; let ext32 = let%bind len = with_header_byte Constants.ext32_header BE.any_int32 in let%bind type_id = any_int8 in match Int32.to_int len with | None -> fail "map value is too long!" | Some i -> let%bind data = take i in create_custom ~type_id ~data ;; let ext = let%map v = choice [ fixext1; fixext2; fixext4; fixext8; fixext16; ext8; ext16; ext32 ] in Extension v ;; let atom = choice [ nil; bool; int; floating; str; bin; ext; uint64; int64 ] let msg = fix (fun msg -> choice [ atom; array msg; map msg ]) let parse s = parse_string ~consume:Prefix msg s |> Result.map_error ~f:(fun s -> Error.of_string s) ;;
sectionYPositions = computeSectionYPositions($el), 10)"
x-init="setTimeout(() => sectionYPositions = computeSectionYPositions($el), 10)"
>