diff --git a/Makefile b/Makefile index 738caf6c7..3cdcd08d4 100644 --- a/Makefile +++ b/Makefile @@ -36,3 +36,8 @@ bench: .PHONY: default install uninstall reinstall clean test doc bench .PHONY: all-supported-ocaml-versions opam-release + + +.PHONY: $(TARGET) +example-%: + DUNE_CONFIG__GLOBAL_LOCK=disabled opam exec -- dune exec $*-example diff --git a/examples/1-AST/README.md b/examples/1-AST/README.md new file mode 100644 index 000000000..de1636bac --- /dev/null +++ b/examples/1-AST/README.md @@ -0,0 +1,293 @@ +# Abstract Syntax Tree (AST) + +### Table of Contents + +- [Description](#description) +- [Preprocessing in OCaml](#preprocessing-in-ocaml) +- [AST Guide](#ast-guide) +- [Why Should I Understand the AST?](#why-should-i-understand-the-ast) +- [First Look](#first-look) +- [Structure](#structure) +- [Language Extensions and Attributes](#language-extensions-and-attributes) +- [Samples](#samples) + +## Description + +The Abstract Syntax Tree (AST) is a critical component in the OCaml compilation process. It represents the structure of the source code in a tree-like format, allowing for advanced code manipulations and transformations. This guide explores the importance of the AST, how it is used in preprocessing, and the different methods available for working with it through **PPX** (PreProcessor eXtensions). + +### Preprocessing in OCaml + +Unlike some programming languages that have built-in preprocessing features—such as C's preprocessor or Rust's macro system, OCaml lacks an integrated macro system. Instead, it relies on standalone preprocessors. + +The OCaml Platform officially supports a library for creating these preprocessors, which can operate at two levels: + +- **Source Level**: Preprocessors work directly on the source code. +- **AST Level**: Preprocessors manipulate the AST, offering more powerful and flexible transformations. (Covered in this guide) + +> [!WARNING] +> One of the key challenges with working with the Parsetree (the AST in OCaml) is that its API is not stable. For instance, in the OCaml 4.13 release, significant changes were made to the Parsetree type, which can impact the compatibility of your preprocessing tools. Read more about it in [The Future of PPX](https://discuss.ocaml.org/t/the-future-of-ppx/3766) + +### AST Guide + +This guide will concentrate on AST-level preprocessing using **PPX** (PreProcessor eXtensions), providing a comprehensive overview of the following topics: + +1. **AST Construction**: Learning how to build and manipulate ASTs. +2. **AST Destructuring**: Breaking down ASTs into manageable components for advanced transformations. + +### Why Should I Understand the AST? + +OCaml's Parsetree can be confusing, verbose, and hard to understand, but it's a powerful tool that can help you write better code, understand how the compiler works, and develop your own PPXs. + +You don't need to be an expert on it knowing all the tree possibilities, but you should know how to read it. For this, I'm going to use the [AST Explorer](https://astexplorer.net/) throughout the repository to help you understand the AST. + +A simple example of learning more about the OCaml compiler is that types are recursive by default, while values are non-recursive. +With the AST, we can see this clearly: +```ocaml +type name = string +let name = "John Doe" + +(* AST Tree *) +(* type name = string *) +[ Pstr_type + ( Recursive + , [ { ptype_name = + { txt = "name" + ; loc = { (* ... *) } + } + ; ptype_params = [] + ; ptype_cstrs = [] + ; ptype_kind = Ptype_abstract + ; ptype_private = Public + ; ptype_manifest = + Some + { ptyp_desc = + Ptyp_constr + ( { txt = Lident "string" + ; loc = { (* ... *) } + } + , [] + ) + ; ptyp_loc = { (* ... *) } + ; ptyp_loc_stack = __lstack + ; ptyp_attributes = [] + } + ; ptype_attributes = [] + ; ptype_loc = { (* ... *) } + } + ] + ) +; Pstr_value + ( Nonrecursive + , [ { pvb_pat = + { ppat_desc = + Ppat_var + { txt = "name" + ; loc = { (* ... *) } + } + ; ppat_loc = { (* ... *) } + ; ppat_loc_stack = [ ] + ; ppat_attributes = [] + } + ; pvb_expr = + { pexp_desc = + Pexp_constant + (Pconst_string + ( "John Doe" + , (* loc ... *) + , None + )) + ; pexp_loc = { (* ... *) } + ; pexp_loc_stack = [ (* ... *) ] + ; pexp_attributes = [] + } + ; pvb_attributes = [] + ; pvb_loc = { (* ... *) } + } + ] + ) +] +``` + +### First Look + +By comparing code snippets with their AST representations, you'll better understand how OCaml interprets your code, which is essential for working with PPXs or delving into the compiler's internals. The [AST Explorer](https://astexplorer.net/) tool will help make these concepts clearer and more accessible. + +Let's take a quick look at the JSON AST representation of a simple OCaml expression: + +```ocaml +(* Foo.ml *) +let name = "john doe" + +(* AST Tree *) +(* let name = "john doe" *) +[ Pstr_type + ( Recursive + , [ { ptype_name = "name" + ; ptype_params = [] + ; ptype_cstrs = [] + ; ptype_kind = Ptype_abstract + ; ptype_private = Public + ; ptype_manifest = Some (Ptyp_constr ( Lident "string", [])) + ; ptype_attributes = [] + ; ptype_loc = { (* ... *) } + } + ] + ) +; Pstr_value + ( Nonrecursive + , [ { pvb_pat = Ppat_var "name" + ; pvb_expr = Pexp_constant (Pconst_string ( "John Doe", (* loc ... *) , None)) + ; pvb_attributes = [] + ; pvb_loc = { (* ... *) } + } + ] + ) +] +``` + +As you can see, it's a little bit verbose. Don't be scared; we are going to learn how to read it, which is the most important thing. + +### Structure + +```ocaml +(* Foo.ml *) +let name = "john doe" + +(* AST Tree *) +(* let name = "john doe" *) +(* This entire list is a structure *) +[ Pstr_value + ( Nonrecursive + , [ { pvb_pat = Ppat_var "name" + ; pvb_expr = Pexp_constant (Pconst_string ( "john doe", (* loc ... *) , None)) + ; pvb_attributes = [] + ; pvb_loc = { (* ... *) } + } + ] + ) +] +``` + +In OCaml, a **module** serves as a container for grouping related definitions, such as types, values, functions, and even other modules, into a single cohesive unit. This modular approach helps organize your code, making it more manageable, reusable, and easier to understand. + +A **structure** refers to the content within a module. It is composed of various declarations, known as **structure items**, which include: + +- **Type definitions** (e.g., `type t = ...`) +- **`let` bindings** (e.g., `let x = 1`) +- **Function definitions** +- **Exception declarations** +- **Other nested modules** + +The structure represents the body of the module, where all these items are defined and implemented. Since each `.ml` file is implicitly a module, the entire content of a file can be viewed as the structure of that module. + +> [!TIP] +> Every module in OCaml creates a new structure, and nested modules create nested structures. + +Consider the following example: + +```ocaml +(* Bar.ml *) +let name = "john doe" + +module GameEnum = struct + type t = Rock | Paper | Scissors + + let to_string = function + | Rock -> "Rock" + | Paper -> "Paper" + | Scissors -> "Scissors" + + let from_string = function + | "Rock" -> Rock + | "Paper" -> Paper + | "Scissors" -> Scissors + | _ -> failwith "Invalid string" +end +``` + +```ocaml +[ + (* This is a structure item *) + Pstr_value + ( Nonrecursive + , [ { pvb_pat = Ppat_var "name" + ; pvb_expr = Pexp_constant (Pconst_string ( "john doe", __loc, None)) + ; pvb_attributes = [] + ; pvb_loc = __loc + } + ] + ) + + (* This is a structure item *) + ; Pstr_module + { pmb_name = Some "GameEnum" + (* This is a structure *) + ; pmb_expr = + Pmod_structure + [ (* ... Structure items ... *) ] + ; pmb_attributes = [] + ; pmb_loc = { (* ... *) } + } +] +``` + +As you can see, `Bar.ml` and `GameEnum` are modules, and their content is a **structure** that contain a list of **structure items**. + +> [!NOTE] +> A structure item can either represent a top-level expression, a type definition, a `let` definition, etc. + +I'm not going to be able to cover all structure items, but you can find more about it in the [OCaml documentation](https://ocaml.org/learn/tutorials/modules.html). I strongly advise you to take a look at the [AST Explorer](./ast_explorer.ml) file and play with it; it will help you a lot. The `ppxlib-pp-ast` command is an official ppxlib tool that allows you to see the AST of a given OCaml file/string. + +### Language Extensions and Attributes + +As the AST represents the structure of the source code in a tree-like format, it also represents the Extension nodes and Attributes. It is mostly from the extension and attributes that the PPXs are built, so it's important to understand that they are part of the AST and have their own structure. + +- Extension nodes are generic placeholders in the syntax tree. They are rejected by the type-checker and are intended to be “expanded” by external tools such as -ppx rewriters. On AST, it is represented as `string Ast_414.Asttypes.loc * payload`. + + So, as extension nodes are placeholders for a code to be added, adding a new extension node with no extender declared should break the compilation. For example, in the code `let name = [%name "John Doe"]`. See a demo [here](https://sketch.sh/s/6DxhTCXYpOkI0G8k9keD0d/) + + There are 2 forms of extension nodes: + + - **For “algebraic” categories**: `[%name "John Doe"]` + - **For structures and signatures**: `[%%name "John Doe"]` +
+ + > In the code `let name = [%name "John Doe"]`, `[%name "John Doe"]` is the extension node, where **name** is the extension name (`string Ast_414.Asttypes.loc`) and **"John Doe"** is the `payload`. For the entire item `let name = "John Doe"`, you must use `%%`: `[%%name "John Doe]`. + + Don't worry much about creating a new extension node; we'll cover it in the [Writing PPXs section](../2%20-%20Writing%20PPXs/README.md). + +- Attributes are “decorations” of the syntax tree, which are mostly ignored by the type-checker but can be used by external tools. Decorators must be attached to a specific node in the syntax tree, otherwise it will break the compilation. (Check it breaking on this running `ppxlib-pp-ast --exp "[@foo]"`) + + As attributes are just “decorations”, you can add a new attribute without breaking the compilation. For example, in the code, `let name = "John Doe" [@print]`. See a demo [here](https://sketch.sh/s/6DxhTCXYpOkI0G8k9keD0d/) + + There are 3 forms of attributes: + + - **Attached to on “algebraic” categories**: `[@name]` + - **Attached to “blocks”**: `[@@name]` + - **Stand-alone of signatures or structures modules**: `[@@@name]` +
+ + > In the code `let name = "John Doe" [@print expr]`, `[@print expr]` is the attribute of the `"John Doe"` node, where **print** is the attribute name (`string Ast_414.Asttypes.loc`) and **expr** is the `payload`. To be an attribute of the entire item `let name = "John Doe"`, you must use `@@`: `[@@print]`. If it is an stand-alone attribute of a module, you must use `@@@`: `[@@@print]`. + + Don't worry much about creating a new attributes node; we'll cover it in the [Writing PPXs section](../2%20-%20Writing%20PPXs/README.md). +
+ +I know that it can be a lot, but don't worry; we are going step by step, and you are going to understand it. + +### Samples +To help you undestand a little bit more about the AST, let's show it with some highlighted examples: + +| Code | Playgrond | AST | +| --------------------------------------------- | --------------------------------------------------------------------- | ------------------------------------------------------------------------ | +| ![Code `let name = "john doe"` with `let name = "john doe"` highlighted](./strucure_item.png) | [Link ](https://astexplorer.net/#/gist/d479d32127d6fcb418622ee84b9aa3b2/1d56a1d5b20fc0a55d5ae9d309226dce58f93d2c) | ![AST representation of: let name = "john doe"](./strucure_item-ast.png) | +| ![Code `let name = "john doe"` with `name` highlighted](./pattern.png) | [Link ](https://astexplorer.net/#/gist/d479d32127d6fcb418622ee84b9aa3b2/1d56a1d5b20fc0a55d5ae9d309226dce58f93d2c) | ![AST representation of: name](./pattern-ast.png) | +| ![Code `let name = [%name "John Doe"]` with `[%name "John Doe"]` highlighted](./extension_node.png) | [Link ](https://astexplorer.net/#/gist/d479d32127d6fcb418622ee84b9aa3b2/4002362a8c42e1c4f28790f54682a9cb4fc07a85) | ![AST representation of: name](./extension_node-ast.png) | +| ![Code `let name = [%name "John Doe"]` with `name` highlighted](./extension_node_name.png) | [Link ](https://astexplorer.net/#/gist/d479d32127d6fcb418622ee84b9aa3b2/4002362a8c42e1c4f28790f54682a9cb4fc07a85) | ![AST representation of: name](./extension_node_name-ast.png) | +| ![Code `let name = [%name "John Doe"]` with `"John Doe"` highlighted](./extension_node_payload.png) | [Link ](https://astexplorer.net/#/gist/d479d32127d6fcb418622ee84b9aa3b2/4002362a8c42e1c4f28790f54682a9cb4fc07a85) | ![AST representation of: name](./extension_node_payload-ast.png) | +| ![Code `let name = "John Doe" [@print expr]` with `print` highlighted](./attribute_name.png) | [Link ](https://astexplorer.net/#/gist/d479d32127d6fcb418622ee84b9aa3b2/b4492b3d2d1b34029d367ff278f5bcda0496c0d2) | ![AST representation of: name](./attribute_name-ast.png) | +| ![Code `let name = "John Doe" [@print expr]` with `expr` highlighted](./attribute_payload.png) | [Link ](https://astexplorer.net/#/gist/d479d32127d6fcb418622ee84b9aa3b2/b4492b3d2d1b34029d367ff278f5bcda0496c0d2) | ![AST representation of: name](./attribute_payload-ast.png) | +| ![Code `module GameEnum = struct (* ... *) end` with `"GameEnum"` highlighted](./module_name.png) | [Link ](https://astexplorer.net/#/gist/d479d32127d6fcb418622ee84b9aa3b2/27d0a140f268bae1a32c8882d55c0b26c7e03fe9) | ![AST representation of: name](./module_name-ast.png) | +| ![Code `module GameEnum = struct (* ... *) end` with `struct` highlighted](./module_structure.png) | [Link ](https://astexplorer.net/#/gist/d479d32127d6fcb418622ee84b9aa3b2/27d0a140f268bae1a32c8882d55c0b26c7e03fe9) | ![AST representation of: name](./module_structure-ast.png) | +| ![GameEnum `module GameEnum = struct (* ... *) end` with `type t = Rock \| Paper \| Scissors` highlighted](./module_structure_item.png) | [Link ](https://astexplorer.net/#/gist/d479d32127d6fcb418622ee84b9aa3b2/27d0a140f268bae1a32c8882d55c0b26c7e03fe9) | ![AST representation of: name](./module_structure_item-ast.png) | + +### [On the next section, we will learn how to build an AST.](./a%20-%20Building%20AST/README.md) diff --git a/examples/1-AST/a - Building AST/README.md b/examples/1-AST/a - Building AST/README.md new file mode 100644 index 000000000..3c402bac2 --- /dev/null +++ b/examples/1-AST/a - Building AST/README.md @@ -0,0 +1,192 @@ +# Building AST + +:link: [Docs](https://ocaml-ppx.github.io/ppxlib/ppxlib/generating-code.html) + +This section has code examples to help you understand it better. +To run the examples: + +```sh +make demo-building_ast +``` + +### Table of Contents + +- [Description](#description) +- [Building ASTs with Pure OCaml](#building-asts-with-pure-ocaml) + - [Example: Building a Simple Integer AST Manually](#example-building-a-simple-integer-ast-manually) +- [Building ASTs with `AST_builder`](#building-asts-with-ast_builder) + - [Example 1: Using `pexp_constant` for Integer AST](#example-1-using-pexp_constant-for-integer-ast) + - [Example 2: Using `eint` for Simplified Integer AST](#example-2-using-eint-for-simplified-integer-ast) +- [Using Metaquot for AST Construction](#using-metaquot-for-ast-construction) + - [Example: Building an Integer AST with Metaquot](#example-building-an-integer-ast-with-metaquot) + - [Using Anti-Quotations in Metaquot](#using-anti-quotations-in-metaquot) + - [Example: Inserting Dynamic Expressions with Anti-Quotations](#example-inserting-dynamic-expressions-with-anti-quotations) +- [Building Complex Expressions](#building-complex-expressions) + - [Example 1: Constructing a Let Expression with `AST_builder`](#example-1-constructing-a-let-expression-with-ast_builder) + - [Example 2: Constructing a Let Expression with Metaquot](#example-2-constructing-a-let-expression-with-metaquot) +- [Conclusion](#conclusion) + +## Description + +Building an AST (Abstract Syntax Tree) is a fundamental part of creating a PPX in OCaml. You'll need to construct an AST to represent the code you want to generate or transform. + +For example, if you want to generate the following code: + +```ocaml +let zero = [%int 0] +``` + +and replace the extension point `[%int 0]` with `0` to produce `let zero = 0`, you’ll need to build an AST that represents this transformation. + +There are several methods to build an AST. We’ll discuss three approaches: + +- **Building ASTs with Pure OCaml** +- **Building ASTs with `AST_builder`** +- **Using Metaquot for AST Construction** + +## Building ASTs with Low-Level Builders + +The most fundamental way to build an AST is to manually construct it using Low-Level Builders data structures. + +### Example: Building a Simple Integer AST Manually + +[:link: Sample Code](./building_ast.ml#L5-L16) + +To construct an AST for a simple integer value `0`: + +```ocaml +let zero ~loc : Ppxlib_ast.Ast.expression = + { + pexp_desc = Pexp_constant (Pconst_integer ("0", None)); + pexp_loc = loc; + pexp_loc_stack = []; + pexp_attributes = []; + } +``` + +While this method provides full control over the AST, it is verbose and less maintainable. + +## Building ASTs with `AST_builder` + +PPXLib provides the `AST_builder` module, which simplifies the process of building ASTs by providing helper functions. + +### Example 1: Using `pexp_constant` for Integer AST + +[:link: Sample Code](./building_ast.ml#L18-L24) + +Using `pexp_constant`, you can construct an integer AST like this: + +```ocaml +let one ~loc = + Ast_builder.Default.pexp_constant ~loc (Parsetree.Pconst_integer ("1", None)) +``` + +This method is more readable and concise compared to the pure OCaml approach. + +### Example 2: Using `eint` for Simplified Integer AST + +[:link: Sample Code](./building_ast.ml#L26-L31) + +For even more simplicity, use `eint`: + +```ocaml +let two ~loc = Ast_builder.Default.eint ~loc 2 +``` + +> [!TIP] +> `eint` is an abbreviation for expression (`e`) integer (`int`). + +## Using Metaquot for AST Construction + +Metaquot is a syntax extension that allows you to write ASTs in a more natural and readable way. + +### Example: Building an Integer AST with Metaquot + +[:link: Sample Code](./building_ast.ml#L33-L38) + +With Metaquot, you can construct an integer AST like this: + +```ocaml +let three ~loc = [%expr 3] +``` + +> [!TIP] +> Metaquot is highly readable and intuitive but is static. For dynamic values, use Anti-Quotations. + +### Using Anti-Quotations in Metaquot + +Anti-Quotations allow you to insert dynamic expressions into your Metaquot ASTs. + +#### Example: Inserting Dynamic Expressions with Anti-Quotations + +[:link: Sample Code](./building_ast.ml#L72-L77) + +To insert a dynamic expression into a Metaquot AST: + +```ocaml +let anti_quotation_expr expr = [%expr 1 + [%e expr]] +``` + +For example, to insert the AST for `1`: + +```ocaml +let _ = + print_endline + ("\nLet expression with metaquot and anti-quotation: " + ^ Astlib.Pprintast.string_of_expression (anti_quotation_expr (one ~loc))) +``` + +## Building Complex Expressions + +Beyond simple expressions, you may need to build more complex ASTs, such as `let` expressions. + +### Example 1: Constructing a Let Expression with `AST_builder` + +[:link: Sample Code](./building_ast.ml#L40-L60) + +To build a `let` expression that binds the value `3` to the variable `foo`: + +```ocaml +let let_expression = + let expression = + Ast_builder.Default.pexp_constant ~loc:Location.none + (Pconst_integer ("3", None)) + in + let pattern = + Ast_builder.Default.ppat_var ~loc:Location.none + (Ast_builder.Default.Located.mk ~loc:Location.none "foo") + in + let let_binding = + Ast_builder.Default.value_binding ~loc:Location.none ~pat:pattern + ~expr:expression + in + Ast_builder.Default.pexp_let ~loc:Location.none Nonrecursive [ let_binding ] + (Ast_builder.Default.eunit ~loc:Location.none) +``` + +### Example 2: Constructing a Let Expression with Metaquot + +[:link: Sample Code](./building_ast.ml#L62-L70) + +Alternatively, with Metaquot: + +```ocaml +let let_expression = + [%expr + let foo = 3 in + ()] +``` + +This approach is shorter and easier to understand. + +## Conclusion + +In this section, we explored three methods for building ASTs: + +- **Pure OCaml**: The most basic but verbose approach. +- **Using `AST_builder`**: A more readable and maintainable option. +- **Using Metaquot**: The most intuitive method, especially when combined with Anti-Quotations for dynamic values. + +Each method has its strengths, so choose the one that best fits your needs. Understanding all three will give you greater flexibility in creating effective and maintainable PPXs. + +### [On the next section, we will learn how to destructure an AST.](../b%20-%20Destructing%20AST/README.md) diff --git a/examples/1-AST/a - Building AST/building_ast.ml b/examples/1-AST/a - Building AST/building_ast.ml new file mode 100644 index 000000000..7c337f71c --- /dev/null +++ b/examples/1-AST/a - Building AST/building_ast.ml @@ -0,0 +1,77 @@ +open Ppxlib + +let loc = Location.none + +let zero ~loc : Ppxlib_ast.Ast.expression = + { + pexp_desc = Pexp_constant (Pconst_integer ("0", None)); + pexp_loc = loc; + pexp_loc_stack = []; + pexp_attributes = []; + } + +let _ = + print_endline + ("\nAST with AST pure tree build: " + ^ Astlib.Pprintast.string_of_expression (zero ~loc)) + +let one ~loc = + Ast_builder.Default.pexp_constant ~loc (Parsetree.Pconst_integer ("1", None)) + +let _ = + print_endline + ("\nAST with AST build pexp_constant: " + ^ Astlib.Pprintast.string_of_expression (one ~loc)) + +let two ~loc = Ast_builder.Default.eint ~loc 2 + +let _ = + print_endline + ("\nAST with AST build eint: " + ^ Astlib.Pprintast.string_of_expression (two ~loc)) + +let three ~loc = [%expr 3] + +let _ = + print_endline + ("\nAST with AST build eint: " + ^ Astlib.Pprintast.string_of_expression (three ~loc)) + +let let_expression = + let expression = + Ast_builder.Default.pexp_constant ~loc:Location.none + (Pconst_integer ("3", None)) + in + let pattern = + Ast_builder.Default.ppat_var ~loc:Location.none + (Ast_builder.Default.Located.mk ~loc:Location.none "foo") + in + let let_binding = + Ast_builder.Default.value_binding ~loc:Location.none ~pat:pattern + ~expr:expression + in + + Ast_builder.Default.pexp_let ~loc:Location.none Nonrecursive [ let_binding ] + (Ast_builder.Default.eunit ~loc:Location.none) + +let _ = + print_endline + ("\nLet expression with Ast_builder: " + ^ Astlib.Pprintast.string_of_expression let_expression) + +let let_expression = + [%expr + let foo = 3 in + ()] + +let _ = + print_endline + ("\nLet expression with metaquot: " + ^ Astlib.Pprintast.string_of_expression let_expression) + +let anti_quotation_expr expr = [%expr 1 + [%e expr]] + +let _ = + print_endline + ("\nLet expression with metaquot and anti-quotation: " + ^ Astlib.Pprintast.string_of_expression (anti_quotation_expr (one ~loc))) diff --git a/examples/1-AST/a - Building AST/dune b/examples/1-AST/a - Building AST/dune new file mode 100644 index 000000000..82eb2ed13 --- /dev/null +++ b/examples/1-AST/a - Building AST/dune @@ -0,0 +1,7 @@ +(executable + (name building_ast) + (public_name building-ast-example) + (package ppxlib) + (libraries ppxlib ppxlib.astlib) + (preprocess + (pps ppxlib.metaquot))) diff --git a/examples/1-AST/ast_explorer.ml b/examples/1-AST/ast_explorer.ml new file mode 100644 index 000000000..79e5f384d --- /dev/null +++ b/examples/1-AST/ast_explorer.ml @@ -0,0 +1,8 @@ +(* + Add any code you want to explore here + and run `ppxlib-pp-ast ./examples/1-AST/ast_explorer.ml` on the repo root to see the AST +*) + +(* Sample code, edit as you wish *) +let name = "john doe" +let age = 99 \ No newline at end of file diff --git a/examples/1-AST/attribute_name-ast.png b/examples/1-AST/attribute_name-ast.png new file mode 100644 index 000000000..35d78b9e1 Binary files /dev/null and b/examples/1-AST/attribute_name-ast.png differ diff --git a/examples/1-AST/attribute_name.png b/examples/1-AST/attribute_name.png new file mode 100644 index 000000000..c9c6c4361 Binary files /dev/null and b/examples/1-AST/attribute_name.png differ diff --git a/examples/1-AST/attribute_payload-ast.png b/examples/1-AST/attribute_payload-ast.png new file mode 100644 index 000000000..ed3ebd901 Binary files /dev/null and b/examples/1-AST/attribute_payload-ast.png differ diff --git a/examples/1-AST/attribute_payload.png b/examples/1-AST/attribute_payload.png new file mode 100644 index 000000000..8f3e777ef Binary files /dev/null and b/examples/1-AST/attribute_payload.png differ diff --git a/examples/1-AST/b - Destructing AST/README.md b/examples/1-AST/b - Destructing AST/README.md new file mode 100644 index 000000000..233fbce6a --- /dev/null +++ b/examples/1-AST/b - Destructing AST/README.md @@ -0,0 +1,176 @@ +# Destructuring AST + +:link: [Docs](https://ocaml-ppx.github.io/ppxlib/ppxlib/matching-code.html) + +This section has code examples to help you understand it better. +To run the examples: + +```sh +make demo-destructing_ast +``` + +### Table of Contents + +- [Description](#description) +- [AST Structure Pattern Matching](#ast-structure-pattern-matching) + - [Example: Matching Integer Payload Manually](#example-matching-integer-payload-manually) +- [Using `Ast_pattern` High-Level Destructors](#using-ast_pattern-high-level-destructors) + - [Example 1: Matching Integer Payload with `Ast_pattern`](#example-1-matching-integer-payload-with-ast_pattern) + - [Example 2: Simplifying Matching with `eint`](#example-2-simplifying-matching-with-eint) +- [Using Metaquot](#using-metaquot) + - [Example 1: Matching Integer Payload with Metaquot](#example-1-matching-integer-payload-with-metaquot) + - [Example 2: Matching Complex Expressions with Metaquot and Anti-Quotations](#example-2-matching-complex-expressions-with-metaquot-and-anti-quotations) +- [Conclusion](#conclusion) + +## Description + +Destructuring an AST (Abstract Syntax Tree) is essential when creating a PPX (preprocessor extension) in OCaml. To generate or transform code, you must first break down the AST to understand and manipulate its structure. + +For example, if you want to transform this code: + +```ocaml +let one = [%one] +``` + +into: + +```ocaml +let one = 1 +``` + +You’ll need to destructure the AST representing the extension point (`[%one]`) to replace it with `1`. +There are several ways to destructure an AST. We’ll explore three methods: + +- **AST Structure Pattern Matching** +- **Using `Ast_pattern` High-Level Destructors** +- **Using Metaquot** + +## AST Structure Pattern Matching + +The most fundamental method for destructuring an AST in PPXLib is by directly matching on the AST’s structure. + +### Example: Matching Integer Payload Manually + +[:link: Sample Code](./destructuring_ast.ml#L11-L26) + +Let’s say we want to destructure an AST representing the integer `1`: + +```ocaml +let match_int_payload ~loc payload = + match payload with + | PStr + [ + { + pstr_desc = + Pstr_eval + ({ pexp_desc = Pexp_constant (Pconst_integer (value, None)); _ }, _); + _; + }; + ] -> ( + try Ok (value |> int_of_string) + with Failure _ -> + Error (Location.Error.createf ~loc "Value is not a valid integer")) + | _ -> Error (Location.Error.createf ~loc "Wrong pattern") +``` + +1. **Pattern Matching the Payload**: + - Begins by matching the `payload` with the expected structure. + - The pattern expects a structure (`PStr`) containing a single item. +2. **Destructuring the Structure Item**: + - Matches the `pstr_desc` field, expecting an evaluated expression (`Pstr_eval`). + - The expression should be a constant integer (`Pexp_constant` with `Pconst_integer`). + - Captures the integer value as a string in `value`. +3. **Handling the Matched Value**: + - Converts the `value` to an integer and returns `Ok` if successful. + - If conversion fails, returns an error message. +4. **Handling Mismatched Patterns**: + - If the `payload` doesn’t match the expected structure, it returns an error. + +While this method is powerful, it can be verbose and difficult to maintain as patterns become more complex. + +## Using `Ast_pattern` High-Level Destructors + +To make AST destructuring more readable, PPXLib provides the `Ast_pattern` module, which offers high-level destructors. + +### Example 1: Matching Integer Payload with `Ast_pattern` + +[:link: Sample Code](./destructuring_ast.ml#L37-L40) + +Let’s destructure the same integer `1` AST using `Ast_pattern`: + +```ocaml +open Ppxlib + +let match_int_payload = + let open Ast_pattern in + pstr (pstr_eval (pexp_constant (pconst_integer (string "1") none)) nil ^:: nil) +``` + +This code achieves the same result as the previous example but in a more concise and readable way. + +- **`PStr`** becomes `pstr` +- **`Pstr_eval`** becomes `pstr_eval` +- **`Pexp_constant`** becomes `pexp_constant` +- **`Pconst_integer`** becomes `pconst_integer` + +### Example 2: Simplifying Matching with `eint` + +[:link: Sample Code](./destructuring_ast.ml#L40-L49) + +You can further simplify it: + +```ocaml +let match_int_payload = + let open Ast_pattern in + pstr (pstr_eval (eint (int 1)) nil ^:: nil) +``` + +Using `eint` instead of `pexp_constant` and `pconst_integer` provides better type safety. The `int` wildcard captures the integer value. + +## Using Metaquot + +Metaquot is a syntax extension that allows you to write and destructure ASTs more intuitively. + +### Example 1: Matching Integer Payload with Metaquot + +[:link: Sample Code](./destructuring_ast.ml#L51-L60) + +Let’s destructure the same integer `1` AST with Metaquot: + +```ocaml +let match_int_payload expr = + match expr with + | [%expr 1] -> Ok 1 + | _ -> Error (Location.Error.createf ~loc:expr.pexp_loc "Wrong pattern") +``` + +### Example 2: Matching Complex Expressions with Metaquot and Anti-Quotations + +[:link: Sample Code](./destructuring_ast.ml#L79-L90) + +For example, to match any expression of the form `1 + `: + +```ocaml +let match_int_payload expr = + match expr with + | [%expr 1 + [%e? e]] -> ( + match e with + | { pexp_desc = Pexp_constant (Pconst_integer (value, None)); _ } -> + Ok (1 + int_of_string value) + | _ -> Error (Location.Error.createf ~loc:e.pexp_loc "Invalid integer")) + | _ -> Error (Location.Error.createf ~loc:expr.pexp_loc "Wrong pattern") +``` + +Metaquot simplifies the process, making the AST patterns more readable, especially for complex structures. + +## Conclusion + +In this section, we explored different methods to destructure an AST using PPXLib: + +- **AST Structure Pattern Matching**: Powerful but verbose. +- **Using `Ast_pattern` High-Level Destructors**: More readable and maintainable. +- **Using Metaquot**: Intuitive and effective for both simple and complex patterns. + +There’s no right way to destructure an AST, choose the approach that best fits your use case. Understanding all these methods is valuable for creating robust and maintainable PPXs. + +### [On the next section, we will learn how to write a PPX.](../../2%20-%20Writing%20PPXs/README.md) \ No newline at end of file diff --git a/examples/1-AST/b - Destructing AST/destructuring_ast.ml b/examples/1-AST/b - Destructing AST/destructuring_ast.ml new file mode 100644 index 000000000..6ca4fc544 --- /dev/null +++ b/examples/1-AST/b - Destructing AST/destructuring_ast.ml @@ -0,0 +1,98 @@ +open Ppxlib + +let loc = Location.none + +let one ~loc = [%expr 1] + +let structure_item loc = + let expr = one ~loc in + Ast_builder.Default.pstr_eval ~loc expr [] + +let match_int_payload ~loc payload = + match payload with + | PStr + [ + { + pstr_desc = + Pstr_eval + ({ pexp_desc = Pexp_constant (Pconst_integer (value, None)); _ }, _); + _; + }; + ] -> ( + try Ok (value |> int_of_string) + with Failure _ -> + Error (Location.Error.createf ~loc "Value is not a valid integer")) + | _ -> Error (Location.Error.createf ~loc "Wrong pattern") + +let test_match_pstr_eval () = + let structure_item = structure_item loc in + let structure = [ structure_item ] in + match match_int_payload ~loc (PStr structure) with + | Ok _ -> + Printf.printf "\nMatched 1 using Ast_pattern" + | Error _ -> Printf.printf "\nDid not match pstr_eval" + +let _ = test_match_pstr_eval () + +let match_int_payload = + let open Ast_pattern in + pstr (pstr_eval (pexp_constant (pconst_integer (string "1") none)) nil ^:: nil) + +let test_match_pstr_eval () = + let structure_item = structure_item loc in + let structure = [ structure_item ] in + try Ast_pattern.parse match_int_payload loc (PStr structure) Printf.printf "\nMatched 1 using Ast_pattern" + with _ -> Printf.printf "\nDid not match 1 payload using Ast_pattern" + +let _ = test_match_pstr_eval () + +let match_int_payload = + let open Ast_pattern in + pstr (pstr_eval (eint (int 1)) nil ^:: nil) + +let test_match_pstr_eval () = + let structure_item = structure_item loc in + let structure = [ structure_item ] in + try Ast_pattern.parse match_int_payload loc (PStr structure) Printf.printf "\nMatched 1 using Ast_patter with eint" + with _ -> Printf.printf "\nDid not match 1 payload using Ast_pattern with eint" + +let _ = test_match_pstr_eval () + +let match_int_payload expr = + match expr with + | [%expr 1] -> Ok 1 + | _ -> + Error + (Location.Error.createf ~loc:expr.pexp_loc + "Value is not a valid integer") + +let test_match_pstr_eval () = + let expr = one ~loc in + match match_int_payload expr with + | Ok _ -> + Printf.printf "\nMatched 1 using metaquot" + | Error _ -> Printf.printf "\nDid not match 1 using metaquot" + +let _ = test_match_pstr_eval () +let let_expression = [%expr 1 + 4] + +let match_int_payload expr = + match expr with + | [%expr 1 + [%e? e]] -> ( + match e with + | { pexp_desc = Pexp_constant (Pconst_integer (value, None)); _ } -> + Ok (1 + int_of_string value) + | _ -> + Error + (Location.Error.createf ~loc:e.pexp_loc + "Value is not a valid integer")) + | _ -> Error (Location.Error.createf ~loc:expr.pexp_loc "Wrong pattern") + +let test_match_pstr_eval () = + match match_int_payload let_expression with + | Ok value -> + Printf.printf "\nMatched 1 + using metaquot and anti-quotation: %s" + (value |> string_of_int) + | Error _ -> Printf.printf "\nDid not match matched 1 + using metaquot and anti-quotation" + +let _ = test_match_pstr_eval () diff --git a/examples/1-AST/b - Destructing AST/dune b/examples/1-AST/b - Destructing AST/dune new file mode 100644 index 000000000..6399e89dc --- /dev/null +++ b/examples/1-AST/b - Destructing AST/dune @@ -0,0 +1,7 @@ +(executable + (name destructuring_ast) + (public_name destructuring-ast-example) + (package ppxlib) + (libraries ppxlib ppxlib.astlib) + (preprocess + (pps ppxlib.metaquot))) diff --git a/examples/1-AST/extension_node-ast.png b/examples/1-AST/extension_node-ast.png new file mode 100644 index 000000000..c78f4d65e Binary files /dev/null and b/examples/1-AST/extension_node-ast.png differ diff --git a/examples/1-AST/extension_node.png b/examples/1-AST/extension_node.png new file mode 100644 index 000000000..0d10b83db Binary files /dev/null and b/examples/1-AST/extension_node.png differ diff --git a/examples/1-AST/extension_node_name-ast.png b/examples/1-AST/extension_node_name-ast.png new file mode 100644 index 000000000..d92212b05 Binary files /dev/null and b/examples/1-AST/extension_node_name-ast.png differ diff --git a/examples/1-AST/extension_node_name.png b/examples/1-AST/extension_node_name.png new file mode 100644 index 000000000..40fed1be7 Binary files /dev/null and b/examples/1-AST/extension_node_name.png differ diff --git a/examples/1-AST/extension_node_payload-ast.png b/examples/1-AST/extension_node_payload-ast.png new file mode 100644 index 000000000..41381d669 Binary files /dev/null and b/examples/1-AST/extension_node_payload-ast.png differ diff --git a/examples/1-AST/extension_node_payload.png b/examples/1-AST/extension_node_payload.png new file mode 100644 index 000000000..c9ef05f06 Binary files /dev/null and b/examples/1-AST/extension_node_payload.png differ diff --git a/examples/1-AST/module_name-ast.png b/examples/1-AST/module_name-ast.png new file mode 100644 index 000000000..08d5d2900 Binary files /dev/null and b/examples/1-AST/module_name-ast.png differ diff --git a/examples/1-AST/module_name.png b/examples/1-AST/module_name.png new file mode 100644 index 000000000..b2a312e25 Binary files /dev/null and b/examples/1-AST/module_name.png differ diff --git a/examples/1-AST/module_structure-ast.png b/examples/1-AST/module_structure-ast.png new file mode 100644 index 000000000..fdedf158f Binary files /dev/null and b/examples/1-AST/module_structure-ast.png differ diff --git a/examples/1-AST/module_structure.png b/examples/1-AST/module_structure.png new file mode 100644 index 000000000..7a4110458 Binary files /dev/null and b/examples/1-AST/module_structure.png differ diff --git a/examples/1-AST/module_structure_item-ast.png b/examples/1-AST/module_structure_item-ast.png new file mode 100644 index 000000000..3aa6515b5 Binary files /dev/null and b/examples/1-AST/module_structure_item-ast.png differ diff --git a/examples/1-AST/module_structure_item.png b/examples/1-AST/module_structure_item.png new file mode 100644 index 000000000..f63da845b Binary files /dev/null and b/examples/1-AST/module_structure_item.png differ diff --git a/examples/1-AST/pattern-ast.png b/examples/1-AST/pattern-ast.png new file mode 100644 index 000000000..e9d3fb149 Binary files /dev/null and b/examples/1-AST/pattern-ast.png differ diff --git a/examples/1-AST/pattern.png b/examples/1-AST/pattern.png new file mode 100644 index 000000000..c512ff3c5 Binary files /dev/null and b/examples/1-AST/pattern.png differ diff --git a/examples/1-AST/strucure_item-ast.png b/examples/1-AST/strucure_item-ast.png new file mode 100644 index 000000000..975dbee3e Binary files /dev/null and b/examples/1-AST/strucure_item-ast.png differ diff --git a/examples/1-AST/strucure_item.png b/examples/1-AST/strucure_item.png new file mode 100644 index 000000000..322d52a07 Binary files /dev/null and b/examples/1-AST/strucure_item.png differ diff --git a/examples/2-Writing-PPXs/README.md b/examples/2-Writing-PPXs/README.md new file mode 100644 index 000000000..54e75b6c9 --- /dev/null +++ b/examples/2-Writing-PPXs/README.md @@ -0,0 +1,44 @@ +# Writing PPXs + +## Description + +After knowing what is an [AST](../1%20-%20AST/README.md), how to [build an AST](../1%20-%20AST/a%20-%20Building%20AST/README.md) and [destructure it](../1%20-%20AST/b%20-%20Destructing%20AST/README.md), we can now write our own PPX in OCaml. + +## Transformations + +The soul of a PPX is the transformation. We want to get our AST and transform it into something else, like a new AST or lint errors. + +Those transformations can be divided into two categories that we will cover on nested folders: + +- [Context-free transformations](./a%20-%20Context%20Free/README.md) +- [Global transformations](./b%20-%20Global/README.md) + +And they can work in different phases: + +- Lint (Global) +- Preprocess (Global) +- Instrumentation - Before (Global) +- Context-free +- Global Trasformation (Global) +- Instrumentation - After (Global) + +The following diagram shows the order of the phases and Driver's methods: + +
+ The beautiful MDN logo. +
Drive's methods phases diagram. (reference)
 +
+ +## How + +PPXs commonly follow these steps: + +- Match the AST we want. +- Work with the AST. For example: + - Returning a new AST. Add new functions, change the name of a variable, etc. + - Linting the code. + - or doing anything else. Really, you're programming, everything is possible! + +### [On the next section, we will learn more about Context Free transformations.](./a%20-%20Context%20Free/README.md) diff --git a/examples/2-Writing-PPXs/a - Context Free/README.md b/examples/2-Writing-PPXs/a - Context Free/README.md new file mode 100644 index 000000000..dc24dd804 --- /dev/null +++ b/examples/2-Writing-PPXs/a - Context Free/README.md @@ -0,0 +1,491 @@ +# Context-Free Transformations + +This section has code examples to help you understand it better. +To run the examples: + +```sh +make demo-context_free +``` + +### Table of Contents + +- [Description](#description) +- [Types of Context-Free Transformations](#types-of-context-free-transformations) +- [Extenders](#extenders) + - [Example 1: A Simple Extender](#example-1-a-simple-extender) + - [Example 2: A More Complex Extender with Payload](#example-2-a-more-complex-extender-with-payload) +- [Derivers](#derivers) + - [Example 1: Enum Deriver](#example-1-enum-deriver) + - [Example 2: Enum Deriver with args](#example-2-enum-deriver-with-args) + +## Description + +Context-free transformations allow you to read and modify code locally, without needing to consider the global context. In practice, this means that a portion of the Abstract Syntax Tree (AST) is provided to the transformation, and the transformation returns a new AST with the applied modifications. + +### Types of Context-Free Transformations + +There are two main types of context-free transformations: + +- **[Extenders](#extenders)**: These modify the extension node by generating new code. +- **[Derivers](#derivers)**: These append code after the item without changing the original item. + +## Extenders +:page_facing_up: [Doc](https://ocaml-ppx.github.io/ppxlib/ppxlib/driver.html#def_extenders)
+⬅️ Extenders work with extension nodes. If you have any doubts about attributes, please review the [AST Extension Node section](../../1%20-%20AST/README.md#ast_extension_node). + +Extenders allow you to replace an extension node with new content. However, they do not have direct access to the surrounding code context, so they cannot modify the surrounding code. + +If an extender is broken or missing, the code will not compile. Therefore, it is important to ensure that the extender is correctly implemented. + +An extension node is a node in the AST that represents an extension point. For example, in the code `let x = [%foo]`, `[%foo]` is an extension node. + +Let's look at some examples to understand how this works. + +With extenders, we need to: + +- **Hook the extension.** +- **Transform the payload** (if there is one). +- **Create a new AST.** + +### Example 1: A Simple Extender +[:link: Sample Code](./context_free.ml#L5-L17) + +Consider the following code: + +```ocaml +let one = [%one] +(* Output: let one = 1 *) +``` + +Here, `[%one]` is replaced with the integer value `1`. This is a basic example of an extender transformation. + +#### Steps to Implement This Extender: + +- **Declare the extension name:** + + ```ocaml + let extender_name = "one" + ``` + +- **Define the extender extractor:** + Since there is no payload (additional data), we define the extractor as: + + ```ocaml + let extender_extracter = Ast_pattern.(pstr nil) + ``` + +- **Create the new AST:** + We define the expression that will replace `[%one]`: + + ```ocaml + let expression ~loc = [%expr 1] + ``` + + Alternatively, you can use: + + ```ocaml + let expression ~loc = Ast_builder.Default.eint ~loc 1 + ``` + +- **Declare the extender and register it:** + + ```ocaml + (* Define the expansion logic *) + let expand ~ctxt = + let loc = Expansion_context.Extension.extension_point_loc ctxt in + expression ~loc + + (* Define the extension *) + let extension = + Extension.V3.declare extender_name Extension.Context.expression + extender_extracter + expand + + (* Register the extender *) + let rule = Ppxlib.Context_free.Rule.extension extension + let () = Driver.register_transformation ~rules:[ rule ] extender_name + ``` + +### Example 2: A More Complex Extender with Payload +[:link: Sample Code](./context_free.ml#L22-L47) + +Let's look at a more complex example, where we replace `[%emoji "grin"]` with an emoji: + +```ocaml +let grin = [%emoji "grin"] +(* Output: let grin = "😀" *) +``` + +#### Steps to Implement This Extender: + +- **Declare the extension name and extractor:** + Here, the payload is a string (the alias of the emoji): + + ```ocaml + let extender_name = "emoji" + let extender_extracter = Ast_pattern.(single_expr_payload (estring __)) + ``` + +- **Create the new AST:** + We define the expression to replace the alias with the corresponding emoji: + + ```ocaml + let expression ~loc ~emoji = [%expr [%e estring ~loc emoji]] + ``` + +- **Define the expansion logic:** + We need to map the alias to an emoji and return the appropriate AST. If the alias isn't found, we return an error: + + ```ocaml + let emojis = + [ + { emoji = "😀"; alias = "grin" }; + { emoji = "😃"; alias = "smiley" }; + { emoji = "😄"; alias = "smile" }; + ] + + let expand ~ctxt emoji_text = + let loc = Expansion_context.Extension.extension_point_loc ctxt in + + let find_emoji_by_alias alias = + List.find_opt (fun emoji -> alias = emoji.alias) emojis + in + + match find_emoji_by_alias emoji_text with + | Some value -> expression ~loc ~emoji:value.emoji + | None -> + let ext = + Location.error_extensionf ~loc "No emoji found for alias %s" emoji_text + in + Ast_builder.Default.pexp_extension ~loc ext + ``` + +- **Declare the extender:** + + ```ocaml + let extension = + Extension.V3.declare extender_name Extension.Context.expression + extender_extracter + expand + ``` + +--- + +## Derivers +:page_facing_up: [Doc](https://ocaml-ppx.github.io/ppxlib/ppxlib/driver.html#def_derivers)
+⬅️ A deriver is a custom attribute provided by PPXlib. If you have any doubts about attributes, please review the AST Attributes section. + +Derivers differ from extenders in that they append new code after an existing item rather than replacing parts of it. The new code can work in conjunction with the original item or independently, depending on the transformation needed. They are specified using the [@@deriving] attribute. + +A simple and common example of a deriver is the `enum` deriver: + +```ocaml +type t = A | B [@@deriving enum] +(* Output: +type t = A | B +let to_string = function + | A -> "A" + | B -> "B" +let from_string = function + | "A" -> A + | "B" -> B + | _ -> raise (Invalid_argument "Argument doesn't match t variants") +*) +``` + +In this example, the deriver `enum` automatically generates `to_string` and `from_string` functions for a variant type. + +Derivers are generally more complex to register than extenders, but PPXLib simplifies this with the `Deriving.add` function, which handles the registration. This function uses `Driver.register_transformation` under the hood. + +It can be attached to various types of structures and signatures. For instance, to create a deriver for a type declaration, you would use the `~str_type_decl` argument. If the deriver should also work for signature items, you would use the `~sig_type_decl` argument. + +The full list of arguments for `Deriving.add` can be found in the [documentation](https://ocaml-ppx.github.io/ppxlib/ppxlib/Ppxlib/Deriving/index.html#val-add). + +### Example 1: Enum Deriver +[:link: Sample Code](./context_free.ml#L51-L125) + +The following example is more complex. Take your time; it’s explained step by step. + +Let's say we want to add `to_string` and `from_string` functions to a simple variant type: + +```ocaml +type t = A | B [@@deriving enum] +(* Output: +type t = A | B +let to_string = function + | A -> "A" + | B -> "B" +let from_string = function + | "A" -> A + | "B" -> B + | _ -> raise (Invalid_argument "Argument doesn't match t variants") +*) +``` + +#### Steps to Implement This Deriver: + +- **Declare the deriver name:** + + ```ocaml + let deriver_name = "enum" + ``` + +- **Define the arguments for the deriver:** + For this example, we don't have any arguments: + + ```ocaml + let args () = Deriving.Args.(empty) + ``` + +- **Build the new AST:** + We'll match the AST we want to transform and generate the `to_string` and `from_string` functions. + + - **Match the type declaration with pattern matching:** + + ```ocaml + let enum ~ctxt ast = + let loc = Expansion_context.Deriver.derived_item_loc ctxt in + match ast with + | ( _, + [ + { + ptype_name = { txt = type_name; _ }; + ptype_kind = Ptype_variant variants; + _; + }; + ] ) -> (*...*) + ``` + + - **Create functions to generate the patterns:** + All we are going to do here is what we covered in [Building AST](../../1%20-%20AST/a%20-%20Building%20AST/README.md). So it shouldn't be a problem to understand this part. + + - **Creating the `to_string` function:** + + ```ocaml + let function_name suffix = type_name ^ suffix in + let arg_pattern = [%pat? value] in + let function_name_pattern = + [%pat? [%p ppat_var ~loc { txt = function_name "_to_string"; loc }]] + in + let to_string_expr = + [%stri + let [%p function_name_pattern] = + fun [%p arg_pattern] -> + [%e + pexp_match ~loc [%expr value] + (List.map + (fun { pcd_name = { txt = value; _ }; _ } -> + case + ~lhs: + (ppat_construct ~loc (Located.lident ~loc value) None) + ~guard:None ~rhs:(expr_string value)) + variants)]] + ``` + + - **Build the `from_string` function:** + + ```ocaml + let else_case = + case + ~lhs:[%pat? [%p ppat_any ~loc]] + ~guard:None + ~rhs: + [%expr raise (Invalid_argument "Argument doesn't match variants")] + in + let from_string_expr = + [%stri + let [%p function_name_pattern] = + fun [%p arg_pattern] -> + [%e + pexp_match ~loc [%expr value] + (List.map + (fun { pcd_name = { txt = value; _ }; _ } -> + case + ~lhs: + (ppat_constant ~loc (Pconst_string (value, loc, None))) + ~guard:None ~rhs: + (pexp_construct ~loc (Located.lident ~loc value) None)) + variants + @ [ else_case ])]] + ``` + + - **Combine and return the functions:** + + ```ocaml + let enum ~ctxt ast = + let loc = Expansion_context.Deriver.derived_item_loc ctxt in + match ast with + | ( _, + [ + { + ptype_name = { txt = type_name; _ }; + ptype_kind = Ptype_variant variants; + _; + }; + ] ) -> + let function_name suffix = type_name ^ suffix in + let arg_pattern = [%pat? value] in + let expr_string = Ast_builder.Default.estring ~loc in + let function_name_pattern = + [%pat? [%p ppat_var ~loc { txt = function_name "_to_string"; loc }]] + in + let to_string_expr = + [%stri + let [%p function_name_pattern] = + fun [%p arg_pattern] -> + [%e + pexp_match ~loc [%expr value] + (List.map + (fun { pcd_name = { txt = value; _ }; _ } -> + case + ~lhs: + (ppat_construct ~loc (Located.lident ~loc value) None) + ~guard:None ~rhs:(expr_string value)) + variants)]] + in + (* Uncomment to see the generated code *) + (* print_endline (Astlib.Pprintast.string_of_structure [ to_string_expr ]); *) + let else_case = + case + ~lhs:[%pat? [%p ppat_any ~loc]] + ~guard:None + ~rhs: + [%expr + [%e + pexp_apply ~loc + [%expr + raise + (Invalid_argument + [%e + estring ~loc + ("Argument doesn't match " ^ type_name + ^ " variants")])] + []]] + in + let function_name_pattern = + [%pat? [%p ppat_var ~loc { txt = function_name "_from_string"; loc }]] + in + let from_string_expr = + [%stri + let [%p function_name_pattern] = + fun [%p arg_pattern] -> + [%e + pexp_match ~loc [%expr value] + (List.map + (fun { pcd_name = { txt = value; _ }; _ } -> + case + ~lhs: + (ppat_constant ~loc (Pconst_string (value, loc, None))) + ~guard:None ~rhs: + (pexp_construct ~loc (Located.lident ~loc value) None)) + variants + @ [ else_case ])]] + in + (* Uncomment to see the generated code *) + (* print_endline (Astlib.Pprintast.string_of_structure [ from_string_expr ]); *) + [ from_string_expr; to_string_expr ] + | _ -> + [%str + [%ocaml.error "Ops, enum2 must be a type with variant without args"]] + ``` + +- **Declare the deriver:** + + ```ocaml + let generator () = + Deriving.Generator.V2.make (args ()) (fun ~ctxt -> + enum ~loc:Expansion_context.Deriver.derived_item_loc ctxt) + let _ = Deriving.add deriver_name ~str_type_decl:(generator ()) + ``` + +### Example 2: Enum Deriver with args +[:link: Sample Code](./context_free.ml#L126-L216) + +Let's say we want to add `to_string` and `from_string` functions to a variant type, but we want to have it with options instead of raise: + +```ocaml +type t = A | B [@@deriving enum2 ~opt] +(* Output: +type t = A | B +let to_string = function + | A -> "A" + | B -> "B" +let from_string = function + | "A" -> Some A + | "B" -> Some B + | _ -> None +*) +``` + +#### Steps to Implement This Deriver: + +This is the same as the previous example, but we need to add a new argument to the deriver: + +- **Declare the deriver name and arguments:** + + ```ocaml + let deriver_name = "enum" + let args () = Deriving.Args.(empty +> arg "opt" bool) + ``` + +- **Build the new AST:** + There will no much difference on the enum code, we just need to check if the `opt` argument is `true` and add the `option` return to the `from_string` function and change the else to `None`: + + ```ocaml + let else_case = + case + ~lhs:[%pat? [%p ppat_any ~loc]] + ~guard:None + ~rhs: + (match opt with + | true -> [%expr None] + | _ -> + [%expr + raise (Invalid_argument "Argument doesn't match variants")]) + in + let function_name_pattern = + [%pat? [%p ppat_var ~loc { txt = function_name "_from_string"; loc }]] + in + let from_string_expr = + [%stri + let [%p function_name_pattern] = + fun [%p arg_pattern] -> + [%e + pexp_match ~loc [%expr value] + (List.map + (fun { pcd_name = { txt = value; _ }; _ } -> + case + ~lhs: + (ppat_constant ~loc (Pconst_string (value, loc, None))) + ~guard:None + ~rhs: + (match opt with + | true -> + [%expr + Some + [%e + pexp_construct ~loc + (Located.lident ~loc value) + None]] + | _ -> + pexp_construct ~loc + (Located.lident ~loc value) + None)) + variants + @ [ else_case ])]] + ``` + +## Conclusion + +Context-free transformations are a powerful tool in OCaml for modifying code locally. By understanding how to implement extenders and derivers, you can enhance your code generation capabilities and simplify repetitive tasks. With the examples provided, you should have a solid foundation for creating your own context-free transformations using PPXLib. + +### [On the next section, we will learn more about global transformations.](../b%20-%20Global/README.md) + +--- + +**WIP** :construction: + +Todo: +- [ ] Special Functions +- [ ] Constant Rewriting + diff --git a/examples/2-Writing-PPXs/a - Context Free/context_free.ml b/examples/2-Writing-PPXs/a - Context Free/context_free.ml new file mode 100644 index 000000000..64ecff9ee --- /dev/null +++ b/examples/2-Writing-PPXs/a - Context Free/context_free.ml @@ -0,0 +1,216 @@ +open Ppxlib +open Ast_builder.Default + +(* PPX Extender *) +let structure_item ~loc = [%expr 1] + +let expand ~ctxt = + let loc = Expansion_context.Extension.extension_point_loc ctxt in + structure_item ~loc + +let my_extension = + Extension.V3.declare "one" Extension.Context.expression + Ast_pattern.(pstr nil) + expand + +let rule = Ppxlib.Context_free.Rule.extension my_extension +let () = Driver.register_transformation ~rules:[ rule ] "one" + +(* PPX Extender with payload *) +type emoji = { emoji : string; alias : string } + +let pattern = Ast_pattern.(single_expr_payload (estring __)) +let expression ~loc ~value = [%expr [%e estring ~loc value]] + +let emojis = + [ + { emoji = "😀"; alias = "grin" }; + { emoji = "😃"; alias = "smiley" }; + { emoji = "😄"; alias = "smile" }; + ] + +let expand ~ctxt emoji_text = + let loc = Expansion_context.Extension.extension_point_loc ctxt in + + let find_emoji_by_alias alias = + List.find_opt (fun emoji -> alias = emoji.alias) emojis + in + + match find_emoji_by_alias emoji_text with + | Some value -> expression ~loc ~value:value.emoji + | None -> + let ext = + Location.error_extensionf ~loc "No emoji for %s alias" emoji_text + in + Ast_builder.Default.pexp_extension ~loc ext + +let my_extension = + Extension.V3.declare "emoji" Extension.Context.expression pattern expand + +(* PPX Deriver *) +let rule = Ppxlib.Context_free.Rule.extension my_extension +let () = Driver.register_transformation ~rules:[ rule ] "emoji" +let args () = Deriving.Args.(empty) + +(* add to_string and from_string helpers to a type variant *) +let enum ~ctxt ast = + let loc = Expansion_context.Deriver.derived_item_loc ctxt in + match ast with + | ( _, + [ + { + ptype_name = { txt = type_name; _ }; + ptype_kind = Ptype_variant variants; + _; + }; + ] ) -> + let function_name suffix = type_name ^ suffix in + let arg_pattern = [%pat? value] in + let expr_string = Ast_builder.Default.estring ~loc in + let function_name_pattern = + [%pat? [%p ppat_var ~loc { txt = function_name "_to_string"; loc }]] + in + let to_string_expr = + [%stri + let[@warning "-32"] [%p function_name_pattern] = + fun [%p arg_pattern] -> + [%e + pexp_match ~loc [%expr value] + (List.map + (fun { pcd_name = { txt = value; _ }; _ } -> + case + ~lhs: + (ppat_construct ~loc (Located.lident ~loc value) None) + ~guard:None ~rhs:(expr_string value)) + variants)]] + in + (* Uncomment to see the generated code *) + (* print_endline (Astlib.Pprintast.string_of_structure [ to_string_expr ]); *) + let else_case = + case + ~lhs:[%pat? [%p ppat_any ~loc]] + ~guard:None + ~rhs: + [%expr raise (Invalid_argument "Argument doesn't match variants")] + in + let function_name_pattern = + [%pat? [%p ppat_var ~loc { txt = function_name "_from_string"; loc }]] + in + let from_string_expr = + [%stri + let[@warning "-32"] [%p function_name_pattern] = + fun [%p arg_pattern] -> + [%e + pexp_match ~loc [%expr value] + (List.map + (fun { pcd_name = { txt = value; _ }; _ } -> + case + ~lhs: + (ppat_constant ~loc (Pconst_string (value, loc, None))) + ~guard:None + ~rhs: + (pexp_construct ~loc (Located.lident ~loc value) None)) + variants + @ [ else_case ])]] + in + (* Uncomment to see the generated code *) + (* print_endline (Astlib.Pprintast.string_of_structure [ from_string_expr ]); *) + [ from_string_expr; to_string_expr ] + | _ -> + [%str + [%ocaml.error "Ops, enum2 must be a type with variant without args"]] + +let generator () = Deriving.Generator.V2.make (args ()) enum +let _ = Deriving.add "enum" ~str_type_decl:(generator ()) +let args () = Deriving.Args.(empty +> flag "opt") + +let enum2 ~ctxt ast opt = + let loc = Expansion_context.Deriver.derived_item_loc ctxt in + match ast with + | ( _, + [ + { + ptype_name = { txt = type_name; _ }; + ptype_kind = Ptype_variant variants; + _; + }; + ] ) -> + let function_name suffix = type_name ^ suffix in + let expr_string = Ast_builder.Default.estring ~loc in + let arg_pattern = [%pat? value] in + let function_name_pattern = + [%pat? [%p ppat_var ~loc { txt = function_name "_to_string"; loc }]] + in + let to_string_expr = + [%stri + let[@warning "-32"] [%p function_name_pattern] = + fun [%p arg_pattern] -> + [%e + pexp_match ~loc [%expr value] + (List.fold_left + (fun acc { pcd_name = { txt = value; _ }; _ } -> + acc + @ [ + case + ~lhs: + (ppat_construct ~loc + (Located.lident ~loc value) + None) + ~guard:None ~rhs:(expr_string value); + ]) + [] variants)]] + in + + (* Uncomment to see the generated code *) + (* print_endline (Astlib.Pprintast.string_of_structure [ to_string_expr ]); *) + let else_case = + case + ~lhs:[%pat? [%p ppat_any ~loc]] + ~guard:None + ~rhs: + (match opt with + | true -> [%expr None] + | _ -> + [%expr + raise (Invalid_argument "Argument doesn't match variants")]) + in + let function_name_pattern = + [%pat? [%p ppat_var ~loc { txt = function_name "_from_string"; loc }]] + in + let from_string_expr = + [%stri + let[@warning "-32"] [%p function_name_pattern] = + fun [%p arg_pattern] -> + [%e + pexp_match ~loc [%expr value] + (List.map + (fun { pcd_name = { txt = value; _ }; _ } -> + case + ~lhs: + (ppat_constant ~loc (Pconst_string (value, loc, None))) + ~guard:None + ~rhs: + (match opt with + | true -> + [%expr + Some + [%e + pexp_construct ~loc + (Located.lident ~loc value) + None]] + | _ -> + pexp_construct ~loc + (Located.lident ~loc value) + None)) + variants + @ [ else_case ])]] + in + (* Uncomment to see the generated code *) + (* print_endline (Astlib.Pprintast.string_of_structure [ from_string_expr ]); *) + [ from_string_expr; to_string_expr ] + | _ -> + [%str + [%ocaml.error "Ops, enum2 must be a type with variant without args"]] + +let generator () = Deriving.Generator.V2.make (args ()) enum2 +let _ = Deriving.add "enum2" ~str_type_decl:(generator ()) diff --git a/examples/2-Writing-PPXs/a - Context Free/demo/context_free_demo.ml b/examples/2-Writing-PPXs/a - Context Free/demo/context_free_demo.ml new file mode 100644 index 000000000..e232e338b --- /dev/null +++ b/examples/2-Writing-PPXs/a - Context Free/demo/context_free_demo.ml @@ -0,0 +1,43 @@ +let one = [%one] +let _ = Printf.printf "One: %d\n" one +let grin = [%emoji "grin"] +let smiley = [%emoji "smiley"] +let _ = print_endline ("grin: " ^ grin) +let _ = print_endline ("smiley: " ^ smiley) + +(* enum with raise *) +let _ = print_endline "\n# Enum with raise" + +type game = Rock | Paper | Scissors [@@deriving enum] + +let _ = Printf.printf "Rock to string: %s\n" (game_to_string Rock) + +let _ = + Printf.printf "Paper to string: %s\n" + (game_to_string (game_from_string "Paper")) + +let _ = + try + Printf.printf "Stick to string: %s\n" + (game_to_string (game_from_string "Stick")) + with _ -> Printf.printf "Stick is not a valid value\n" + +(* enum with option *) +let _ = print_endline "\n# Enum with option" + +type game2 = Rock | Paper | Scissors [@@deriving enum2 ~opt] + +let _ = Printf.printf "Rock to string: %s\n" (game2_to_string Rock) + +let _ = + match game2_from_string "Paper" with + | Some value -> Printf.printf "Paper to string: %s\n" (game2_to_string value) + | None -> Printf.printf "Paper is not a valid value\n" + +let _ = + match game2_from_string "Stick" with + | Some value -> Printf.printf "Stick to string: %s\n" (game2_to_string value) + | None -> Printf.printf "Stick is not a valid value\n" + +(* Uncomment the code bellow to see the error *) +(* type bar = string [@@deriving enum2] *) diff --git a/examples/2-Writing-PPXs/a - Context Free/demo/dune b/examples/2-Writing-PPXs/a - Context Free/demo/dune new file mode 100644 index 000000000..58a18ba31 --- /dev/null +++ b/examples/2-Writing-PPXs/a - Context Free/demo/dune @@ -0,0 +1,6 @@ +(executable + (name context_free_demo) + (package ppxlib) + (public_name context-free-example) + (preprocess + (pps context_free))) diff --git a/examples/2-Writing-PPXs/a - Context Free/dune b/examples/2-Writing-PPXs/a - Context Free/dune new file mode 100644 index 000000000..306dfac34 --- /dev/null +++ b/examples/2-Writing-PPXs/a - Context Free/dune @@ -0,0 +1,7 @@ +(library + (name context_free) + (kind ppx_rewriter) + (package ppxlib) + (libraries ppxlib yojson ppxlib.astlib) + (preprocess + (pps ppxlib.metaquot))) diff --git a/examples/2-Writing-PPXs/b - Global/README.md b/examples/2-Writing-PPXs/b - Global/README.md new file mode 100644 index 000000000..5da81f461 --- /dev/null +++ b/examples/2-Writing-PPXs/b - Global/README.md @@ -0,0 +1,279 @@ +# Global Transformations + +This section contains code examples to help you understand how to implement global transformations in OCaml using PPXLib. +To run the examples: + +```sh +make demo-global +``` + +### Table of Contents + +- [Description](#description) +- [Types of Global Transformations](#types-of-global-transformations) +- [Using `Ast_traverse`](#using-ast_traverse) + - [How It Works](#how-it-works) + - [Key Points](#key-points) +- [Lint](#lint) + - [Example 1: Linting Variable Names to Have the Prefix `demo_`](#example-1-linting-variable-names-to-have-the-prefix-demo_) +- [Preprocess](#preprocess) + - [Example 1: Extending a Module with the `[@enum]` Attribute](#example-1-extending-a-module-with-the-enum-attribute) +- [Global Transformation](#global-transformation) + - [Example 1: Extending a Module with the `[@enum2 opt]` Attribute](#example-1-extending-a-module-with-the-enum2-opt-attribute) +- [Conclusion](#conclusion) + +## Description + +As we saw in the [Writing PPXs section](../README.md), global transformations are a powerful way to automate tasks that affect entire modules or large sections of code. By extending the principles of context-free transformations to operate at the module level, you can implement transformations that significantly reduce boilerplate and improve code consistency. + +### Types of Global Transformations + +- Lint +- Preprocess +- Instrumentation - Before +- Global Transformation +- Instrumentation - After + +For now, in this section, we are going to focus on **Lint**, **Preprocess**, and **Global Transformation** because they are the most common phases to register a global transformation. +In the future, we plan to add **Instrumentation - Before** and **Instrumentation - After**. + +## Using `Ast_traverse` + +To help with global transformations, we'll use the `Ast_traverse` module from PPXLib in all examples. `Ast_traverse` makes it easier to walk through and change the AST in a structured way. + +### How It Works: + +`Ast_traverse` is helpful for navigating and modifying complex structures like the AST. + +Here are the main types of traversals you can do with `Ast_traverse`: + +- **Iterators**: Go through the AST and perform actions on each node, often for side effects like checking for specific patterns or enforcing rules. + +- **Maps**: Traverse the AST and replace nodes where needed. This is useful for making changes to the AST and returning a modified version. + +- **Folds**: Traverse the AST while keeping track of some data (an accumulator) that gets updated at each node, such as counting nodes or gathering specific information. + +- **Lifts**: Transform an AST node into a different type by working from the bottom up, often used to convert AST structures into other forms. + +### Key Points: + +- **Inherit from `Ast_traverse` classes**: Depending on your needs, you can inherit from classes like `Ast_traverse.iter` for iterators or `Ast_traverse.map` for maps. This gives you a base to start from. + +- **Override specific methods**: Customize your traversal by overriding methods that handle specific AST nodes, like `module_binding` or `structure_item`. + +- **Register with `Driver.register_transformation`**: After defining your traversal, register it with the PPX driver. This ensures your transformations are applied during compilation. + +Using `Ast_traverse` simplifies global transformations, letting you efficiently modify large sections of code or entire modules without needing to handle all the details manually. + +## Lint + +Linting is a form of static analysis that checks code for potential errors, bugs, or style issues. PPXLib provides a mechanism to implement linting rules using PPX. It takes as input the whole AST and outputs a list of "lint" errors. For linting, we are going to use the `Ast_traverse.fold` as we want to provide a list of errors. + +### Example 1: Linting Variable Names to Have the Prefix `demo_` + +[:link: Sample Code](./context_free.ml#L1-L4) + +Let's create a linting rule that ensures that all `value_binding`s have the prefix `demo_`. + +#### Consider the following example: + +```ocaml +(* This will raise a lint error *) +let name = "John Doe" + +(* This will not raise a lint error *) +let demo_name = "John Doe" +``` + +#### Steps to Implement This Transformation: + +- **Understand the AST Structure:** + We want to match all `value_binding`s. To do this, it’s helpful to see the structure of the AST for a `value_binding`. For that, you can use [AST Explorer](https://astexplorer.net/#/gist/d479d32127d6fcb418622ee84b9aa3b2/27d0a140f268bae1a32c8882d55c0b26c7e03fe9). If you’re not familiar with reading ASTs, check out the [AST section](../../1%20-%20AST/README.md). + +- **Ast_traverse.fold:** + We are going to use `Ast_traverse.fold` to provide a list of errors. Since we want to match all `value_binding` names, we’ll override the `value_binding` method in the AST traversal object, and for each `value_binding`, we’ll check if the variable name starts with `demo_` using `value_binding.pvb_pat.ppat_desc`. + + ```ocaml + let traverse = + object + (* Inherit from Ast_traverse.fold with the Lint_error.t list as the accumulator *) + inherit [Driver.Lint_error.t list] Ast_traverse.fold + + (* Override the value_binding method to lint the variable name *) + (* the value_binding method is called for each value_binding in the AST *) + method! value_binding vb acc = + let loc = vb.pvb_loc in + match ast with + (* Match all pattern variables and get their names *) + | Ppat_var { txt = name; _ } -> + (* Check if the variable name starts with demo_ *) + if String.starts_with name ~prefix:"demo_" then acc + else + (* If not, add a lint error to the accumulator *) + Driver.Lint_error.of_string loc + "Oops, variable names must start with demo_" + :: acc + | _ -> acc + end + ``` + +- **Register the Lint Rule with the PPX Driver:** + Register with `~lint_impl`. + + ```ocaml + let _ = Driver.register_transformation "lint" ~lint_impl:traverse#structure + ``` + +## Preprocess + +Preprocessing is the first phase that alters the AST. + + +> [!WARNING] +> You should only register a transformation in this phase if it is really necessary. You can use the Global Transformation phase instead. + +### Example 1: Extending a Module with the `[@enum]` Attribute + +[:link: Sample Code](./context_free.ml#L9-L18) + +Let’s say we want to extend a module with automatically generated `to_string` and `from_string` functions based on a variant type using the `[@enum]` attribute. + +#### Consider the following example: + +```ocaml +module GameEnum = struct + type t = Rock | Paper | Scissors +end [@enum] +(* Output: +module GameEnum = struct + type t = Rock | Paper | Scissors + let to_string = function + | Rock -> "Rock" + | Paper -> "Paper" + | Scissors -> "Scissors" + let from_string = function + | "Rock" -> Rock + | "Paper" -> Paper + | "Scissors" -> Scissors + | _ -> failwith "Invalid string" +end *) +``` + +#### Steps to Implement This Global Transformation: + +- **Understand the AST Structure:** + We want to match a `module_expr` with the `[@enum]` attribute and generate `to_string` and `from_string` functions based on the variant type within the module. + +- **Ast_traverse.map:** + We are going to use `Ast_traverse.map` because we want to modify the AST. We’ll override the `module_expr` method in the AST traversal object to append the generated `to_string` and `from_string` functions to the module's structure. + + ```ocaml + let traverse = + object + inherit Ast_traverse.map as super + + (* Override the module_expr method to generate to_string and from_string functions *) + method! module_expr mod_exp = + (* Call the super method to traverse the module expression *) + let mod_exp = super#module_expr mod_exp in + (* Check if the module expression has the [@enum] attribute *) + match mod_exp.pmod_attributes with + | [ { attr_name = { txt = "enum"; _ }; _ } ] + -> ( + (* match the module expression structure to get the type name and variants *) + match mod_exp.pmod_desc with + | Pmod_structure + ([ { pstr_desc = Pstr_type (name, variants); _ } ] as str) -> + (* We are not going to show the enum function because we already covered it in the previous Context-free section *) + let type_ = + enum ~loc:mod_exp.pmod_loc (name, variants) () + in + (* Append the generated functions to the module structure *) + Ast_builder.Default.pmod_structure ~loc:mod_exp.pmod_loc (str @ type_) + | _ -> mod_exp) + | _ -> mod_exp + end + ``` + +- **Register the Deriver with the PPX Driver:** + + ```ocaml + let _ = Driver.register_transformation "enum" ~impl:traverse#structure + ``` + +## Global Transformation + +The Global Transformation phase can be confusing because everything we’ve discussed in this section falls under global transformations. However, the Global Transformation phase specifically refers to the phase that happens after the Context-free phase. + +This is the most common phase to register a global transformation that alters the AST. + +The API of the global transformation is the same as the preprocess, and to make it simple, we are going to use the same example as the preprocess, but with payload. + +### Example 1: Extending a Module with the `[@enum2 opt]` Attribute + +[:link: Sample Code](./context_free.ml#L27-L47) + +Let’s extend the previous example to add support for an `opt` argument that modifies the behavior of the `from_string` function to return an `option` type instead of raising an exception. + +#### Consider the following example: + +```ocaml +module GameEnum2 = struct + type t = Rock | Paper | Scissors +end [@enum2 opt] +(* Output: +module GameEnum2 = struct + type t = Rock | Paper | Scissors + let to_string = function + | Rock -> "Rock" + | Paper -> "Paper" + | Scissors -> "Scissors" + let from_string = function + | "Rock" -> Some Rock + | "Paper" -> Some Paper + | "Scissors" -> Some Scissors + | _ -> None +end *) +``` + +#### Steps to Implement This Global Transformation: + +- **This example is an extension of the previous one.** + The only thing that changes is the `from_string` function, which now returns an `option` type instead of raising an exception. To do this, we need to get the attribute's payload. + + ```ocaml + (* Check if the module expression has the @enum2 attribute and get the attribute's payload *) + | [ { attr_name = { txt = "enum2"; _ }; attr_payload = payload; _ } ] + -> ( + (* match the module expression structure to get the type name and variants *) + let opt = + match payload with PStr [%str opt] -> true | _ -> false + in + match mod_exp.pmod_desc with + | Pmod_structure + ([ { pstr_desc = Pstr_type (name, variants); _ } ] as str) -> + (* We are not going to show the enum function because we already covered it in the previous Context-free section *) + let type_ = + enum ~loc:mod_exp.pmod_loc ~opt (name, variants) () + in + Ast_builder.Default.pmod_structure ~loc:mod_exp.pmod_loc (str @ type_) + | _ -> mod_exp) + | _ -> mod_exp + ``` + +- **Register the Deriver with the PPX Driver:** + The difference here compared to the preprocess is that we are going to use the `~impl` instead of `~preprocess_impl`. + + ```ocaml + let _ = Driver.register_transformation "enum2" ~impl:traverse#structure + ``` + +## Conclusion + +Global transformations in OCaml using PPXLib allow you to automate repetitive tasks and enforce coding patterns across your entire codebase. By using phases like **Preprocess**, **Global Transformation**, and **Lint**, you can reduce boilerplate code, maintain consistency, and catch potential issues early. + +We looked at how `Ast_traverse` helps in navigating and modifying the AST for tasks like generating `to_string` and `from_string` functions or implementing linting rules. The examples showed how to extend modules with attributes like `[@enum]` and `[@enum2 opt]`. + +Understanding these concepts and using the right transformation phase ensures your code is cleaner, more consistent, and easier to maintain. + +### [In the next section, we will explore advanced use cases of global transformations.](../c%20-%20Advanced%20Global%20Transformations/README.md) \ No newline at end of file diff --git a/examples/2-Writing-PPXs/b - Global/demo/dune b/examples/2-Writing-PPXs/b - Global/demo/dune new file mode 100644 index 000000000..a6aca7eee --- /dev/null +++ b/examples/2-Writing-PPXs/b - Global/demo/dune @@ -0,0 +1,6 @@ +(executable + (name global_demo) + (public_name global-example) + (package ppxlib) + (preprocess + (pps global))) diff --git a/examples/2-Writing-PPXs/b - Global/demo/global_demo.ml b/examples/2-Writing-PPXs/b - Global/demo/global_demo.ml new file mode 100644 index 000000000..1bbaf1dcb --- /dev/null +++ b/examples/2-Writing-PPXs/b - Global/demo/global_demo.ml @@ -0,0 +1,51 @@ +let demo_name = "Global Demo" +let _ = demo_name + +(* Uncomment the code bellow to see the lint error *) +(* let name = "John Doe" *) + +(* module enum *) +let _ = print_endline "\n# Enum" + +module GameEnum = struct + type t = Rock | Paper | Scissors +end [@enum] + +let _ = print_endline (GameEnum.to_string Rock) +let _ = print_endline (GameEnum.to_string (GameEnum.from_string "Paper")) + +let _ = + try + Printf.printf "Stick to string: %s\n" + (GameEnum.to_string (GameEnum.from_string "Stick")) + with _ -> Printf.printf "Stick is not a valid value\n" + +(* module enum *) +let _ = print_endline "\n# Enum with option" + +module GameEnum2 = struct + type t = Rock | Paper | Scissors +end [@enum2 opt] + +let _ = print_endline (GameEnum2.to_string Rock) + +let _ = + match GameEnum2.from_string "Paper" with + | Some value -> + Printf.printf "Paper to string: %s\n" (GameEnum2.to_string value) + | None -> Printf.printf "Paper is not a valid value\n" + +let _ = + match GameEnum2.from_string "Stick" with + | Some value -> + Printf.printf "Stick to string: %s\n" (GameEnum2.to_string value) + | None -> Printf.printf "Stick is not a valid value\n" + +(* Uncomment the code bellow to see the error *) +(* module GameEnumError = struct + type _t = Rock | Paper | Scissors + + module GameEnum = struct + type t = Rock | Paper | Scissors + end [@enum] +end [@enum] *) diff --git a/examples/2-Writing-PPXs/b - Global/dune b/examples/2-Writing-PPXs/b - Global/dune new file mode 100644 index 000000000..642bb43aa --- /dev/null +++ b/examples/2-Writing-PPXs/b - Global/dune @@ -0,0 +1,6 @@ +(library + (name global) + (kind ppx_rewriter) + (libraries context_free ppxlib ppxlib.astlib) + (preprocess + (pps ppxlib.metaquot))) \ No newline at end of file diff --git a/examples/2-Writing-PPXs/b - Global/global.ml b/examples/2-Writing-PPXs/b - Global/global.ml new file mode 100644 index 000000000..29cf4217d --- /dev/null +++ b/examples/2-Writing-PPXs/b - Global/global.ml @@ -0,0 +1,137 @@ +open Ppxlib +open Ast_builder.Default + +let enum_tag = "enum" + +(* This function is well explained in the Context Free Section *) +let enum ~loc ?(opt = false) ast () = + match ast with + | _, [ { ptype_kind = Ptype_variant variants; _ } ] -> + let expr_string = Ast_builder.Default.estring ~loc in + let to_string_expr = + [%stri + let[@warning "-32"] to_string value = + [%e + pexp_match ~loc [%expr value] + (List.map + (fun { pcd_name = { txt = value; _ }; _ } -> + case + ~lhs: + (ppat_construct ~loc (Located.lident ~loc value) None) + ~guard:None ~rhs:(expr_string value)) + variants)]] + in + let else_case = + case + ~lhs:[%pat? [%p ppat_any ~loc]] + ~guard:None + ~rhs: + (match opt with + | true -> [%expr None] + | _ -> + [%expr + raise (Invalid_argument "Argument doesn't match variants")]) + in + let from_string_expr = + [%stri + let[@warning "-32"] from_string value = + [%e + pexp_match ~loc [%expr value] + (List.map + (fun { pcd_name = { txt = value; _ }; _ } -> + case + ~lhs: + (ppat_constant ~loc (Pconst_string (value, loc, None))) + ~guard:None + ~rhs: + (match opt with + | true -> + [%expr + Some + [%e + pexp_construct ~loc + (Located.lident ~loc value) + None]] + | _ -> + pexp_construct ~loc + (Located.lident ~loc value) + None)) + variants + @ [ else_case ])]] + in + [ from_string_expr; to_string_expr ] + | _ -> + [%str [%ocaml.error "Ops, enum must be a type with variant without args"]] + +module Lint = struct + let traverse = + object + inherit [Driver.Lint_error.t list] Ast_traverse.fold + + method! value_binding mb acc = + let loc = mb.pvb_loc in + match mb.pvb_pat.ppat_desc with + | Ppat_var { txt = name; _ } -> + if String.starts_with name ~prefix:"demo_" then acc + else + Driver.Lint_error.of_string loc + "Ops, variable name must not start with demo_" + :: acc + | _ -> acc + end +end + +let _ = + Driver.register_transformation "enum2" ~lint_impl:(fun st -> + Lint.traverse#structure st []) + +module PreProcess = struct + let traverse = + object (_ : Ast_traverse.map) + inherit Ast_traverse.map as super + + method! module_expr mod_exp = + let mod_exp = super#module_expr mod_exp in + match mod_exp.pmod_attributes with + | [ { attr_name = { txt = "enum"; _ }; _ } ] -> ( + match mod_exp.pmod_desc with + | Pmod_structure + ([ { pstr_desc = Pstr_type (name, variants); _ } ] as str) -> + let type_ = enum ~loc:mod_exp.pmod_loc (name, variants) () in + Ast_builder.Default.pmod_structure ~loc:mod_exp.pmod_loc + (str @ type_) + | _ -> mod_exp) + | _ -> mod_exp + end +end + +let _ = + Driver.register_transformation "enum" ~impl:PreProcess.traverse#structure + +module Global = struct + let traverse = + object (_ : Ast_traverse.map) + inherit Ast_traverse.map as super + + method! module_expr mod_exp = + let mod_exp = super#module_expr mod_exp in + match mod_exp.pmod_attributes with + | [ { attr_name = { txt = "enum2"; _ }; attr_payload = payload; _ } ] + -> ( + let opt = + match payload with PStr [%str opt] -> true | _ -> false + in + match mod_exp.pmod_desc with + | Pmod_structure + ([ { pstr_desc = Pstr_type (name, variants); _ } ] as str) -> + let type_ = + enum ~loc:mod_exp.pmod_loc ~opt (name, variants) () + in + Ast_builder.Default.pmod_structure ~loc:mod_exp.pmod_loc + (str @ type_) + | _ -> mod_exp) + | _ -> mod_exp + end +end + +let _ = Driver.register_transformation "enum2" ~impl:Global.traverse#structure diff --git a/examples/2-Writing-PPXs/b - Global/mod_expr.png b/examples/2-Writing-PPXs/b - Global/mod_expr.png new file mode 100644 index 000000000..63e5929c7 Binary files /dev/null and b/examples/2-Writing-PPXs/b - Global/mod_expr.png differ diff --git a/examples/2-Writing-PPXs/b - Global/mod_expr_ast.png b/examples/2-Writing-PPXs/b - Global/mod_expr_ast.png new file mode 100644 index 000000000..d8b593ae7 Binary files /dev/null and b/examples/2-Writing-PPXs/b - Global/mod_expr_ast.png differ diff --git a/examples/2-Writing-PPXs/b - Global/value_binding_pattern_name.png b/examples/2-Writing-PPXs/b - Global/value_binding_pattern_name.png new file mode 100644 index 000000000..12b451276 Binary files /dev/null and b/examples/2-Writing-PPXs/b - Global/value_binding_pattern_name.png differ diff --git a/examples/2-Writing-PPXs/b - Global/value_binding_pattern_name_ast.png b/examples/2-Writing-PPXs/b - Global/value_binding_pattern_name_ast.png new file mode 100644 index 000000000..ebe463f9f Binary files /dev/null and b/examples/2-Writing-PPXs/b - Global/value_binding_pattern_name_ast.png differ diff --git a/examples/2-Writing-PPXs/ppxlib-phases.png b/examples/2-Writing-PPXs/ppxlib-phases.png new file mode 100644 index 000000000..fcb2ee7ed Binary files /dev/null and b/examples/2-Writing-PPXs/ppxlib-phases.png differ diff --git a/examples/README.md b/examples/README.md new file mode 100644 index 000000000..9eb0878f1 --- /dev/null +++ b/examples/README.md @@ -0,0 +1,20 @@ +## PPX by examples + +This examples were made to help on understanding what are and how to write PPXs in OCaml with PPXLib. + +## Content + +- [AST](./examples/1%20-%20AST/README.md) + - [Building an AST](./examples/1%20-%20AST/a%20-%20Building%20AST/README.md) + - [Destructing an AST](./examples/1%20-%20AST/b%20-%20Destructing%20AST/README.md) +- [Writing a PPX](./examples/2%20-%20Writing%20PPXs/README.md) + - [Context-free transformations](./examples/2%20-%20Writing%20PPXs/a%20-%20Context%20Free/README.md) + - [Global transformations](./examples/2%20-%20Writing%20PPXs/b%20-%20Global/README.md) +- Testing a PPX (wip) + +## References + +- [Ocaml Metaprogramming Docs](https://ocaml.org/docs/metaprogramming) +- [PPXLib documentation](https://ocaml-ppx.github.io/ppxlib/ppxlib/index.html) +- [The needed introduction to writing a ppx](https://www.youtube.com/live/dMoRMqQ6GLs?feature=shared&t=4251) +- [An introduction to OCaml PPX ecosystem](https://tarides.com/blog/2019-05-09-an-introduction-to-ocaml-ppx-ecosystem/) diff --git a/examples/dune b/examples/dune deleted file mode 100644 index 0ac85f7bc..000000000 --- a/examples/dune +++ /dev/null @@ -1,4 +0,0 @@ -(alias - (name runtest) - (deps - (alias_rec all))) diff --git a/examples/simple-deriver/README.md b/examples/simple-deriver/README.md deleted file mode 100644 index 3ca268692..000000000 --- a/examples/simple-deriver/README.md +++ /dev/null @@ -1,28 +0,0 @@ -# ppx_deriving_accessors - -This folder contains an example of a very simple ppx deriver that will generate -accessors for record fields from the record type definition. - -E.g. the following: - -```ocaml -type t = - { a : string - ; b : int - } - [@@deriving accessors] -``` - -will generate the following: - -```ocaml -let a x = x.a -let b x = x.b -``` - -It can also be used in `.mli` files to generate the corresponding signatures: - -```ocaml -val a : t -> string -val b : t -> int -``` diff --git a/examples/simple-deriver/dune b/examples/simple-deriver/dune deleted file mode 100644 index 55a09ddf4..000000000 --- a/examples/simple-deriver/dune +++ /dev/null @@ -1,4 +0,0 @@ -(library - (name ppx_deriving_accessors) - (kind ppx_deriver) - (libraries ppxlib)) diff --git a/examples/simple-deriver/ppx_deriving_accessors.ml b/examples/simple-deriver/ppx_deriving_accessors.ml deleted file mode 100644 index a951b9e97..000000000 --- a/examples/simple-deriver/ppx_deriving_accessors.ml +++ /dev/null @@ -1,77 +0,0 @@ -open Ppxlib -module List = ListLabels -open Ast_builder.Default - -let accessor_impl (ld : label_declaration) = - let loc = ld.pld_loc in - pstr_value ~loc Nonrecursive - [ - { - pvb_pat = ppat_var ~loc ld.pld_name; - pvb_expr = - pexp_fun ~loc Nolabel None - (ppat_var ~loc { loc; txt = "x" }) - (pexp_field ~loc - (pexp_ident ~loc { loc; txt = lident "x" }) - { loc; txt = lident ld.pld_name.txt }); - pvb_attributes = []; - pvb_loc = loc; - }; - ] - -let accessor_intf ~ptype_name (ld : label_declaration) = - let loc = ld.pld_loc in - psig_value ~loc - { - pval_name = ld.pld_name; - pval_type = - ptyp_arrow ~loc Nolabel - (ptyp_constr ~loc { loc; txt = lident ptype_name.txt } []) - ld.pld_type; - pval_attributes = []; - pval_loc = loc; - pval_prim = []; - } - -let generate_impl ~ctxt (_rec_flag, type_declarations) = - let loc = Expansion_context.Deriver.derived_item_loc ctxt in - List.map type_declarations ~f:(fun (td : type_declaration) -> - match td with - | { - ptype_kind = Ptype_abstract | Ptype_variant _ | Ptype_open; - ptype_loc; - _; - } -> - let ext = - Location.error_extensionf ~loc:ptype_loc - "Cannot derive accessors for non record types" - in - [ Ast_builder.Default.pstr_extension ~loc ext [] ] - | { ptype_kind = Ptype_record fields; _ } -> - List.map fields ~f:accessor_impl) - |> List.concat - -let generate_intf ~ctxt (_rec_flag, type_declarations) = - let loc = Expansion_context.Deriver.derived_item_loc ctxt in - List.map type_declarations ~f:(fun (td : type_declaration) -> - match td with - | { - ptype_kind = Ptype_abstract | Ptype_variant _ | Ptype_open; - ptype_loc; - _; - } -> - let ext = - Location.error_extensionf ~loc:ptype_loc - "Cannot derive accessors for non record types" - in - [ Ast_builder.Default.psig_extension ~loc ext [] ] - | { ptype_kind = Ptype_record fields; ptype_name; _ } -> - List.map fields ~f:(accessor_intf ~ptype_name)) - |> List.concat - -let impl_generator = Deriving.Generator.V2.make_noarg generate_impl -let intf_generator = Deriving.Generator.V2.make_noarg generate_intf - -let my_deriver = - Deriving.add "accessors" ~str_type_decl:impl_generator - ~sig_type_decl:intf_generator diff --git a/examples/simple-extension-rewriter/README.md b/examples/simple-extension-rewriter/README.md deleted file mode 100644 index 2f0c087bf..000000000 --- a/examples/simple-extension-rewriter/README.md +++ /dev/null @@ -1,24 +0,0 @@ -# ppx_get_env - -This folder contains an example of a very simple ppx rewriter that will expand -`[%get_env "SOME_ENV_VAR"]` into the value of the env variable `SOME_ENV_VAR` at compile time, -as a string. - -E.g., assuming we set `MY_VAR="foo"`, it will turn: - -```ocaml -let () = print_string [%get_env "MY_VAR"] -``` - -into: - -```ocaml -let () = print_string "foo" -``` - -Note that this is just a toy example and we'd actually advise you against this type of ppx -that have side effects or rely heavily on the file system or env variables unless you absolutely know -what you are doing. - -In particular in this case it won't work well with dune since dune won't know about the dependency -on the env variables specified in the extension's payload. diff --git a/examples/simple-extension-rewriter/dune b/examples/simple-extension-rewriter/dune deleted file mode 100644 index df53df227..000000000 --- a/examples/simple-extension-rewriter/dune +++ /dev/null @@ -1,4 +0,0 @@ -(library - (name ppx_get_env) - (kind ppx_rewriter) - (libraries ppxlib)) diff --git a/examples/simple-extension-rewriter/ppx_get_env.ml b/examples/simple-extension-rewriter/ppx_get_env.ml deleted file mode 100644 index 90f158d7f..000000000 --- a/examples/simple-extension-rewriter/ppx_get_env.ml +++ /dev/null @@ -1,20 +0,0 @@ -open Ppxlib - -let expand ~ctxt env_var = - let loc = Expansion_context.Extension.extension_point_loc ctxt in - match Sys.getenv env_var with - | value -> Ast_builder.Default.estring ~loc value - | exception Not_found -> - let ext = - Location.error_extensionf ~loc "The environement variable %s is unbound" - env_var - in - Ast_builder.Default.pexp_extension ~loc ext - -let my_extension = - Extension.V3.declare "get_env" Extension.Context.expression - Ast_pattern.(single_expr_payload (estring __)) - expand - -let rule = Ppxlib.Context_free.Rule.extension my_extension -let () = Driver.register_transformation ~rules:[ rule ] "get_env" diff --git a/examples/simple-extension-rewriter/ppx_get_env.mli b/examples/simple-extension-rewriter/ppx_get_env.mli deleted file mode 100644 index e69de29bb..000000000