+412

doc/dark_repl.mld

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

+2

doc/dune

··· 1 1 + (documentation 2 2 + (package odoc-scrollycode-extension))

+198

doc/index.mld

··· 1 1 + {0 Scrollycode Demos} 2 2 + 3 3 + {%html: 4 4 + <link rel="preconnect" href="https://fonts.googleapis.com"> 5 5 + <link rel="preconnect" href="https://fonts.gstatic.com" crossorigin> 6 6 + <link href="https://fonts.googleapis.com/css2?family=Fraunces:ital,opsz,wght@0,9..144,300..900;1,9..144,300..900&family=Source+Code+Pro:ital,wght@0,300..900;1,300..900&family=Source+Serif+4:ital,opsz,wght@0,8..60,300..900;1,8..60,300..900&display=swap" rel="stylesheet"> 7 7 + <style> 8 8 + .odoc-nav, .odoc-tocs, .odoc-search { display: none !important; } 9 9 + .odoc-preamble > h1 { display: none !important; } 10 10 + .odoc-preamble, .odoc-content { max-width: none !important; padding: 0 !important; margin: 0 !important; } 11 11 + body.odoc, .odoc { padding: 0 !important; margin: 0 !important; max-width: none !important; } 12 12 + 13 13 + .demos-index { 14 14 + font-family: 'Source Serif 4', Georgia, serif; 15 15 + background: #f4f0e8; 16 16 + min-height: 100vh; 17 17 + } 18 18 + 19 19 + .demos-header { 20 20 + max-width: 680px; 21 21 + margin: 0 auto; 22 22 + padding: 6rem 2rem 3rem; 23 23 + text-align: center; 24 24 + } 25 25 + 26 26 + .demos-header h1 { 27 27 + font-family: 'Fraunces', serif; 28 28 + font-size: clamp(2rem, 5vw, 3.2rem); 29 29 + font-weight: 800; 30 30 + line-height: 1.15; 31 31 + letter-spacing: -0.02em; 32 32 + margin-bottom: 1rem; 33 33 + color: #2c2416; 34 34 + } 35 35 + 36 36 + .demos-header h1 em { 37 37 + font-style: italic; 38 38 + color: #c25832; 39 39 + } 40 40 + 41 41 + .demos-header p { 42 42 + color: #6b5d4d; 43 43 + max-width: 50ch; 44 44 + margin: 0 auto; 45 45 + font-size: 1.05rem; 46 46 + line-height: 1.6; 47 47 + } 48 48 + 49 49 + .demos-list { 50 50 + max-width: 720px; 51 51 + margin: 0 auto; 52 52 + padding: 1rem 2rem 6rem; 53 53 + display: flex; 54 54 + flex-direction: column; 55 55 + gap: 1.25rem; 56 56 + } 57 57 + 58 58 + .demo-card { 59 59 + display: block; 60 60 + background: #fff; 61 61 + border: 1px solid rgba(44,36,22,0.08); 62 62 + border-radius: 10px; 63 63 + padding: 1.5rem 1.75rem; 64 64 + text-decoration: none; 65 65 + color: inherit; 66 66 + transition: border-color 0.2s ease, box-shadow 0.2s ease, transform 0.15s ease; 67 67 + } 68 68 + 69 69 + .demo-card:hover { 70 70 + border-color: #c25832; 71 71 + box-shadow: 0 4px 20px rgba(194,88,50,0.1); 72 72 + transform: translateY(-2px); 73 73 + } 74 74 + 75 75 + .demo-card-header { 76 76 + display: flex; 77 77 + align-items: baseline; 78 78 + gap: 0.75rem; 79 79 + margin-bottom: 0.5rem; 80 80 + } 81 81 + 82 82 + .demo-card-number { 83 83 + font-family: 'Source Code Pro', monospace; 84 84 + font-size: 0.68rem; 85 85 + font-weight: 600; 86 86 + letter-spacing: 0.08em; 87 87 + color: #c25832; 88 88 + flex-shrink: 0; 89 89 + } 90 90 + 91 91 + .demo-card h2 { 92 92 + font-family: 'Fraunces', serif; 93 93 + font-size: 1.2rem; 94 94 + font-weight: 700; 95 95 + letter-spacing: -0.01em; 96 96 + margin: 0; 97 97 + } 98 98 + 99 99 + .demo-card p { 100 100 + color: #6b5d4d; 101 101 + font-size: 0.92rem; 102 102 + line-height: 1.6; 103 103 + margin: 0.5rem 0; 104 104 + } 105 105 + 106 106 + .demo-card .tags { 107 107 + display: flex; 108 108 + flex-wrap: wrap; 109 109 + gap: 0.4rem; 110 110 + margin-top: 0.75rem; 111 111 + } 112 112 + 113 113 + .tag { 114 114 + font-family: 'Source Code Pro', monospace; 115 115 + font-size: 0.65rem; 116 116 + letter-spacing: 0.04em; 117 117 + padding: 0.2em 0.6em; 118 118 + border-radius: 4px; 119 119 + background: rgba(194,88,50,0.07); 120 120 + color: #c25832; 121 121 + } 122 122 + 123 123 + .tag.dark { 124 124 + background: #1a1a2e; 125 125 + color: rgba(255,255,255,0.5); 126 126 + } 127 127 + 128 128 + .demos-footer { 129 129 + text-align: center; 130 130 + padding: 0 2rem 4rem; 131 131 + font-family: 'Source Code Pro', monospace; 132 132 + font-size: 0.72rem; 133 133 + color: #6b5d4d; 134 134 + letter-spacing: 0.04em; 135 135 + } 136 136 + 137 137 + .demos-footer a { 138 138 + color: #c25832; 139 139 + text-decoration: none; 140 140 + } 141 141 + </style> 142 142 + 143 143 + <div class="demos-index"> 144 144 + 145 145 + <div class="demos-header"> 146 146 + <h1>Scrollycoding in <em>OCaml</em></h1> 147 147 + <p>Three odoc extension plugins, each rendering the same scrollycode pattern with a radically different visual theme. Authored as <code>.mld</code> files using <code>@scrolly.&lt;theme&gt;</code> custom tags.</p> 148 148 + </div> 149 149 + 150 150 + <div class="demos-list"> 151 151 + 152 152 + <a class="demo-card" href="warm_parser.html"> 153 153 + <div class="demo-card-header"> 154 154 + <span class="demo-card-number">01</span> 155 155 + <h2>The Warm Workshop</h2> 156 156 + </div> 157 157 + <p>Building a JSON parser step by step. Warm cream background with a dark navy code panel, Fraunces serif display type, and earthy burnt-sienna accents. Classic scrollycode split layout.</p> 158 158 + <div class="tags"> 159 159 + <span class="tag">@scrolly.warm</span> 160 160 + <span class="tag">Fraunces + Source Serif</span> 161 161 + <span class="tag">parser tutorial</span> 162 162 + </div> 163 163 + </a> 164 164 + 165 165 + <a class="demo-card" href="dark_repl.html"> 166 166 + <div class="demo-card-header"> 167 167 + <span class="demo-card-number">02</span> 168 168 + <h2>The Dark Terminal</h2> 169 169 + </div> 170 170 + <p>Building a REPL from scratch. Near-black cinematic theme with phosphor-green accents, JetBrains Mono code font, and the code panel as the visual hero. Prose in a narrow left column.</p> 171 171 + <div class="tags"> 172 172 + <span class="tag dark">@scrolly.dark</span> 173 173 + <span class="tag">JetBrains Mono + Outfit</span> 174 174 + <span class="tag">REPL tutorial</span> 175 175 + </div> 176 176 + </a> 177 177 + 178 178 + <a class="demo-card" href="notebook_testing.html"> 179 179 + <div class="demo-card-header"> 180 180 + <span class="demo-card-number">03</span> 181 181 + <h2>The Notebook</h2> 182 182 + </div> 183 183 + <p>Building a test framework incrementally. Clean editorial aesthetic with a soft white background, blue-violet accents, Newsreader serif headings, and generous whitespace.</p> 184 184 + <div class="tags"> 185 185 + <span class="tag">@scrolly.notebook</span> 186 186 + <span class="tag">Newsreader + DM Sans</span> 187 187 + <span class="tag">testing tutorial</span> 188 188 + </div> 189 189 + </a> 190 190 + 191 191 + </div> 192 192 + 193 193 + <div class="demos-footer"> 194 194 + Powered by <a href="https://ocaml.github.io/odoc/">odoc</a> custom tag extensions &middot; Inspired by <a href="https://codehike.org">Code Hike</a> 195 195 + </div> 196 196 + 197 197 + </div> 198 198 + %}

+403

doc/notebook_testing.mld

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

+384

doc/warm_parser.mld

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