1 ============================================================ 2 Kaleidoscope: Extending the Language: User-defined Operators 3 ============================================================ 4 5 .. contents:: 6 :local: 7 8 Chapter 6 Introduction 9 ====================== 10 11 Welcome to Chapter 6 of the "`Implementing a language with 12 LLVM <index.html>`_" tutorial. At this point in our tutorial, we now 13 have a fully functional language that is fairly minimal, but also 14 useful. There is still one big problem with it, however. Our language 15 doesn't have many useful operators (like division, logical negation, or 16 even any comparisons besides less-than). 17 18 This chapter of the tutorial takes a wild digression into adding 19 user-defined operators to the simple and beautiful Kaleidoscope 20 language. This digression now gives us a simple and ugly language in 21 some ways, but also a powerful one at the same time. One of the great 22 things about creating your own language is that you get to decide what 23 is good or bad. In this tutorial we'll assume that it is okay to use 24 this as a way to show some interesting parsing techniques. 25 26 At the end of this tutorial, we'll run through an example Kaleidoscope 27 application that `renders the Mandelbrot set <#example>`_. This gives an 28 example of what you can build with Kaleidoscope and its feature set. 29 30 User-defined Operators: the Idea 31 ================================ 32 33 The "operator overloading" that we will add to Kaleidoscope is more 34 general than languages like C++. In C++, you are only allowed to 35 redefine existing operators: you can't programatically change the 36 grammar, introduce new operators, change precedence levels, etc. In this 37 chapter, we will add this capability to Kaleidoscope, which will let the 38 user round out the set of operators that are supported. 39 40 The point of going into user-defined operators in a tutorial like this 41 is to show the power and flexibility of using a hand-written parser. 42 Thus far, the parser we have been implementing uses recursive descent 43 for most parts of the grammar and operator precedence parsing for the 44 expressions. See `Chapter 2 <OCamlLangImpl2.html>`_ for details. Without 45 using operator precedence parsing, it would be very difficult to allow 46 the programmer to introduce new operators into the grammar: the grammar 47 is dynamically extensible as the JIT runs. 48 49 The two specific features we'll add are programmable unary operators 50 (right now, Kaleidoscope has no unary operators at all) as well as 51 binary operators. An example of this is: 52 53 :: 54 55 # Logical unary not. 56 def unary!(v) 57 if v then 58 0 59 else 60 1; 61 62 # Define > with the same precedence as <. 63 def binary> 10 (LHS RHS) 64 RHS < LHS; 65 66 # Binary "logical or", (note that it does not "short circuit") 67 def binary| 5 (LHS RHS) 68 if LHS then 69 1 70 else if RHS then 71 1 72 else 73 0; 74 75 # Define = with slightly lower precedence than relationals. 76 def binary= 9 (LHS RHS) 77 !(LHS < RHS | LHS > RHS); 78 79 Many languages aspire to being able to implement their standard runtime 80 library in the language itself. In Kaleidoscope, we can implement 81 significant parts of the language in the library! 82 83 We will break down implementation of these features into two parts: 84 implementing support for user-defined binary operators and adding unary 85 operators. 86 87 User-defined Binary Operators 88 ============================= 89 90 Adding support for user-defined binary operators is pretty simple with 91 our current framework. We'll first add support for the unary/binary 92 keywords: 93 94 .. code-block:: ocaml 95 96 type token = 97 ... 98 (* operators *) 99 | Binary | Unary 100 101 ... 102 103 and lex_ident buffer = parser 104 ... 105 | "for" -> [< 'Token.For; stream >] 106 | "in" -> [< 'Token.In; stream >] 107 | "binary" -> [< 'Token.Binary; stream >] 108 | "unary" -> [< 'Token.Unary; stream >] 109 110 This just adds lexer support for the unary and binary keywords, like we 111 did in `previous chapters <OCamlLangImpl5.html#iflexer>`_. One nice 112 thing about our current AST, is that we represent binary operators with 113 full generalisation by using their ASCII code as the opcode. For our 114 extended operators, we'll use this same representation, so we don't need 115 any new AST or parser support. 116 117 On the other hand, we have to be able to represent the definitions of 118 these new operators, in the "def binary\| 5" part of the function 119 definition. In our grammar so far, the "name" for the function 120 definition is parsed as the "prototype" production and into the 121 ``Ast.Prototype`` AST node. To represent our new user-defined operators 122 as prototypes, we have to extend the ``Ast.Prototype`` AST node like 123 this: 124 125 .. code-block:: ocaml 126 127 (* proto - This type represents the "prototype" for a function, which captures 128 * its name, and its argument names (thus implicitly the number of arguments the 129 * function takes). *) 130 type proto = 131 | Prototype of string * string array 132 | BinOpPrototype of string * string array * int 133 134 Basically, in addition to knowing a name for the prototype, we now keep 135 track of whether it was an operator, and if it was, what precedence 136 level the operator is at. The precedence is only used for binary 137 operators (as you'll see below, it just doesn't apply for unary 138 operators). Now that we have a way to represent the prototype for a 139 user-defined operator, we need to parse it: 140 141 .. code-block:: ocaml 142 143 (* prototype 144 * ::= id '(' id* ')' 145 * ::= binary LETTER number? (id, id) 146 * ::= unary LETTER number? (id) *) 147 let parse_prototype = 148 let rec parse_args accumulator = parser 149 | [< 'Token.Ident id; e=parse_args (id::accumulator) >] -> e 150 | [< >] -> accumulator 151 in 152 let parse_operator = parser 153 | [< 'Token.Unary >] -> "unary", 1 154 | [< 'Token.Binary >] -> "binary", 2 155 in 156 let parse_binary_precedence = parser 157 | [< 'Token.Number n >] -> int_of_float n 158 | [< >] -> 30 159 in 160 parser 161 | [< 'Token.Ident id; 162 'Token.Kwd '(' ?? "expected '(' in prototype"; 163 args=parse_args []; 164 'Token.Kwd ')' ?? "expected ')' in prototype" >] -> 165 (* success. *) 166 Ast.Prototype (id, Array.of_list (List.rev args)) 167 | [< (prefix, kind)=parse_operator; 168 'Token.Kwd op ?? "expected an operator"; 169 (* Read the precedence if present. *) 170 binary_precedence=parse_binary_precedence; 171 'Token.Kwd '(' ?? "expected '(' in prototype"; 172 args=parse_args []; 173 'Token.Kwd ')' ?? "expected ')' in prototype" >] -> 174 let name = prefix ^ (String.make 1 op) in 175 let args = Array.of_list (List.rev args) in 176 177 (* Verify right number of arguments for operator. *) 178 if Array.length args != kind 179 then raise (Stream.Error "invalid number of operands for operator") 180 else 181 if kind == 1 then 182 Ast.Prototype (name, args) 183 else 184 Ast.BinOpPrototype (name, args, binary_precedence) 185 | [< >] -> 186 raise (Stream.Error "expected function name in prototype") 187 188 This is all fairly straightforward parsing code, and we have already 189 seen a lot of similar code in the past. One interesting part about the 190 code above is the couple lines that set up ``name`` for binary 191 operators. This builds names like "binary@" for a newly defined "@" 192 operator. This then takes advantage of the fact that symbol names in the 193 LLVM symbol table are allowed to have any character in them, including 194 embedded nul characters. 195 196 The next interesting thing to add, is codegen support for these binary 197 operators. Given our current structure, this is a simple addition of a 198 default case for our existing binary operator node: 199 200 .. code-block:: ocaml 201 202 let codegen_expr = function 203 ... 204 | Ast.Binary (op, lhs, rhs) -> 205 let lhs_val = codegen_expr lhs in 206 let rhs_val = codegen_expr rhs in 207 begin 208 match op with 209 | '+' -> build_add lhs_val rhs_val "addtmp" builder 210 | '-' -> build_sub lhs_val rhs_val "subtmp" builder 211 | '*' -> build_mul lhs_val rhs_val "multmp" builder 212 | '<' -> 213 (* Convert bool 0/1 to double 0.0 or 1.0 *) 214 let i = build_fcmp Fcmp.Ult lhs_val rhs_val "cmptmp" builder in 215 build_uitofp i double_type "booltmp" builder 216 | _ -> 217 (* If it wasn't a builtin binary operator, it must be a user defined 218 * one. Emit a call to it. *) 219 let callee = "binary" ^ (String.make 1 op) in 220 let callee = 221 match lookup_function callee the_module with 222 | Some callee -> callee 223 | None -> raise (Error "binary operator not found!") 224 in 225 build_call callee [|lhs_val; rhs_val|] "binop" builder 226 end 227 228 As you can see above, the new code is actually really simple. It just 229 does a lookup for the appropriate operator in the symbol table and 230 generates a function call to it. Since user-defined operators are just 231 built as normal functions (because the "prototype" boils down to a 232 function with the right name) everything falls into place. 233 234 The final piece of code we are missing, is a bit of top level magic: 235 236 .. code-block:: ocaml 237 238 let codegen_func the_fpm = function 239 | Ast.Function (proto, body) -> 240 Hashtbl.clear named_values; 241 let the_function = codegen_proto proto in 242 243 (* If this is an operator, install it. *) 244 begin match proto with 245 | Ast.BinOpPrototype (name, args, prec) -> 246 let op = name.[String.length name - 1] in 247 Hashtbl.add Parser.binop_precedence op prec; 248 | _ -> () 249 end; 250 251 (* Create a new basic block to start insertion into. *) 252 let bb = append_block context "entry" the_function in 253 position_at_end bb builder; 254 ... 255 256 Basically, before codegening a function, if it is a user-defined 257 operator, we register it in the precedence table. This allows the binary 258 operator parsing logic we already have in place to handle it. Since we 259 are working on a fully-general operator precedence parser, this is all 260 we need to do to "extend the grammar". 261 262 Now we have useful user-defined binary operators. This builds a lot on 263 the previous framework we built for other operators. Adding unary 264 operators is a bit more challenging, because we don't have any framework 265 for it yet - lets see what it takes. 266 267 User-defined Unary Operators 268 ============================ 269 270 Since we don't currently support unary operators in the Kaleidoscope 271 language, we'll need to add everything to support them. Above, we added 272 simple support for the 'unary' keyword to the lexer. In addition to 273 that, we need an AST node: 274 275 .. code-block:: ocaml 276 277 type expr = 278 ... 279 (* variant for a unary operator. *) 280 | Unary of char * expr 281 ... 282 283 This AST node is very simple and obvious by now. It directly mirrors the 284 binary operator AST node, except that it only has one child. With this, 285 we need to add the parsing logic. Parsing a unary operator is pretty 286 simple: we'll add a new function to do it: 287 288 .. code-block:: ocaml 289 290 (* unary 291 * ::= primary 292 * ::= '!' unary *) 293 and parse_unary = parser 294 (* If this is a unary operator, read it. *) 295 | [< 'Token.Kwd op when op != '(' && op != ')'; operand=parse_expr >] -> 296 Ast.Unary (op, operand) 297 298 (* If the current token is not an operator, it must be a primary expr. *) 299 | [< stream >] -> parse_primary stream 300 301 The grammar we add is pretty straightforward here. If we see a unary 302 operator when parsing a primary operator, we eat the operator as a 303 prefix and parse the remaining piece as another unary operator. This 304 allows us to handle multiple unary operators (e.g. "!!x"). Note that 305 unary operators can't have ambiguous parses like binary operators can, 306 so there is no need for precedence information. 307 308 The problem with this function, is that we need to call ParseUnary from 309 somewhere. To do this, we change previous callers of ParsePrimary to 310 call ``parse_unary`` instead: 311 312 .. code-block:: ocaml 313 314 (* binoprhs 315 * ::= ('+' primary)* *) 316 and parse_bin_rhs expr_prec lhs stream = 317 ... 318 (* Parse the unary expression after the binary operator. *) 319 let rhs = parse_unary stream in 320 ... 321 322 ... 323 324 (* expression 325 * ::= primary binoprhs *) 326 and parse_expr = parser 327 | [< lhs=parse_unary; stream >] -> parse_bin_rhs 0 lhs stream 328 329 With these two simple changes, we are now able to parse unary operators 330 and build the AST for them. Next up, we need to add parser support for 331 prototypes, to parse the unary operator prototype. We extend the binary 332 operator code above with: 333 334 .. code-block:: ocaml 335 336 (* prototype 337 * ::= id '(' id* ')' 338 * ::= binary LETTER number? (id, id) 339 * ::= unary LETTER number? (id) *) 340 let parse_prototype = 341 let rec parse_args accumulator = parser 342 | [< 'Token.Ident id; e=parse_args (id::accumulator) >] -> e 343 | [< >] -> accumulator 344 in 345 let parse_operator = parser 346 | [< 'Token.Unary >] -> "unary", 1 347 | [< 'Token.Binary >] -> "binary", 2 348 in 349 let parse_binary_precedence = parser 350 | [< 'Token.Number n >] -> int_of_float n 351 | [< >] -> 30 352 in 353 parser 354 | [< 'Token.Ident id; 355 'Token.Kwd '(' ?? "expected '(' in prototype"; 356 args=parse_args []; 357 'Token.Kwd ')' ?? "expected ')' in prototype" >] -> 358 (* success. *) 359 Ast.Prototype (id, Array.of_list (List.rev args)) 360 | [< (prefix, kind)=parse_operator; 361 'Token.Kwd op ?? "expected an operator"; 362 (* Read the precedence if present. *) 363 binary_precedence=parse_binary_precedence; 364 'Token.Kwd '(' ?? "expected '(' in prototype"; 365 args=parse_args []; 366 'Token.Kwd ')' ?? "expected ')' in prototype" >] -> 367 let name = prefix ^ (String.make 1 op) in 368 let args = Array.of_list (List.rev args) in 369 370 (* Verify right number of arguments for operator. *) 371 if Array.length args != kind 372 then raise (Stream.Error "invalid number of operands for operator") 373 else 374 if kind == 1 then 375 Ast.Prototype (name, args) 376 else 377 Ast.BinOpPrototype (name, args, binary_precedence) 378 | [< >] -> 379 raise (Stream.Error "expected function name in prototype") 380 381 As with binary operators, we name unary operators with a name that 382 includes the operator character. This assists us at code generation 383 time. Speaking of, the final piece we need to add is codegen support for 384 unary operators. It looks like this: 385 386 .. code-block:: ocaml 387 388 let rec codegen_expr = function 389 ... 390 | Ast.Unary (op, operand) -> 391 let operand = codegen_expr operand in 392 let callee = "unary" ^ (String.make 1 op) in 393 let callee = 394 match lookup_function callee the_module with 395 | Some callee -> callee 396 | None -> raise (Error "unknown unary operator") 397 in 398 build_call callee [|operand|] "unop" builder 399 400 This code is similar to, but simpler than, the code for binary 401 operators. It is simpler primarily because it doesn't need to handle any 402 predefined operators. 403 404 Kicking the Tires 405 ================= 406 407 It is somewhat hard to believe, but with a few simple extensions we've 408 covered in the last chapters, we have grown a real-ish language. With 409 this, we can do a lot of interesting things, including I/O, math, and a 410 bunch of other things. For example, we can now add a nice sequencing 411 operator (printd is defined to print out the specified value and a 412 newline): 413 414 :: 415 416 ready> extern printd(x); 417 Read extern: declare double @printd(double) 418 ready> def binary : 1 (x y) 0; # Low-precedence operator that ignores operands. 419 .. 420 ready> printd(123) : printd(456) : printd(789); 421 123.000000 422 456.000000 423 789.000000 424 Evaluated to 0.000000 425 426 We can also define a bunch of other "primitive" operations, such as: 427 428 :: 429 430 # Logical unary not. 431 def unary!(v) 432 if v then 433 0 434 else 435 1; 436 437 # Unary negate. 438 def unary-(v) 439 0-v; 440 441 # Define > with the same precedence as <. 442 def binary> 10 (LHS RHS) 443 RHS < LHS; 444 445 # Binary logical or, which does not short circuit. 446 def binary| 5 (LHS RHS) 447 if LHS then 448 1 449 else if RHS then 450 1 451 else 452 0; 453 454 # Binary logical and, which does not short circuit. 455 def binary& 6 (LHS RHS) 456 if !LHS then 457 0 458 else 459 !!RHS; 460 461 # Define = with slightly lower precedence than relationals. 462 def binary = 9 (LHS RHS) 463 !(LHS < RHS | LHS > RHS); 464 465 Given the previous if/then/else support, we can also define interesting 466 functions for I/O. For example, the following prints out a character 467 whose "density" reflects the value passed in: the lower the value, the 468 denser the character: 469 470 :: 471 472 ready> 473 474 extern putchard(char) 475 def printdensity(d) 476 if d > 8 then 477 putchard(32) # ' ' 478 else if d > 4 then 479 putchard(46) # '.' 480 else if d > 2 then 481 putchard(43) # '+' 482 else 483 putchard(42); # '*' 484 ... 485 ready> printdensity(1): printdensity(2): printdensity(3) : 486 printdensity(4): printdensity(5): printdensity(9): putchard(10); 487 *++.. 488 Evaluated to 0.000000 489 490 Based on these simple primitive operations, we can start to define more 491 interesting things. For example, here's a little function that solves 492 for the number of iterations it takes a function in the complex plane to 493 converge: 494 495 :: 496 497 # determine whether the specific location diverges. 498 # Solve for z = z^2 + c in the complex plane. 499 def mandleconverger(real imag iters creal cimag) 500 if iters > 255 | (real*real + imag*imag > 4) then 501 iters 502 else 503 mandleconverger(real*real - imag*imag + creal, 504 2*real*imag + cimag, 505 iters+1, creal, cimag); 506 507 # return the number of iterations required for the iteration to escape 508 def mandleconverge(real imag) 509 mandleconverger(real, imag, 0, real, imag); 510 511 This "z = z\ :sup:`2`\ + c" function is a beautiful little creature 512 that is the basis for computation of the `Mandelbrot 513 Set <http://en.wikipedia.org/wiki/Mandelbrot_set>`_. Our 514 ``mandelconverge`` function returns the number of iterations that it 515 takes for a complex orbit to escape, saturating to 255. This is not a 516 very useful function by itself, but if you plot its value over a 517 two-dimensional plane, you can see the Mandelbrot set. Given that we are 518 limited to using putchard here, our amazing graphical output is limited, 519 but we can whip together something using the density plotter above: 520 521 :: 522 523 # compute and plot the mandlebrot set with the specified 2 dimensional range 524 # info. 525 def mandelhelp(xmin xmax xstep ymin ymax ystep) 526 for y = ymin, y < ymax, ystep in ( 527 (for x = xmin, x < xmax, xstep in 528 printdensity(mandleconverge(x,y))) 529 : putchard(10) 530 ) 531 532 # mandel - This is a convenient helper function for plotting the mandelbrot set 533 # from the specified position with the specified Magnification. 534 def mandel(realstart imagstart realmag imagmag) 535 mandelhelp(realstart, realstart+realmag*78, realmag, 536 imagstart, imagstart+imagmag*40, imagmag); 537 538 Given this, we can try plotting out the mandlebrot set! Lets try it out: 539 540 :: 541 542 ready> mandel(-2.3, -1.3, 0.05, 0.07); 543 *******************************+++++++++++************************************* 544 *************************+++++++++++++++++++++++******************************* 545 **********************+++++++++++++++++++++++++++++**************************** 546 *******************+++++++++++++++++++++.. ...++++++++************************* 547 *****************++++++++++++++++++++++.... ...+++++++++*********************** 548 ***************+++++++++++++++++++++++..... ...+++++++++********************* 549 **************+++++++++++++++++++++++.... ....+++++++++******************** 550 *************++++++++++++++++++++++...... .....++++++++******************* 551 ************+++++++++++++++++++++....... .......+++++++****************** 552 ***********+++++++++++++++++++.... ... .+++++++***************** 553 **********+++++++++++++++++....... .+++++++**************** 554 *********++++++++++++++........... ...+++++++*************** 555 ********++++++++++++............ ...++++++++************** 556 ********++++++++++... .......... .++++++++************** 557 *******+++++++++..... .+++++++++************* 558 *******++++++++...... ..+++++++++************* 559 *******++++++....... ..+++++++++************* 560 *******+++++...... ..+++++++++************* 561 *******.... .... ...+++++++++************* 562 *******.... . ...+++++++++************* 563 *******+++++...... ...+++++++++************* 564 *******++++++....... ..+++++++++************* 565 *******++++++++...... .+++++++++************* 566 *******+++++++++..... ..+++++++++************* 567 ********++++++++++... .......... .++++++++************** 568 ********++++++++++++............ ...++++++++************** 569 *********++++++++++++++.......... ...+++++++*************** 570 **********++++++++++++++++........ .+++++++**************** 571 **********++++++++++++++++++++.... ... ..+++++++**************** 572 ***********++++++++++++++++++++++....... .......++++++++***************** 573 ************+++++++++++++++++++++++...... ......++++++++****************** 574 **************+++++++++++++++++++++++.... ....++++++++******************** 575 ***************+++++++++++++++++++++++..... ...+++++++++********************* 576 *****************++++++++++++++++++++++.... ...++++++++*********************** 577 *******************+++++++++++++++++++++......++++++++************************* 578 *********************++++++++++++++++++++++.++++++++*************************** 579 *************************+++++++++++++++++++++++******************************* 580 ******************************+++++++++++++************************************ 581 ******************************************************************************* 582 ******************************************************************************* 583 ******************************************************************************* 584 Evaluated to 0.000000 585 ready> mandel(-2, -1, 0.02, 0.04); 586 **************************+++++++++++++++++++++++++++++++++++++++++++++++++++++ 587 ***********************++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 588 *********************+++++++++++++++++++++++++++++++++++++++++++++++++++++++++. 589 *******************+++++++++++++++++++++++++++++++++++++++++++++++++++++++++... 590 *****************+++++++++++++++++++++++++++++++++++++++++++++++++++++++++..... 591 ***************++++++++++++++++++++++++++++++++++++++++++++++++++++++++........ 592 **************++++++++++++++++++++++++++++++++++++++++++++++++++++++........... 593 ************+++++++++++++++++++++++++++++++++++++++++++++++++++++.............. 594 ***********++++++++++++++++++++++++++++++++++++++++++++++++++........ . 595 **********++++++++++++++++++++++++++++++++++++++++++++++............. 596 ********+++++++++++++++++++++++++++++++++++++++++++.................. 597 *******+++++++++++++++++++++++++++++++++++++++....................... 598 ******+++++++++++++++++++++++++++++++++++........................... 599 *****++++++++++++++++++++++++++++++++............................ 600 *****++++++++++++++++++++++++++++............................... 601 ****++++++++++++++++++++++++++...... ......................... 602 ***++++++++++++++++++++++++......... ...... ........... 603 ***++++++++++++++++++++++............ 604 **+++++++++++++++++++++.............. 605 **+++++++++++++++++++................ 606 *++++++++++++++++++................. 607 *++++++++++++++++............ ... 608 *++++++++++++++.............. 609 *+++....++++................ 610 *.......... ........... 611 * 612 *.......... ........... 613 *+++....++++................ 614 *++++++++++++++.............. 615 *++++++++++++++++............ ... 616 *++++++++++++++++++................. 617 **+++++++++++++++++++................ 618 **+++++++++++++++++++++.............. 619 ***++++++++++++++++++++++............ 620 ***++++++++++++++++++++++++......... ...... ........... 621 ****++++++++++++++++++++++++++...... ......................... 622 *****++++++++++++++++++++++++++++............................... 623 *****++++++++++++++++++++++++++++++++............................ 624 ******+++++++++++++++++++++++++++++++++++........................... 625 *******+++++++++++++++++++++++++++++++++++++++....................... 626 ********+++++++++++++++++++++++++++++++++++++++++++.................. 627 Evaluated to 0.000000 628 ready> mandel(-0.9, -1.4, 0.02, 0.03); 629 ******************************************************************************* 630 ******************************************************************************* 631 ******************************************************************************* 632 **********+++++++++++++++++++++************************************************ 633 *+++++++++++++++++++++++++++++++++++++++*************************************** 634 +++++++++++++++++++++++++++++++++++++++++++++********************************** 635 ++++++++++++++++++++++++++++++++++++++++++++++++++***************************** 636 ++++++++++++++++++++++++++++++++++++++++++++++++++++++************************* 637 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++********************** 638 +++++++++++++++++++++++++++++++++.........++++++++++++++++++******************* 639 +++++++++++++++++++++++++++++++.... ......+++++++++++++++++++**************** 640 +++++++++++++++++++++++++++++....... ........+++++++++++++++++++************** 641 ++++++++++++++++++++++++++++........ ........++++++++++++++++++++************ 642 +++++++++++++++++++++++++++......... .. ...+++++++++++++++++++++********** 643 ++++++++++++++++++++++++++........... ....++++++++++++++++++++++******** 644 ++++++++++++++++++++++++............. .......++++++++++++++++++++++****** 645 +++++++++++++++++++++++............. ........+++++++++++++++++++++++**** 646 ++++++++++++++++++++++........... ..........++++++++++++++++++++++*** 647 ++++++++++++++++++++........... .........++++++++++++++++++++++* 648 ++++++++++++++++++............ ...........++++++++++++++++++++ 649 ++++++++++++++++............... .............++++++++++++++++++ 650 ++++++++++++++................. ...............++++++++++++++++ 651 ++++++++++++.................. .................++++++++++++++ 652 +++++++++.................. .................+++++++++++++ 653 ++++++........ . ......... ..++++++++++++ 654 ++............ ...... ....++++++++++ 655 .............. ...++++++++++ 656 .............. ....+++++++++ 657 .............. .....++++++++ 658 ............. ......++++++++ 659 ........... .......++++++++ 660 ......... ........+++++++ 661 ......... ........+++++++ 662 ......... ....+++++++ 663 ........ ...+++++++ 664 ....... ...+++++++ 665 ....+++++++ 666 .....+++++++ 667 ....+++++++ 668 ....+++++++ 669 ....+++++++ 670 Evaluated to 0.000000 671 ready> ^D 672 673 At this point, you may be starting to realize that Kaleidoscope is a 674 real and powerful language. It may not be self-similar :), but it can be 675 used to plot things that are! 676 677 With this, we conclude the "adding user-defined operators" chapter of 678 the tutorial. We have successfully augmented our language, adding the 679 ability to extend the language in the library, and we have shown how 680 this can be used to build a simple but interesting end-user application 681 in Kaleidoscope. At this point, Kaleidoscope can build a variety of 682 applications that are functional and can call functions with 683 side-effects, but it can't actually define and mutate a variable itself. 684 685 Strikingly, variable mutation is an important feature of some languages, 686 and it is not at all obvious how to `add support for mutable 687 variables <OCamlLangImpl7.html>`_ without having to add an "SSA 688 construction" phase to your front-end. In the next chapter, we will 689 describe how you can add variable mutation without building SSA in your 690 front-end. 691 692 Full Code Listing 693 ================= 694 695 Here is the complete code listing for our running example, enhanced with 696 the if/then/else and for expressions.. To build this example, use: 697 698 .. code-block:: bash 699 700 # Compile 701 ocamlbuild toy.byte 702 # Run 703 ./toy.byte 704 705 Here is the code: 706 707 \_tags: 708 :: 709 710 <{lexer,parser}.ml>: use_camlp4, pp(camlp4of) 711 <*.{byte,native}>: g++, use_llvm, use_llvm_analysis 712 <*.{byte,native}>: use_llvm_executionengine, use_llvm_target 713 <*.{byte,native}>: use_llvm_scalar_opts, use_bindings 714 715 myocamlbuild.ml: 716 .. code-block:: ocaml 717 718 open Ocamlbuild_plugin;; 719 720 ocaml_lib ~extern:true "llvm";; 721 ocaml_lib ~extern:true "llvm_analysis";; 722 ocaml_lib ~extern:true "llvm_executionengine";; 723 ocaml_lib ~extern:true "llvm_target";; 724 ocaml_lib ~extern:true "llvm_scalar_opts";; 725 726 flag ["link"; "ocaml"; "g++"] (S[A"-cc"; A"g++"; A"-cclib"; A"-rdynamic"]);; 727 dep ["link"; "ocaml"; "use_bindings"] ["bindings.o"];; 728 729 token.ml: 730 .. code-block:: ocaml 731 732 (*===----------------------------------------------------------------------=== 733 * Lexer Tokens 734 *===----------------------------------------------------------------------===*) 735 736 (* The lexer returns these 'Kwd' if it is an unknown character, otherwise one of 737 * these others for known things. *) 738 type token = 739 (* commands *) 740 | Def | Extern 741 742 (* primary *) 743 | Ident of string | Number of float 744 745 (* unknown *) 746 | Kwd of char 747 748 (* control *) 749 | If | Then | Else 750 | For | In 751 752 (* operators *) 753 | Binary | Unary 754 755 lexer.ml: 756 .. code-block:: ocaml 757 758 (*===----------------------------------------------------------------------=== 759 * Lexer 760 *===----------------------------------------------------------------------===*) 761 762 let rec lex = parser 763 (* Skip any whitespace. *) 764 | [< ' (' ' | '\n' | '\r' | '\t'); stream >] -> lex stream 765 766 (* identifier: [a-zA-Z][a-zA-Z0-9] *) 767 | [< ' ('A' .. 'Z' | 'a' .. 'z' as c); stream >] -> 768 let buffer = Buffer.create 1 in 769 Buffer.add_char buffer c; 770 lex_ident buffer stream 771 772 (* number: [0-9.]+ *) 773 | [< ' ('0' .. '9' as c); stream >] -> 774 let buffer = Buffer.create 1 in 775 Buffer.add_char buffer c; 776 lex_number buffer stream 777 778 (* Comment until end of line. *) 779 | [< ' ('#'); stream >] -> 780 lex_comment stream 781 782 (* Otherwise, just return the character as its ascii value. *) 783 | [< 'c; stream >] -> 784 [< 'Token.Kwd c; lex stream >] 785 786 (* end of stream. *) 787 | [< >] -> [< >] 788 789 and lex_number buffer = parser 790 | [< ' ('0' .. '9' | '.' as c); stream >] -> 791 Buffer.add_char buffer c; 792 lex_number buffer stream 793 | [< stream=lex >] -> 794 [< 'Token.Number (float_of_string (Buffer.contents buffer)); stream >] 795 796 and lex_ident buffer = parser 797 | [< ' ('A' .. 'Z' | 'a' .. 'z' | '0' .. '9' as c); stream >] -> 798 Buffer.add_char buffer c; 799 lex_ident buffer stream 800 | [< stream=lex >] -> 801 match Buffer.contents buffer with 802 | "def" -> [< 'Token.Def; stream >] 803 | "extern" -> [< 'Token.Extern; stream >] 804 | "if" -> [< 'Token.If; stream >] 805 | "then" -> [< 'Token.Then; stream >] 806 | "else" -> [< 'Token.Else; stream >] 807 | "for" -> [< 'Token.For; stream >] 808 | "in" -> [< 'Token.In; stream >] 809 | "binary" -> [< 'Token.Binary; stream >] 810 | "unary" -> [< 'Token.Unary; stream >] 811 | id -> [< 'Token.Ident id; stream >] 812 813 and lex_comment = parser 814 | [< ' ('\n'); stream=lex >] -> stream 815 | [< 'c; e=lex_comment >] -> e 816 | [< >] -> [< >] 817 818 ast.ml: 819 .. code-block:: ocaml 820 821 (*===----------------------------------------------------------------------=== 822 * Abstract Syntax Tree (aka Parse Tree) 823 *===----------------------------------------------------------------------===*) 824 825 (* expr - Base type for all expression nodes. *) 826 type expr = 827 (* variant for numeric literals like "1.0". *) 828 | Number of float 829 830 (* variant for referencing a variable, like "a". *) 831 | Variable of string 832 833 (* variant for a unary operator. *) 834 | Unary of char * expr 835 836 (* variant for a binary operator. *) 837 | Binary of char * expr * expr 838 839 (* variant for function calls. *) 840 | Call of string * expr array 841 842 (* variant for if/then/else. *) 843 | If of expr * expr * expr 844 845 (* variant for for/in. *) 846 | For of string * expr * expr * expr option * expr 847 848 (* proto - This type represents the "prototype" for a function, which captures 849 * its name, and its argument names (thus implicitly the number of arguments the 850 * function takes). *) 851 type proto = 852 | Prototype of string * string array 853 | BinOpPrototype of string * string array * int 854 855 (* func - This type represents a function definition itself. *) 856 type func = Function of proto * expr 857 858 parser.ml: 859 .. code-block:: ocaml 860 861 (*===---------------------------------------------------------------------=== 862 * Parser 863 *===---------------------------------------------------------------------===*) 864 865 (* binop_precedence - This holds the precedence for each binary operator that is 866 * defined *) 867 let binop_precedence:(char, int) Hashtbl.t = Hashtbl.create 10 868 869 (* precedence - Get the precedence of the pending binary operator token. *) 870 let precedence c = try Hashtbl.find binop_precedence c with Not_found -> -1 871 872 (* primary 873 * ::= identifier 874 * ::= numberexpr 875 * ::= parenexpr 876 * ::= ifexpr 877 * ::= forexpr *) 878 let rec parse_primary = parser 879 (* numberexpr ::= number *) 880 | [< 'Token.Number n >] -> Ast.Number n 881 882 (* parenexpr ::= '(' expression ')' *) 883 | [< 'Token.Kwd '('; e=parse_expr; 'Token.Kwd ')' ?? "expected ')'" >] -> e 884 885 (* identifierexpr 886 * ::= identifier 887 * ::= identifier '(' argumentexpr ')' *) 888 | [< 'Token.Ident id; stream >] -> 889 let rec parse_args accumulator = parser 890 | [< e=parse_expr; stream >] -> 891 begin parser 892 | [< 'Token.Kwd ','; e=parse_args (e :: accumulator) >] -> e 893 | [< >] -> e :: accumulator 894 end stream 895 | [< >] -> accumulator 896 in 897 let rec parse_ident id = parser 898 (* Call. *) 899 | [< 'Token.Kwd '('; 900 args=parse_args []; 901 'Token.Kwd ')' ?? "expected ')'">] -> 902 Ast.Call (id, Array.of_list (List.rev args)) 903 904 (* Simple variable ref. *) 905 | [< >] -> Ast.Variable id 906 in 907 parse_ident id stream 908 909 (* ifexpr ::= 'if' expr 'then' expr 'else' expr *) 910 | [< 'Token.If; c=parse_expr; 911 'Token.Then ?? "expected 'then'"; t=parse_expr; 912 'Token.Else ?? "expected 'else'"; e=parse_expr >] -> 913 Ast.If (c, t, e) 914 915 (* forexpr 916 ::= 'for' identifier '=' expr ',' expr (',' expr)? 'in' expression *) 917 | [< 'Token.For; 918 'Token.Ident id ?? "expected identifier after for"; 919 'Token.Kwd '=' ?? "expected '=' after for"; 920 stream >] -> 921 begin parser 922 | [< 923 start=parse_expr; 924 'Token.Kwd ',' ?? "expected ',' after for"; 925 end_=parse_expr; 926 stream >] -> 927 let step = 928 begin parser 929 | [< 'Token.Kwd ','; step=parse_expr >] -> Some step 930 | [< >] -> None 931 end stream 932 in 933 begin parser 934 | [< 'Token.In; body=parse_expr >] -> 935 Ast.For (id, start, end_, step, body) 936 | [< >] -> 937 raise (Stream.Error "expected 'in' after for") 938 end stream 939 | [< >] -> 940 raise (Stream.Error "expected '=' after for") 941 end stream 942 943 | [< >] -> raise (Stream.Error "unknown token when expecting an expression.") 944 945 (* unary 946 * ::= primary 947 * ::= '!' unary *) 948 and parse_unary = parser 949 (* If this is a unary operator, read it. *) 950 | [< 'Token.Kwd op when op != '(' && op != ')'; operand=parse_expr >] -> 951 Ast.Unary (op, operand) 952 953 (* If the current token is not an operator, it must be a primary expr. *) 954 | [< stream >] -> parse_primary stream 955 956 (* binoprhs 957 * ::= ('+' primary)* *) 958 and parse_bin_rhs expr_prec lhs stream = 959 match Stream.peek stream with 960 (* If this is a binop, find its precedence. *) 961 | Some (Token.Kwd c) when Hashtbl.mem binop_precedence c -> 962 let token_prec = precedence c in 963 964 (* If this is a binop that binds at least as tightly as the current binop, 965 * consume it, otherwise we are done. *) 966 if token_prec < expr_prec then lhs else begin 967 (* Eat the binop. *) 968 Stream.junk stream; 969 970 (* Parse the unary expression after the binary operator. *) 971 let rhs = parse_unary stream in 972 973 (* Okay, we know this is a binop. *) 974 let rhs = 975 match Stream.peek stream with 976 | Some (Token.Kwd c2) -> 977 (* If BinOp binds less tightly with rhs than the operator after 978 * rhs, let the pending operator take rhs as its lhs. *) 979 let next_prec = precedence c2 in 980 if token_prec < next_prec 981 then parse_bin_rhs (token_prec + 1) rhs stream 982 else rhs 983 | _ -> rhs 984 in 985 986 (* Merge lhs/rhs. *) 987 let lhs = Ast.Binary (c, lhs, rhs) in 988 parse_bin_rhs expr_prec lhs stream 989 end 990 | _ -> lhs 991 992 (* expression 993 * ::= primary binoprhs *) 994 and parse_expr = parser 995 | [< lhs=parse_unary; stream >] -> parse_bin_rhs 0 lhs stream 996 997 (* prototype 998 * ::= id '(' id* ')' 999 * ::= binary LETTER number? (id, id) 1000 * ::= unary LETTER number? (id) *) 1001 let parse_prototype = 1002 let rec parse_args accumulator = parser 1003 | [< 'Token.Ident id; e=parse_args (id::accumulator) >] -> e 1004 | [< >] -> accumulator 1005 in 1006 let parse_operator = parser 1007 | [< 'Token.Unary >] -> "unary", 1 1008 | [< 'Token.Binary >] -> "binary", 2 1009 in 1010 let parse_binary_precedence = parser 1011 | [< 'Token.Number n >] -> int_of_float n 1012 | [< >] -> 30 1013 in 1014 parser 1015 | [< 'Token.Ident id; 1016 'Token.Kwd '(' ?? "expected '(' in prototype"; 1017 args=parse_args []; 1018 'Token.Kwd ')' ?? "expected ')' in prototype" >] -> 1019 (* success. *) 1020 Ast.Prototype (id, Array.of_list (List.rev args)) 1021 | [< (prefix, kind)=parse_operator; 1022 'Token.Kwd op ?? "expected an operator"; 1023 (* Read the precedence if present. *) 1024 binary_precedence=parse_binary_precedence; 1025 'Token.Kwd '(' ?? "expected '(' in prototype"; 1026 args=parse_args []; 1027 'Token.Kwd ')' ?? "expected ')' in prototype" >] -> 1028 let name = prefix ^ (String.make 1 op) in 1029 let args = Array.of_list (List.rev args) in 1030 1031 (* Verify right number of arguments for operator. *) 1032 if Array.length args != kind 1033 then raise (Stream.Error "invalid number of operands for operator") 1034 else 1035 if kind == 1 then 1036 Ast.Prototype (name, args) 1037 else 1038 Ast.BinOpPrototype (name, args, binary_precedence) 1039 | [< >] -> 1040 raise (Stream.Error "expected function name in prototype") 1041 1042 (* definition ::= 'def' prototype expression *) 1043 let parse_definition = parser 1044 | [< 'Token.Def; p=parse_prototype; e=parse_expr >] -> 1045 Ast.Function (p, e) 1046 1047 (* toplevelexpr ::= expression *) 1048 let parse_toplevel = parser 1049 | [< e=parse_expr >] -> 1050 (* Make an anonymous proto. *) 1051 Ast.Function (Ast.Prototype ("", [||]), e) 1052 1053 (* external ::= 'extern' prototype *) 1054 let parse_extern = parser 1055 | [< 'Token.Extern; e=parse_prototype >] -> e 1056 1057 codegen.ml: 1058 .. code-block:: ocaml 1059 1060 (*===----------------------------------------------------------------------=== 1061 * Code Generation 1062 *===----------------------------------------------------------------------===*) 1063 1064 open Llvm 1065 1066 exception Error of string 1067 1068 let context = global_context () 1069 let the_module = create_module context "my cool jit" 1070 let builder = builder context 1071 let named_values:(string, llvalue) Hashtbl.t = Hashtbl.create 10 1072 let double_type = double_type context 1073 1074 let rec codegen_expr = function 1075 | Ast.Number n -> const_float double_type n 1076 | Ast.Variable name -> 1077 (try Hashtbl.find named_values name with 1078 | Not_found -> raise (Error "unknown variable name")) 1079 | Ast.Unary (op, operand) -> 1080 let operand = codegen_expr operand in 1081 let callee = "unary" ^ (String.make 1 op) in 1082 let callee = 1083 match lookup_function callee the_module with 1084 | Some callee -> callee 1085 | None -> raise (Error "unknown unary operator") 1086 in 1087 build_call callee [|operand|] "unop" builder 1088 | Ast.Binary (op, lhs, rhs) -> 1089 let lhs_val = codegen_expr lhs in 1090 let rhs_val = codegen_expr rhs in 1091 begin 1092 match op with 1093 | '+' -> build_add lhs_val rhs_val "addtmp" builder 1094 | '-' -> build_sub lhs_val rhs_val "subtmp" builder 1095 | '*' -> build_mul lhs_val rhs_val "multmp" builder 1096 | '<' -> 1097 (* Convert bool 0/1 to double 0.0 or 1.0 *) 1098 let i = build_fcmp Fcmp.Ult lhs_val rhs_val "cmptmp" builder in 1099 build_uitofp i double_type "booltmp" builder 1100 | _ -> 1101 (* If it wasn't a builtin binary operator, it must be a user defined 1102 * one. Emit a call to it. *) 1103 let callee = "binary" ^ (String.make 1 op) in 1104 let callee = 1105 match lookup_function callee the_module with 1106 | Some callee -> callee 1107 | None -> raise (Error "binary operator not found!") 1108 in 1109 build_call callee [|lhs_val; rhs_val|] "binop" builder 1110 end 1111 | Ast.Call (callee, args) -> 1112 (* Look up the name in the module table. *) 1113 let callee = 1114 match lookup_function callee the_module with 1115 | Some callee -> callee 1116 | None -> raise (Error "unknown function referenced") 1117 in 1118 let params = params callee in 1119 1120 (* If argument mismatch error. *) 1121 if Array.length params == Array.length args then () else 1122 raise (Error "incorrect # arguments passed"); 1123 let args = Array.map codegen_expr args in 1124 build_call callee args "calltmp" builder 1125 | Ast.If (cond, then_, else_) -> 1126 let cond = codegen_expr cond in 1127 1128 (* Convert condition to a bool by comparing equal to 0.0 *) 1129 let zero = const_float double_type 0.0 in 1130 let cond_val = build_fcmp Fcmp.One cond zero "ifcond" builder in 1131 1132 (* Grab the first block so that we might later add the conditional branch 1133 * to it at the end of the function. *) 1134 let start_bb = insertion_block builder in 1135 let the_function = block_parent start_bb in 1136 1137 let then_bb = append_block context "then" the_function in 1138 1139 (* Emit 'then' value. *) 1140 position_at_end then_bb builder; 1141 let then_val = codegen_expr then_ in 1142 1143 (* Codegen of 'then' can change the current block, update then_bb for the 1144 * phi. We create a new name because one is used for the phi node, and the 1145 * other is used for the conditional branch. *) 1146 let new_then_bb = insertion_block builder in 1147 1148 (* Emit 'else' value. *) 1149 let else_bb = append_block context "else" the_function in 1150 position_at_end else_bb builder; 1151 let else_val = codegen_expr else_ in 1152 1153 (* Codegen of 'else' can change the current block, update else_bb for the 1154 * phi. *) 1155 let new_else_bb = insertion_block builder in 1156 1157 (* Emit merge block. *) 1158 let merge_bb = append_block context "ifcont" the_function in 1159 position_at_end merge_bb builder; 1160 let incoming = [(then_val, new_then_bb); (else_val, new_else_bb)] in 1161 let phi = build_phi incoming "iftmp" builder in 1162 1163 (* Return to the start block to add the conditional branch. *) 1164 position_at_end start_bb builder; 1165 ignore (build_cond_br cond_val then_bb else_bb builder); 1166 1167 (* Set a unconditional branch at the end of the 'then' block and the 1168 * 'else' block to the 'merge' block. *) 1169 position_at_end new_then_bb builder; ignore (build_br merge_bb builder); 1170 position_at_end new_else_bb builder; ignore (build_br merge_bb builder); 1171 1172 (* Finally, set the builder to the end of the merge block. *) 1173 position_at_end merge_bb builder; 1174 1175 phi 1176 | Ast.For (var_name, start, end_, step, body) -> 1177 (* Emit the start code first, without 'variable' in scope. *) 1178 let start_val = codegen_expr start in 1179 1180 (* Make the new basic block for the loop header, inserting after current 1181 * block. *) 1182 let preheader_bb = insertion_block builder in 1183 let the_function = block_parent preheader_bb in 1184 let loop_bb = append_block context "loop" the_function in 1185 1186 (* Insert an explicit fall through from the current block to the 1187 * loop_bb. *) 1188 ignore (build_br loop_bb builder); 1189 1190 (* Start insertion in loop_bb. *) 1191 position_at_end loop_bb builder; 1192 1193 (* Start the PHI node with an entry for start. *) 1194 let variable = build_phi [(start_val, preheader_bb)] var_name builder in 1195 1196 (* Within the loop, the variable is defined equal to the PHI node. If it 1197 * shadows an existing variable, we have to restore it, so save it 1198 * now. *) 1199 let old_val = 1200 try Some (Hashtbl.find named_values var_name) with Not_found -> None 1201 in 1202 Hashtbl.add named_values var_name variable; 1203 1204 (* Emit the body of the loop. This, like any other expr, can change the 1205 * current BB. Note that we ignore the value computed by the body, but 1206 * don't allow an error *) 1207 ignore (codegen_expr body); 1208 1209 (* Emit the step value. *) 1210 let step_val = 1211 match step with 1212 | Some step -> codegen_expr step 1213 (* If not specified, use 1.0. *) 1214 | None -> const_float double_type 1.0 1215 in 1216 1217 let next_var = build_add variable step_val "nextvar" builder in 1218 1219 (* Compute the end condition. *) 1220 let end_cond = codegen_expr end_ in 1221 1222 (* Convert condition to a bool by comparing equal to 0.0. *) 1223 let zero = const_float double_type 0.0 in 1224 let end_cond = build_fcmp Fcmp.One end_cond zero "loopcond" builder in 1225 1226 (* Create the "after loop" block and insert it. *) 1227 let loop_end_bb = insertion_block builder in 1228 let after_bb = append_block context "afterloop" the_function in 1229 1230 (* Insert the conditional branch into the end of loop_end_bb. *) 1231 ignore (build_cond_br end_cond loop_bb after_bb builder); 1232 1233 (* Any new code will be inserted in after_bb. *) 1234 position_at_end after_bb builder; 1235 1236 (* Add a new entry to the PHI node for the backedge. *) 1237 add_incoming (next_var, loop_end_bb) variable; 1238 1239 (* Restore the unshadowed variable. *) 1240 begin match old_val with 1241 | Some old_val -> Hashtbl.add named_values var_name old_val 1242 | None -> () 1243 end; 1244 1245 (* for expr always returns 0.0. *) 1246 const_null double_type 1247 1248 let codegen_proto = function 1249 | Ast.Prototype (name, args) | Ast.BinOpPrototype (name, args, _) -> 1250 (* Make the function type: double(double,double) etc. *) 1251 let doubles = Array.make (Array.length args) double_type in 1252 let ft = function_type double_type doubles in 1253 let f = 1254 match lookup_function name the_module with 1255 | None -> declare_function name ft the_module 1256 1257 (* If 'f' conflicted, there was already something named 'name'. If it 1258 * has a body, don't allow redefinition or reextern. *) 1259 | Some f -> 1260 (* If 'f' already has a body, reject this. *) 1261 if block_begin f <> At_end f then 1262 raise (Error "redefinition of function"); 1263 1264 (* If 'f' took a different number of arguments, reject. *) 1265 if element_type (type_of f) <> ft then 1266 raise (Error "redefinition of function with different # args"); 1267 f 1268 in 1269 1270 (* Set names for all arguments. *) 1271 Array.iteri (fun i a -> 1272 let n = args.(i) in 1273 set_value_name n a; 1274 Hashtbl.add named_values n a; 1275 ) (params f); 1276 f 1277 1278 let codegen_func the_fpm = function 1279 | Ast.Function (proto, body) -> 1280 Hashtbl.clear named_values; 1281 let the_function = codegen_proto proto in 1282 1283 (* If this is an operator, install it. *) 1284 begin match proto with 1285 | Ast.BinOpPrototype (name, args, prec) -> 1286 let op = name.[String.length name - 1] in 1287 Hashtbl.add Parser.binop_precedence op prec; 1288 | _ -> () 1289 end; 1290 1291 (* Create a new basic block to start insertion into. *) 1292 let bb = append_block context "entry" the_function in 1293 position_at_end bb builder; 1294 1295 try 1296 let ret_val = codegen_expr body in 1297 1298 (* Finish off the function. *) 1299 let _ = build_ret ret_val builder in 1300 1301 (* Validate the generated code, checking for consistency. *) 1302 Llvm_analysis.assert_valid_function the_function; 1303 1304 (* Optimize the function. *) 1305 let _ = PassManager.run_function the_function the_fpm in 1306 1307 the_function 1308 with e -> 1309 delete_function the_function; 1310 raise e 1311 1312 toplevel.ml: 1313 .. code-block:: ocaml 1314 1315 (*===----------------------------------------------------------------------=== 1316 * Top-Level parsing and JIT Driver 1317 *===----------------------------------------------------------------------===*) 1318 1319 open Llvm 1320 open Llvm_executionengine 1321 1322 (* top ::= definition | external | expression | ';' *) 1323 let rec main_loop the_fpm the_execution_engine stream = 1324 match Stream.peek stream with 1325 | None -> () 1326 1327 (* ignore top-level semicolons. *) 1328 | Some (Token.Kwd ';') -> 1329 Stream.junk stream; 1330 main_loop the_fpm the_execution_engine stream 1331 1332 | Some token -> 1333 begin 1334 try match token with 1335 | Token.Def -> 1336 let e = Parser.parse_definition stream in 1337 print_endline "parsed a function definition."; 1338 dump_value (Codegen.codegen_func the_fpm e); 1339 | Token.Extern -> 1340 let e = Parser.parse_extern stream in 1341 print_endline "parsed an extern."; 1342 dump_value (Codegen.codegen_proto e); 1343 | _ -> 1344 (* Evaluate a top-level expression into an anonymous function. *) 1345 let e = Parser.parse_toplevel stream in 1346 print_endline "parsed a top-level expr"; 1347 let the_function = Codegen.codegen_func the_fpm e in 1348 dump_value the_function; 1349 1350 (* JIT the function, returning a function pointer. *) 1351 let result = ExecutionEngine.run_function the_function [||] 1352 the_execution_engine in 1353 1354 print_string "Evaluated to "; 1355 print_float (GenericValue.as_float Codegen.double_type result); 1356 print_newline (); 1357 with Stream.Error s | Codegen.Error s -> 1358 (* Skip token for error recovery. *) 1359 Stream.junk stream; 1360 print_endline s; 1361 end; 1362 print_string "ready> "; flush stdout; 1363 main_loop the_fpm the_execution_engine stream 1364 1365 toy.ml: 1366 .. code-block:: ocaml 1367 1368 (*===----------------------------------------------------------------------=== 1369 * Main driver code. 1370 *===----------------------------------------------------------------------===*) 1371 1372 open Llvm 1373 open Llvm_executionengine 1374 open Llvm_target 1375 open Llvm_scalar_opts 1376 1377 let main () = 1378 ignore (initialize_native_target ()); 1379 1380 (* Install standard binary operators. 1381 * 1 is the lowest precedence. *) 1382 Hashtbl.add Parser.binop_precedence '<' 10; 1383 Hashtbl.add Parser.binop_precedence '+' 20; 1384 Hashtbl.add Parser.binop_precedence '-' 20; 1385 Hashtbl.add Parser.binop_precedence '*' 40; (* highest. *) 1386 1387 (* Prime the first token. *) 1388 print_string "ready> "; flush stdout; 1389 let stream = Lexer.lex (Stream.of_channel stdin) in 1390 1391 (* Create the JIT. *) 1392 let the_execution_engine = ExecutionEngine.create Codegen.the_module in 1393 let the_fpm = PassManager.create_function Codegen.the_module in 1394 1395 (* Set up the optimizer pipeline. Start with registering info about how the 1396 * target lays out data structures. *) 1397 DataLayout.add (ExecutionEngine.target_data the_execution_engine) the_fpm; 1398 1399 (* Do simple "peephole" optimizations and bit-twiddling optzn. *) 1400 add_instruction_combination the_fpm; 1401 1402 (* reassociate expressions. *) 1403 add_reassociation the_fpm; 1404 1405 (* Eliminate Common SubExpressions. *) 1406 add_gvn the_fpm; 1407 1408 (* Simplify the control flow graph (deleting unreachable blocks, etc). *) 1409 add_cfg_simplification the_fpm; 1410 1411 ignore (PassManager.initialize the_fpm); 1412 1413 (* Run the main "interpreter loop" now. *) 1414 Toplevel.main_loop the_fpm the_execution_engine stream; 1415 1416 (* Print out all the generated code. *) 1417 dump_module Codegen.the_module 1418 ;; 1419 1420 main () 1421 1422 bindings.c 1423 .. code-block:: c 1424 1425 #include <stdio.h> 1426 1427 /* putchard - putchar that takes a double and returns 0. */ 1428 extern double putchard(double X) { 1429 putchar((char)X); 1430 return 0; 1431 } 1432 1433 /* printd - printf that takes a double prints it as "%f\n", returning 0. */ 1434 extern double printd(double X) { 1435 printf("%f\n", X); 1436 return 0; 1437 } 1438 1439 `Next: Extending the language: mutable variables / SSA 1440 construction <OCamlLangImpl7.html>`_ 1441 1442
