constify the getters in SDNodeDbgValue.
[oota-llvm.git] / docs / tutorial / OCamlLangImpl7.rst
1 =======================================================
2 Kaleidoscope: Extending the Language: Mutable Variables
3 =======================================================
4
5 .. contents::
6    :local:
7
8 Chapter 7 Introduction
9 ======================
10
11 Welcome to Chapter 7 of the "`Implementing a language with
12 LLVM <index.html>`_" tutorial. In chapters 1 through 6, we've built a
13 very respectable, albeit simple, `functional programming
14 language <http://en.wikipedia.org/wiki/Functional_programming>`_. In our
15 journey, we learned some parsing techniques, how to build and represent
16 an AST, how to build LLVM IR, and how to optimize the resultant code as
17 well as JIT compile it.
18
19 While Kaleidoscope is interesting as a functional language, the fact
20 that it is functional makes it "too easy" to generate LLVM IR for it. In
21 particular, a functional language makes it very easy to build LLVM IR
22 directly in `SSA
23 form <http://en.wikipedia.org/wiki/Static_single_assignment_form>`_.
24 Since LLVM requires that the input code be in SSA form, this is a very
25 nice property and it is often unclear to newcomers how to generate code
26 for an imperative language with mutable variables.
27
28 The short (and happy) summary of this chapter is that there is no need
29 for your front-end to build SSA form: LLVM provides highly tuned and
30 well tested support for this, though the way it works is a bit
31 unexpected for some.
32
33 Why is this a hard problem?
34 ===========================
35
36 To understand why mutable variables cause complexities in SSA
37 construction, consider this extremely simple C example:
38
39 .. code-block:: c
40
41     int G, H;
42     int test(_Bool Condition) {
43       int X;
44       if (Condition)
45         X = G;
46       else
47         X = H;
48       return X;
49     }
50
51 In this case, we have the variable "X", whose value depends on the path
52 executed in the program. Because there are two different possible values
53 for X before the return instruction, a PHI node is inserted to merge the
54 two values. The LLVM IR that we want for this example looks like this:
55
56 .. code-block:: llvm
57
58     @G = weak global i32 0   ; type of @G is i32*
59     @H = weak global i32 0   ; type of @H is i32*
60
61     define i32 @test(i1 %Condition) {
62     entry:
63       br i1 %Condition, label %cond_true, label %cond_false
64
65     cond_true:
66       %X.0 = load i32* @G
67       br label %cond_next
68
69     cond_false:
70       %X.1 = load i32* @H
71       br label %cond_next
72
73     cond_next:
74       %X.2 = phi i32 [ %X.1, %cond_false ], [ %X.0, %cond_true ]
75       ret i32 %X.2
76     }
77
78 In this example, the loads from the G and H global variables are
79 explicit in the LLVM IR, and they live in the then/else branches of the
80 if statement (cond\_true/cond\_false). In order to merge the incoming
81 values, the X.2 phi node in the cond\_next block selects the right value
82 to use based on where control flow is coming from: if control flow comes
83 from the cond\_false block, X.2 gets the value of X.1. Alternatively, if
84 control flow comes from cond\_true, it gets the value of X.0. The intent
85 of this chapter is not to explain the details of SSA form. For more
86 information, see one of the many `online
87 references <http://en.wikipedia.org/wiki/Static_single_assignment_form>`_.
88
89 The question for this article is "who places the phi nodes when lowering
90 assignments to mutable variables?". The issue here is that LLVM
91 *requires* that its IR be in SSA form: there is no "non-ssa" mode for
92 it. However, SSA construction requires non-trivial algorithms and data
93 structures, so it is inconvenient and wasteful for every front-end to
94 have to reproduce this logic.
95
96 Memory in LLVM
97 ==============
98
99 The 'trick' here is that while LLVM does require all register values to
100 be in SSA form, it does not require (or permit) memory objects to be in
101 SSA form. In the example above, note that the loads from G and H are
102 direct accesses to G and H: they are not renamed or versioned. This
103 differs from some other compiler systems, which do try to version memory
104 objects. In LLVM, instead of encoding dataflow analysis of memory into
105 the LLVM IR, it is handled with `Analysis
106 Passes <../WritingAnLLVMPass.html>`_ which are computed on demand.
107
108 With this in mind, the high-level idea is that we want to make a stack
109 variable (which lives in memory, because it is on the stack) for each
110 mutable object in a function. To take advantage of this trick, we need
111 to talk about how LLVM represents stack variables.
112
113 In LLVM, all memory accesses are explicit with load/store instructions,
114 and it is carefully designed not to have (or need) an "address-of"
115 operator. Notice how the type of the @G/@H global variables is actually
116 "i32\*" even though the variable is defined as "i32". What this means is
117 that @G defines *space* for an i32 in the global data area, but its
118 *name* actually refers to the address for that space. Stack variables
119 work the same way, except that instead of being declared with global
120 variable definitions, they are declared with the `LLVM alloca
121 instruction <../LangRef.html#i_alloca>`_:
122
123 .. code-block:: llvm
124
125     define i32 @example() {
126     entry:
127       %X = alloca i32           ; type of %X is i32*.
128       ...
129       %tmp = load i32* %X       ; load the stack value %X from the stack.
130       %tmp2 = add i32 %tmp, 1   ; increment it
131       store i32 %tmp2, i32* %X  ; store it back
132       ...
133
134 This code shows an example of how you can declare and manipulate a stack
135 variable in the LLVM IR. Stack memory allocated with the alloca
136 instruction is fully general: you can pass the address of the stack slot
137 to functions, you can store it in other variables, etc. In our example
138 above, we could rewrite the example to use the alloca technique to avoid
139 using a PHI node:
140
141 .. code-block:: llvm
142
143     @G = weak global i32 0   ; type of @G is i32*
144     @H = weak global i32 0   ; type of @H is i32*
145
146     define i32 @test(i1 %Condition) {
147     entry:
148       %X = alloca i32           ; type of %X is i32*.
149       br i1 %Condition, label %cond_true, label %cond_false
150
151     cond_true:
152       %X.0 = load i32* @G
153             store i32 %X.0, i32* %X   ; Update X
154       br label %cond_next
155
156     cond_false:
157       %X.1 = load i32* @H
158             store i32 %X.1, i32* %X   ; Update X
159       br label %cond_next
160
161     cond_next:
162       %X.2 = load i32* %X       ; Read X
163       ret i32 %X.2
164     }
165
166 With this, we have discovered a way to handle arbitrary mutable
167 variables without the need to create Phi nodes at all:
168
169 #. Each mutable variable becomes a stack allocation.
170 #. Each read of the variable becomes a load from the stack.
171 #. Each update of the variable becomes a store to the stack.
172 #. Taking the address of a variable just uses the stack address
173    directly.
174
175 While this solution has solved our immediate problem, it introduced
176 another one: we have now apparently introduced a lot of stack traffic
177 for very simple and common operations, a major performance problem.
178 Fortunately for us, the LLVM optimizer has a highly-tuned optimization
179 pass named "mem2reg" that handles this case, promoting allocas like this
180 into SSA registers, inserting Phi nodes as appropriate. If you run this
181 example through the pass, for example, you'll get:
182
183 .. code-block:: bash
184
185     $ llvm-as < example.ll | opt -mem2reg | llvm-dis
186     @G = weak global i32 0
187     @H = weak global i32 0
188
189     define i32 @test(i1 %Condition) {
190     entry:
191       br i1 %Condition, label %cond_true, label %cond_false
192
193     cond_true:
194       %X.0 = load i32* @G
195       br label %cond_next
196
197     cond_false:
198       %X.1 = load i32* @H
199       br label %cond_next
200
201     cond_next:
202       %X.01 = phi i32 [ %X.1, %cond_false ], [ %X.0, %cond_true ]
203       ret i32 %X.01
204     }
205
206 The mem2reg pass implements the standard "iterated dominance frontier"
207 algorithm for constructing SSA form and has a number of optimizations
208 that speed up (very common) degenerate cases. The mem2reg optimization
209 pass is the answer to dealing with mutable variables, and we highly
210 recommend that you depend on it. Note that mem2reg only works on
211 variables in certain circumstances:
212
213 #. mem2reg is alloca-driven: it looks for allocas and if it can handle
214    them, it promotes them. It does not apply to global variables or heap
215    allocations.
216 #. mem2reg only looks for alloca instructions in the entry block of the
217    function. Being in the entry block guarantees that the alloca is only
218    executed once, which makes analysis simpler.
219 #. mem2reg only promotes allocas whose uses are direct loads and stores.
220    If the address of the stack object is passed to a function, or if any
221    funny pointer arithmetic is involved, the alloca will not be
222    promoted.
223 #. mem2reg only works on allocas of `first
224    class <../LangRef.html#t_classifications>`_ values (such as pointers,
225    scalars and vectors), and only if the array size of the allocation is
226    1 (or missing in the .ll file). mem2reg is not capable of promoting
227    structs or arrays to registers. Note that the "scalarrepl" pass is
228    more powerful and can promote structs, "unions", and arrays in many
229    cases.
230
231 All of these properties are easy to satisfy for most imperative
232 languages, and we'll illustrate it below with Kaleidoscope. The final
233 question you may be asking is: should I bother with this nonsense for my
234 front-end? Wouldn't it be better if I just did SSA construction
235 directly, avoiding use of the mem2reg optimization pass? In short, we
236 strongly recommend that you use this technique for building SSA form,
237 unless there is an extremely good reason not to. Using this technique
238 is:
239
240 -  Proven and well tested: clang uses this technique
241    for local mutable variables. As such, the most common clients of LLVM
242    are using this to handle a bulk of their variables. You can be sure
243    that bugs are found fast and fixed early.
244 -  Extremely Fast: mem2reg has a number of special cases that make it
245    fast in common cases as well as fully general. For example, it has
246    fast-paths for variables that are only used in a single block,
247    variables that only have one assignment point, good heuristics to
248    avoid insertion of unneeded phi nodes, etc.
249 -  Needed for debug info generation: `Debug information in
250    LLVM <../SourceLevelDebugging.html>`_ relies on having the address of
251    the variable exposed so that debug info can be attached to it. This
252    technique dovetails very naturally with this style of debug info.
253
254 If nothing else, this makes it much easier to get your front-end up and
255 running, and is very simple to implement. Lets extend Kaleidoscope with
256 mutable variables now!
257
258 Mutable Variables in Kaleidoscope
259 =================================
260
261 Now that we know the sort of problem we want to tackle, lets see what
262 this looks like in the context of our little Kaleidoscope language.
263 We're going to add two features:
264
265 #. The ability to mutate variables with the '=' operator.
266 #. The ability to define new variables.
267
268 While the first item is really what this is about, we only have
269 variables for incoming arguments as well as for induction variables, and
270 redefining those only goes so far :). Also, the ability to define new
271 variables is a useful thing regardless of whether you will be mutating
272 them. Here's a motivating example that shows how we could use these:
273
274 ::
275
276     # Define ':' for sequencing: as a low-precedence operator that ignores operands
277     # and just returns the RHS.
278     def binary : 1 (x y) y;
279
280     # Recursive fib, we could do this before.
281     def fib(x)
282       if (x < 3) then
283         1
284       else
285         fib(x-1)+fib(x-2);
286
287     # Iterative fib.
288     def fibi(x)
289       var a = 1, b = 1, c in
290       (for i = 3, i < x in
291          c = a + b :
292          a = b :
293          b = c) :
294       b;
295
296     # Call it.
297     fibi(10);
298
299 In order to mutate variables, we have to change our existing variables
300 to use the "alloca trick". Once we have that, we'll add our new
301 operator, then extend Kaleidoscope to support new variable definitions.
302
303 Adjusting Existing Variables for Mutation
304 =========================================
305
306 The symbol table in Kaleidoscope is managed at code generation time by
307 the '``named_values``' map. This map currently keeps track of the LLVM
308 "Value\*" that holds the double value for the named variable. In order
309 to support mutation, we need to change this slightly, so that it
310 ``named_values`` holds the *memory location* of the variable in
311 question. Note that this change is a refactoring: it changes the
312 structure of the code, but does not (by itself) change the behavior of
313 the compiler. All of these changes are isolated in the Kaleidoscope code
314 generator.
315
316 At this point in Kaleidoscope's development, it only supports variables
317 for two things: incoming arguments to functions and the induction
318 variable of 'for' loops. For consistency, we'll allow mutation of these
319 variables in addition to other user-defined variables. This means that
320 these will both need memory locations.
321
322 To start our transformation of Kaleidoscope, we'll change the
323 ``named_values`` map so that it maps to AllocaInst\* instead of Value\*.
324 Once we do this, the C++ compiler will tell us what parts of the code we
325 need to update:
326
327 **Note:** the ocaml bindings currently model both ``Value*``'s and
328 ``AllocInst*``'s as ``Llvm.llvalue``'s, but this may change in the future
329 to be more type safe.
330
331 .. code-block:: ocaml
332
333     let named_values:(string, llvalue) Hashtbl.t = Hashtbl.create 10
334
335 Also, since we will need to create these alloca's, we'll use a helper
336 function that ensures that the allocas are created in the entry block of
337 the function:
338
339 .. code-block:: ocaml
340
341     (* Create an alloca instruction in the entry block of the function. This
342      * is used for mutable variables etc. *)
343     let create_entry_block_alloca the_function var_name =
344       let builder = builder_at (instr_begin (entry_block the_function)) in
345       build_alloca double_type var_name builder
346
347 This funny looking code creates an ``Llvm.llbuilder`` object that is
348 pointing at the first instruction of the entry block. It then creates an
349 alloca with the expected name and returns it. Because all values in
350 Kaleidoscope are doubles, there is no need to pass in a type to use.
351
352 With this in place, the first functionality change we want to make is to
353 variable references. In our new scheme, variables live on the stack, so
354 code generating a reference to them actually needs to produce a load
355 from the stack slot:
356
357 .. code-block:: ocaml
358
359     let rec codegen_expr = function
360       ...
361       | Ast.Variable name ->
362           let v = try Hashtbl.find named_values name with
363             | Not_found -> raise (Error "unknown variable name")
364           in
365           (* Load the value. *)
366           build_load v name builder
367
368 As you can see, this is pretty straightforward. Now we need to update
369 the things that define the variables to set up the alloca. We'll start
370 with ``codegen_expr Ast.For ...`` (see the `full code listing <#code>`_
371 for the unabridged code):
372
373 .. code-block:: ocaml
374
375       | Ast.For (var_name, start, end_, step, body) ->
376           let the_function = block_parent (insertion_block builder) in
377
378           (* Create an alloca for the variable in the entry block. *)
379           let alloca = create_entry_block_alloca the_function var_name in
380
381           (* Emit the start code first, without 'variable' in scope. *)
382           let start_val = codegen_expr start in
383
384           (* Store the value into the alloca. *)
385           ignore(build_store start_val alloca builder);
386
387           ...
388
389           (* Within the loop, the variable is defined equal to the PHI node. If it
390            * shadows an existing variable, we have to restore it, so save it
391            * now. *)
392           let old_val =
393             try Some (Hashtbl.find named_values var_name) with Not_found -> None
394           in
395           Hashtbl.add named_values var_name alloca;
396
397           ...
398
399           (* Compute the end condition. *)
400           let end_cond = codegen_expr end_ in
401
402           (* Reload, increment, and restore the alloca. This handles the case where
403            * the body of the loop mutates the variable. *)
404           let cur_var = build_load alloca var_name builder in
405           let next_var = build_add cur_var step_val "nextvar" builder in
406           ignore(build_store next_var alloca builder);
407           ...
408
409 This code is virtually identical to the code `before we allowed mutable
410 variables <OCamlLangImpl5.html#forcodegen>`_. The big difference is that
411 we no longer have to construct a PHI node, and we use load/store to
412 access the variable as needed.
413
414 To support mutable argument variables, we need to also make allocas for
415 them. The code for this is also pretty simple:
416
417 .. code-block:: ocaml
418
419     (* Create an alloca for each argument and register the argument in the symbol
420      * table so that references to it will succeed. *)
421     let create_argument_allocas the_function proto =
422       let args = match proto with
423         | Ast.Prototype (_, args) | Ast.BinOpPrototype (_, args, _) -> args
424       in
425       Array.iteri (fun i ai ->
426         let var_name = args.(i) in
427         (* Create an alloca for this variable. *)
428         let alloca = create_entry_block_alloca the_function var_name in
429
430         (* Store the initial value into the alloca. *)
431         ignore(build_store ai alloca builder);
432
433         (* Add arguments to variable symbol table. *)
434         Hashtbl.add named_values var_name alloca;
435       ) (params the_function)
436
437 For each argument, we make an alloca, store the input value to the
438 function into the alloca, and register the alloca as the memory location
439 for the argument. This method gets invoked by ``Codegen.codegen_func``
440 right after it sets up the entry block for the function.
441
442 The final missing piece is adding the mem2reg pass, which allows us to
443 get good codegen once again:
444
445 .. code-block:: ocaml
446
447     let main () =
448       ...
449       let the_fpm = PassManager.create_function Codegen.the_module in
450
451       (* Set up the optimizer pipeline.  Start with registering info about how the
452        * target lays out data structures. *)
453       DataLayout.add (ExecutionEngine.target_data the_execution_engine) the_fpm;
454
455       (* Promote allocas to registers. *)
456       add_memory_to_register_promotion the_fpm;
457
458       (* Do simple "peephole" optimizations and bit-twiddling optzn. *)
459       add_instruction_combining the_fpm;
460
461       (* reassociate expressions. *)
462       add_reassociation the_fpm;
463
464 It is interesting to see what the code looks like before and after the
465 mem2reg optimization runs. For example, this is the before/after code
466 for our recursive fib function. Before the optimization:
467
468 .. code-block:: llvm
469
470     define double @fib(double %x) {
471     entry:
472       %x1 = alloca double
473       store double %x, double* %x1
474       %x2 = load double* %x1
475       %cmptmp = fcmp ult double %x2, 3.000000e+00
476       %booltmp = uitofp i1 %cmptmp to double
477       %ifcond = fcmp one double %booltmp, 0.000000e+00
478       br i1 %ifcond, label %then, label %else
479
480     then:    ; preds = %entry
481       br label %ifcont
482
483     else:    ; preds = %entry
484       %x3 = load double* %x1
485       %subtmp = fsub double %x3, 1.000000e+00
486       %calltmp = call double @fib(double %subtmp)
487       %x4 = load double* %x1
488       %subtmp5 = fsub double %x4, 2.000000e+00
489       %calltmp6 = call double @fib(double %subtmp5)
490       %addtmp = fadd double %calltmp, %calltmp6
491       br label %ifcont
492
493     ifcont:    ; preds = %else, %then
494       %iftmp = phi double [ 1.000000e+00, %then ], [ %addtmp, %else ]
495       ret double %iftmp
496     }
497
498 Here there is only one variable (x, the input argument) but you can
499 still see the extremely simple-minded code generation strategy we are
500 using. In the entry block, an alloca is created, and the initial input
501 value is stored into it. Each reference to the variable does a reload
502 from the stack. Also, note that we didn't modify the if/then/else
503 expression, so it still inserts a PHI node. While we could make an
504 alloca for it, it is actually easier to create a PHI node for it, so we
505 still just make the PHI.
506
507 Here is the code after the mem2reg pass runs:
508
509 .. code-block:: llvm
510
511     define double @fib(double %x) {
512     entry:
513       %cmptmp = fcmp ult double %x, 3.000000e+00
514       %booltmp = uitofp i1 %cmptmp to double
515       %ifcond = fcmp one double %booltmp, 0.000000e+00
516       br i1 %ifcond, label %then, label %else
517
518     then:
519       br label %ifcont
520
521     else:
522       %subtmp = fsub double %x, 1.000000e+00
523       %calltmp = call double @fib(double %subtmp)
524       %subtmp5 = fsub double %x, 2.000000e+00
525       %calltmp6 = call double @fib(double %subtmp5)
526       %addtmp = fadd double %calltmp, %calltmp6
527       br label %ifcont
528
529     ifcont:    ; preds = %else, %then
530       %iftmp = phi double [ 1.000000e+00, %then ], [ %addtmp, %else ]
531       ret double %iftmp
532     }
533
534 This is a trivial case for mem2reg, since there are no redefinitions of
535 the variable. The point of showing this is to calm your tension about
536 inserting such blatent inefficiencies :).
537
538 After the rest of the optimizers run, we get:
539
540 .. code-block:: llvm
541
542     define double @fib(double %x) {
543     entry:
544       %cmptmp = fcmp ult double %x, 3.000000e+00
545       %booltmp = uitofp i1 %cmptmp to double
546       %ifcond = fcmp ueq double %booltmp, 0.000000e+00
547       br i1 %ifcond, label %else, label %ifcont
548
549     else:
550       %subtmp = fsub double %x, 1.000000e+00
551       %calltmp = call double @fib(double %subtmp)
552       %subtmp5 = fsub double %x, 2.000000e+00
553       %calltmp6 = call double @fib(double %subtmp5)
554       %addtmp = fadd double %calltmp, %calltmp6
555       ret double %addtmp
556
557     ifcont:
558       ret double 1.000000e+00
559     }
560
561 Here we see that the simplifycfg pass decided to clone the return
562 instruction into the end of the 'else' block. This allowed it to
563 eliminate some branches and the PHI node.
564
565 Now that all symbol table references are updated to use stack variables,
566 we'll add the assignment operator.
567
568 New Assignment Operator
569 =======================
570
571 With our current framework, adding a new assignment operator is really
572 simple. We will parse it just like any other binary operator, but handle
573 it internally (instead of allowing the user to define it). The first
574 step is to set a precedence:
575
576 .. code-block:: ocaml
577
578     let main () =
579       (* Install standard binary operators.
580        * 1 is the lowest precedence. *)
581       Hashtbl.add Parser.binop_precedence '=' 2;
582       Hashtbl.add Parser.binop_precedence '<' 10;
583       Hashtbl.add Parser.binop_precedence '+' 20;
584       Hashtbl.add Parser.binop_precedence '-' 20;
585       ...
586
587 Now that the parser knows the precedence of the binary operator, it
588 takes care of all the parsing and AST generation. We just need to
589 implement codegen for the assignment operator. This looks like:
590
591 .. code-block:: ocaml
592
593     let rec codegen_expr = function
594           begin match op with
595           | '=' ->
596               (* Special case '=' because we don't want to emit the LHS as an
597                * expression. *)
598               let name =
599                 match lhs with
600                 | Ast.Variable name -> name
601                 | _ -> raise (Error "destination of '=' must be a variable")
602               in
603
604 Unlike the rest of the binary operators, our assignment operator doesn't
605 follow the "emit LHS, emit RHS, do computation" model. As such, it is
606 handled as a special case before the other binary operators are handled.
607 The other strange thing is that it requires the LHS to be a variable. It
608 is invalid to have "(x+1) = expr" - only things like "x = expr" are
609 allowed.
610
611 .. code-block:: ocaml
612
613               (* Codegen the rhs. *)
614               let val_ = codegen_expr rhs in
615
616               (* Lookup the name. *)
617               let variable = try Hashtbl.find named_values name with
618               | Not_found -> raise (Error "unknown variable name")
619               in
620               ignore(build_store val_ variable builder);
621               val_
622           | _ ->
623                 ...
624
625 Once we have the variable, codegen'ing the assignment is
626 straightforward: we emit the RHS of the assignment, create a store, and
627 return the computed value. Returning a value allows for chained
628 assignments like "X = (Y = Z)".
629
630 Now that we have an assignment operator, we can mutate loop variables
631 and arguments. For example, we can now run code like this:
632
633 ::
634
635     # Function to print a double.
636     extern printd(x);
637
638     # Define ':' for sequencing: as a low-precedence operator that ignores operands
639     # and just returns the RHS.
640     def binary : 1 (x y) y;
641
642     def test(x)
643       printd(x) :
644       x = 4 :
645       printd(x);
646
647     test(123);
648
649 When run, this example prints "123" and then "4", showing that we did
650 actually mutate the value! Okay, we have now officially implemented our
651 goal: getting this to work requires SSA construction in the general
652 case. However, to be really useful, we want the ability to define our
653 own local variables, lets add this next!
654
655 User-defined Local Variables
656 ============================
657
658 Adding var/in is just like any other other extensions we made to
659 Kaleidoscope: we extend the lexer, the parser, the AST and the code
660 generator. The first step for adding our new 'var/in' construct is to
661 extend the lexer. As before, this is pretty trivial, the code looks like
662 this:
663
664 .. code-block:: ocaml
665
666     type token =
667       ...
668       (* var definition *)
669       | Var
670
671     ...
672
673     and lex_ident buffer = parser
674           ...
675           | "in" -> [< 'Token.In; stream >]
676           | "binary" -> [< 'Token.Binary; stream >]
677           | "unary" -> [< 'Token.Unary; stream >]
678           | "var" -> [< 'Token.Var; stream >]
679           ...
680
681 The next step is to define the AST node that we will construct. For
682 var/in, it looks like this:
683
684 .. code-block:: ocaml
685
686     type expr =
687       ...
688       (* variant for var/in. *)
689       | Var of (string * expr option) array * expr
690       ...
691
692 var/in allows a list of names to be defined all at once, and each name
693 can optionally have an initializer value. As such, we capture this
694 information in the VarNames vector. Also, var/in has a body, this body
695 is allowed to access the variables defined by the var/in.
696
697 With this in place, we can define the parser pieces. The first thing we
698 do is add it as a primary expression:
699
700 .. code-block:: ocaml
701
702     (* primary
703      *   ::= identifier
704      *   ::= numberexpr
705      *   ::= parenexpr
706      *   ::= ifexpr
707      *   ::= forexpr
708      *   ::= varexpr *)
709     let rec parse_primary = parser
710       ...
711       (* varexpr
712        *   ::= 'var' identifier ('=' expression?
713        *             (',' identifier ('=' expression)?)* 'in' expression *)
714       | [< 'Token.Var;
715            (* At least one variable name is required. *)
716            'Token.Ident id ?? "expected identifier after var";
717            init=parse_var_init;
718            var_names=parse_var_names [(id, init)];
719            (* At this point, we have to have 'in'. *)
720            'Token.In ?? "expected 'in' keyword after 'var'";
721            body=parse_expr >] ->
722           Ast.Var (Array.of_list (List.rev var_names), body)
723
724     ...
725
726     and parse_var_init = parser
727       (* read in the optional initializer. *)
728       | [< 'Token.Kwd '='; e=parse_expr >] -> Some e
729       | [< >] -> None
730
731     and parse_var_names accumulator = parser
732       | [< 'Token.Kwd ',';
733            'Token.Ident id ?? "expected identifier list after var";
734            init=parse_var_init;
735            e=parse_var_names ((id, init) :: accumulator) >] -> e
736       | [< >] -> accumulator
737
738 Now that we can parse and represent the code, we need to support
739 emission of LLVM IR for it. This code starts out with:
740
741 .. code-block:: ocaml
742
743     let rec codegen_expr = function
744       ...
745       | Ast.Var (var_names, body)
746           let old_bindings = ref [] in
747
748           let the_function = block_parent (insertion_block builder) in
749
750           (* Register all variables and emit their initializer. *)
751           Array.iter (fun (var_name, init) ->
752
753 Basically it loops over all the variables, installing them one at a
754 time. For each variable we put into the symbol table, we remember the
755 previous value that we replace in OldBindings.
756
757 .. code-block:: ocaml
758
759             (* Emit the initializer before adding the variable to scope, this
760              * prevents the initializer from referencing the variable itself, and
761              * permits stuff like this:
762              *   var a = 1 in
763              *     var a = a in ...   # refers to outer 'a'. *)
764             let init_val =
765               match init with
766               | Some init -> codegen_expr init
767               (* If not specified, use 0.0. *)
768               | None -> const_float double_type 0.0
769             in
770
771             let alloca = create_entry_block_alloca the_function var_name in
772             ignore(build_store init_val alloca builder);
773
774             (* Remember the old variable binding so that we can restore the binding
775              * when we unrecurse. *)
776
777             begin
778               try
779                 let old_value = Hashtbl.find named_values var_name in
780                 old_bindings := (var_name, old_value) :: !old_bindings;
781               with Not_found > ()
782             end;
783
784             (* Remember this binding. *)
785             Hashtbl.add named_values var_name alloca;
786           ) var_names;
787
788 There are more comments here than code. The basic idea is that we emit
789 the initializer, create the alloca, then update the symbol table to
790 point to it. Once all the variables are installed in the symbol table,
791 we evaluate the body of the var/in expression:
792
793 .. code-block:: ocaml
794
795           (* Codegen the body, now that all vars are in scope. *)
796           let body_val = codegen_expr body in
797
798 Finally, before returning, we restore the previous variable bindings:
799
800 .. code-block:: ocaml
801
802           (* Pop all our variables from scope. *)
803           List.iter (fun (var_name, old_value) ->
804             Hashtbl.add named_values var_name old_value
805           ) !old_bindings;
806
807           (* Return the body computation. *)
808           body_val
809
810 The end result of all of this is that we get properly scoped variable
811 definitions, and we even (trivially) allow mutation of them :).
812
813 With this, we completed what we set out to do. Our nice iterative fib
814 example from the intro compiles and runs just fine. The mem2reg pass
815 optimizes all of our stack variables into SSA registers, inserting PHI
816 nodes where needed, and our front-end remains simple: no "iterated
817 dominance frontier" computation anywhere in sight.
818
819 Full Code Listing
820 =================
821
822 Here is the complete code listing for our running example, enhanced with
823 mutable variables and var/in support. To build this example, use:
824
825 .. code-block:: bash
826
827     # Compile
828     ocamlbuild toy.byte
829     # Run
830     ./toy.byte
831
832 Here is the code:
833
834 \_tags:
835     ::
836
837         <{lexer,parser}.ml>: use_camlp4, pp(camlp4of)
838         <*.{byte,native}>: g++, use_llvm, use_llvm_analysis
839         <*.{byte,native}>: use_llvm_executionengine, use_llvm_target
840         <*.{byte,native}>: use_llvm_scalar_opts, use_bindings
841
842 myocamlbuild.ml:
843     .. code-block:: ocaml
844
845         open Ocamlbuild_plugin;;
846
847         ocaml_lib ~extern:true "llvm";;
848         ocaml_lib ~extern:true "llvm_analysis";;
849         ocaml_lib ~extern:true "llvm_executionengine";;
850         ocaml_lib ~extern:true "llvm_target";;
851         ocaml_lib ~extern:true "llvm_scalar_opts";;
852
853         flag ["link"; "ocaml"; "g++"] (S[A"-cc"; A"g++"; A"-cclib"; A"-rdynamic"]);;
854         dep ["link"; "ocaml"; "use_bindings"] ["bindings.o"];;
855
856 token.ml:
857     .. code-block:: ocaml
858
859         (*===----------------------------------------------------------------------===
860          * Lexer Tokens
861          *===----------------------------------------------------------------------===*)
862
863         (* The lexer returns these 'Kwd' if it is an unknown character, otherwise one of
864          * these others for known things. *)
865         type token =
866           (* commands *)
867           | Def | Extern
868
869           (* primary *)
870           | Ident of string | Number of float
871
872           (* unknown *)
873           | Kwd of char
874
875           (* control *)
876           | If | Then | Else
877           | For | In
878
879           (* operators *)
880           | Binary | Unary
881
882           (* var definition *)
883           | Var
884
885 lexer.ml:
886     .. code-block:: ocaml
887
888         (*===----------------------------------------------------------------------===
889          * Lexer
890          *===----------------------------------------------------------------------===*)
891
892         let rec lex = parser
893           (* Skip any whitespace. *)
894           | [< ' (' ' | '\n' | '\r' | '\t'); stream >] -> lex stream
895
896           (* identifier: [a-zA-Z][a-zA-Z0-9] *)
897           | [< ' ('A' .. 'Z' | 'a' .. 'z' as c); stream >] ->
898               let buffer = Buffer.create 1 in
899               Buffer.add_char buffer c;
900               lex_ident buffer stream
901
902           (* number: [0-9.]+ *)
903           | [< ' ('0' .. '9' as c); stream >] ->
904               let buffer = Buffer.create 1 in
905               Buffer.add_char buffer c;
906               lex_number buffer stream
907
908           (* Comment until end of line. *)
909           | [< ' ('#'); stream >] ->
910               lex_comment stream
911
912           (* Otherwise, just return the character as its ascii value. *)
913           | [< 'c; stream >] ->
914               [< 'Token.Kwd c; lex stream >]
915
916           (* end of stream. *)
917           | [< >] -> [< >]
918
919         and lex_number buffer = parser
920           | [< ' ('0' .. '9' | '.' as c); stream >] ->
921               Buffer.add_char buffer c;
922               lex_number buffer stream
923           | [< stream=lex >] ->
924               [< 'Token.Number (float_of_string (Buffer.contents buffer)); stream >]
925
926         and lex_ident buffer = parser
927           | [< ' ('A' .. 'Z' | 'a' .. 'z' | '0' .. '9' as c); stream >] ->
928               Buffer.add_char buffer c;
929               lex_ident buffer stream
930           | [< stream=lex >] ->
931               match Buffer.contents buffer with
932               | "def" -> [< 'Token.Def; stream >]
933               | "extern" -> [< 'Token.Extern; stream >]
934               | "if" -> [< 'Token.If; stream >]
935               | "then" -> [< 'Token.Then; stream >]
936               | "else" -> [< 'Token.Else; stream >]
937               | "for" -> [< 'Token.For; stream >]
938               | "in" -> [< 'Token.In; stream >]
939               | "binary" -> [< 'Token.Binary; stream >]
940               | "unary" -> [< 'Token.Unary; stream >]
941               | "var" -> [< 'Token.Var; stream >]
942               | id -> [< 'Token.Ident id; stream >]
943
944         and lex_comment = parser
945           | [< ' ('\n'); stream=lex >] -> stream
946           | [< 'c; e=lex_comment >] -> e
947           | [< >] -> [< >]
948
949 ast.ml:
950     .. code-block:: ocaml
951
952         (*===----------------------------------------------------------------------===
953          * Abstract Syntax Tree (aka Parse Tree)
954          *===----------------------------------------------------------------------===*)
955
956         (* expr - Base type for all expression nodes. *)
957         type expr =
958           (* variant for numeric literals like "1.0". *)
959           | Number of float
960
961           (* variant for referencing a variable, like "a". *)
962           | Variable of string
963
964           (* variant for a unary operator. *)
965           | Unary of char * expr
966
967           (* variant for a binary operator. *)
968           | Binary of char * expr * expr
969
970           (* variant for function calls. *)
971           | Call of string * expr array
972
973           (* variant for if/then/else. *)
974           | If of expr * expr * expr
975
976           (* variant for for/in. *)
977           | For of string * expr * expr * expr option * expr
978
979           (* variant for var/in. *)
980           | Var of (string * expr option) array * expr
981
982         (* proto - This type represents the "prototype" for a function, which captures
983          * its name, and its argument names (thus implicitly the number of arguments the
984          * function takes). *)
985         type proto =
986           | Prototype of string * string array
987           | BinOpPrototype of string * string array * int
988
989         (* func - This type represents a function definition itself. *)
990         type func = Function of proto * expr
991
992 parser.ml:
993     .. code-block:: ocaml
994
995         (*===---------------------------------------------------------------------===
996          * Parser
997          *===---------------------------------------------------------------------===*)
998
999         (* binop_precedence - This holds the precedence for each binary operator that is
1000          * defined *)
1001         let binop_precedence:(char, int) Hashtbl.t = Hashtbl.create 10
1002
1003         (* precedence - Get the precedence of the pending binary operator token. *)
1004         let precedence c = try Hashtbl.find binop_precedence c with Not_found -> -1
1005
1006         (* primary
1007          *   ::= identifier
1008          *   ::= numberexpr
1009          *   ::= parenexpr
1010          *   ::= ifexpr
1011          *   ::= forexpr
1012          *   ::= varexpr *)
1013         let rec parse_primary = parser
1014           (* numberexpr ::= number *)
1015           | [< 'Token.Number n >] -> Ast.Number n
1016
1017           (* parenexpr ::= '(' expression ')' *)
1018           | [< 'Token.Kwd '('; e=parse_expr; 'Token.Kwd ')' ?? "expected ')'" >] -> e
1019
1020           (* identifierexpr
1021            *   ::= identifier
1022            *   ::= identifier '(' argumentexpr ')' *)
1023           | [< 'Token.Ident id; stream >] ->
1024               let rec parse_args accumulator = parser
1025                 | [< e=parse_expr; stream >] ->
1026                     begin parser
1027                       | [< 'Token.Kwd ','; e=parse_args (e :: accumulator) >] -> e
1028                       | [< >] -> e :: accumulator
1029                     end stream
1030                 | [< >] -> accumulator
1031               in
1032               let rec parse_ident id = parser
1033                 (* Call. *)
1034                 | [< 'Token.Kwd '(';
1035                      args=parse_args [];
1036                      'Token.Kwd ')' ?? "expected ')'">] ->
1037                     Ast.Call (id, Array.of_list (List.rev args))
1038
1039                 (* Simple variable ref. *)
1040                 | [< >] -> Ast.Variable id
1041               in
1042               parse_ident id stream
1043
1044           (* ifexpr ::= 'if' expr 'then' expr 'else' expr *)
1045           | [< 'Token.If; c=parse_expr;
1046                'Token.Then ?? "expected 'then'"; t=parse_expr;
1047                'Token.Else ?? "expected 'else'"; e=parse_expr >] ->
1048               Ast.If (c, t, e)
1049
1050           (* forexpr
1051                 ::= 'for' identifier '=' expr ',' expr (',' expr)? 'in' expression *)
1052           | [< 'Token.For;
1053                'Token.Ident id ?? "expected identifier after for";
1054                'Token.Kwd '=' ?? "expected '=' after for";
1055                stream >] ->
1056               begin parser
1057                 | [<
1058                      start=parse_expr;
1059                      'Token.Kwd ',' ?? "expected ',' after for";
1060                      end_=parse_expr;
1061                      stream >] ->
1062                     let step =
1063                       begin parser
1064                       | [< 'Token.Kwd ','; step=parse_expr >] -> Some step
1065                       | [< >] -> None
1066                       end stream
1067                     in
1068                     begin parser
1069                     | [< 'Token.In; body=parse_expr >] ->
1070                         Ast.For (id, start, end_, step, body)
1071                     | [< >] ->
1072                         raise (Stream.Error "expected 'in' after for")
1073                     end stream
1074                 | [< >] ->
1075                     raise (Stream.Error "expected '=' after for")
1076               end stream
1077
1078           (* varexpr
1079            *   ::= 'var' identifier ('=' expression?
1080            *             (',' identifier ('=' expression)?)* 'in' expression *)
1081           | [< 'Token.Var;
1082                (* At least one variable name is required. *)
1083                'Token.Ident id ?? "expected identifier after var";
1084                init=parse_var_init;
1085                var_names=parse_var_names [(id, init)];
1086                (* At this point, we have to have 'in'. *)
1087                'Token.In ?? "expected 'in' keyword after 'var'";
1088                body=parse_expr >] ->
1089               Ast.Var (Array.of_list (List.rev var_names), body)
1090
1091           | [< >] -> raise (Stream.Error "unknown token when expecting an expression.")
1092
1093         (* unary
1094          *   ::= primary
1095          *   ::= '!' unary *)
1096         and parse_unary = parser
1097           (* If this is a unary operator, read it. *)
1098           | [< 'Token.Kwd op when op != '(' && op != ')'; operand=parse_expr >] ->
1099               Ast.Unary (op, operand)
1100
1101           (* If the current token is not an operator, it must be a primary expr. *)
1102           | [< stream >] -> parse_primary stream
1103
1104         (* binoprhs
1105          *   ::= ('+' primary)* *)
1106         and parse_bin_rhs expr_prec lhs stream =
1107           match Stream.peek stream with
1108           (* If this is a binop, find its precedence. *)
1109           | Some (Token.Kwd c) when Hashtbl.mem binop_precedence c ->
1110               let token_prec = precedence c in
1111
1112               (* If this is a binop that binds at least as tightly as the current binop,
1113                * consume it, otherwise we are done. *)
1114               if token_prec < expr_prec then lhs else begin
1115                 (* Eat the binop. *)
1116                 Stream.junk stream;
1117
1118                 (* Parse the primary expression after the binary operator. *)
1119                 let rhs = parse_unary stream in
1120
1121                 (* Okay, we know this is a binop. *)
1122                 let rhs =
1123                   match Stream.peek stream with
1124                   | Some (Token.Kwd c2) ->
1125                       (* If BinOp binds less tightly with rhs than the operator after
1126                        * rhs, let the pending operator take rhs as its lhs. *)
1127                       let next_prec = precedence c2 in
1128                       if token_prec < next_prec
1129                       then parse_bin_rhs (token_prec + 1) rhs stream
1130                       else rhs
1131                   | _ -> rhs
1132                 in
1133
1134                 (* Merge lhs/rhs. *)
1135                 let lhs = Ast.Binary (c, lhs, rhs) in
1136                 parse_bin_rhs expr_prec lhs stream
1137               end
1138           | _ -> lhs
1139
1140         and parse_var_init = parser
1141           (* read in the optional initializer. *)
1142           | [< 'Token.Kwd '='; e=parse_expr >] -> Some e
1143           | [< >] -> None
1144
1145         and parse_var_names accumulator = parser
1146           | [< 'Token.Kwd ',';
1147                'Token.Ident id ?? "expected identifier list after var";
1148                init=parse_var_init;
1149                e=parse_var_names ((id, init) :: accumulator) >] -> e
1150           | [< >] -> accumulator
1151
1152         (* expression
1153          *   ::= primary binoprhs *)
1154         and parse_expr = parser
1155           | [< lhs=parse_unary; stream >] -> parse_bin_rhs 0 lhs stream
1156
1157         (* prototype
1158          *   ::= id '(' id* ')'
1159          *   ::= binary LETTER number? (id, id)
1160          *   ::= unary LETTER number? (id) *)
1161         let parse_prototype =
1162           let rec parse_args accumulator = parser
1163             | [< 'Token.Ident id; e=parse_args (id::accumulator) >] -> e
1164             | [< >] -> accumulator
1165           in
1166           let parse_operator = parser
1167             | [< 'Token.Unary >] -> "unary", 1
1168             | [< 'Token.Binary >] -> "binary", 2
1169           in
1170           let parse_binary_precedence = parser
1171             | [< 'Token.Number n >] -> int_of_float n
1172             | [< >] -> 30
1173           in
1174           parser
1175           | [< 'Token.Ident id;
1176                'Token.Kwd '(' ?? "expected '(' in prototype";
1177                args=parse_args [];
1178                'Token.Kwd ')' ?? "expected ')' in prototype" >] ->
1179               (* success. *)
1180               Ast.Prototype (id, Array.of_list (List.rev args))
1181           | [< (prefix, kind)=parse_operator;
1182                'Token.Kwd op ?? "expected an operator";
1183                (* Read the precedence if present. *)
1184                binary_precedence=parse_binary_precedence;
1185                'Token.Kwd '(' ?? "expected '(' in prototype";
1186                 args=parse_args [];
1187                'Token.Kwd ')' ?? "expected ')' in prototype" >] ->
1188               let name = prefix ^ (String.make 1 op) in
1189               let args = Array.of_list (List.rev args) in
1190
1191               (* Verify right number of arguments for operator. *)
1192               if Array.length args != kind
1193               then raise (Stream.Error "invalid number of operands for operator")
1194               else
1195                 if kind == 1 then
1196                   Ast.Prototype (name, args)
1197                 else
1198                   Ast.BinOpPrototype (name, args, binary_precedence)
1199           | [< >] ->
1200               raise (Stream.Error "expected function name in prototype")
1201
1202         (* definition ::= 'def' prototype expression *)
1203         let parse_definition = parser
1204           | [< 'Token.Def; p=parse_prototype; e=parse_expr >] ->
1205               Ast.Function (p, e)
1206
1207         (* toplevelexpr ::= expression *)
1208         let parse_toplevel = parser
1209           | [< e=parse_expr >] ->
1210               (* Make an anonymous proto. *)
1211               Ast.Function (Ast.Prototype ("", [||]), e)
1212
1213         (*  external ::= 'extern' prototype *)
1214         let parse_extern = parser
1215           | [< 'Token.Extern; e=parse_prototype >] -> e
1216
1217 codegen.ml:
1218     .. code-block:: ocaml
1219
1220         (*===----------------------------------------------------------------------===
1221          * Code Generation
1222          *===----------------------------------------------------------------------===*)
1223
1224         open Llvm
1225
1226         exception Error of string
1227
1228         let context = global_context ()
1229         let the_module = create_module context "my cool jit"
1230         let builder = builder context
1231         let named_values:(string, llvalue) Hashtbl.t = Hashtbl.create 10
1232         let double_type = double_type context
1233
1234         (* Create an alloca instruction in the entry block of the function. This
1235          * is used for mutable variables etc. *)
1236         let create_entry_block_alloca the_function var_name =
1237           let builder = builder_at context (instr_begin (entry_block the_function)) in
1238           build_alloca double_type var_name builder
1239
1240         let rec codegen_expr = function
1241           | Ast.Number n -> const_float double_type n
1242           | Ast.Variable name ->
1243               let v = try Hashtbl.find named_values name with
1244                 | Not_found -> raise (Error "unknown variable name")
1245               in
1246               (* Load the value. *)
1247               build_load v name builder
1248           | Ast.Unary (op, operand) ->
1249               let operand = codegen_expr operand in
1250               let callee = "unary" ^ (String.make 1 op) in
1251               let callee =
1252                 match lookup_function callee the_module with
1253                 | Some callee -> callee
1254                 | None -> raise (Error "unknown unary operator")
1255               in
1256               build_call callee [|operand|] "unop" builder
1257           | Ast.Binary (op, lhs, rhs) ->
1258               begin match op with
1259               | '=' ->
1260                   (* Special case '=' because we don't want to emit the LHS as an
1261                    * expression. *)
1262                   let name =
1263                     match lhs with
1264                     | Ast.Variable name -> name
1265                     | _ -> raise (Error "destination of '=' must be a variable")
1266                   in
1267
1268                   (* Codegen the rhs. *)
1269                   let val_ = codegen_expr rhs in
1270
1271                   (* Lookup the name. *)
1272                   let variable = try Hashtbl.find named_values name with
1273                   | Not_found -> raise (Error "unknown variable name")
1274                   in
1275                   ignore(build_store val_ variable builder);
1276                   val_
1277               | _ ->
1278                   let lhs_val = codegen_expr lhs in
1279                   let rhs_val = codegen_expr rhs in
1280                   begin
1281                     match op with
1282                     | '+' -> build_add lhs_val rhs_val "addtmp" builder
1283                     | '-' -> build_sub lhs_val rhs_val "subtmp" builder
1284                     | '*' -> build_mul lhs_val rhs_val "multmp" builder
1285                     | '<' ->
1286                         (* Convert bool 0/1 to double 0.0 or 1.0 *)
1287                         let i = build_fcmp Fcmp.Ult lhs_val rhs_val "cmptmp" builder in
1288                         build_uitofp i double_type "booltmp" builder
1289                     | _ ->
1290                         (* If it wasn't a builtin binary operator, it must be a user defined
1291                          * one. Emit a call to it. *)
1292                         let callee = "binary" ^ (String.make 1 op) in
1293                         let callee =
1294                           match lookup_function callee the_module with
1295                           | Some callee -> callee
1296                           | None -> raise (Error "binary operator not found!")
1297                         in
1298                         build_call callee [|lhs_val; rhs_val|] "binop" builder
1299                   end
1300               end
1301           | Ast.Call (callee, args) ->
1302               (* Look up the name in the module table. *)
1303               let callee =
1304                 match lookup_function callee the_module with
1305                 | Some callee -> callee
1306                 | None -> raise (Error "unknown function referenced")
1307               in
1308               let params = params callee in
1309
1310               (* If argument mismatch error. *)
1311               if Array.length params == Array.length args then () else
1312                 raise (Error "incorrect # arguments passed");
1313               let args = Array.map codegen_expr args in
1314               build_call callee args "calltmp" builder
1315           | Ast.If (cond, then_, else_) ->
1316               let cond = codegen_expr cond in
1317
1318               (* Convert condition to a bool by comparing equal to 0.0 *)
1319               let zero = const_float double_type 0.0 in
1320               let cond_val = build_fcmp Fcmp.One cond zero "ifcond" builder in
1321
1322               (* Grab the first block so that we might later add the conditional branch
1323                * to it at the end of the function. *)
1324               let start_bb = insertion_block builder in
1325               let the_function = block_parent start_bb in
1326
1327               let then_bb = append_block context "then" the_function in
1328
1329               (* Emit 'then' value. *)
1330               position_at_end then_bb builder;
1331               let then_val = codegen_expr then_ in
1332
1333               (* Codegen of 'then' can change the current block, update then_bb for the
1334                * phi. We create a new name because one is used for the phi node, and the
1335                * other is used for the conditional branch. *)
1336               let new_then_bb = insertion_block builder in
1337
1338               (* Emit 'else' value. *)
1339               let else_bb = append_block context "else" the_function in
1340               position_at_end else_bb builder;
1341               let else_val = codegen_expr else_ in
1342
1343               (* Codegen of 'else' can change the current block, update else_bb for the
1344                * phi. *)
1345               let new_else_bb = insertion_block builder in
1346
1347               (* Emit merge block. *)
1348               let merge_bb = append_block context "ifcont" the_function in
1349               position_at_end merge_bb builder;
1350               let incoming = [(then_val, new_then_bb); (else_val, new_else_bb)] in
1351               let phi = build_phi incoming "iftmp" builder in
1352
1353               (* Return to the start block to add the conditional branch. *)
1354               position_at_end start_bb builder;
1355               ignore (build_cond_br cond_val then_bb else_bb builder);
1356
1357               (* Set a unconditional branch at the end of the 'then' block and the
1358                * 'else' block to the 'merge' block. *)
1359               position_at_end new_then_bb builder; ignore (build_br merge_bb builder);
1360               position_at_end new_else_bb builder; ignore (build_br merge_bb builder);
1361
1362               (* Finally, set the builder to the end of the merge block. *)
1363               position_at_end merge_bb builder;
1364
1365               phi
1366           | Ast.For (var_name, start, end_, step, body) ->
1367               (* Output this as:
1368                *   var = alloca double
1369                *   ...
1370                *   start = startexpr
1371                *   store start -> var
1372                *   goto loop
1373                * loop:
1374                *   ...
1375                *   bodyexpr
1376                *   ...
1377                * loopend:
1378                *   step = stepexpr
1379                *   endcond = endexpr
1380                *
1381                *   curvar = load var
1382                *   nextvar = curvar + step
1383                *   store nextvar -> var
1384                *   br endcond, loop, endloop
1385                * outloop: *)
1386
1387               let the_function = block_parent (insertion_block builder) in
1388
1389               (* Create an alloca for the variable in the entry block. *)
1390               let alloca = create_entry_block_alloca the_function var_name in
1391
1392               (* Emit the start code first, without 'variable' in scope. *)
1393               let start_val = codegen_expr start in
1394
1395               (* Store the value into the alloca. *)
1396               ignore(build_store start_val alloca builder);
1397
1398               (* Make the new basic block for the loop header, inserting after current
1399                * block. *)
1400               let loop_bb = append_block context "loop" the_function in
1401
1402               (* Insert an explicit fall through from the current block to the
1403                * loop_bb. *)
1404               ignore (build_br loop_bb builder);
1405
1406               (* Start insertion in loop_bb. *)
1407               position_at_end loop_bb builder;
1408
1409               (* Within the loop, the variable is defined equal to the PHI node. If it
1410                * shadows an existing variable, we have to restore it, so save it
1411                * now. *)
1412               let old_val =
1413                 try Some (Hashtbl.find named_values var_name) with Not_found -> None
1414               in
1415               Hashtbl.add named_values var_name alloca;
1416
1417               (* Emit the body of the loop.  This, like any other expr, can change the
1418                * current BB.  Note that we ignore the value computed by the body, but
1419                * don't allow an error *)
1420               ignore (codegen_expr body);
1421
1422               (* Emit the step value. *)
1423               let step_val =
1424                 match step with
1425                 | Some step -> codegen_expr step
1426                 (* If not specified, use 1.0. *)
1427                 | None -> const_float double_type 1.0
1428               in
1429
1430               (* Compute the end condition. *)
1431               let end_cond = codegen_expr end_ in
1432
1433               (* Reload, increment, and restore the alloca. This handles the case where
1434                * the body of the loop mutates the variable. *)
1435               let cur_var = build_load alloca var_name builder in
1436               let next_var = build_add cur_var step_val "nextvar" builder in
1437               ignore(build_store next_var alloca builder);
1438
1439               (* Convert condition to a bool by comparing equal to 0.0. *)
1440               let zero = const_float double_type 0.0 in
1441               let end_cond = build_fcmp Fcmp.One end_cond zero "loopcond" builder in
1442
1443               (* Create the "after loop" block and insert it. *)
1444               let after_bb = append_block context "afterloop" the_function in
1445
1446               (* Insert the conditional branch into the end of loop_end_bb. *)
1447               ignore (build_cond_br end_cond loop_bb after_bb builder);
1448
1449               (* Any new code will be inserted in after_bb. *)
1450               position_at_end after_bb builder;
1451
1452               (* Restore the unshadowed variable. *)
1453               begin match old_val with
1454               | Some old_val -> Hashtbl.add named_values var_name old_val
1455               | None -> ()
1456               end;
1457
1458               (* for expr always returns 0.0. *)
1459               const_null double_type
1460           | Ast.Var (var_names, body) ->
1461               let old_bindings = ref [] in
1462
1463               let the_function = block_parent (insertion_block builder) in
1464
1465               (* Register all variables and emit their initializer. *)
1466               Array.iter (fun (var_name, init) ->
1467                 (* Emit the initializer before adding the variable to scope, this
1468                  * prevents the initializer from referencing the variable itself, and
1469                  * permits stuff like this:
1470                  *   var a = 1 in
1471                  *     var a = a in ...   # refers to outer 'a'. *)
1472                 let init_val =
1473                   match init with
1474                   | Some init -> codegen_expr init
1475                   (* If not specified, use 0.0. *)
1476                   | None -> const_float double_type 0.0
1477                 in
1478
1479                 let alloca = create_entry_block_alloca the_function var_name in
1480                 ignore(build_store init_val alloca builder);
1481
1482                 (* Remember the old variable binding so that we can restore the binding
1483                  * when we unrecurse. *)
1484                 begin
1485                   try
1486                     let old_value = Hashtbl.find named_values var_name in
1487                     old_bindings := (var_name, old_value) :: !old_bindings;
1488                   with Not_found -> ()
1489                 end;
1490
1491                 (* Remember this binding. *)
1492                 Hashtbl.add named_values var_name alloca;
1493               ) var_names;
1494
1495               (* Codegen the body, now that all vars are in scope. *)
1496               let body_val = codegen_expr body in
1497
1498               (* Pop all our variables from scope. *)
1499               List.iter (fun (var_name, old_value) ->
1500                 Hashtbl.add named_values var_name old_value
1501               ) !old_bindings;
1502
1503               (* Return the body computation. *)
1504               body_val
1505
1506         let codegen_proto = function
1507           | Ast.Prototype (name, args) | Ast.BinOpPrototype (name, args, _) ->
1508               (* Make the function type: double(double,double) etc. *)
1509               let doubles = Array.make (Array.length args) double_type in
1510               let ft = function_type double_type doubles in
1511               let f =
1512                 match lookup_function name the_module with
1513                 | None -> declare_function name ft the_module
1514
1515                 (* If 'f' conflicted, there was already something named 'name'. If it
1516                  * has a body, don't allow redefinition or reextern. *)
1517                 | Some f ->
1518                     (* If 'f' already has a body, reject this. *)
1519                     if block_begin f <> At_end f then
1520                       raise (Error "redefinition of function");
1521
1522                     (* If 'f' took a different number of arguments, reject. *)
1523                     if element_type (type_of f) <> ft then
1524                       raise (Error "redefinition of function with different # args");
1525                     f
1526               in
1527
1528               (* Set names for all arguments. *)
1529               Array.iteri (fun i a ->
1530                 let n = args.(i) in
1531                 set_value_name n a;
1532                 Hashtbl.add named_values n a;
1533               ) (params f);
1534               f
1535
1536         (* Create an alloca for each argument and register the argument in the symbol
1537          * table so that references to it will succeed. *)
1538         let create_argument_allocas the_function proto =
1539           let args = match proto with
1540             | Ast.Prototype (_, args) | Ast.BinOpPrototype (_, args, _) -> args
1541           in
1542           Array.iteri (fun i ai ->
1543             let var_name = args.(i) in
1544             (* Create an alloca for this variable. *)
1545             let alloca = create_entry_block_alloca the_function var_name in
1546
1547             (* Store the initial value into the alloca. *)
1548             ignore(build_store ai alloca builder);
1549
1550             (* Add arguments to variable symbol table. *)
1551             Hashtbl.add named_values var_name alloca;
1552           ) (params the_function)
1553
1554         let codegen_func the_fpm = function
1555           | Ast.Function (proto, body) ->
1556               Hashtbl.clear named_values;
1557               let the_function = codegen_proto proto in
1558
1559               (* If this is an operator, install it. *)
1560               begin match proto with
1561               | Ast.BinOpPrototype (name, args, prec) ->
1562                   let op = name.[String.length name - 1] in
1563                   Hashtbl.add Parser.binop_precedence op prec;
1564               | _ -> ()
1565               end;
1566
1567               (* Create a new basic block to start insertion into. *)
1568               let bb = append_block context "entry" the_function in
1569               position_at_end bb builder;
1570
1571               try
1572                 (* Add all arguments to the symbol table and create their allocas. *)
1573                 create_argument_allocas the_function proto;
1574
1575                 let ret_val = codegen_expr body in
1576
1577                 (* Finish off the function. *)
1578                 let _ = build_ret ret_val builder in
1579
1580                 (* Validate the generated code, checking for consistency. *)
1581                 Llvm_analysis.assert_valid_function the_function;
1582
1583                 (* Optimize the function. *)
1584                 let _ = PassManager.run_function the_function the_fpm in
1585
1586                 the_function
1587               with e ->
1588                 delete_function the_function;
1589                 raise e
1590
1591 toplevel.ml:
1592     .. code-block:: ocaml
1593
1594         (*===----------------------------------------------------------------------===
1595          * Top-Level parsing and JIT Driver
1596          *===----------------------------------------------------------------------===*)
1597
1598         open Llvm
1599         open Llvm_executionengine
1600
1601         (* top ::= definition | external | expression | ';' *)
1602         let rec main_loop the_fpm the_execution_engine stream =
1603           match Stream.peek stream with
1604           | None -> ()
1605
1606           (* ignore top-level semicolons. *)
1607           | Some (Token.Kwd ';') ->
1608               Stream.junk stream;
1609               main_loop the_fpm the_execution_engine stream
1610
1611           | Some token ->
1612               begin
1613                 try match token with
1614                 | Token.Def ->
1615                     let e = Parser.parse_definition stream in
1616                     print_endline "parsed a function definition.";
1617                     dump_value (Codegen.codegen_func the_fpm e);
1618                 | Token.Extern ->
1619                     let e = Parser.parse_extern stream in
1620                     print_endline "parsed an extern.";
1621                     dump_value (Codegen.codegen_proto e);
1622                 | _ ->
1623                     (* Evaluate a top-level expression into an anonymous function. *)
1624                     let e = Parser.parse_toplevel stream in
1625                     print_endline "parsed a top-level expr";
1626                     let the_function = Codegen.codegen_func the_fpm e in
1627                     dump_value the_function;
1628
1629                     (* JIT the function, returning a function pointer. *)
1630                     let result = ExecutionEngine.run_function the_function [||]
1631                       the_execution_engine in
1632
1633                     print_string "Evaluated to ";
1634                     print_float (GenericValue.as_float Codegen.double_type result);
1635                     print_newline ();
1636                 with Stream.Error s | Codegen.Error s ->
1637                   (* Skip token for error recovery. *)
1638                   Stream.junk stream;
1639                   print_endline s;
1640               end;
1641               print_string "ready> "; flush stdout;
1642               main_loop the_fpm the_execution_engine stream
1643
1644 toy.ml:
1645     .. code-block:: ocaml
1646
1647         (*===----------------------------------------------------------------------===
1648          * Main driver code.
1649          *===----------------------------------------------------------------------===*)
1650
1651         open Llvm
1652         open Llvm_executionengine
1653         open Llvm_target
1654         open Llvm_scalar_opts
1655
1656         let main () =
1657           ignore (initialize_native_target ());
1658
1659           (* Install standard binary operators.
1660            * 1 is the lowest precedence. *)
1661           Hashtbl.add Parser.binop_precedence '=' 2;
1662           Hashtbl.add Parser.binop_precedence '<' 10;
1663           Hashtbl.add Parser.binop_precedence '+' 20;
1664           Hashtbl.add Parser.binop_precedence '-' 20;
1665           Hashtbl.add Parser.binop_precedence '*' 40;    (* highest. *)
1666
1667           (* Prime the first token. *)
1668           print_string "ready> "; flush stdout;
1669           let stream = Lexer.lex (Stream.of_channel stdin) in
1670
1671           (* Create the JIT. *)
1672           let the_execution_engine = ExecutionEngine.create Codegen.the_module in
1673           let the_fpm = PassManager.create_function Codegen.the_module in
1674
1675           (* Set up the optimizer pipeline.  Start with registering info about how the
1676            * target lays out data structures. *)
1677           DataLayout.add (ExecutionEngine.target_data the_execution_engine) the_fpm;
1678
1679           (* Promote allocas to registers. *)
1680           add_memory_to_register_promotion the_fpm;
1681
1682           (* Do simple "peephole" optimizations and bit-twiddling optzn. *)
1683           add_instruction_combination the_fpm;
1684
1685           (* reassociate expressions. *)
1686           add_reassociation the_fpm;
1687
1688           (* Eliminate Common SubExpressions. *)
1689           add_gvn the_fpm;
1690
1691           (* Simplify the control flow graph (deleting unreachable blocks, etc). *)
1692           add_cfg_simplification the_fpm;
1693
1694           ignore (PassManager.initialize the_fpm);
1695
1696           (* Run the main "interpreter loop" now. *)
1697           Toplevel.main_loop the_fpm the_execution_engine stream;
1698
1699           (* Print out all the generated code. *)
1700           dump_module Codegen.the_module
1701         ;;
1702
1703         main ()
1704
1705 bindings.c
1706     .. code-block:: c
1707
1708         #include <stdio.h>
1709
1710         /* putchard - putchar that takes a double and returns 0. */
1711         extern double putchard(double X) {
1712           putchar((char)X);
1713           return 0;
1714         }
1715
1716         /* printd - printf that takes a double prints it as "%f\n", returning 0. */
1717         extern double printd(double X) {
1718           printf("%f\n", X);
1719           return 0;
1720         }
1721
1722 `Next: Conclusion and other useful LLVM tidbits <OCamlLangImpl8.html>`_
1723