fix(odoc-scrollycode-extension): indent code blocks to fix odoc warnings

+314 -314

odoc-scrollycode-extension/doc/dark_repl.mld

··· 10 10 Four constructors is all we need. 11 11 12 12 {[ 13 - type expr = 14 - | Lit of int 15 - | Add of expr * expr 16 - | Let of string * expr * expr 17 - | Var of string 13 + type expr = 14 + | Lit of int 15 + | Add of expr * expr 16 + | Let of string * expr * expr 17 + | Var of string 18 18 ]} 19 19 } 20 20 {li ··· 25 25 simple association list. 26 26 27 27 {[ 28 - type expr = 29 - | Lit of int 30 - | Add of expr * expr 31 - | Let of string * expr * expr 32 - | Var of string 28 + type expr = 29 + | Lit of int 30 + | Add of expr * expr 31 + | Let of string * expr * expr 32 + | Var of string 33 33 34 - type value = Int of int 34 + type value = Int of int 35 35 36 - type env = (string * value) list 36 + type env = (string * value) list 37 37 38 - let empty_env : env = [] 38 + let empty_env : env = [] 39 39 40 - let extend env name v = (name, v) :: env 40 + let extend env name v = (name, v) :: env 41 41 42 - let lookup env name = 43 - match List.assoc_opt name env with 44 - | Some v -> v 45 - | None -> failwith ("unbound: " ^ name) 42 + let lookup env name = 43 + match List.assoc_opt name env with 44 + | Some v -> v 45 + | None -> failwith ("unbound: " ^ name) 46 46 ]} 47 47 } 48 48 {li ··· 53 53 Let-bindings extend the environment for the body expression. 54 54 55 55 {[ 56 - type expr = 57 - | Lit of int 58 - | Add of expr * expr 59 - | Let of string * expr * expr 60 - | Var of string 56 + type expr = 57 + | Lit of int 58 + | Add of expr * expr 59 + | Let of string * expr * expr 60 + | Var of string 61 61 62 - type value = Int of int 62 + type value = Int of int 63 63 64 - type env = (string * value) list 64 + type env = (string * value) list 65 65 66 - let empty_env : env = [] 66 + let empty_env : env = [] 67 67 68 - let extend env name v = (name, v) :: env 68 + let extend env name v = (name, v) :: env 69 69 70 - let lookup env name = 71 - match List.assoc_opt name env with 72 - | Some v -> v 73 - | None -> failwith ("unbound: " ^ name) 70 + let lookup env name = 71 + match List.assoc_opt name env with 72 + | Some v -> v 73 + | None -> failwith ("unbound: " ^ name) 74 74 75 - let rec eval env = function 76 - | Lit n -> Int n 77 - | Add (a, b) -> 78 - let (Int x) = eval env a in 79 - let (Int y) = eval env b in 80 - Int (x + y) 81 - | Let (name, rhs, body) -> 82 - let v = eval env rhs in 83 - eval (extend env name v) body 84 - | Var name -> lookup env name 75 + let rec eval env = function 76 + | Lit n -> Int n 77 + | Add (a, b) -> 78 + let (Int x) = eval env a in 79 + let (Int y) = eval env b in 80 + Int (x + y) 81 + | Let (name, rhs, body) -> 82 + let v = eval env rhs in 83 + eval (extend env name v) body 84 + | Var name -> lookup env name 85 85 ]} 86 86 } 87 87 {li ··· 92 92 parentheses. Whitespace is consumed but not produced. 93 93 94 94 {[ 95 - type expr = 96 - | Lit of int 97 - | Add of expr * expr 98 - | Let of string * expr * expr 99 - | Var of string 95 + type expr = 96 + | Lit of int 97 + | Add of expr * expr 98 + | Let of string * expr * expr 99 + | Var of string 100 100 101 - type value = Int of int 102 - type env = (string * value) list 103 - let empty_env : env = [] 104 - let extend env name v = (name, v) :: env 105 - let lookup env name = 106 - match List.assoc_opt name env with 107 - | Some v -> v 108 - | None -> failwith ("unbound: " ^ name) 101 + type value = Int of int 102 + type env = (string * value) list 103 + let empty_env : env = [] 104 + let extend env name v = (name, v) :: env 105 + let lookup env name = 106 + match List.assoc_opt name env with 107 + | Some v -> v 108 + | None -> failwith ("unbound: " ^ name) 109 109 110 - let rec eval env = function 111 - | Lit n -> Int n 112 - | Add (a, b) -> 113 - let (Int x) = eval env a in 114 - let (Int y) = eval env b in 115 - Int (x + y) 116 - | Let (name, rhs, body) -> 117 - let v = eval env rhs in 118 - eval (extend env name v) body 119 - | Var name -> lookup env name 110 + let rec eval env = function 111 + | Lit n -> Int n 112 + | Add (a, b) -> 113 + let (Int x) = eval env a in 114 + let (Int y) = eval env b in 115 + Int (x + y) 116 + | Let (name, rhs, body) -> 117 + let v = eval env rhs in 118 + eval (extend env name v) body 119 + | Var name -> lookup env name 120 120 121 - type token = 122 - | TNum of int 123 - | TIdent of string 124 - | TPlus | TEqual 125 - | TLParen | TRParen 126 - | TLet | TIn 121 + type token = 122 + | TNum of int 123 + | TIdent of string 124 + | TPlus | TEqual 125 + | TLParen | TRParen 126 + | TLet | TIn 127 127 128 - let is_alpha c = 129 - (c >= 'a' && c <= 'z') 130 - || (c >= 'A' && c <= 'Z') 131 - || c = '_' 128 + let is_alpha c = 129 + (c >= 'a' && c <= 'z') 130 + || (c >= 'A' && c <= 'Z') 131 + || c = '_' 132 132 133 - let is_digit c = c >= '0' && c <= '9' 133 + let is_digit c = c >= '0' && c <= '9' 134 134 135 - let tokenize input = 136 - let len = String.length input in 137 - let pos = ref 0 in 138 - let tokens = ref [] in 139 - while !pos < len do 140 - let c = input.[!pos] in 141 - if c = ' ' || c = '\t' || c = '\n' then 142 - incr pos 143 - else if is_digit c then begin 144 - let start = !pos in 145 - while !pos < len && is_digit input.[!pos] do 146 - incr pos done; 147 - let s = String.sub input start (!pos - start) in 148 - tokens := TNum (int_of_string s) :: !tokens 149 - end else if is_alpha c then begin 150 - let start = !pos in 151 - while !pos < len && is_alpha input.[!pos] do 152 - incr pos done; 153 - let s = String.sub input start (!pos - start) in 154 - let tok = match s with 155 - | "let" -> TLet | "in" -> TIn 156 - | _ -> TIdent s in 157 - tokens := tok :: !tokens 158 - end else begin 159 - let tok = match c with 160 - | '+' -> TPlus | '=' -> TEqual 161 - | '(' -> TLParen | ')' -> TRParen 162 - | _ -> failwith "unexpected char" in 163 - tokens := tok :: !tokens; 164 - incr pos 165 - end 166 - done; 167 - List.rev !tokens 135 + let tokenize input = 136 + let len = String.length input in 137 + let pos = ref 0 in 138 + let tokens = ref [] in 139 + while !pos < len do 140 + let c = input.[!pos] in 141 + if c = ' ' || c = '\t' || c = '\n' then 142 + incr pos 143 + else if is_digit c then begin 144 + let start = !pos in 145 + while !pos < len && is_digit input.[!pos] do 146 + incr pos done; 147 + let s = String.sub input start (!pos - start) in 148 + tokens := TNum (int_of_string s) :: !tokens 149 + end else if is_alpha c then begin 150 + let start = !pos in 151 + while !pos < len && is_alpha input.[!pos] do 152 + incr pos done; 153 + let s = String.sub input start (!pos - start) in 154 + let tok = match s with 155 + | "let" -> TLet | "in" -> TIn 156 + | _ -> TIdent s in 157 + tokens := tok :: !tokens 158 + end else begin 159 + let tok = match c with 160 + | '+' -> TPlus | '=' -> TEqual 161 + | '(' -> TLParen | ')' -> TRParen 162 + | _ -> failwith "unexpected char" in 163 + tokens := tok :: !tokens; 164 + incr pos 165 + end 166 + done; 167 + List.rev !tokens 168 168 ]} 169 169 } 170 170 {li ··· 175 175 a left-associative chain of atoms. 176 176 177 177 {[ 178 - type expr = 179 - | Lit of int 180 - | Add of expr * expr 181 - | Let of string * expr * expr 182 - | Var of string 178 + type expr = 179 + | Lit of int 180 + | Add of expr * expr 181 + | Let of string * expr * expr 182 + | Var of string 183 183 184 - type value = Int of int 185 - type env = (string * value) list 186 - let empty_env : env = [] 187 - let extend env name v = (name, v) :: env 188 - let lookup env name = 189 - match List.assoc_opt name env with 190 - | Some v -> v 191 - | None -> failwith ("unbound: " ^ name) 184 + type value = Int of int 185 + type env = (string * value) list 186 + let empty_env : env = [] 187 + let extend env name v = (name, v) :: env 188 + let lookup env name = 189 + match List.assoc_opt name env with 190 + | Some v -> v 191 + | None -> failwith ("unbound: " ^ name) 192 192 193 - let rec eval env = function 194 - | Lit n -> Int n 195 - | Add (a, b) -> 196 - let (Int x) = eval env a in 197 - let (Int y) = eval env b in 198 - Int (x + y) 199 - | Let (name, rhs, body) -> 200 - let v = eval env rhs in 201 - eval (extend env name v) body 202 - | Var name -> lookup env name 193 + let rec eval env = function 194 + | Lit n -> Int n 195 + | Add (a, b) -> 196 + let (Int x) = eval env a in 197 + let (Int y) = eval env b in 198 + Int (x + y) 199 + | Let (name, rhs, body) -> 200 + let v = eval env rhs in 201 + eval (extend env name v) body 202 + | Var name -> lookup env name 203 203 204 - type token = 205 - | TNum of int | TIdent of string 206 - | TPlus | TEqual 207 - | TLParen | TRParen 208 - | TLet | TIn 204 + type token = 205 + | TNum of int | TIdent of string 206 + | TPlus | TEqual 207 + | TLParen | TRParen 208 + | TLet | TIn 209 209 210 - let is_alpha c = 211 - (c >= 'a' && c <= 'z') 212 - || (c >= 'A' && c <= 'Z') || c = '_' 213 - let is_digit c = c >= '0' && c <= '9' 210 + let is_alpha c = 211 + (c >= 'a' && c <= 'z') 212 + || (c >= 'A' && c <= 'Z') || c = '_' 213 + let is_digit c = c >= '0' && c <= '9' 214 214 215 - let tokenize input = 216 - let len = String.length input in 217 - let pos = ref 0 in 218 - let tokens = ref [] in 219 - while !pos < len do 220 - let c = input.[!pos] in 221 - if c = ' ' || c = '\t' || c = '\n' then 222 - incr pos 223 - else if is_digit c then begin 224 - let start = !pos in 225 - while !pos < len && is_digit input.[!pos] 226 - do incr pos done; 227 - let s = String.sub input start 228 - (!pos - start) in 229 - tokens := TNum (int_of_string s) :: !tokens 230 - end else if is_alpha c then begin 231 - let start = !pos in 232 - while !pos < len && is_alpha input.[!pos] 233 - do incr pos done; 234 - let s = String.sub input start 235 - (!pos - start) in 236 - let tok = match s with 237 - | "let" -> TLet | "in" -> TIn 238 - | _ -> TIdent s in 239 - tokens := tok :: !tokens 240 - end else begin 241 - let tok = match c with 242 - | '+' -> TPlus | '=' -> TEqual 243 - | '(' -> TLParen | ')' -> TRParen 244 - | _ -> failwith "unexpected char" in 245 - tokens := tok :: !tokens; incr pos 246 - end 247 - done; 248 - List.rev !tokens 215 + let tokenize input = 216 + let len = String.length input in 217 + let pos = ref 0 in 218 + let tokens = ref [] in 219 + while !pos < len do 220 + let c = input.[!pos] in 221 + if c = ' ' || c = '\t' || c = '\n' then 222 + incr pos 223 + else if is_digit c then begin 224 + let start = !pos in 225 + while !pos < len && is_digit input.[!pos] 226 + do incr pos done; 227 + let s = String.sub input start 228 + (!pos - start) in 229 + tokens := TNum (int_of_string s) :: !tokens 230 + end else if is_alpha c then begin 231 + let start = !pos in 232 + while !pos < len && is_alpha input.[!pos] 233 + do incr pos done; 234 + let s = String.sub input start 235 + (!pos - start) in 236 + let tok = match s with 237 + | "let" -> TLet | "in" -> TIn 238 + | _ -> TIdent s in 239 + tokens := tok :: !tokens 240 + end else begin 241 + let tok = match c with 242 + | '+' -> TPlus | '=' -> TEqual 243 + | '(' -> TLParen | ')' -> TRParen 244 + | _ -> failwith "unexpected char" in 245 + tokens := tok :: !tokens; incr pos 246 + end 247 + done; 248 + List.rev !tokens 249 249 250 - let parse tokens = 251 - let toks = ref tokens in 252 - let next () = 253 - match !toks with 254 - | [] -> failwith "unexpected end" 255 - | t :: rest -> toks := rest; t in 256 - let peek () = 257 - match !toks with [] -> None | t :: _ -> Some t in 258 - let rec parse_expr () = 259 - let left = parse_atom () in 260 - parse_add left 261 - and parse_add left = 262 - match peek () with 263 - | Some TPlus -> 264 - ignore (next ()); 265 - let right = parse_atom () in 266 - parse_add (Add (left, right)) 267 - | _ -> left 268 - and parse_atom () = 269 - match next () with 270 - | TNum n -> Lit n 271 - | TIdent s -> Var s 272 - | TLParen -> 273 - let e = parse_expr () in 274 - ignore (next ()); e 275 - | TLet -> 276 - let (TIdent name) = next () in 277 - ignore (next ()); 278 - let rhs = parse_expr () in 279 - ignore (next ()); 280 - let body = parse_expr () in 281 - Let (name, rhs, body) 282 - | _ -> failwith "unexpected token" in 283 - parse_expr () 250 + let parse tokens = 251 + let toks = ref tokens in 252 + let next () = 253 + match !toks with 254 + | [] -> failwith "unexpected end" 255 + | t :: rest -> toks := rest; t in 256 + let peek () = 257 + match !toks with [] -> None | t :: _ -> Some t in 258 + let rec parse_expr () = 259 + let left = parse_atom () in 260 + parse_add left 261 + and parse_add left = 262 + match peek () with 263 + | Some TPlus -> 264 + ignore (next ()); 265 + let right = parse_atom () in 266 + parse_add (Add (left, right)) 267 + | _ -> left 268 + and parse_atom () = 269 + match next () with 270 + | TNum n -> Lit n 271 + | TIdent s -> Var s 272 + | TLParen -> 273 + let e = parse_expr () in 274 + ignore (next ()); e 275 + | TLet -> 276 + let (TIdent name) = next () in 277 + ignore (next ()); 278 + let rhs = parse_expr () in 279 + ignore (next ()); 280 + let body = parse_expr () in 281 + Let (name, rhs, body) 282 + | _ -> failwith "unexpected token" in 283 + parse_expr () 284 284 ]} 285 285 } 286 286 {li ··· 292 292 bindings across interactions. 293 293 294 294 {[ 295 - type expr = 296 - | Lit of int 297 - | Add of expr * expr 298 - | Let of string * expr * expr 299 - | Var of string 295 + type expr = 296 + | Lit of int 297 + | Add of expr * expr 298 + | Let of string * expr * expr 299 + | Var of string 300 300 301 - type value = Int of int 302 - type env = (string * value) list 303 - let empty_env : env = [] 304 - let extend env name v = (name, v) :: env 305 - let lookup env name = 306 - match List.assoc_opt name env with 307 - | Some v -> v 308 - | None -> failwith ("unbound: " ^ name) 301 + type value = Int of int 302 + type env = (string * value) list 303 + let empty_env : env = [] 304 + let extend env name v = (name, v) :: env 305 + let lookup env name = 306 + match List.assoc_opt name env with 307 + | Some v -> v 308 + | None -> failwith ("unbound: " ^ name) 309 309 310 - let rec eval env = function 311 - | Lit n -> Int n 312 - | Add (a, b) -> 313 - let (Int x) = eval env a in 314 - let (Int y) = eval env b in 315 - Int (x + y) 316 - | Let (name, rhs, body) -> 317 - let v = eval env rhs in 318 - eval (extend env name v) body 319 - | Var name -> lookup env name 310 + let rec eval env = function 311 + | Lit n -> Int n 312 + | Add (a, b) -> 313 + let (Int x) = eval env a in 314 + let (Int y) = eval env b in 315 + Int (x + y) 316 + | Let (name, rhs, body) -> 317 + let v = eval env rhs in 318 + eval (extend env name v) body 319 + | Var name -> lookup env name 320 320 321 - type token = 322 - | TNum of int | TIdent of string 323 - | TPlus | TEqual 324 - | TLParen | TRParen 325 - | TLet | TIn 321 + type token = 322 + | TNum of int | TIdent of string 323 + | TPlus | TEqual 324 + | TLParen | TRParen 325 + | TLet | TIn 326 326 327 - let is_alpha c = 328 - (c >= 'a' && c <= 'z') 329 - || (c >= 'A' && c <= 'Z') || c = '_' 330 - let is_digit c = c >= '0' && c <= '9' 327 + let is_alpha c = 328 + (c >= 'a' && c <= 'z') 329 + || (c >= 'A' && c <= 'Z') || c = '_' 330 + let is_digit c = c >= '0' && c <= '9' 331 331 332 - let tokenize input = 333 - let len = String.length input in 334 - let pos = ref 0 in 335 - let tokens = ref [] in 336 - while !pos < len do 337 - let c = input.[!pos] in 338 - if c = ' ' || c = '\t' || c = '\n' then 339 - incr pos 340 - else if is_digit c then begin 341 - let start = !pos in 342 - while !pos < len && is_digit input.[!pos] 343 - do incr pos done; 344 - tokens := TNum (int_of_string 345 - (String.sub input start 346 - (!pos - start))) :: !tokens 347 - end else if is_alpha c then begin 348 - let start = !pos in 349 - while !pos < len && is_alpha input.[!pos] 350 - do incr pos done; 351 - let s = String.sub input start 352 - (!pos - start) in 353 - tokens := (match s with 354 - | "let" -> TLet | "in" -> TIn 355 - | _ -> TIdent s) :: !tokens 356 - end else begin 357 - tokens := (match c with 358 - | '+' -> TPlus | '=' -> TEqual 359 - | '(' -> TLParen | ')' -> TRParen 360 - | _ -> failwith "unexpected") :: !tokens; 361 - incr pos 362 - end 363 - done; List.rev !tokens 332 + let tokenize input = 333 + let len = String.length input in 334 + let pos = ref 0 in 335 + let tokens = ref [] in 336 + while !pos < len do 337 + let c = input.[!pos] in 338 + if c = ' ' || c = '\t' || c = '\n' then 339 + incr pos 340 + else if is_digit c then begin 341 + let start = !pos in 342 + while !pos < len && is_digit input.[!pos] 343 + do incr pos done; 344 + tokens := TNum (int_of_string 345 + (String.sub input start 346 + (!pos - start))) :: !tokens 347 + end else if is_alpha c then begin 348 + let start = !pos in 349 + while !pos < len && is_alpha input.[!pos] 350 + do incr pos done; 351 + let s = String.sub input start 352 + (!pos - start) in 353 + tokens := (match s with 354 + | "let" -> TLet | "in" -> TIn 355 + | _ -> TIdent s) :: !tokens 356 + end else begin 357 + tokens := (match c with 358 + | '+' -> TPlus | '=' -> TEqual 359 + | '(' -> TLParen | ')' -> TRParen 360 + | _ -> failwith "unexpected") :: !tokens; 361 + incr pos 362 + end 363 + done; List.rev !tokens 364 364 365 - let parse tokens = 366 - let toks = ref tokens in 367 - let next () = match !toks with 368 - | [] -> failwith "end" 369 - | t :: r -> toks := r; t in 370 - let peek () = match !toks with 371 - | [] -> None | t :: _ -> Some t in 372 - let rec expr () = 373 - let l = atom () in add l 374 - and add left = match peek () with 375 - | Some TPlus -> 376 - ignore (next ()); 377 - add (Add (left, atom ())) 378 - | _ -> left 379 - and atom () = match next () with 380 - | TNum n -> Lit n 381 - | TIdent s -> Var s 382 - | TLParen -> 383 - let e = expr () in 384 - ignore (next ()); e 385 - | TLet -> 386 - let (TIdent name) = next () in 387 - ignore (next ()); 388 - let rhs = expr () in 389 - ignore (next ()); 390 - Let (name, rhs, expr ()) 391 - | _ -> failwith "unexpected" in 392 - expr () 365 + let parse tokens = 366 + let toks = ref tokens in 367 + let next () = match !toks with 368 + | [] -> failwith "end" 369 + | t :: r -> toks := r; t in 370 + let peek () = match !toks with 371 + | [] -> None | t :: _ -> Some t in 372 + let rec expr () = 373 + let l = atom () in add l 374 + and add left = match peek () with 375 + | Some TPlus -> 376 + ignore (next ()); 377 + add (Add (left, atom ())) 378 + | _ -> left 379 + and atom () = match next () with 380 + | TNum n -> Lit n 381 + | TIdent s -> Var s 382 + | TLParen -> 383 + let e = expr () in 384 + ignore (next ()); e 385 + | TLet -> 386 + let (TIdent name) = next () in 387 + ignore (next ()); 388 + let rhs = expr () in 389 + ignore (next ()); 390 + Let (name, rhs, expr ()) 391 + | _ -> failwith "unexpected" in 392 + expr () 393 393 394 - let print_value = function 395 - | Int n -> Printf.printf "=> %d\n" n 394 + let print_value = function 395 + | Int n -> Printf.printf "=> %d\n" n 396 396 397 - let repl () = 398 - let env = ref empty_env in 399 - try while true do 400 - print_string "> "; 401 - let line = input_line stdin in 402 - let tokens = tokenize line in 403 - let ast = parse tokens in 404 - let result = eval !env ast in 405 - print_value result 406 - done with End_of_file -> 407 - print_endline "Goodbye." 397 + let repl () = 398 + let env = ref empty_env in 399 + try while true do 400 + print_string "> "; 401 + let line = input_line stdin in 402 + let tokens = tokenize line in 403 + let ast = parse tokens in 404 + let result = eval !env ast in 405 + print_value result 406 + done with End_of_file -> 407 + print_endline "Goodbye." 408 408 409 - let () = repl () 409 + let () = repl () 410 410 ]} 411 411 } 412 412 }

+287 -287

odoc-scrollycode-extension/doc/notebook_testing.mld

··· 10 10 the foundation everything else builds on. 11 11 12 12 {[ 13 - exception Test_failure of string 13 + exception Test_failure of string 14 14 15 - let assert_equal ~expected ~actual msg = 16 - if expected <> actual then 17 - raise (Test_failure 18 - (Printf.sprintf "%s: expected %s, got %s" 19 - msg 20 - (string_of_int expected) 21 - (string_of_int actual))) 15 + let assert_equal ~expected ~actual msg = 16 + if expected <> actual then 17 + raise (Test_failure 18 + (Printf.sprintf "%s: expected %s, got %s" 19 + msg 20 + (string_of_int expected) 21 + (string_of_int actual))) 22 22 ]} 23 23 } 24 24 {li ··· 29 29 Each test is just a unit function that might raise. 30 30 31 31 {[ 32 - exception Test_failure of string 32 + exception Test_failure of string 33 33 34 - let assert_equal ~expected ~actual msg = 35 - if expected <> actual then 36 - raise (Test_failure 37 - (Printf.sprintf "%s: expected %s, got %s" 38 - msg 39 - (string_of_int expected) 40 - (string_of_int actual))) 34 + let assert_equal ~expected ~actual msg = 35 + if expected <> actual then 36 + raise (Test_failure 37 + (Printf.sprintf "%s: expected %s, got %s" 38 + msg 39 + (string_of_int expected) 40 + (string_of_int actual))) 41 41 42 - type test = { 43 - name : string; 44 - fn : unit -> unit; 45 - } 42 + type test = { 43 + name : string; 44 + fn : unit -> unit; 45 + } 46 46 47 - let tests : test list ref = ref [] 47 + let tests : test list ref = ref [] 48 48 49 - let register name fn = 50 - tests := { name; fn } :: !tests 49 + let register name fn = 50 + tests := { name; fn } :: !tests 51 51 52 - let () = register "addition" (fun () -> 53 - assert_equal ~expected:4 ~actual:(2 + 2) 54 - "two plus two") 52 + let () = register "addition" (fun () -> 53 + assert_equal ~expected:4 ~actual:(2 + 2) 54 + "two plus two") 55 55 56 - let () = register "multiplication" (fun () -> 57 - assert_equal ~expected:6 ~actual:(2 * 3) 58 - "two times three") 56 + let () = register "multiplication" (fun () -> 57 + assert_equal ~expected:6 ~actual:(2 * 3) 58 + "two times three") 59 59 ]} 60 60 } 61 61 {li ··· 66 66 and prints a summary at the end. 67 67 68 68 {[ 69 - exception Test_failure of string 69 + exception Test_failure of string 70 70 71 - let assert_equal ~expected ~actual msg = 72 - if expected <> actual then 73 - raise (Test_failure 74 - (Printf.sprintf "%s: expected %s, got %s" 75 - msg 76 - (string_of_int expected) 77 - (string_of_int actual))) 71 + let assert_equal ~expected ~actual msg = 72 + if expected <> actual then 73 + raise (Test_failure 74 + (Printf.sprintf "%s: expected %s, got %s" 75 + msg 76 + (string_of_int expected) 77 + (string_of_int actual))) 78 78 79 - type test = { 80 - name : string; 81 - fn : unit -> unit; 82 - } 79 + type test = { 80 + name : string; 81 + fn : unit -> unit; 82 + } 83 83 84 - let tests : test list ref = ref [] 84 + let tests : test list ref = ref [] 85 85 86 - let register name fn = 87 - tests := { name; fn } :: !tests 86 + let register name fn = 87 + tests := { name; fn } :: !tests 88 88 89 - type result = 90 - | Pass 91 - | Fail of string 89 + type result = 90 + | Pass 91 + | Fail of string 92 92 93 - let run_one test = 94 - try test.fn (); Pass 95 - with 96 - | Test_failure msg -> Fail msg 97 - | exn -> Fail (Printexc.to_string exn) 93 + let run_one test = 94 + try test.fn (); Pass 95 + with 96 + | Test_failure msg -> Fail msg 97 + | exn -> Fail (Printexc.to_string exn) 98 98 99 - let run_all () = 100 - let results = 101 - List.rev !tests 102 - |> List.map (fun t -> (t.name, run_one t)) 103 - in 104 - let passed = 105 - List.length 106 - (List.filter 107 - (fun (_, r) -> r = Pass) results) 108 - in 109 - let total = List.length results in 110 - List.iter (fun (name, result) -> 111 - match result with 112 - | Pass -> 113 - Printf.printf " PASS %s\n" name 114 - | Fail msg -> 115 - Printf.printf " FAIL %s: %s\n" name msg 116 - ) results; 117 - Printf.printf "\n%d/%d tests passed\n" 118 - passed total; 119 - if passed < total then exit 1 99 + let run_all () = 100 + let results = 101 + List.rev !tests 102 + |> List.map (fun t -> (t.name, run_one t)) 103 + in 104 + let passed = 105 + List.length 106 + (List.filter 107 + (fun (_, r) -> r = Pass) results) 108 + in 109 + let total = List.length results in 110 + List.iter (fun (name, result) -> 111 + match result with 112 + | Pass -> 113 + Printf.printf " PASS %s\n" name 114 + | Fail msg -> 115 + Printf.printf " FAIL %s: %s\n" name msg 116 + ) results; 117 + Printf.printf "\n%d/%d tests passed\n" 118 + passed total; 119 + if passed < total then exit 1 120 120 ]} 121 121 } 122 122 {li ··· 127 127 assertion that checks an exception is thrown. 128 128 129 129 {[ 130 - exception Test_failure of string 130 + exception Test_failure of string 131 131 132 - let assert_equal ~expected ~actual msg = 133 - if expected <> actual then 134 - raise (Test_failure 135 - (Printf.sprintf "%s: expected %s, got %s" 136 - msg 137 - (string_of_int expected) 138 - (string_of_int actual))) 132 + let assert_equal ~expected ~actual msg = 133 + if expected <> actual then 134 + raise (Test_failure 135 + (Printf.sprintf "%s: expected %s, got %s" 136 + msg 137 + (string_of_int expected) 138 + (string_of_int actual))) 139 139 140 - let assert_string_equal ~expected ~actual msg = 141 - if expected <> actual then 142 - raise (Test_failure 143 - (Printf.sprintf 144 - "%s: expected %S, got %S" 145 - msg expected actual)) 140 + let assert_string_equal ~expected ~actual msg = 141 + if expected <> actual then 142 + raise (Test_failure 143 + (Printf.sprintf 144 + "%s: expected %S, got %S" 145 + msg expected actual)) 146 146 147 - let assert_true condition msg = 148 - if not condition then 149 - raise (Test_failure msg) 147 + let assert_true condition msg = 148 + if not condition then 149 + raise (Test_failure msg) 150 150 151 - let assert_raises fn msg = 152 - try fn (); 153 - raise (Test_failure 154 - (msg ^ ": expected exception")) 155 - with 156 - | Test_failure _ as e -> raise e 157 - | _ -> () 151 + let assert_raises fn msg = 152 + try fn (); 153 + raise (Test_failure 154 + (msg ^ ": expected exception")) 155 + with 156 + | Test_failure _ as e -> raise e 157 + | _ -> () 158 158 159 - type test = { 160 - name : string; 161 - fn : unit -> unit; 162 - } 159 + type test = { 160 + name : string; 161 + fn : unit -> unit; 162 + } 163 163 164 - let tests : test list ref = ref [] 164 + let tests : test list ref = ref [] 165 165 166 - let register name fn = 167 - tests := { name; fn } :: !tests 166 + let register name fn = 167 + tests := { name; fn } :: !tests 168 168 169 - type result = Pass | Fail of string 169 + type result = Pass | Fail of string 170 170 171 - let run_one test = 172 - try test.fn (); Pass 173 - with 174 - | Test_failure msg -> Fail msg 175 - | exn -> Fail (Printexc.to_string exn) 171 + let run_one test = 172 + try test.fn (); Pass 173 + with 174 + | Test_failure msg -> Fail msg 175 + | exn -> Fail (Printexc.to_string exn) 176 176 177 - let run_all () = 178 - let results = 179 - List.rev !tests 180 - |> List.map (fun t -> (t.name, run_one t)) 181 - in 182 - let passed = List.length 183 - (List.filter 184 - (fun (_, r) -> r = Pass) results) in 185 - let total = List.length results in 186 - List.iter (fun (name, result) -> 187 - match result with 188 - | Pass -> 189 - Printf.printf " PASS %s\n" name 190 - | Fail msg -> 191 - Printf.printf " FAIL %s: %s\n" 192 - name msg 193 - ) results; 194 - Printf.printf "\n%d/%d tests passed\n" 195 - passed total; 196 - if passed < total then exit 1 177 + let run_all () = 178 + let results = 179 + List.rev !tests 180 + |> List.map (fun t -> (t.name, run_one t)) 181 + in 182 + let passed = List.length 183 + (List.filter 184 + (fun (_, r) -> r = Pass) results) in 185 + let total = List.length results in 186 + List.iter (fun (name, result) -> 187 + match result with 188 + | Pass -> 189 + Printf.printf " PASS %s\n" name 190 + | Fail msg -> 191 + Printf.printf " FAIL %s: %s\n" 192 + name msg 193 + ) results; 194 + Printf.printf "\n%d/%d tests passed\n" 195 + passed total; 196 + if passed < total then exit 1 197 197 ]} 198 198 } 199 199 {li ··· 204 204 can be nested and run independently. 205 205 206 206 {[ 207 - exception Test_failure of string 207 + exception Test_failure of string 208 208 209 - let assert_equal ~expected ~actual msg = 210 - if expected <> actual then 211 - raise (Test_failure 212 - (Printf.sprintf "%s: expected %s, got %s" 213 - msg 214 - (string_of_int expected) 215 - (string_of_int actual))) 209 + let assert_equal ~expected ~actual msg = 210 + if expected <> actual then 211 + raise (Test_failure 212 + (Printf.sprintf "%s: expected %s, got %s" 213 + msg 214 + (string_of_int expected) 215 + (string_of_int actual))) 216 216 217 - let assert_string_equal ~expected ~actual msg = 218 - if expected <> actual then 219 - raise (Test_failure 220 - (Printf.sprintf "%s: expected %S, got %S" 221 - msg expected actual)) 217 + let assert_string_equal ~expected ~actual msg = 218 + if expected <> actual then 219 + raise (Test_failure 220 + (Printf.sprintf "%s: expected %S, got %S" 221 + msg expected actual)) 222 222 223 - let assert_true condition msg = 224 - if not condition then 225 - raise (Test_failure msg) 223 + let assert_true condition msg = 224 + if not condition then 225 + raise (Test_failure msg) 226 226 227 - let assert_raises fn msg = 228 - try fn (); 229 - raise (Test_failure 230 - (msg ^ ": expected exception")) 231 - with Test_failure _ as e -> raise e | _ -> () 227 + let assert_raises fn msg = 228 + try fn (); 229 + raise (Test_failure 230 + (msg ^ ": expected exception")) 231 + with Test_failure _ as e -> raise e | _ -> () 232 232 233 - type test = { name : string; fn : unit -> unit } 234 - type result = Pass | Fail of string 233 + type test = { name : string; fn : unit -> unit } 234 + type result = Pass | Fail of string 235 235 236 - type suite = { 237 - suite_name : string; 238 - mutable suite_tests : test list; 239 - } 236 + type suite = { 237 + suite_name : string; 238 + mutable suite_tests : test list; 239 + } 240 240 241 - let suites : suite list ref = ref [] 241 + let suites : suite list ref = ref [] 242 242 243 - let create_suite name = 244 - let s = { suite_name = name; 245 - suite_tests = [] } in 246 - suites := s :: !suites; s 243 + let create_suite name = 244 + let s = { suite_name = name; 245 + suite_tests = [] } in 246 + suites := s :: !suites; s 247 247 248 - let add_test suite name fn = 249 - suite.suite_tests <- 250 - { name; fn } :: suite.suite_tests 248 + let add_test suite name fn = 249 + suite.suite_tests <- 250 + { name; fn } :: suite.suite_tests 251 251 252 - let run_one test = 253 - try test.fn (); Pass 254 - with 255 - | Test_failure msg -> Fail msg 256 - | exn -> Fail (Printexc.to_string exn) 252 + let run_one test = 253 + try test.fn (); Pass 254 + with 255 + | Test_failure msg -> Fail msg 256 + | exn -> Fail (Printexc.to_string exn) 257 257 258 - let run_suite suite = 259 - Printf.printf "Suite: %s\n" suite.suite_name; 260 - let results = 261 - List.rev suite.suite_tests 262 - |> List.map (fun t -> 263 - (t.name, run_one t)) in 264 - let passed = List.length 265 - (List.filter 266 - (fun (_, r) -> r = Pass) results) in 267 - let total = List.length results in 268 - List.iter (fun (name, result) -> 269 - match result with 270 - | Pass -> 271 - Printf.printf " PASS %s\n" name 272 - | Fail msg -> 273 - Printf.printf " FAIL %s: %s\n" 274 - name msg 275 - ) results; 276 - Printf.printf " %d/%d passed\n\n" 277 - passed total; 278 - passed = total 258 + let run_suite suite = 259 + Printf.printf "Suite: %s\n" suite.suite_name; 260 + let results = 261 + List.rev suite.suite_tests 262 + |> List.map (fun t -> 263 + (t.name, run_one t)) in 264 + let passed = List.length 265 + (List.filter 266 + (fun (_, r) -> r = Pass) results) in 267 + let total = List.length results in 268 + List.iter (fun (name, result) -> 269 + match result with 270 + | Pass -> 271 + Printf.printf " PASS %s\n" name 272 + | Fail msg -> 273 + Printf.printf " FAIL %s: %s\n" 274 + name msg 275 + ) results; 276 + Printf.printf " %d/%d passed\n\n" 277 + passed total; 278 + passed = total 279 279 280 - let run_all_suites () = 281 - let all_ok = List.for_all run_suite 282 - (List.rev !suites) in 283 - if not all_ok then exit 1 280 + let run_all_suites () = 281 + let all_ok = List.for_all run_suite 282 + (List.rev !suites) in 283 + if not all_ok then exit 1 284 284 ]} 285 285 } 286 286 {li ··· 292 292 This is how tools like ppx_expect and Cram tests work. 293 293 294 294 {[ 295 - exception Test_failure of string 295 + exception Test_failure of string 296 296 297 - let assert_equal ~expected ~actual msg = 298 - if expected <> actual then 299 - raise (Test_failure 300 - (Printf.sprintf "%s: expected %s, got %s" 301 - msg 302 - (string_of_int expected) 303 - (string_of_int actual))) 297 + let assert_equal ~expected ~actual msg = 298 + if expected <> actual then 299 + raise (Test_failure 300 + (Printf.sprintf "%s: expected %s, got %s" 301 + msg 302 + (string_of_int expected) 303 + (string_of_int actual))) 304 304 305 - let assert_string_equal ~expected ~actual msg = 306 - if expected <> actual then 307 - raise (Test_failure 308 - (Printf.sprintf "%s: expected %S, got %S" 309 - msg expected actual)) 305 + let assert_string_equal ~expected ~actual msg = 306 + if expected <> actual then 307 + raise (Test_failure 308 + (Printf.sprintf "%s: expected %S, got %S" 309 + msg expected actual)) 310 310 311 - let assert_true condition msg = 312 - if not condition then 313 - raise (Test_failure msg) 311 + let assert_true condition msg = 312 + if not condition then 313 + raise (Test_failure msg) 314 314 315 - let assert_raises fn msg = 316 - try fn (); 317 - raise (Test_failure 318 - (msg ^ ": expected exception")) 319 - with Test_failure _ as e -> raise e | _ -> () 315 + let assert_raises fn msg = 316 + try fn (); 317 + raise (Test_failure 318 + (msg ^ ": expected exception")) 319 + with Test_failure _ as e -> raise e | _ -> () 320 320 321 - type test = { name : string; fn : unit -> unit } 322 - type result = Pass | Fail of string 321 + type test = { name : string; fn : unit -> unit } 322 + type result = Pass | Fail of string 323 323 324 - type suite = { 325 - suite_name : string; 326 - mutable suite_tests : test list; 327 - } 324 + type suite = { 325 + suite_name : string; 326 + mutable suite_tests : test list; 327 + } 328 328 329 - let suites : suite list ref = ref [] 329 + let suites : suite list ref = ref [] 330 330 331 - let create_suite name = 332 - let s = { suite_name = name; 333 - suite_tests = [] } in 334 - suites := s :: !suites; s 331 + let create_suite name = 332 + let s = { suite_name = name; 333 + suite_tests = [] } in 334 + suites := s :: !suites; s 335 335 336 - let add_test suite name fn = 337 - suite.suite_tests <- 338 - { name; fn } :: suite.suite_tests 336 + let add_test suite name fn = 337 + suite.suite_tests <- 338 + { name; fn } :: suite.suite_tests 339 339 340 - let run_one test = 341 - try test.fn (); Pass 342 - with 343 - | Test_failure msg -> Fail msg 344 - | exn -> Fail (Printexc.to_string exn) 340 + let run_one test = 341 + try test.fn (); Pass 342 + with 343 + | Test_failure msg -> Fail msg 344 + | exn -> Fail (Printexc.to_string exn) 345 345 346 - (* Expect test infrastructure *) 347 - let expect_dir = "_expect" 346 + (* Expect test infrastructure *) 347 + let expect_dir = "_expect" 348 348 349 - let expect_test suite name fn = 350 - add_test suite name (fun () -> 351 - let buf = Buffer.create 256 in 352 - fn (Buffer.add_string buf); 353 - let actual = Buffer.contents buf in 354 - let path = Printf.sprintf "%s/%s/%s.expected" 355 - expect_dir suite.suite_name name in 356 - if Sys.file_exists path then begin 357 - let ic = open_in path in 358 - let expected = really_input_string ic 359 - (in_channel_length ic) in 360 - close_in ic; 361 - assert_string_equal 362 - ~expected ~actual 363 - (name ^ " snapshot") 364 - end else begin 365 - let dir = Filename.dirname path in 366 - ignore (Sys.command 367 - ("mkdir -p " ^ dir)); 368 - let oc = open_out path in 369 - output_string oc actual; 370 - close_out oc; 371 - Printf.printf 372 - " NEW %s (snapshot saved)\n" name 373 - end) 349 + let expect_test suite name fn = 350 + add_test suite name (fun () -> 351 + let buf = Buffer.create 256 in 352 + fn (Buffer.add_string buf); 353 + let actual = Buffer.contents buf in 354 + let path = Printf.sprintf "%s/%s/%s.expected" 355 + expect_dir suite.suite_name name in 356 + if Sys.file_exists path then begin 357 + let ic = open_in path in 358 + let expected = really_input_string ic 359 + (in_channel_length ic) in 360 + close_in ic; 361 + assert_string_equal 362 + ~expected ~actual 363 + (name ^ " snapshot") 364 + end else begin 365 + let dir = Filename.dirname path in 366 + ignore (Sys.command 367 + ("mkdir -p " ^ dir)); 368 + let oc = open_out path in 369 + output_string oc actual; 370 + close_out oc; 371 + Printf.printf 372 + " NEW %s (snapshot saved)\n" name 373 + end) 374 374 375 - let run_suite suite = 376 - Printf.printf "Suite: %s\n" suite.suite_name; 377 - let results = 378 - List.rev suite.suite_tests 379 - |> List.map (fun t -> 380 - (t.name, run_one t)) in 381 - let passed = List.length 382 - (List.filter 383 - (fun (_, r) -> r = Pass) results) in 384 - let total = List.length results in 385 - List.iter (fun (name, result) -> 386 - match result with 387 - | Pass -> 388 - Printf.printf " PASS %s\n" name 389 - | Fail msg -> 390 - Printf.printf " FAIL %s: %s\n" 391 - name msg 392 - ) results; 393 - Printf.printf " %d/%d passed\n\n" 394 - passed total; 395 - passed = total 375 + let run_suite suite = 376 + Printf.printf "Suite: %s\n" suite.suite_name; 377 + let results = 378 + List.rev suite.suite_tests 379 + |> List.map (fun t -> 380 + (t.name, run_one t)) in 381 + let passed = List.length 382 + (List.filter 383 + (fun (_, r) -> r = Pass) results) in 384 + let total = List.length results in 385 + List.iter (fun (name, result) -> 386 + match result with 387 + | Pass -> 388 + Printf.printf " PASS %s\n" name 389 + | Fail msg -> 390 + Printf.printf " FAIL %s: %s\n" 391 + name msg 392 + ) results; 393 + Printf.printf " %d/%d passed\n\n" 394 + passed total; 395 + passed = total 396 396 397 - let run_all_suites () = 398 - let all_ok = List.for_all run_suite 399 - (List.rev !suites) in 400 - if not all_ok then exit 1 397 + let run_all_suites () = 398 + let all_ok = List.for_all run_suite 399 + (List.rev !suites) in 400 + if not all_ok then exit 1 401 401 ]} 402 402 } 403 403 }

+289 -289

odoc-scrollycode-extension/doc/warm_parser.mld

··· 10 10 We encode this directly as an OCaml variant. 11 11 12 12 {[ 13 - (* >type json = 14 - (* > | Null 15 - (* > | Bool of bool 16 - (* > | Number of float 17 - (* > | String of string 18 - (* > | Array of json list 19 - (* > | Object of (string * json) list 13 + (* >type json = 14 + (* > | Null 15 + (* > | Bool of bool 16 + (* > | Number of float 17 + (* > | String of string 18 + (* > | Array of json list 19 + (* > | Object of (string * json) list 20 20 ]} 21 21 } 22 22 {li ··· 27 27 on a string with a mutable position index. 28 28 29 29 {[ 30 - type json = 31 - | Null 32 - | Bool of bool 33 - | Number of float 34 - | String of string 35 - | Array of json list 36 - | Object of (string * json) list 30 + type json = 31 + | Null 32 + | Bool of bool 33 + | Number of float 34 + | String of string 35 + | Array of json list 36 + | Object of (string * json) list 37 37 38 - (* >type scanner = { 39 - (* > input : string; 40 - (* > mutable pos : int; 41 - (* >} 42 - (* > 43 - (* >let peek s = 44 - (* > while s.pos < String.length s.input 45 - (* > && s.input.[s.pos] = ' ' do 46 - (* > s.pos <- s.pos + 1 47 - (* > done; 48 - (* > if s.pos < String.length s.input 49 - (* > then Some s.input.[s.pos] 50 - (* > else None 51 - (* > 52 - (* >let advance s = s.pos <- s.pos + 1 38 + (* >type scanner = { 39 + (* > input : string; 40 + (* > mutable pos : int; 41 + (* >} 42 + (* > 43 + (* >let peek s = 44 + (* > while s.pos < String.length s.input 45 + (* > && s.input.[s.pos] = ' ' do 46 + (* > s.pos <- s.pos + 1 47 + (* > done; 48 + (* > if s.pos < String.length s.input 49 + (* > then Some s.input.[s.pos] 50 + (* > else None 51 + (* > 52 + (* >let advance s = s.pos <- s.pos + 1 53 53 ]} 54 54 } 55 55 {li ··· 60 60 case without escape sequences. 61 61 62 62 {[ 63 - type json = 64 - | Null 65 - | Bool of bool 66 - | Number of float 67 - | String of string 68 - | Array of json list 69 - | Object of (string * json) list 63 + type json = 64 + | Null 65 + | Bool of bool 66 + | Number of float 67 + | String of string 68 + | Array of json list 69 + | Object of (string * json) list 70 70 71 - type scanner = { 72 - input : string; 73 - mutable pos : int; 74 - } 71 + type scanner = { 72 + input : string; 73 + mutable pos : int; 74 + } 75 75 76 - let peek s = 77 - while s.pos < String.length s.input 78 - && s.input.[s.pos] = ' ' do 79 - s.pos <- s.pos + 1 80 - done; 81 - if s.pos < String.length s.input 82 - then Some s.input.[s.pos] 83 - else None 76 + let peek s = 77 + while s.pos < String.length s.input 78 + && s.input.[s.pos] = ' ' do 79 + s.pos <- s.pos + 1 80 + done; 81 + if s.pos < String.length s.input 82 + then Some s.input.[s.pos] 83 + else None 84 84 85 - let advance s = s.pos <- s.pos + 1 85 + let advance s = s.pos <- s.pos + 1 86 86 87 - (* >let parse_string s = 88 - (* > advance s; 89 - (* > let buf = Buffer.create 64 in 90 - (* > while s.pos < String.length s.input 91 - (* > && s.input.[s.pos] <> '"' do 92 - (* > Buffer.add_char buf s.input.[s.pos]; 93 - (* > advance s 94 - (* > done; 95 - (* > advance s; 96 - (* > Buffer.contents buf 87 + (* >let parse_string s = 88 + (* > advance s; 89 + (* > let buf = Buffer.create 64 in 90 + (* > while s.pos < String.length s.input 91 + (* > && s.input.[s.pos] <> '"' do 92 + (* > Buffer.add_char buf s.input.[s.pos]; 93 + (* > advance s 94 + (* > done; 95 + (* > advance s; 96 + (* > Buffer.contents buf 97 97 ]} 98 98 } 99 99 {li ··· 104 104 A production parser would handle exponents too. 105 105 106 106 {[ 107 - type json = 108 - | Null 109 - | Bool of bool 110 - | Number of float 111 - | String of string 112 - | Array of json list 113 - | Object of (string * json) list 107 + type json = 108 + | Null 109 + | Bool of bool 110 + | Number of float 111 + | String of string 112 + | Array of json list 113 + | Object of (string * json) list 114 114 115 - type scanner = { 116 - input : string; 117 - mutable pos : int; 118 - } 115 + type scanner = { 116 + input : string; 117 + mutable pos : int; 118 + } 119 119 120 - let peek s = 121 - while s.pos < String.length s.input 122 - && s.input.[s.pos] = ' ' do 123 - s.pos <- s.pos + 1 124 - done; 125 - if s.pos < String.length s.input 126 - then Some s.input.[s.pos] 127 - else None 120 + let peek s = 121 + while s.pos < String.length s.input 122 + && s.input.[s.pos] = ' ' do 123 + s.pos <- s.pos + 1 124 + done; 125 + if s.pos < String.length s.input 126 + then Some s.input.[s.pos] 127 + else None 128 128 129 - let advance s = s.pos <- s.pos + 1 129 + let advance s = s.pos <- s.pos + 1 130 130 131 - let parse_string s = 132 - advance s; 133 - let buf = Buffer.create 64 in 134 - while s.pos < String.length s.input 135 - && s.input.[s.pos] <> '"' do 136 - Buffer.add_char buf s.input.[s.pos]; 137 - advance s 138 - done; 139 - advance s; 140 - Buffer.contents buf 131 + let parse_string s = 132 + advance s; 133 + let buf = Buffer.create 64 in 134 + while s.pos < String.length s.input 135 + && s.input.[s.pos] <> '"' do 136 + Buffer.add_char buf s.input.[s.pos]; 137 + advance s 138 + done; 139 + advance s; 140 + Buffer.contents buf 141 141 142 - (* >let is_digit c = c >= '0' && c <= '9' 143 - (* > 144 - (* >let parse_number s = 145 - (* > let start = s.pos in 146 - (* > while s.pos < String.length s.input 147 - (* > && (is_digit s.input.[s.pos] 148 - (* > || s.input.[s.pos] = '.' 149 - (* > || s.input.[s.pos] = '-') do 150 - (* > advance s 151 - (* > done; 152 - (* > float_of_string 153 - (* > (String.sub s.input start (s.pos - start)) 142 + (* >let is_digit c = c >= '0' && c <= '9' 143 + (* > 144 + (* >let parse_number s = 145 + (* > let start = s.pos in 146 + (* > while s.pos < String.length s.input 147 + (* > && (is_digit s.input.[s.pos] 148 + (* > || s.input.[s.pos] = '.' 149 + (* > || s.input.[s.pos] = '-') do 150 + (* > advance s 151 + (* > done; 152 + (* > float_of_string 153 + (* > (String.sub s.input start (s.pos - start)) 154 154 ]} 155 155 } 156 156 {li ··· 162 162 structures, we recurse. 163 163 164 164 {[ 165 - type json = 166 - | Null 167 - | Bool of bool 168 - | Number of float 169 - | String of string 170 - | Array of json list 171 - | Object of (string * json) list 165 + type json = 166 + | Null 167 + | Bool of bool 168 + | Number of float 169 + | String of string 170 + | Array of json list 171 + | Object of (string * json) list 172 172 173 - type scanner = { 174 - input : string; 175 - mutable pos : int; 176 - } 173 + type scanner = { 174 + input : string; 175 + mutable pos : int; 176 + } 177 177 178 - let peek s = 179 - while s.pos < String.length s.input 180 - && s.input.[s.pos] = ' ' do 181 - s.pos <- s.pos + 1 182 - done; 183 - if s.pos < String.length s.input 184 - then Some s.input.[s.pos] 185 - else None 178 + let peek s = 179 + while s.pos < String.length s.input 180 + && s.input.[s.pos] = ' ' do 181 + s.pos <- s.pos + 1 182 + done; 183 + if s.pos < String.length s.input 184 + then Some s.input.[s.pos] 185 + else None 186 186 187 - let advance s = s.pos <- s.pos + 1 187 + let advance s = s.pos <- s.pos + 1 188 188 189 - let parse_string s = 190 - advance s; 191 - let buf = Buffer.create 64 in 192 - while s.pos < String.length s.input 193 - && s.input.[s.pos] <> '"' do 194 - Buffer.add_char buf s.input.[s.pos]; 195 - advance s 196 - done; 197 - advance s; 198 - Buffer.contents buf 189 + let parse_string s = 190 + advance s; 191 + let buf = Buffer.create 64 in 192 + while s.pos < String.length s.input 193 + && s.input.[s.pos] <> '"' do 194 + Buffer.add_char buf s.input.[s.pos]; 195 + advance s 196 + done; 197 + advance s; 198 + Buffer.contents buf 199 199 200 - let is_digit c = c >= '0' && c <= '9' 200 + let is_digit c = c >= '0' && c <= '9' 201 201 202 - let parse_number s = 203 - let start = s.pos in 204 - while s.pos < String.length s.input 205 - && (is_digit s.input.[s.pos] 206 - || s.input.[s.pos] = '.' 207 - || s.input.[s.pos] = '-') do 208 - advance s 209 - done; 210 - float_of_string 211 - (String.sub s.input start (s.pos - start)) 202 + let parse_number s = 203 + let start = s.pos in 204 + while s.pos < String.length s.input 205 + && (is_digit s.input.[s.pos] 206 + || s.input.[s.pos] = '.' 207 + || s.input.[s.pos] = '-') do 208 + advance s 209 + done; 210 + float_of_string 211 + (String.sub s.input start (s.pos - start)) 212 212 213 - (* >let expect s c = 214 - (* > match peek s with 215 - (* > | Some c' when c' = c -> advance s 216 - (* > | _ -> failwith "unexpected character" 217 - (* > 218 - (* >let rec parse_value s = 219 - (* > match peek s with 220 - (* > | Some '"' -> String (parse_string s) 221 - (* > | Some c when is_digit c || c = '-' -> 222 - (* > Number (parse_number s) 223 - (* > | Some 't' -> 224 - (* > s.pos <- s.pos + 4; Bool true 225 - (* > | Some 'f' -> 226 - (* > s.pos <- s.pos + 5; Bool false 227 - (* > | Some 'n' -> 228 - (* > s.pos <- s.pos + 4; Null 229 - (* > | Some '[' -> parse_array s 230 - (* > | Some '{' -> parse_object s 231 - (* > | _ -> failwith "unexpected token" 232 - (* > 233 - (* >and parse_array s = 234 - (* > advance s; 235 - (* > let items = ref [] in 236 - (* > (match peek s with 237 - (* > | Some ']' -> advance s 238 - (* > | _ -> 239 - (* > items := [parse_value s]; 240 - (* > while peek s = Some ',' do 241 - (* > advance s; 242 - (* > items := parse_value s :: !items 243 - (* > done; 244 - (* > expect s ']'); 245 - (* > Array (List.rev !items) 246 - (* > 247 - (* >and parse_object s = 248 - (* > advance s; 249 - (* > let pairs = ref [] in 250 - (* > (match peek s with 251 - (* > | Some '}' -> advance s 252 - (* > | _ -> 253 - (* > let key = parse_string s in 254 - (* > expect s ':'; 255 - (* > let value = parse_value s in 256 - (* > pairs := [(key, value)]; 257 - (* > while peek s = Some ',' do 258 - (* > advance s; 259 - (* > let k = parse_string s in 260 - (* > expect s ':'; 261 - (* > let v = parse_value s in 262 - (* > pairs := (k, v) :: !pairs 263 - (* > done; 264 - (* > expect s '}'); 265 - (* > Object (List.rev !pairs) 213 + (* >let expect s c = 214 + (* > match peek s with 215 + (* > | Some c' when c' = c -> advance s 216 + (* > | _ -> failwith "unexpected character" 217 + (* > 218 + (* >let rec parse_value s = 219 + (* > match peek s with 220 + (* > | Some '"' -> String (parse_string s) 221 + (* > | Some c when is_digit c || c = '-' -> 222 + (* > Number (parse_number s) 223 + (* > | Some 't' -> 224 + (* > s.pos <- s.pos + 4; Bool true 225 + (* > | Some 'f' -> 226 + (* > s.pos <- s.pos + 5; Bool false 227 + (* > | Some 'n' -> 228 + (* > s.pos <- s.pos + 4; Null 229 + (* > | Some '[' -> parse_array s 230 + (* > | Some '{' -> parse_object s 231 + (* > | _ -> failwith "unexpected token" 232 + (* > 233 + (* >and parse_array s = 234 + (* > advance s; 235 + (* > let items = ref [] in 236 + (* > (match peek s with 237 + (* > | Some ']' -> advance s 238 + (* > | _ -> 239 + (* > items := [parse_value s]; 240 + (* > while peek s = Some ',' do 241 + (* > advance s; 242 + (* > items := parse_value s :: !items 243 + (* > done; 244 + (* > expect s ']'); 245 + (* > Array (List.rev !items) 246 + (* > 247 + (* >and parse_object s = 248 + (* > advance s; 249 + (* > let pairs = ref [] in 250 + (* > (match peek s with 251 + (* > | Some '}' -> advance s 252 + (* > | _ -> 253 + (* > let key = parse_string s in 254 + (* > expect s ':'; 255 + (* > let value = parse_value s in 256 + (* > pairs := [(key, value)]; 257 + (* > while peek s = Some ',' do 258 + (* > advance s; 259 + (* > let k = parse_string s in 260 + (* > expect s ':'; 261 + (* > let v = parse_value s in 262 + (* > pairs := (k, v) :: !pairs 263 + (* > done; 264 + (* > expect s '}'); 265 + (* > Object (List.rev !pairs) 266 266 ]} 267 267 } 268 268 {li ··· 273 273 is about 80 lines of OCaml — no dependencies, no magic. 274 274 275 275 {[ 276 - type json = 277 - | Null 278 - | Bool of bool 279 - | Number of float 280 - | String of string 281 - | Array of json list 282 - | Object of (string * json) list 276 + type json = 277 + | Null 278 + | Bool of bool 279 + | Number of float 280 + | String of string 281 + | Array of json list 282 + | Object of (string * json) list 283 283 284 - type scanner = { 285 - input : string; 286 - mutable pos : int; 287 - } 284 + type scanner = { 285 + input : string; 286 + mutable pos : int; 287 + } 288 288 289 - let peek s = 290 - while s.pos < String.length s.input 291 - && s.input.[s.pos] = ' ' do 292 - s.pos <- s.pos + 1 293 - done; 294 - if s.pos < String.length s.input 295 - then Some s.input.[s.pos] 296 - else None 289 + let peek s = 290 + while s.pos < String.length s.input 291 + && s.input.[s.pos] = ' ' do 292 + s.pos <- s.pos + 1 293 + done; 294 + if s.pos < String.length s.input 295 + then Some s.input.[s.pos] 296 + else None 297 297 298 - let advance s = s.pos <- s.pos + 1 298 + let advance s = s.pos <- s.pos + 1 299 299 300 - let parse_string s = 301 - advance s; 302 - let buf = Buffer.create 64 in 303 - while s.pos < String.length s.input 304 - && s.input.[s.pos] <> '"' do 305 - Buffer.add_char buf s.input.[s.pos]; 306 - advance s 307 - done; 308 - advance s; 309 - Buffer.contents buf 300 + let parse_string s = 301 + advance s; 302 + let buf = Buffer.create 64 in 303 + while s.pos < String.length s.input 304 + && s.input.[s.pos] <> '"' do 305 + Buffer.add_char buf s.input.[s.pos]; 306 + advance s 307 + done; 308 + advance s; 309 + Buffer.contents buf 310 310 311 - let is_digit c = c >= '0' && c <= '9' 311 + let is_digit c = c >= '0' && c <= '9' 312 312 313 - let parse_number s = 314 - let start = s.pos in 315 - while s.pos < String.length s.input 316 - && (is_digit s.input.[s.pos] 317 - || s.input.[s.pos] = '.' 318 - || s.input.[s.pos] = '-') do 319 - advance s 320 - done; 321 - float_of_string 322 - (String.sub s.input start (s.pos - start)) 313 + let parse_number s = 314 + let start = s.pos in 315 + while s.pos < String.length s.input 316 + && (is_digit s.input.[s.pos] 317 + || s.input.[s.pos] = '.' 318 + || s.input.[s.pos] = '-') do 319 + advance s 320 + done; 321 + float_of_string 322 + (String.sub s.input start (s.pos - start)) 323 323 324 - let expect s c = 325 - match peek s with 326 - | Some c' when c' = c -> advance s 327 - | _ -> failwith "unexpected character" 324 + let expect s c = 325 + match peek s with 326 + | Some c' when c' = c -> advance s 327 + | _ -> failwith "unexpected character" 328 328 329 - let rec parse_value s = 330 - match peek s with 331 - | Some '"' -> String (parse_string s) 332 - | Some c when is_digit c || c = '-' -> 333 - Number (parse_number s) 334 - | Some 't' -> 335 - s.pos <- s.pos + 4; Bool true 336 - | Some 'f' -> 337 - s.pos <- s.pos + 5; Bool false 338 - | Some 'n' -> 339 - s.pos <- s.pos + 4; Null 340 - | Some '[' -> parse_array s 341 - | Some '{' -> parse_object s 342 - | _ -> failwith "unexpected token" 329 + let rec parse_value s = 330 + match peek s with 331 + | Some '"' -> String (parse_string s) 332 + | Some c when is_digit c || c = '-' -> 333 + Number (parse_number s) 334 + | Some 't' -> 335 + s.pos <- s.pos + 4; Bool true 336 + | Some 'f' -> 337 + s.pos <- s.pos + 5; Bool false 338 + | Some 'n' -> 339 + s.pos <- s.pos + 4; Null 340 + | Some '[' -> parse_array s 341 + | Some '{' -> parse_object s 342 + | _ -> failwith "unexpected token" 343 343 344 - and parse_array s = 345 - advance s; 346 - let items = ref [] in 347 - (match peek s with 348 - | Some ']' -> advance s 349 - | _ -> 350 - items := [parse_value s]; 351 - while peek s = Some ',' do 352 - advance s; 353 - items := parse_value s :: !items 354 - done; 355 - expect s ']'); 356 - Array (List.rev !items) 344 + and parse_array s = 345 + advance s; 346 + let items = ref [] in 347 + (match peek s with 348 + | Some ']' -> advance s 349 + | _ -> 350 + items := [parse_value s]; 351 + while peek s = Some ',' do 352 + advance s; 353 + items := parse_value s :: !items 354 + done; 355 + expect s ']'); 356 + Array (List.rev !items) 357 357 358 - and parse_object s = 359 - advance s; 360 - let pairs = ref [] in 361 - (match peek s with 362 - | Some '}' -> advance s 363 - | _ -> 364 - let key = parse_string s in 365 - expect s ':'; 366 - let value = parse_value s in 367 - pairs := [(key, value)]; 368 - while peek s = Some ',' do 369 - advance s; 370 - let k = parse_string s in 358 + and parse_object s = 359 + advance s; 360 + let pairs = ref [] in 361 + (match peek s with 362 + | Some '}' -> advance s 363 + | _ -> 364 + let key = parse_string s in 371 365 expect s ':'; 372 - let v = parse_value s in 373 - pairs := (k, v) :: !pairs 374 - done; 375 - expect s '}'); 376 - Object (List.rev !pairs) 366 + let value = parse_value s in 367 + pairs := [(key, value)]; 368 + while peek s = Some ',' do 369 + advance s; 370 + let k = parse_string s in 371 + expect s ':'; 372 + let v = parse_value s in 373 + pairs := (k, v) :: !pairs 374 + done; 375 + expect s '}'); 376 + Object (List.rev !pairs) 377 377 378 - (* >let parse input = 379 - (* > let s = { input; pos = 0 } in 380 - (* > let v = parse_value s in 381 - (* > v 378 + (* >let parse input = 379 + (* > let s = { input; pos = 0 } in 380 + (* > let v = parse_value s in 381 + (* > v 382 382 ]} 383 383 } 384 384 }

Configure Feed

Configure Feed