├── .ocamlformat ├── .gitignore ├── dune ├── examples ├── 1 - AST │ ├── pattern.png │ ├── module_name.png │ ├── pattern_ast.png │ ├── strucure_item.png │ ├── attribute_name.png │ ├── extension_node.png │ ├── module_name_ast.png │ ├── module_structure.png │ ├── attribute_attached.png │ ├── attribute_name_ast.png │ ├── attribute_payload.png │ ├── extension_node_ast.png │ ├── strucure_item_ast.png │ ├── attribute_payload_ast.png │ ├── extension_node_name.png │ ├── module_structure_ast.png │ ├── module_structure_item.png │ ├── attribute_attached_ast.png │ ├── extension_node_name_ast.png │ ├── extension_node_payload.png │ ├── extension_node_payload_ast.png │ ├── module_structure_item_ast.png │ ├── a - Building AST │ │ ├── dune │ │ ├── building_ast.ml │ │ └── README.md │ ├── b - Destructing AST │ │ ├── dune │ │ ├── destructuring_ast.ml │ │ └── README.md │ └── README.md └── 2 - Writing PPXs │ ├── ppxlib-phases.png │ ├── b - Global │ ├── demo │ │ ├── dune │ │ └── global_demo.ml │ ├── mod_expr.png │ ├── mod_expr_ast.png │ ├── dune │ ├── value_binding_pattern_name.png │ ├── value_binding_pattern_name_ast.png │ ├── global.ml │ └── README.md │ ├── a - Context Free │ ├── demo │ │ ├── dune │ │ └── context_free_demo.ml │ ├── dune │ ├── context_free.ml │ └── README.md │ └── README.md ├── .github ├── dependabot.yml └── workflows │ └── build-test.yml ├── dune-project ├── ppx-studies.opam ├── Makefile └── README.md /.ocamlformat: -------------------------------------------------------------------------------- 1 | profile = default 2 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | _build/ 2 | _opam/ 3 | node_modules/ 4 | static/ -------------------------------------------------------------------------------- /dune: -------------------------------------------------------------------------------- 1 | (dirs examples) 2 | 3 | (documentation 4 | (package ppx-studies)) 5 | -------------------------------------------------------------------------------- /examples/1 - AST/pattern.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pedrobslisboa/ppx-by-example/HEAD/examples/1 - AST/pattern.png -------------------------------------------------------------------------------- /examples/1 - AST/module_name.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pedrobslisboa/ppx-by-example/HEAD/examples/1 - AST/module_name.png -------------------------------------------------------------------------------- /examples/1 - AST/pattern_ast.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pedrobslisboa/ppx-by-example/HEAD/examples/1 - AST/pattern_ast.png -------------------------------------------------------------------------------- /examples/1 - AST/strucure_item.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pedrobslisboa/ppx-by-example/HEAD/examples/1 - AST/strucure_item.png -------------------------------------------------------------------------------- /examples/1 - AST/attribute_name.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pedrobslisboa/ppx-by-example/HEAD/examples/1 - AST/attribute_name.png -------------------------------------------------------------------------------- /examples/1 - AST/extension_node.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pedrobslisboa/ppx-by-example/HEAD/examples/1 - AST/extension_node.png -------------------------------------------------------------------------------- /examples/1 - AST/module_name_ast.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pedrobslisboa/ppx-by-example/HEAD/examples/1 - AST/module_name_ast.png -------------------------------------------------------------------------------- /examples/1 - AST/module_structure.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pedrobslisboa/ppx-by-example/HEAD/examples/1 - AST/module_structure.png -------------------------------------------------------------------------------- /examples/1 - AST/attribute_attached.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pedrobslisboa/ppx-by-example/HEAD/examples/1 - AST/attribute_attached.png -------------------------------------------------------------------------------- /examples/1 - AST/attribute_name_ast.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pedrobslisboa/ppx-by-example/HEAD/examples/1 - AST/attribute_name_ast.png -------------------------------------------------------------------------------- /examples/1 - AST/attribute_payload.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pedrobslisboa/ppx-by-example/HEAD/examples/1 - AST/attribute_payload.png -------------------------------------------------------------------------------- /examples/1 - AST/extension_node_ast.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pedrobslisboa/ppx-by-example/HEAD/examples/1 - AST/extension_node_ast.png -------------------------------------------------------------------------------- /examples/1 - AST/strucure_item_ast.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pedrobslisboa/ppx-by-example/HEAD/examples/1 - AST/strucure_item_ast.png -------------------------------------------------------------------------------- /examples/1 - AST/attribute_payload_ast.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pedrobslisboa/ppx-by-example/HEAD/examples/1 - AST/attribute_payload_ast.png -------------------------------------------------------------------------------- /examples/1 - AST/extension_node_name.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pedrobslisboa/ppx-by-example/HEAD/examples/1 - AST/extension_node_name.png -------------------------------------------------------------------------------- /examples/1 - AST/module_structure_ast.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pedrobslisboa/ppx-by-example/HEAD/examples/1 - AST/module_structure_ast.png -------------------------------------------------------------------------------- /examples/1 - AST/module_structure_item.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pedrobslisboa/ppx-by-example/HEAD/examples/1 - AST/module_structure_item.png -------------------------------------------------------------------------------- /examples/1 - AST/attribute_attached_ast.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pedrobslisboa/ppx-by-example/HEAD/examples/1 - AST/attribute_attached_ast.png -------------------------------------------------------------------------------- /examples/1 - AST/extension_node_name_ast.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pedrobslisboa/ppx-by-example/HEAD/examples/1 - AST/extension_node_name_ast.png -------------------------------------------------------------------------------- /examples/1 - AST/extension_node_payload.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pedrobslisboa/ppx-by-example/HEAD/examples/1 - AST/extension_node_payload.png -------------------------------------------------------------------------------- /examples/2 - Writing PPXs/ppxlib-phases.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pedrobslisboa/ppx-by-example/HEAD/examples/2 - Writing PPXs/ppxlib-phases.png -------------------------------------------------------------------------------- /examples/1 - AST/extension_node_payload_ast.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pedrobslisboa/ppx-by-example/HEAD/examples/1 - AST/extension_node_payload_ast.png -------------------------------------------------------------------------------- /examples/1 - AST/module_structure_item_ast.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pedrobslisboa/ppx-by-example/HEAD/examples/1 - AST/module_structure_item_ast.png -------------------------------------------------------------------------------- /examples/2 - Writing PPXs/b - Global/demo/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name global_demo) 3 | (public_name global_demo) 4 | (preprocess 5 | (pps global))) 6 | -------------------------------------------------------------------------------- /.github/dependabot.yml: -------------------------------------------------------------------------------- 1 | version: 2 2 | updates: 3 | - package-ecosystem: github-actions 4 | directory: / 5 | schedule: 6 | interval: monthly 7 | -------------------------------------------------------------------------------- /examples/2 - Writing PPXs/b - Global/mod_expr.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pedrobslisboa/ppx-by-example/HEAD/examples/2 - Writing PPXs/b - Global/mod_expr.png -------------------------------------------------------------------------------- /examples/2 - Writing PPXs/b - Global/mod_expr_ast.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pedrobslisboa/ppx-by-example/HEAD/examples/2 - Writing PPXs/b - Global/mod_expr_ast.png -------------------------------------------------------------------------------- /examples/2 - Writing PPXs/a - Context Free/demo/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name context_free_demo) 3 | (public_name context_free_demo) 4 | (preprocess 5 | (pps context_free))) 6 | -------------------------------------------------------------------------------- /examples/2 - Writing PPXs/b - Global/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name global) 3 | (kind ppx_rewriter) 4 | (libraries context_free ppxlib ppxlib.astlib) 5 | (preprocess 6 | (pps ppxlib.metaquot))) -------------------------------------------------------------------------------- /examples/2 - Writing PPXs/b - Global/value_binding_pattern_name.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pedrobslisboa/ppx-by-example/HEAD/examples/2 - Writing PPXs/b - Global/value_binding_pattern_name.png -------------------------------------------------------------------------------- /examples/1 - AST/a - Building AST/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name building_ast) 3 | (public_name building_ast_demo) 4 | (libraries ppxlib ppxlib.astlib) 5 | (preprocess 6 | (pps ppxlib.metaquot))) 7 | -------------------------------------------------------------------------------- /examples/2 - Writing PPXs/b - Global/value_binding_pattern_name_ast.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pedrobslisboa/ppx-by-example/HEAD/examples/2 - Writing PPXs/b - Global/value_binding_pattern_name_ast.png -------------------------------------------------------------------------------- /examples/1 - AST/b - Destructing AST/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name destructuring_ast) 3 | (public_name destructing_ast_demo) 4 | (libraries ppxlib ppxlib.astlib) 5 | (preprocess 6 | (pps ppxlib.metaquot))) 7 | -------------------------------------------------------------------------------- /examples/2 - Writing PPXs/a - Context Free/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name context_free) 3 | (kind ppx_rewriter) 4 | (libraries ppxlib yojson ppxlib.astlib) 5 | (preprocess 6 | (pps ppxlib.metaquot ppx_deriving.show ppx_deriving.ord))) -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 3.8) 2 | 3 | (using melange 0.1) 4 | 5 | (name ppx-studies) 6 | 7 | (license MIT) 8 | 9 | (maintainers "Pedro B S Lisboa ") 10 | 11 | (authors "Pedro B S Lisboa ") 12 | 13 | (source 14 | (github pedrobslisboa/ppx-studies)) 15 | 16 | (generate_opam_files true) 17 | 18 | (implicit_transitive_deps false) 19 | 20 | (package 21 | (name ppx-studies) 22 | (synopsis "This project contains examples to help on understanding what are and how to write PPXs in OCaml.") 23 | (allow_empty) 24 | (depends 25 | (ocaml 26 | (>= 5.0.0)) 27 | ocaml-lsp-server 28 | ocamlformat 29 | ppx_deriving 30 | ppxlib)) 31 | -------------------------------------------------------------------------------- /ppx-studies.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | synopsis: 4 | "This project contains examples to help on understanding what are and how to write PPXs in OCaml." 5 | maintainer: ["Pedro B S Lisboa "] 6 | authors: ["Pedro B S Lisboa "] 7 | license: "MIT" 8 | homepage: "https://github.com/pedrobslisboa/ppx-studies" 9 | bug-reports: "https://github.com/pedrobslisboa/ppx-studies/issues" 10 | depends: [ 11 | "dune" {>= "3.8"} 12 | "ocaml" {>= "5.0.0"} 13 | "ocaml-lsp-server" 14 | "ocamlformat" 15 | "ppx_deriving" 16 | "ppxlib" 17 | "odoc" {with-doc} 18 | ] 19 | build: [ 20 | ["dune" "subst"] {dev} 21 | [ 22 | "dune" 23 | "build" 24 | "-p" 25 | name 26 | "-j" 27 | jobs 28 | "@install" 29 | "@runtest" {with-test} 30 | "@doc" {with-doc} 31 | ] 32 | ] 33 | dev-repo: "git+https://github.com/pedrobslisboa/ppx-studies.git" 34 | -------------------------------------------------------------------------------- /.github/workflows/build-test.yml: -------------------------------------------------------------------------------- 1 | name: Build and Test 2 | 3 | on: 4 | - push 5 | - pull_request 6 | 7 | jobs: 8 | build-and-test: 9 | strategy: 10 | fail-fast: false 11 | matrix: 12 | os: 13 | - macos-latest 14 | - ubuntu-latest 15 | # - windows-latest 16 | ocaml-version: 17 | - 5.1 18 | 19 | runs-on: ${{ matrix.os }} 20 | 21 | steps: 22 | - name: Checkout code 23 | uses: actions/checkout@v4 24 | 25 | - name: Use OCaml ${{ matrix.ocaml-version }} 26 | uses: ocaml/setup-ocaml@v2 27 | with: 28 | ocaml-compiler: ${{ matrix.ocaml-version }} 29 | dune-cache: true 30 | opam-depext-flags: "--with-test" 31 | allow-prerelease-opam: true 32 | 33 | - run: opam install . --deps-only --with-test 34 | 35 | - name: build project 36 | run: opam exec -- dune build 37 | 38 | - name: run test 39 | run: opam exec -- dune runtest 40 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | project_name = ppx-by-example 2 | 3 | DUNE = opam exec -- dune 4 | opam_file = $(project_name).opam 5 | 6 | .PHONY: help 7 | help: 8 | @echo ""; 9 | @echo "List of available make commands"; 10 | @echo ""; 11 | @grep -E '^[a-zA-Z_-]+:.*?## .*$$' $(MAKEFILE_LIST) | sort | awk 'BEGIN {FS = ":.*?## "}; {printf " \033[36m%-15s\033[0m %s\n", $$1, $$2}'; 12 | @echo ""; 13 | 14 | .PHONY: build-dev 15 | dev: 16 | $(DUNE) build -w @all 17 | 18 | .PHONY: clean 19 | clean: ## Clean artifacts 20 | $(DUNE) clean 21 | 22 | .PHONY: exec 23 | exec: ## Run the project 24 | $(DUNE) exec $(demo) 25 | 26 | .PHONY: format 27 | format: 28 | DUNE_CONFIG__GLOBAL_LOCK=disabled $(DUNE) build @fmt --auto-promote 29 | 30 | .PHONY: format-check 31 | format-check: 32 | $(DUNE) build @fmt 33 | 34 | .PHONY: create-switch 35 | create-switch: ## Create opam switch 36 | opam switch create . 5.1.1 --deps-only --with-test -y 37 | 38 | .PHONY: install 39 | install: 40 | $(DUNE) build @install 41 | opam install . --deps-only --with-test 42 | cd demo && yarn install 43 | 44 | .PHONY: init 45 | init: create-switch install 46 | 47 | .PHONY: $(TARGET) 48 | demo-%: 49 | DUNE_CONFIG__GLOBAL_LOCK=disabled opam exec -- dune exec $*_demo -------------------------------------------------------------------------------- /examples/2 - Writing PPXs/a - Context Free/demo/context_free_demo.ml: -------------------------------------------------------------------------------- 1 | let one = [%one] 2 | let _ = Printf.printf "One: %d\n" one 3 | let grin = [%emoji "grin"] 4 | let smiley = [%emoji "smiley"] 5 | let _ = print_endline ("grin: " ^ grin) 6 | let _ = print_endline ("smiley: " ^ smiley) 7 | 8 | (* enum with raise *) 9 | let _ = print_endline "\n# Enum with raise" 10 | 11 | type game = Rock | Paper | Scissors [@@deriving enum] 12 | 13 | let _ = Printf.printf "Rock to string: %s\n" (game_to_string Rock) 14 | 15 | let _ = 16 | Printf.printf "Paper to string: %s\n" 17 | (game_to_string (game_from_string "Paper")) 18 | 19 | let _ = 20 | try 21 | Printf.printf "Stick to string: %s\n" 22 | (game_to_string (game_from_string "Stick")) 23 | with _ -> Printf.printf "Stick is not a valid value\n" 24 | 25 | (* enum with option *) 26 | let _ = print_endline "\n# Enum with option" 27 | 28 | type game2 = Rock | Paper | Scissors [@@deriving enum2 ~opt] 29 | 30 | let _ = Printf.printf "Rock to string: %s\n" (game2_to_string Rock) 31 | 32 | let _ = 33 | match game2_from_string "Paper" with 34 | | Some value -> Printf.printf "Paper to string: %s\n" (game2_to_string value) 35 | | None -> Printf.printf "Paper is not a valid value\n" 36 | 37 | let _ = 38 | match game2_from_string "Stick" with 39 | | Some value -> Printf.printf "Stick to string: %s\n" (game2_to_string value) 40 | | None -> Printf.printf "Stick is not a valid value\n" 41 | 42 | (* Uncomment the code bellow to see the error *) 43 | (* type bar = string [@@deriving enum2] *) 44 | -------------------------------------------------------------------------------- /examples/2 - Writing PPXs/b - Global/demo/global_demo.ml: -------------------------------------------------------------------------------- 1 | let demo_name = "Global Demo" 2 | let _ = demo_name 3 | 4 | (* Uncomment the code bellow to see the lint error *) 5 | (* let name = "John Doe" *) 6 | 7 | (* module enum *) 8 | let _ = print_endline "\n# Enum" 9 | 10 | module GameEnum = struct 11 | type t = Rock | Paper | Scissors 12 | end [@enum] 13 | 14 | let _ = print_endline (GameEnum.to_string Rock) 15 | let _ = print_endline (GameEnum.to_string (GameEnum.from_string "Paper")) 16 | 17 | let _ = 18 | try 19 | Printf.printf "Stick to string: %s\n" 20 | (GameEnum.to_string (GameEnum.from_string "Stick")) 21 | with _ -> Printf.printf "Stick is not a valid value\n" 22 | 23 | (* module enum *) 24 | let _ = print_endline "\n# Enum with option" 25 | 26 | module GameEnum2 = struct 27 | type t = Rock | Paper | Scissors 28 | end [@enum2 opt] 29 | 30 | let _ = print_endline (GameEnum2.to_string Rock) 31 | 32 | let _ = 33 | match GameEnum2.from_string "Paper" with 34 | | Some value -> 35 | Printf.printf "Paper to string: %s\n" (GameEnum2.to_string value) 36 | | None -> Printf.printf "Paper is not a valid value\n" 37 | 38 | let _ = 39 | match GameEnum2.from_string "Stick" with 40 | | Some value -> 41 | Printf.printf "Stick to string: %s\n" (GameEnum2.to_string value) 42 | | None -> Printf.printf "Stick is not a valid value\n" 43 | 44 | (* Uncomment the code bellow to see the error *) 45 | (* module GameEnumError = struct 46 | type _t = Rock | Paper | Scissors 47 | 48 | module GameEnum = struct 49 | type t = Rock | Paper | Scissors 50 | end [@enum] 51 | end [@enum] *) 52 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ## PPX by examples 2 | 3 | :warning: **This repository is a work in progress.** :warning: 4 | 5 | This repository contains examples to help on understanding what are and how to write PPXs in OCaml and for it we are going to use PPXLib. 6 | 7 | On my ppx learning journey, I'm having some difficulties to find examples and explanations about how to write a PPX. So, I decided to create this repository to help others that are in the same situation as me, and also push me into learning more about it. 8 | 9 | So as I said, I'm learning, and I'm not an expert on the subject. If you find any mistake or have any suggestion, please open an issue or a pull request. I'll be glad to receive your feedback. 10 | 11 | ## Content 12 | 13 | - [AST](./examples/1%20-%20AST/README.md) 14 | - [Building an AST](./examples/1%20-%20AST/a%20-%20Building%20AST/README.md) 15 | - [Destructing an AST](./examples/1%20-%20AST/b%20-%20Destructing%20AST/README.md) 16 | - [Writing a PPX](./examples/2%20-%20Writing%20PPXs/README.md) 17 | - [Context-free transformations](./examples/2%20-%20Writing%20PPXs/a%20-%20Context%20Free/README.md) 18 | - [Global transformations](./examples/2%20-%20Writing%20PPXs/b%20-%20Global/README.md) 19 | - Testing a PPX (wip) 20 | 21 | ## References 22 | 23 | - [Ocaml Metaprogramming Docs](https://ocaml.org/docs/metaprogramming) 24 | - [PPXLib documentation](https://ocaml-ppx.github.io/ppxlib/ppxlib/index.html) 25 | - [The needed introduction to writing a ppx](https://www.youtube.com/live/dMoRMqQ6GLs?feature=shared&t=4251) 26 | - [An introduction to OCaml PPX ecosystem 27 | ](https://tarides.com/blog/2019-05-09-an-introduction-to-ocaml-ppx-ecosystem/) 28 | -------------------------------------------------------------------------------- /examples/2 - Writing PPXs/README.md: -------------------------------------------------------------------------------- 1 | # Writing PPXs 2 | 3 | ## Description 4 | 5 | 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. 6 | 7 | ## Transformations 8 | 9 | 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. 10 | 11 | Those transformations can be divided into two categories that we will cover on nested folders: 12 | 13 | - [Context-free transformations](./a%20-%20Context%20Free/README.md) 14 | - [Global transformations](./b%20-%20Global/README.md) 15 | 16 | And they can work in different phases: 17 | 18 | - Lint (Global) 19 | - Preprocess (Global) 20 | - Instrumentation - Before (Global) 21 | - Context-free 22 | - Global Trasformation (Global) 23 | - Instrumentation - After (Global) 24 | 25 | The following diagram shows the order of the phases and Driver's methods: 26 | 27 |
28 | The beautiful MDN logo. 31 |
Drive's methods phases diagram. (reference)
 32 |
33 | 34 | ## How 35 | 36 | PPXs commonly follow these steps: 37 | 38 | - Match the AST we want. 39 | - Work with the AST. For example: 40 | - Returning a new AST. Add new functions, change the name of a variable, etc. 41 | - Linting the code. 42 | - or doing anything else. Really, you're programming, everything is possible! 43 | 44 | ### [On the next section, we will learn more about Context Free transformations.](./a%20-%20Context%20Free/README.md) 45 | -------------------------------------------------------------------------------- /examples/1 - AST/a - Building AST/building_ast.ml: -------------------------------------------------------------------------------- 1 | open Ppxlib 2 | 3 | let loc = Location.none 4 | 5 | let zero ~loc : Ppxlib_ast.Ast.expression = 6 | { 7 | pexp_desc = Pexp_constant (Pconst_integer ("0", None)); 8 | pexp_loc = loc; 9 | pexp_loc_stack = []; 10 | pexp_attributes = []; 11 | } 12 | 13 | let _ = 14 | print_endline 15 | ("\nAST with AST pure tree build: " 16 | ^ Astlib.Pprintast.string_of_expression (zero ~loc)) 17 | 18 | let one ~loc = 19 | Ast_builder.Default.pexp_constant ~loc (Parsetree.Pconst_integer ("1", None)) 20 | 21 | let _ = 22 | print_endline 23 | ("\nAST with AST build pexp_constant: " 24 | ^ Astlib.Pprintast.string_of_expression (one ~loc)) 25 | 26 | let two ~loc = Ast_builder.Default.eint ~loc 2 27 | 28 | let _ = 29 | print_endline 30 | ("\nAST with AST build eint: " 31 | ^ Astlib.Pprintast.string_of_expression (two ~loc)) 32 | 33 | let three ~loc = [%expr 3] 34 | 35 | let _ = 36 | print_endline 37 | ("\nAST with AST build eint: " 38 | ^ Astlib.Pprintast.string_of_expression (three ~loc)) 39 | 40 | let let_expression = 41 | let expression = 42 | Ast_builder.Default.pexp_constant ~loc:Location.none 43 | (Pconst_integer ("3", None)) 44 | in 45 | let pattern = 46 | Ast_builder.Default.ppat_var ~loc:Location.none 47 | (Ast_builder.Default.Located.mk ~loc:Location.none "foo") 48 | in 49 | let let_binding = 50 | Ast_builder.Default.value_binding ~loc:Location.none ~pat:pattern 51 | ~expr:expression 52 | in 53 | 54 | Ast_builder.Default.pexp_let ~loc:Location.none Nonrecursive [ let_binding ] 55 | (Ast_builder.Default.eunit ~loc:Location.none) 56 | 57 | let _ = 58 | print_endline 59 | ("\nLet expression with Ast_builder: " 60 | ^ Astlib.Pprintast.string_of_expression let_expression) 61 | 62 | let let_expression = 63 | [%expr 64 | let foo = 3 in 65 | ()] 66 | 67 | let _ = 68 | print_endline 69 | ("\nLet expression with metaquot: " 70 | ^ Astlib.Pprintast.string_of_expression let_expression) 71 | 72 | let anti_quotation_expr expr= [%expr 1 + [%e expr]] 73 | 74 | let _ = 75 | print_endline 76 | ("\nLet expression with metaquot and anti-quotation: " 77 | ^ Astlib.Pprintast.string_of_expression (anti_quotation_expr (one ~loc))) -------------------------------------------------------------------------------- /examples/1 - AST/b - Destructing AST/destructuring_ast.ml: -------------------------------------------------------------------------------- 1 | open Ppxlib 2 | 3 | let loc = Location.none 4 | 5 | let one ~loc = [%expr 1] 6 | 7 | let structure_item loc = 8 | let expr = one ~loc in 9 | Ast_builder.Default.pstr_eval ~loc expr [] 10 | 11 | let match_int_payload ~loc payload = 12 | match payload with 13 | | PStr 14 | [ 15 | { 16 | pstr_desc = 17 | Pstr_eval 18 | ({ pexp_desc = Pexp_constant (Pconst_integer (value, None)); _ }, _); 19 | _; 20 | }; 21 | ] -> ( 22 | try Ok (value |> int_of_string) 23 | with Failure _ -> 24 | Error (Location.Error.createf ~loc "Value is not a valid integer")) 25 | | _ -> Error (Location.Error.createf ~loc "Wrong pattern") 26 | 27 | let test_match_pstr_eval () = 28 | let structure_item = structure_item loc in 29 | let structure = [ structure_item ] in 30 | match match_int_payload ~loc (PStr structure) with 31 | | Ok _ -> 32 | Printf.printf "\nMatched 1 using Ast_pattern" 33 | | Error _ -> Printf.printf "\nDid not match pstr_eval" 34 | 35 | let _ = test_match_pstr_eval () 36 | 37 | let match_int_payload = 38 | let open Ast_pattern in 39 | pstr (pstr_eval (pexp_constant (pconst_integer (string "1") none)) nil ^:: nil) 40 | 41 | let test_match_pstr_eval () = 42 | let structure_item = structure_item loc in 43 | let structure = [ structure_item ] in 44 | try Ast_pattern.parse match_int_payload loc (PStr structure) Printf.printf "\nMatched 1 using Ast_pattern" 45 | with _ -> Printf.printf "\nDid not match 1 payload using Ast_pattern" 46 | 47 | let _ = test_match_pstr_eval () 48 | 49 | let match_int_payload = 50 | let open Ast_pattern in 51 | pstr (pstr_eval (eint (int 1)) nil ^:: nil) 52 | 53 | let test_match_pstr_eval () = 54 | let structure_item = structure_item loc in 55 | let structure = [ structure_item ] in 56 | try Ast_pattern.parse match_int_payload loc (PStr structure) Printf.printf "\nMatched 1 using Ast_patter with eint" 57 | with _ -> Printf.printf "\nDid not match 1 payload using Ast_pattern with eint" 58 | 59 | let _ = test_match_pstr_eval () 60 | 61 | let match_int_payload expr = 62 | match expr with 63 | | [%expr 1] -> Ok 1 64 | | _ -> 65 | Error 66 | (Location.Error.createf ~loc:expr.pexp_loc 67 | "Value is not a valid integer") 68 | 69 | let test_match_pstr_eval () = 70 | let expr = one ~loc in 71 | match match_int_payload expr with 72 | | Ok _ -> 73 | Printf.printf "\nMatched 1 using metaquot" 74 | | Error _ -> Printf.printf "\nDid not match 1 using metaquot" 75 | 76 | let _ = test_match_pstr_eval () 77 | let let_expression = [%expr 1 + 4] 78 | 79 | let match_int_payload expr = 80 | match expr with 81 | | [%expr 1 + [%e? e]] -> ( 82 | match e with 83 | | { pexp_desc = Pexp_constant (Pconst_integer (value, None)); _ } -> 84 | Ok (1 + int_of_string value) 85 | | _ -> 86 | Error 87 | (Location.Error.createf ~loc:e.pexp_loc 88 | "Value is not a valid integer")) 89 | | _ -> Error (Location.Error.createf ~loc:expr.pexp_loc "Wrong pattern") 90 | 91 | let test_match_pstr_eval () = 92 | match match_int_payload let_expression with 93 | | Ok value -> 94 | Printf.printf "\nMatched 1 + using metaquot and anti-quotation: %s" 95 | (value |> string_of_int) 96 | | Error _ -> Printf.printf "\nDid not match matched 1 + using metaquot and anti-quotation" 97 | 98 | let _ = test_match_pstr_eval () 99 | -------------------------------------------------------------------------------- /examples/2 - Writing PPXs/b - Global/global.ml: -------------------------------------------------------------------------------- 1 | open Ppxlib 2 | open Ast_builder.Default 3 | 4 | let enum_tag = "enum" 5 | 6 | (* This function is well explained in the Context Free Section *) 7 | let enum ~loc ?(opt = false) ast () = 8 | match ast with 9 | | _, [ { ptype_kind = Ptype_variant variants; _ } ] -> 10 | let expr_string = Ast_builder.Default.estring ~loc in 11 | let to_string_expr = 12 | [%stri 13 | let[@warning "-32"] to_string value = 14 | [%e 15 | pexp_match ~loc [%expr value] 16 | (List.map 17 | (fun { pcd_name = { txt = value; _ }; _ } -> 18 | case 19 | ~lhs: 20 | (ppat_construct ~loc (Located.lident ~loc value) None) 21 | ~guard:None ~rhs:(expr_string value)) 22 | variants)]] 23 | in 24 | let else_case = 25 | case 26 | ~lhs:[%pat? [%p ppat_any ~loc]] 27 | ~guard:None 28 | ~rhs: 29 | (match opt with 30 | | true -> [%expr None] 31 | | _ -> 32 | [%expr 33 | raise (Invalid_argument "Argument doesn't match variants")]) 34 | in 35 | let from_string_expr = 36 | [%stri 37 | let[@warning "-32"] from_string value = 38 | [%e 39 | pexp_match ~loc [%expr value] 40 | (List.map 41 | (fun { pcd_name = { txt = value; _ }; _ } -> 42 | case 43 | ~lhs: 44 | (ppat_constant ~loc (Pconst_string (value, loc, None))) 45 | ~guard:None 46 | ~rhs: 47 | (match opt with 48 | | true -> 49 | [%expr 50 | Some 51 | [%e 52 | pexp_construct ~loc 53 | (Located.lident ~loc value) 54 | None]] 55 | | _ -> 56 | pexp_construct ~loc 57 | (Located.lident ~loc value) 58 | None)) 59 | variants 60 | @ [ else_case ])]] 61 | in 62 | [ from_string_expr; to_string_expr ] 63 | | _ -> 64 | [%str [%ocaml.error "Ops, enum must be a type with variant without args"]] 65 | 66 | module Lint = struct 67 | let traverse = 68 | object 69 | inherit [Driver.Lint_error.t list] Ast_traverse.fold 70 | 71 | method! value_binding mb acc = 72 | let loc = mb.pvb_loc in 73 | match mb.pvb_pat.ppat_desc with 74 | | Ppat_var { txt = name; _ } -> 75 | if String.starts_with name ~prefix:"demo_" then acc 76 | else 77 | Driver.Lint_error.of_string loc 78 | "Ops, variable name must not start with demo_" 79 | :: acc 80 | | _ -> acc 81 | end 82 | end 83 | 84 | let _ = 85 | Driver.register_transformation "enum2" ~lint_impl:(fun st -> 86 | Lint.traverse#structure st []) 87 | 88 | module PreProcess = struct 89 | let traverse = 90 | object (_ : Ast_traverse.map) 91 | inherit Ast_traverse.map as super 92 | 93 | method! module_expr mod_exp = 94 | let mod_exp = super#module_expr mod_exp in 95 | match mod_exp.pmod_attributes with 96 | | [ { attr_name = { txt = "enum"; _ }; _ } ] -> ( 97 | match mod_exp.pmod_desc with 98 | | Pmod_structure 99 | ([ { pstr_desc = Pstr_type (name, variants); _ } ] as str) -> 100 | let type_ = enum ~loc:mod_exp.pmod_loc (name, variants) () in 101 | Ast_builder.Default.pmod_structure ~loc:mod_exp.pmod_loc 102 | (str @ type_) 103 | | _ -> mod_exp) 104 | | _ -> mod_exp 105 | end 106 | end 107 | 108 | let _ = 109 | Driver.register_transformation "enum" ~impl:PreProcess.traverse#structure 110 | 111 | module Global = struct 112 | let traverse = 113 | object (_ : Ast_traverse.map) 114 | inherit Ast_traverse.map as super 115 | 116 | method! module_expr mod_exp = 117 | let mod_exp = super#module_expr mod_exp in 118 | match mod_exp.pmod_attributes with 119 | | [ { attr_name = { txt = "enum2"; _ }; attr_payload = payload; _ } ] 120 | -> ( 121 | let opt = 122 | match payload with PStr [%str opt] -> true | _ -> false 123 | in 124 | match mod_exp.pmod_desc with 125 | | Pmod_structure 126 | ([ { pstr_desc = Pstr_type (name, variants); _ } ] as str) -> 127 | let type_ = 128 | enum ~loc:mod_exp.pmod_loc ~opt (name, variants) () 129 | in 130 | Ast_builder.Default.pmod_structure ~loc:mod_exp.pmod_loc 131 | (str @ type_) 132 | | _ -> mod_exp) 133 | | _ -> mod_exp 134 | end 135 | end 136 | 137 | let _ = Driver.register_transformation "enum2" ~impl:Global.traverse#structure 138 | -------------------------------------------------------------------------------- /examples/1 - AST/b - Destructing AST/README.md: -------------------------------------------------------------------------------- 1 | # Destructuring AST 2 | 3 | :link: [Docs](https://ocaml-ppx.github.io/ppxlib/ppxlib/matching-code.html) 4 | 5 | This section has code examples to help you understand it better. 6 | To run the examples: 7 | 8 | ```sh 9 | make demo-destructing_ast 10 | ``` 11 | 12 | ### Table of Contents 13 | 14 | - [Description](#description) 15 | - [AST Structure Pattern Matching](#ast-structure-pattern-matching) 16 | - [Example: Matching Integer Payload Manually](#example-matching-integer-payload-manually) 17 | - [Using `Ast_pattern` High-Level Destructors](#using-ast_pattern-high-level-destructors) 18 | - [Example 1: Matching Integer Payload with `Ast_pattern`](#example-1-matching-integer-payload-with-ast_pattern) 19 | - [Example 2: Simplifying Matching with `eint`](#example-2-simplifying-matching-with-eint) 20 | - [Using Metaquot](#using-metaquot) 21 | - [Example 1: Matching Integer Payload with Metaquot](#example-1-matching-integer-payload-with-metaquot) 22 | - [Example 2: Matching Complex Expressions with Metaquot and Anti-Quotations](#example-2-matching-complex-expressions-with-metaquot-and-anti-quotations) 23 | - [Conclusion](#conclusion) 24 | 25 | ## Description 26 | 27 | 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. 28 | 29 | For example, if you want to transform this code: 30 | 31 | ```ocaml 32 | let one = [%one] 33 | ``` 34 | 35 | into: 36 | 37 | ```ocaml 38 | let one = 1 39 | ``` 40 | 41 | You’ll need to destructure the AST representing the extension point (`[%one]`) to replace it with `1`. 42 | There are several ways to destructure an AST. We’ll explore three methods: 43 | 44 | - **AST Structure Pattern Matching** 45 | - **Using `Ast_pattern` High-Level Destructors** 46 | - **Using Metaquot** 47 | 48 | ## AST Structure Pattern Matching 49 | 50 | The most fundamental method for destructuring an AST in PPXLib is by directly matching on the AST’s structure. 51 | 52 | ### Example: Matching Integer Payload Manually 53 | 54 | [:link: Sample Code](./destructuring_ast.ml#L11-L26) 55 | 56 | Let’s say we want to destructure an AST representing the integer `1`: 57 | 58 | ```ocaml 59 | let match_int_payload ~loc payload = 60 | match payload with 61 | | PStr 62 | [ 63 | { 64 | pstr_desc = 65 | Pstr_eval 66 | ({ pexp_desc = Pexp_constant (Pconst_integer (value, None)); _ }, _); 67 | _; 68 | }; 69 | ] -> ( 70 | try Ok (value |> int_of_string) 71 | with Failure _ -> 72 | Error (Location.Error.createf ~loc "Value is not a valid integer")) 73 | | _ -> Error (Location.Error.createf ~loc "Wrong pattern") 74 | ``` 75 | 76 | 1. **Pattern Matching the Payload**: 77 | - Begins by matching the `payload` with the expected structure. 78 | - The pattern expects a structure (`PStr`) containing a single item. 79 | 2. **Destructuring the Structure Item**: 80 | - Matches the `pstr_desc` field, expecting an evaluated expression (`Pstr_eval`). 81 | - The expression should be a constant integer (`Pexp_constant` with `Pconst_integer`). 82 | - Captures the integer value as a string in `value`. 83 | 3. **Handling the Matched Value**: 84 | - Converts the `value` to an integer and returns `Ok` if successful. 85 | - If conversion fails, returns an error message. 86 | 4. **Handling Mismatched Patterns**: 87 | - If the `payload` doesn’t match the expected structure, it returns an error. 88 | 89 | While this method is powerful, it can be verbose and difficult to maintain as patterns become more complex. 90 | 91 | ## Using `Ast_pattern` High-Level Destructors 92 | 93 | To make AST destructuring more readable, PPXLib provides the `Ast_pattern` module, which offers high-level destructors. 94 | 95 | ### Example 1: Matching Integer Payload with `Ast_pattern` 96 | 97 | [:link: Sample Code](./destructuring_ast.ml#L37-L40) 98 | 99 | Let’s destructure the same integer `1` AST using `Ast_pattern`: 100 | 101 | ```ocaml 102 | open Ppxlib 103 | 104 | let match_int_payload = 105 | let open Ast_pattern in 106 | pstr (pstr_eval (pexp_constant (pconst_integer (string "1") none)) nil ^:: nil) 107 | ``` 108 | 109 | This code achieves the same result as the previous example but in a more concise and readable way. 110 | 111 | - **`PStr`** becomes `pstr` 112 | - **`Pstr_eval`** becomes `pstr_eval` 113 | - **`Pexp_constant`** becomes `pexp_constant` 114 | - **`Pconst_integer`** becomes `pconst_integer` 115 | 116 | ### Example 2: Simplifying Matching with `eint` 117 | 118 | [:link: Sample Code](./destructuring_ast.ml#L40-L49) 119 | 120 | You can further simplify it: 121 | 122 | ```ocaml 123 | let match_int_payload = 124 | let open Ast_pattern in 125 | pstr (pstr_eval (eint (int 1)) nil ^:: nil) 126 | ``` 127 | 128 | Using `eint` instead of `pexp_constant` and `pconst_integer` provides better type safety. The `int` wildcard captures the integer value. 129 | 130 | ## Using Metaquot 131 | 132 | Metaquot is a syntax extension that allows you to write and destructure ASTs more intuitively. 133 | 134 | ### Example 1: Matching Integer Payload with Metaquot 135 | 136 | [:link: Sample Code](./destructuring_ast.ml#L51-L60) 137 | 138 | Let’s destructure the same integer `1` AST with Metaquot: 139 | 140 | ```ocaml 141 | let match_int_payload expr = 142 | match expr with 143 | | [%expr 1] -> Ok 1 144 | | _ -> Error (Location.Error.createf ~loc:expr.pexp_loc "Wrong pattern") 145 | ``` 146 | 147 | ### Example 2: Matching Complex Expressions with Metaquot and Anti-Quotations 148 | 149 | [:link: Sample Code](./destructuring_ast.ml#L79-L90) 150 | 151 | For example, to match any expression of the form `1 + `: 152 | 153 | ```ocaml 154 | let match_int_payload expr = 155 | match expr with 156 | | [%expr 1 + [%e? e]] -> ( 157 | match e with 158 | | { pexp_desc = Pexp_constant (Pconst_integer (value, None)); _ } -> 159 | Ok (1 + int_of_string value) 160 | | _ -> Error (Location.Error.createf ~loc:e.pexp_loc "Invalid integer")) 161 | | _ -> Error (Location.Error.createf ~loc:expr.pexp_loc "Wrong pattern") 162 | ``` 163 | 164 | Metaquot simplifies the process, making the AST patterns more readable, especially for complex structures. 165 | 166 | ## Conclusion 167 | 168 | In this section, we explored different methods to destructure an AST using PPXLib: 169 | 170 | - **AST Structure Pattern Matching**: Powerful but verbose. 171 | - **Using `Ast_pattern` High-Level Destructors**: More readable and maintainable. 172 | - **Using Metaquot**: Intuitive and effective for both simple and complex patterns. 173 | 174 | 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. 175 | 176 | ### [On the next section, we will learn how to write a PPX.](../../2%20-%20Writing%20PPXs/README.md) -------------------------------------------------------------------------------- /examples/1 - AST/a - Building AST/README.md: -------------------------------------------------------------------------------- 1 | # Building AST 2 | 3 | :link: [Docs](https://ocaml-ppx.github.io/ppxlib/ppxlib/generating-code.html) 4 | 5 | This section has code examples to help you understand it better. 6 | To run the examples: 7 | 8 | ```sh 9 | make demo-building_ast 10 | ``` 11 | 12 | ### Table of Contents 13 | 14 | - [Description](#description) 15 | - [Building ASTs with Pure OCaml](#building-asts-with-pure-ocaml) 16 | - [Example: Building a Simple Integer AST Manually](#example-building-a-simple-integer-ast-manually) 17 | - [Building ASTs with `AST_builder`](#building-asts-with-ast_builder) 18 | - [Example 1: Using `pexp_constant` for Integer AST](#example-1-using-pexp_constant-for-integer-ast) 19 | - [Example 2: Using `eint` for Simplified Integer AST](#example-2-using-eint-for-simplified-integer-ast) 20 | - [Using Metaquot for AST Construction](#using-metaquot-for-ast-construction) 21 | - [Example: Building an Integer AST with Metaquot](#example-building-an-integer-ast-with-metaquot) 22 | - [Using Anti-Quotations in Metaquot](#using-anti-quotations-in-metaquot) 23 | - [Example: Inserting Dynamic Expressions with Anti-Quotations](#example-inserting-dynamic-expressions-with-anti-quotations) 24 | - [Building Complex Expressions](#building-complex-expressions) 25 | - [Example 1: Constructing a Let Expression with `AST_builder`](#example-1-constructing-a-let-expression-with-ast_builder) 26 | - [Example 2: Constructing a Let Expression with Metaquot](#example-2-constructing-a-let-expression-with-metaquot) 27 | - [Conclusion](#conclusion) 28 | 29 | ## Description 30 | 31 | 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. 32 | 33 | For example, if you want to generate the following code: 34 | 35 | ```ocaml 36 | let zero = [%int 0] 37 | ``` 38 | 39 | 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. 40 | 41 | There are several methods to build an AST. We’ll discuss three approaches: 42 | 43 | - **Building ASTs with Pure OCaml** 44 | - **Building ASTs with `AST_builder`** 45 | - **Using Metaquot for AST Construction** 46 | 47 | ## Building ASTs with Low-Level Builders 48 | 49 | The most fundamental way to build an AST is to manually construct it using Low-Level Builders data structures. 50 | 51 | ### Example: Building a Simple Integer AST Manually 52 | 53 | [:link: Sample Code](./building_ast.ml#L5-L16) 54 | 55 | To construct an AST for a simple integer value `0`: 56 | 57 | ```ocaml 58 | let zero ~loc : Ppxlib_ast.Ast.expression = 59 | { 60 | pexp_desc = Pexp_constant (Pconst_integer ("0", None)); 61 | pexp_loc = loc; 62 | pexp_loc_stack = []; 63 | pexp_attributes = []; 64 | } 65 | ``` 66 | 67 | While this method provides full control over the AST, it is verbose and less maintainable. 68 | 69 | ## Building ASTs with `AST_builder` 70 | 71 | PPXLib provides the `AST_builder` module, which simplifies the process of building ASTs by providing helper functions. 72 | 73 | ### Example 1: Using `pexp_constant` for Integer AST 74 | 75 | [:link: Sample Code](./building_ast.ml#L18-L24) 76 | 77 | Using `pexp_constant`, you can construct an integer AST like this: 78 | 79 | ```ocaml 80 | let one ~loc = 81 | Ast_builder.Default.pexp_constant ~loc (Parsetree.Pconst_integer ("1", None)) 82 | ``` 83 | 84 | This method is more readable and concise compared to the pure OCaml approach. 85 | 86 | ### Example 2: Using `eint` for Simplified Integer AST 87 | 88 | [:link: Sample Code](./building_ast.ml#L26-L31) 89 | 90 | For even more simplicity, use `eint`: 91 | 92 | ```ocaml 93 | let two ~loc = Ast_builder.Default.eint ~loc 2 94 | ``` 95 | 96 | > **:bulb: Tip** 97 | > `eint` is an abbreviation for expression (`e`) integer (`int`). 98 | 99 | ## Using Metaquot for AST Construction 100 | 101 | Metaquot is a syntax extension that allows you to write ASTs in a more natural and readable way. 102 | 103 | ### Example: Building an Integer AST with Metaquot 104 | 105 | [:link: Sample Code](./building_ast.ml#L33-L38) 106 | 107 | With Metaquot, you can construct an integer AST like this: 108 | 109 | ```ocaml 110 | let three ~loc = [%expr 3] 111 | ``` 112 | 113 | > **:bulb: Tip** 114 | > Metaquot is highly readable and intuitive but is static. For dynamic values, use Anti-Quotations. 115 | 116 | ### Using Anti-Quotations in Metaquot 117 | 118 | Anti-Quotations allow you to insert dynamic expressions into your Metaquot ASTs. 119 | 120 | #### Example: Inserting Dynamic Expressions with Anti-Quotations 121 | 122 | [:link: Sample Code](./building_ast.ml#L72-L77) 123 | 124 | To insert a dynamic expression into a Metaquot AST: 125 | 126 | ```ocaml 127 | let anti_quotation_expr expr = [%expr 1 + [%e expr]] 128 | ``` 129 | 130 | For example, to insert the AST for `1`: 131 | 132 | ```ocaml 133 | let _ = 134 | print_endline 135 | ("\nLet expression with metaquot and anti-quotation: " 136 | ^ Astlib.Pprintast.string_of_expression (anti_quotation_expr (one ~loc))) 137 | ``` 138 | 139 | ## Building Complex Expressions 140 | 141 | Beyond simple expressions, you may need to build more complex ASTs, such as `let` expressions. 142 | 143 | ### Example 1: Constructing a Let Expression with `AST_builder` 144 | 145 | [:link: Sample Code](./building_ast.ml#L40-L60) 146 | 147 | To build a `let` expression that binds the value `3` to the variable `foo`: 148 | 149 | ```ocaml 150 | let let_expression = 151 | let expression = 152 | Ast_builder.Default.pexp_constant ~loc:Location.none 153 | (Pconst_integer ("3", None)) 154 | in 155 | let pattern = 156 | Ast_builder.Default.ppat_var ~loc:Location.none 157 | (Ast_builder.Default.Located.mk ~loc:Location.none "foo") 158 | in 159 | let let_binding = 160 | Ast_builder.Default.value_binding ~loc:Location.none ~pat:pattern 161 | ~expr:expression 162 | in 163 | Ast_builder.Default.pexp_let ~loc:Location.none Nonrecursive [ let_binding ] 164 | (Ast_builder.Default.eunit ~loc:Location.none) 165 | ``` 166 | 167 | ### Example 2: Constructing a Let Expression with Metaquot 168 | 169 | [:link: Sample Code](./building_ast.ml#L62-L70) 170 | 171 | Alternatively, with Metaquot: 172 | 173 | ```ocaml 174 | let let_expression = 175 | [%expr 176 | let foo = 3 in 177 | ()] 178 | ``` 179 | 180 | This approach is shorter and easier to understand. 181 | 182 | ## Conclusion 183 | 184 | In this section, we explored three methods for building ASTs: 185 | 186 | - **Pure OCaml**: The most basic but verbose approach. 187 | - **Using `AST_builder`**: A more readable and maintainable option. 188 | - **Using Metaquot**: The most intuitive method, especially when combined with Anti-Quotations for dynamic values. 189 | 190 | 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. 191 | 192 | ### [On the next section, we will learn how to destructure an AST.](../b%20-%20Destructing%20AST/README.md) 193 | -------------------------------------------------------------------------------- /examples/2 - Writing PPXs/a - Context Free/context_free.ml: -------------------------------------------------------------------------------- 1 | open Ppxlib 2 | open Ast_builder.Default 3 | 4 | (* PPX Extender *) 5 | let structure_item ~loc = [%expr 1] 6 | 7 | let expand ~ctxt = 8 | let loc = Expansion_context.Extension.extension_point_loc ctxt in 9 | structure_item ~loc 10 | 11 | let my_extension = 12 | Extension.V3.declare "one" Extension.Context.expression 13 | Ast_pattern.(pstr nil) 14 | expand 15 | 16 | let rule = Ppxlib.Context_free.Rule.extension my_extension 17 | let () = Driver.register_transformation ~rules:[ rule ] "one" 18 | 19 | (* PPX Extender with payload *) 20 | type emoji = { emoji : string; alias : string } 21 | 22 | let pattern = Ast_pattern.(single_expr_payload (estring __)) 23 | let expression ~loc ~value = [%expr [%e estring ~loc value]] 24 | 25 | let emojis = 26 | [ 27 | { emoji = "😀"; alias = "grin" }; 28 | { emoji = "😃"; alias = "smiley" }; 29 | { emoji = "😄"; alias = "smile" }; 30 | ] 31 | 32 | let expand ~ctxt emoji_text = 33 | let loc = Expansion_context.Extension.extension_point_loc ctxt in 34 | 35 | let find_emoji_by_alias alias = 36 | List.find_opt (fun emoji -> alias = emoji.alias) emojis 37 | in 38 | 39 | match find_emoji_by_alias emoji_text with 40 | | Some value -> expression ~loc ~value:value.emoji 41 | | None -> 42 | let ext = 43 | Location.error_extensionf ~loc "No emoji for %s alias" emoji_text 44 | in 45 | Ast_builder.Default.pexp_extension ~loc ext 46 | 47 | let my_extension = 48 | Extension.V3.declare "emoji" Extension.Context.expression pattern expand 49 | 50 | (* PPX Deriver *) 51 | let rule = Ppxlib.Context_free.Rule.extension my_extension 52 | let () = Driver.register_transformation ~rules:[ rule ] "emoji" 53 | let args () = Deriving.Args.(empty) 54 | 55 | (* add to_string and from_string helpers to a type variant *) 56 | let enum ~ctxt ast = 57 | let loc = Expansion_context.Deriver.derived_item_loc ctxt in 58 | match ast with 59 | | ( _, 60 | [ 61 | { 62 | ptype_name = { txt = type_name; _ }; 63 | ptype_kind = Ptype_variant variants; 64 | _; 65 | }; 66 | ] ) -> 67 | let function_name suffix = type_name ^ suffix in 68 | let arg_pattern = [%pat? value] in 69 | let expr_string = Ast_builder.Default.estring ~loc in 70 | let function_name_pattern = 71 | [%pat? [%p ppat_var ~loc { txt = function_name "_to_string"; loc }]] 72 | in 73 | let to_string_expr = 74 | [%stri 75 | let[@warning "-32"] [%p function_name_pattern] = 76 | fun [%p arg_pattern] -> 77 | [%e 78 | pexp_match ~loc [%expr value] 79 | (List.map 80 | (fun { pcd_name = { txt = value; _ }; _ } -> 81 | case 82 | ~lhs: 83 | (ppat_construct ~loc (Located.lident ~loc value) None) 84 | ~guard:None ~rhs:(expr_string value)) 85 | variants)]] 86 | in 87 | (* Uncomment to see the generated code *) 88 | (* print_endline (Astlib.Pprintast.string_of_structure [ to_string_expr ]); *) 89 | let else_case = 90 | case 91 | ~lhs:[%pat? [%p ppat_any ~loc]] 92 | ~guard:None 93 | ~rhs: 94 | [%expr raise (Invalid_argument "Argument doesn't match variants")] 95 | in 96 | let function_name_pattern = 97 | [%pat? [%p ppat_var ~loc { txt = function_name "_from_string"; loc }]] 98 | in 99 | let from_string_expr = 100 | [%stri 101 | let[@warning "-32"] [%p function_name_pattern] = 102 | fun [%p arg_pattern] -> 103 | [%e 104 | pexp_match ~loc [%expr value] 105 | (List.map 106 | (fun { pcd_name = { txt = value; _ }; _ } -> 107 | case 108 | ~lhs: 109 | (ppat_constant ~loc (Pconst_string (value, loc, None))) 110 | ~guard:None 111 | ~rhs: 112 | (pexp_construct ~loc (Located.lident ~loc value) None)) 113 | variants 114 | @ [ else_case ])]] 115 | in 116 | (* Uncomment to see the generated code *) 117 | (* print_endline (Astlib.Pprintast.string_of_structure [ from_string_expr ]); *) 118 | [ from_string_expr; to_string_expr ] 119 | | _ -> 120 | [%str 121 | [%ocaml.error "Ops, enum2 must be a type with variant without args"]] 122 | 123 | let generator () = Deriving.Generator.V2.make (args ()) enum 124 | let _ = Deriving.add "enum" ~str_type_decl:(generator ()) 125 | let args () = Deriving.Args.(empty +> flag "opt") 126 | 127 | let enum2 ~ctxt ast opt = 128 | let loc = Expansion_context.Deriver.derived_item_loc ctxt in 129 | match ast with 130 | | ( _, 131 | [ 132 | { 133 | ptype_name = { txt = type_name; _ }; 134 | ptype_kind = Ptype_variant variants; 135 | _; 136 | }; 137 | ] ) -> 138 | let function_name suffix = type_name ^ suffix in 139 | let expr_string = Ast_builder.Default.estring ~loc in 140 | let arg_pattern = [%pat? value] in 141 | let function_name_pattern = 142 | [%pat? [%p ppat_var ~loc { txt = function_name "_to_string"; loc }]] 143 | in 144 | let to_string_expr = 145 | [%stri 146 | let[@warning "-32"] [%p function_name_pattern] = 147 | fun [%p arg_pattern] -> 148 | [%e 149 | pexp_match ~loc [%expr value] 150 | (List.fold_left 151 | (fun acc { pcd_name = { txt = value; _ }; _ } -> 152 | acc 153 | @ [ 154 | case 155 | ~lhs: 156 | (ppat_construct ~loc 157 | (Located.lident ~loc value) 158 | None) 159 | ~guard:None ~rhs:(expr_string value); 160 | ]) 161 | [] variants)]] 162 | in 163 | 164 | (* Uncomment to see the generated code *) 165 | (* print_endline (Astlib.Pprintast.string_of_structure [ to_string_expr ]); *) 166 | let else_case = 167 | case 168 | ~lhs:[%pat? [%p ppat_any ~loc]] 169 | ~guard:None 170 | ~rhs: 171 | (match opt with 172 | | true -> [%expr None] 173 | | _ -> 174 | [%expr 175 | raise (Invalid_argument "Argument doesn't match variants")]) 176 | in 177 | let function_name_pattern = 178 | [%pat? [%p ppat_var ~loc { txt = function_name "_from_string"; loc }]] 179 | in 180 | let from_string_expr = 181 | [%stri 182 | let[@warning "-32"] [%p function_name_pattern] = 183 | fun [%p arg_pattern] -> 184 | [%e 185 | pexp_match ~loc [%expr value] 186 | (List.map 187 | (fun { pcd_name = { txt = value; _ }; _ } -> 188 | case 189 | ~lhs: 190 | (ppat_constant ~loc (Pconst_string (value, loc, None))) 191 | ~guard:None 192 | ~rhs: 193 | (match opt with 194 | | true -> 195 | [%expr 196 | Some 197 | [%e 198 | pexp_construct ~loc 199 | (Located.lident ~loc value) 200 | None]] 201 | | _ -> 202 | pexp_construct ~loc 203 | (Located.lident ~loc value) 204 | None)) 205 | variants 206 | @ [ else_case ])]] 207 | in 208 | (* Uncomment to see the generated code *) 209 | (* print_endline (Astlib.Pprintast.string_of_structure [ from_string_expr ]); *) 210 | [ from_string_expr; to_string_expr ] 211 | | _ -> 212 | [%str 213 | [%ocaml.error "Ops, enum2 must be a type with variant without args"]] 214 | 215 | let generator () = Deriving.Generator.V2.make (args ()) enum2 216 | let _ = Deriving.add "enum2" ~str_type_decl:(generator ()) 217 | -------------------------------------------------------------------------------- /examples/2 - Writing PPXs/b - Global/README.md: -------------------------------------------------------------------------------- 1 | # Global Transformations 2 | 3 | This section contains code examples to help you understand how to implement global transformations in OCaml using PPXLib. 4 | To run the examples: 5 | 6 | ```sh 7 | make demo-global 8 | ``` 9 | 10 | ### Table of Contents 11 | 12 | - [Description](#description) 13 | - [Types of Global Transformations](#types-of-global-transformations) 14 | - [Using `Ast_traverse`](#using-ast_traverse) 15 | - [How It Works](#how-it-works) 16 | - [Key Points](#key-points) 17 | - [Lint](#lint) 18 | - [Example 1: Linting Variable Names to Have the Prefix `demo_`](#example-1-linting-variable-names-to-have-the-prefix-demo_) 19 | - [Preprocess](#preprocess) 20 | - [Example 1: Extending a Module with the `[@enum]` Attribute](#example-1-extending-a-module-with-the-enum-attribute) 21 | - [Global Transformation](#global-transformation) 22 | - [Example 1: Extending a Module with the `[@enum2 opt]` Attribute](#example-1-extending-a-module-with-the-enum2-opt-attribute) 23 | - [Conclusion](#conclusion) 24 | 25 | ## Description 26 | 27 | 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. 28 | 29 | ### Types of Global Transformations 30 | 31 | - Lint 32 | - Preprocess 33 | - Instrumentation - Before 34 | - Global Transformation 35 | - Instrumentation - After 36 | 37 | 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. 38 | In the future, we plan to add **Instrumentation - Before** and **Instrumentation - After**. 39 | 40 | ## Using `Ast_traverse` 41 | 42 | 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. 43 | 44 | ### How It Works: 45 | 46 | `Ast_traverse` is helpful for navigating and modifying complex structures like the AST. 47 | 48 | Here are the main types of traversals you can do with `Ast_traverse`: 49 | 50 | - **Iterators**: Go through the AST and perform actions on each node, often for side effects like checking for specific patterns or enforcing rules. 51 | 52 | - **Maps**: Traverse the AST and replace nodes where needed. This is useful for making changes to the AST and returning a modified version. 53 | 54 | - **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. 55 | 56 | - **Lifts**: Transform an AST node into a different type by working from the bottom up, often used to convert AST structures into other forms. 57 | 58 | ### Key Points: 59 | 60 | - **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. 61 | 62 | - **Override specific methods**: Customize your traversal by overriding methods that handle specific AST nodes, like `module_binding` or `structure_item`. 63 | 64 | - **Register with `Driver.register_transformation`**: After defining your traversal, register it with the PPX driver. This ensures your transformations are applied during compilation. 65 | 66 | 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. 67 | 68 | ## Lint 69 | 70 | 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. 71 | 72 | ### Example 1: Linting Variable Names to Have the Prefix `demo_` 73 | 74 | [:link: Sample Code](./context_free.ml#L1-L4) 75 | 76 | Let's create a linting rule that ensures that all `value_binding`s have the prefix `demo_`. 77 | 78 | #### Consider the following example: 79 | 80 | ```ocaml 81 | (* This will raise a lint error *) 82 | let name = "John Doe" 83 | 84 | (* This will not raise a lint error *) 85 | let demo_name = "John Doe" 86 | ``` 87 | 88 | #### Steps to Implement This Transformation: 89 | 90 | - **Understand the AST Structure:** 91 | 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). 92 | 93 | - **Ast_traverse.fold:** 94 | 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`. 95 | 96 | ```ocaml 97 | let traverse = 98 | object 99 | (* Inherit from Ast_traverse.fold with the Lint_error.t list as the accumulator *) 100 | inherit [Driver.Lint_error.t list] Ast_traverse.fold 101 | 102 | (* Override the value_binding method to lint the variable name *) 103 | (* the value_binding method is called for each value_binding in the AST *) 104 | method! value_binding vb acc = 105 | let loc = vb.pvb_loc in 106 | match ast with 107 | (* Match all pattern variables and get their names *) 108 | | Ppat_var { txt = name; _ } -> 109 | (* Check if the variable name starts with demo_ *) 110 | if String.starts_with name ~prefix:"demo_" then acc 111 | else 112 | (* If not, add a lint error to the accumulator *) 113 | Driver.Lint_error.of_string loc 114 | "Oops, variable names must start with demo_" 115 | :: acc 116 | | _ -> acc 117 | end 118 | ``` 119 | 120 | - **Register the Lint Rule with the PPX Driver:** 121 | Register with `~lint_impl`. 122 | 123 | ```ocaml 124 | let _ = Driver.register_transformation "lint" ~lint_impl:traverse#structure 125 | ``` 126 | 127 | ## Preprocess 128 | 129 | Preprocessing is the first phase that alters the AST. 130 | 131 | :warning: **Warning**: You should only register a transformation in this phase if it is really necessary. You can use the Global Transformation phase instead. 132 | 133 | ### Example 1: Extending a Module with the `[@enum]` Attribute 134 | 135 | [:link: Sample Code](./context_free.ml#L9-L18) 136 | 137 | 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. 138 | 139 | #### Consider the following example: 140 | 141 | ```ocaml 142 | module GameEnum = struct 143 | type t = Rock | Paper | Scissors 144 | end [@enum] 145 | (* Output: 146 | module GameEnum = struct 147 | type t = Rock | Paper | Scissors 148 | let to_string = function 149 | | Rock -> "Rock" 150 | | Paper -> "Paper" 151 | | Scissors -> "Scissors" 152 | let from_string = function 153 | | "Rock" -> Rock 154 | | "Paper" -> Paper 155 | | "Scissors" -> Scissors 156 | | _ -> failwith "Invalid string" 157 | end *) 158 | ``` 159 | 160 | #### Steps to Implement This Global Transformation: 161 | 162 | - **Understand the AST Structure:** 163 | 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. 164 | 165 | - **Ast_traverse.map:** 166 | 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. 167 | 168 | ```ocaml 169 | let traverse = 170 | object 171 | inherit Ast_traverse.map as super 172 | 173 | (* Override the module_expr method to generate to_string and from_string functions *) 174 | method! module_expr mod_exp = 175 | (* Call the super method to traverse the module expression *) 176 | let mod_exp = super#module_expr mod_exp in 177 | (* Check if the module expression has the [@enum] attribute *) 178 | match mod_exp.pmod_attributes with 179 | | [ { attr_name = { txt = "enum"; _ }; _ } ] 180 | -> ( 181 | (* match the module expression structure to get the type name and variants *) 182 | match mod_exp.pmod_desc with 183 | | Pmod_structure 184 | ([ { pstr_desc = Pstr_type (name, variants); _ } ] as str) -> 185 | (* We are not going to show the enum function because we already covered it in the previous Context-free section *) 186 | let type_ = 187 | enum ~loc:mod_exp.pmod_loc (name, variants) () 188 | in 189 | (* Append the generated functions to the module structure *) 190 | Ast_builder.Default.pmod_structure ~loc:mod_exp.pmod_loc (str @ type_) 191 | | _ -> mod_exp) 192 | | _ -> mod_exp 193 | end 194 | ``` 195 | 196 | - **Register the Deriver with the PPX Driver:** 197 | 198 | ```ocaml 199 | let _ = Driver.register_transformation "enum" ~impl:traverse#structure 200 | ``` 201 | 202 | ## Global Transformation 203 | 204 | 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. 205 | 206 | This is the most common phase to register a global transformation that alters the AST. 207 | 208 | 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. 209 | 210 | ### Example 1: Extending a Module with the `[@enum2 opt]` Attribute 211 | 212 | [:link: Sample Code](./context_free.ml#L27-L47) 213 | 214 | 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. 215 | 216 | #### Consider the following example: 217 | 218 | ```ocaml 219 | module GameEnum2 = struct 220 | type t = Rock | Paper | Scissors 221 | end [@enum2 opt] 222 | (* Output: 223 | module GameEnum2 = struct 224 | type t = Rock | Paper | Scissors 225 | let to_string = function 226 | | Rock -> "Rock" 227 | | Paper -> "Paper" 228 | | Scissors -> "Scissors" 229 | let from_string = function 230 | | "Rock" -> Some Rock 231 | | "Paper" -> Some Paper 232 | | "Scissors" -> Some Scissors 233 | | _ -> None 234 | end *) 235 | ``` 236 | 237 | #### Steps to Implement This Global Transformation: 238 | 239 | - **This example is an extension of the previous one.** 240 | 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. 241 | 242 | ```ocaml 243 | (* Check if the module expression has the @enum2 attribute and get the attribute's payload *) 244 | | [ { attr_name = { txt = "enum2"; _ }; attr_payload = payload; _ } ] 245 | -> ( 246 | (* match the module expression structure to get the type name and variants *) 247 | let opt = 248 | match payload with PStr [%str opt] -> true | _ -> false 249 | in 250 | match mod_exp.pmod_desc with 251 | | Pmod_structure 252 | ([ { pstr_desc = Pstr_type (name, variants); _ } ] as str) -> 253 | (* We are not going to show the enum function because we already covered it in the previous Context-free section *) 254 | let type_ = 255 | enum ~loc:mod_exp.pmod_loc ~opt (name, variants) () 256 | in 257 | Ast_builder.Default.pmod_structure ~loc:mod_exp.pmod_loc (str @ type_) 258 | | _ -> mod_exp) 259 | | _ -> mod_exp 260 | ``` 261 | 262 | - **Register the Deriver with the PPX Driver:** 263 | The difference here compared to the preprocess is that we are going to use the `~impl` instead of `~preprocess_impl`. 264 | 265 | ```ocaml 266 | let _ = Driver.register_transformation "enum2" ~impl:traverse#structure 267 | ``` 268 | 269 | ## Conclusion 270 | 271 | 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. 272 | 273 | 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]`. 274 | 275 | Understanding these concepts and using the right transformation phase ensures your code is cleaner, more consistent, and easier to maintain. 276 | 277 | ### [In the next section, we will explore advanced use cases of global transformations.](../c%20-%20Advanced%20Global%20Transformations/README.md) -------------------------------------------------------------------------------- /examples/1 - AST/README.md: -------------------------------------------------------------------------------- 1 | # Abstract Syntax Tree (AST) 2 | 3 | ### Table of Contents 4 | 5 | - [Description](#description) 6 | - [Preprocessing in OCaml](#preprocessing-in-ocaml) 7 | - [AST Guide](#ast-guide) 8 | - [Why Should I Understand the AST?](#why-should-i-understand-the-ast) 9 | - [First Look](#first-look) 10 | - [Structure](#structure) 11 | - [Language Extensions and Attributes](#language-extensions-and-attributes) 12 | - [Samples](#samples) 13 | 14 | ## Description 15 | 16 | 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). 17 | 18 | ### Preprocessing in OCaml 19 | 20 | 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. 21 | 22 | The OCaml Platform officially supports a library for creating these preprocessors, which can operate at two levels: 23 | 24 | - **Source Level**: Preprocessors work directly on the source code. 25 | - **AST Level**: Preprocessors manipulate the AST, offering more powerful and flexible transformations. (Covered in this guide) 26 | 27 | > **⚠️ Warning** 28 | > 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) 29 | 30 | ### AST Guide 31 | 32 | This guide will concentrate on AST-level preprocessing using **PPX** (PreProcessor eXtensions), providing a comprehensive overview of the following topics: 33 | 34 | 1. **AST Construction**: Learning how to build and manipulate ASTs. 35 | 2. **AST Destructuring**: Breaking down ASTs into manageable components for advanced transformations. 36 | 37 | ### Why Should I Understand the AST? 38 | 39 | 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. 40 | 41 | 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. 42 | 43 | A simple example of learning more about the OCaml compiler is that types are recursive by default, while values are non-recursive. 44 | With the AST, we can see this clearly: 45 | ```ocaml 46 | type name = string 47 | let name = "John Doe" 48 | ``` 49 | ```json5 50 | // AST Tree 51 | { 52 | "type": "structure", 53 | "structure": [ 54 | // type name = string 55 | { 56 | "type": "structure_item", 57 | "pstr_desc": { 58 | "type": "Pstr_type", 59 | "rec_flag": { 60 | "type": "Recursive" 61 | }, 62 | "type_declarations": [ 63 | { 64 | "type": "type_declaration", 65 | "ptype_name": {/* ... */}, 66 | } 67 | ] 68 | }, 69 | "pstr_loc": {/* ... */}, 70 | }, 71 | // let name = "John Doe" 72 | { 73 | "type": "structure_item", 74 | "pstr_desc": { 75 | "type": "Pstr_value", 76 | "rec_flag": { 77 | "type": "Nonrecursive" 78 | }, 79 | "value_bindings": [ 80 | { 81 | "type": "value_binding", 82 | "pvb_pat": {/* ... */}, 83 | } 84 | ] 85 | }, 86 | "pstr_loc": {/* ... */}, 87 | } 88 | ] 89 | } 90 | ``` 91 | 92 | ### First Look 93 | 94 | 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. 95 | 96 | Let's take a quick look at the JSON AST representation of a simple OCaml expression: 97 | 98 | ```ocaml 99 | (* Foo.ml *) 100 | let name = "john doe" 101 | ``` 102 | 103 | ```json5 104 | // AST Tree 105 | { 106 | "type": "structure", 107 | "structure": [ 108 | { 109 | "type": "structure_item", 110 | "pstr_desc": { 111 | "type": "Pstr_value", 112 | "rec_flag": { 113 | /* ... */ 114 | }, 115 | "value_bindings": [ 116 | { 117 | "type": "value_binding", 118 | "pvb_pat": { 119 | "type": "pattern", 120 | "ppat_desc": { 121 | "type": "Ppat_var", 122 | "string_loc": { 123 | "type": "string Asttypes.loc", 124 | "txt": "name", 125 | "loc": { 126 | /* ... */ 127 | } 128 | } 129 | }, 130 | "ppat_loc": { 131 | /* ... */ 132 | } 133 | }, 134 | "pvb_expr": { 135 | "type": "expression", 136 | "pexp_desc": { 137 | "type": "Pexp_constant", 138 | "constant": { 139 | "type": "Pconst_string", 140 | "string": "john doe", 141 | "quotation_delimiter": { 142 | /* ... */ 143 | } 144 | } 145 | }, 146 | "pexp_loc": { 147 | /* ... */ 148 | } 149 | }, 150 | "pvb_loc": { 151 | /* ... */ 152 | } 153 | } 154 | ] 155 | }, 156 | "pstr_loc": { 157 | /* ... */ 158 | } 159 | } 160 | ] 161 | } 162 | ``` 163 | 164 | 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. 165 | 166 | ### Structure 167 | 168 | ```json5 169 | // AST Tree 170 | { 171 | "type": "structure", 172 | "structure": [ 173 | /* ... */ 174 | ] 175 | } 176 | ``` 177 | 178 | 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. 179 | 180 | A **structure** refers to the content within a module. It is composed of various declarations, known as **structure items**, which include: 181 | 182 | - **Type definitions** (e.g., `type t = ...`) 183 | - **`let` bindings** (e.g., `let x = 1`) 184 | - **Function definitions** 185 | - **Exception declarations** 186 | - **Other nested modules** 187 | 188 | 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. 189 | 190 | > **:bulb: Tip** 191 | > Every module in OCaml creates a new structure, and nested modules create nested structures. 192 | 193 | Consider the following example: 194 | 195 | ```ocaml 196 | (* Bar.ml *) 197 | let name = "john doe" 198 | 199 | module GameEnum = struct 200 | type t = Rock | Paper | Scissors 201 | 202 | let to_string = function 203 | | Rock -> "Rock" 204 | | Paper -> "Paper" 205 | | Scissors -> "Scissors" 206 | 207 | let from_string = function 208 | | "Rock" -> Rock 209 | | "Paper" -> Paper 210 | | "Scissors" -> Scissors 211 | | _ -> failwith "Invalid string" 212 | end 213 | ``` 214 | 215 | ```json5 216 | // AST Tree 217 | { 218 | "type": "structure", 219 | "structure": [ 220 | { 221 | "type": "structure_item", 222 | "pstr_desc": { 223 | /* ... */ 224 | }, 225 | "pstr_loc": { 226 | /* ... */ 227 | } 228 | }, 229 | { 230 | "type": "structure_item", 231 | "pstr_desc": { 232 | "type": "Pstr_module", 233 | "module_binding": { 234 | "type": "module_binding", 235 | "pmb_name": { 236 | /* ... */ 237 | }, 238 | "pmb_expr": { 239 | "type": "module_expr", 240 | "pmod_desc": { 241 | "type": "Pmod_structure", 242 | "structure": [ 243 | { 244 | "type": "structure_item", 245 | "pstr_desc": { 246 | /* ... */ 247 | } 248 | /* ... */ 249 | } 250 | ] 251 | /* ... */ 252 | } 253 | /* ... */ 254 | } 255 | /* ... */ 256 | } 257 | /* ... */ 258 | } 259 | } 260 | ] 261 | } 262 | ``` 263 | 264 | As you can see, `Bar.ml` and `GameEnum` are modules, and their content is a **structure** that contain a list of **structure items**. 265 | 266 | > **📝 Note** 267 | > A structure item can either represent a top-level expression, a type definition, a `let` definition, etc. 268 | 269 | 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](https://astexplorer.net/) and play with it; it will help you a lot. Here is a [sample](https://astexplorer.net/#/gist/79e2c7cf04e26236bce5627e6d59a020/caa55456cfa6c30c37cc3a701979cf837c213b71). 270 | 271 | ### Language Extensions and Attributes 272 | 273 | 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. 274 | 275 | - 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`. 276 | 277 | 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/) 278 | 279 | There are 2 forms of extension nodes: 280 | 281 | - **For “algebraic” categories**: `[%name "John Doe"]` 282 | - **For structures and signatures**: `[%%name "John Doe"]` 283 |
284 | 285 | > 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]`. 286 | 287 | 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). 288 | 289 | - 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. (Check it breaking on this [AST sample](https://astexplorer.net/#/gist/c2f77c38bd5b855775e7ea6513230775/95bbbedaf54dd6daadb278b9d5ed7b28718331f2)) 290 | 291 | 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/) 292 | 293 | There are 3 forms of attributes: 294 | 295 | - **Attached to on “algebraic” categories**: `[@name]` 296 | - **Attached to “blocks”**: `[@@name]` 297 | - **Stand-alone of signatures or structures modules**: `[@@@name]` 298 |
299 | 300 | > 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]`. 301 | 302 | 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). 303 |
304 | 305 | 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. 306 | 307 | ### Samples 308 | 309 | To help you undestand a little bit more about the AST, let's show it with some highlighted examples: 310 | 311 | | Code | Playgrond | AST | 312 | | --------------------------------------------- | --------------------------------------------------------------------- | ------------------------------------------------------------------------ | 313 | | ![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) | 314 | | ![Code `let name = "john doe"` with `name` highlighted](./pattern.png) | [Link ](https://astexplorer.net/#/gist/d479d32127d6fcb418622ee84b9aa3b2/1d56a1d5b20fc0a55d5ae9d309226dce58f93d2c) | ![AST representation of: name](./pattern_ast.png) | 315 | | ![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) | 316 | | ![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) | 317 | | ![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) | 318 | | ![Code `let name = "John Doe" [@print expr]` with `"John Doe"` highlighted](./attribute_attached.png) | [Link ](https://astexplorer.net/#/gist/d479d32127d6fcb418622ee84b9aa3b2/b4492b3d2d1b34029d367ff278f5bcda0496c0d2) | ![AST representation of: name](./attribute_attached_ast.png) | 319 | | ![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) | 320 | | ![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) | 321 | | ![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) | 322 | | ![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) | 323 | | ![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) | 324 | 325 | ### [On the next section, we will learn how to build an AST.](./a%20-%20Building%20AST/README.md) 326 | -------------------------------------------------------------------------------- /examples/2 - Writing PPXs/a - Context Free/README.md: -------------------------------------------------------------------------------- 1 | # Context-Free Transformations 2 | 3 | This section has code examples to help you understand it better. 4 | To run the examples: 5 | 6 | ```sh 7 | make demo-context_free 8 | ``` 9 | 10 | ### Table of Contents 11 | 12 | - [Description](#description) 13 | - [Types of Context-Free Transformations](#types-of-context-free-transformations) 14 | - [Extenders](#extenders) 15 | - [Example 1: A Simple Extender](#example-1-a-simple-extender) 16 | - [Example 2: A More Complex Extender with Payload](#example-2-a-more-complex-extender-with-payload) 17 | - [Derivers](#derivers) 18 | - [Example 1: Enum Deriver](#example-1-enum-deriver) 19 | - [Example 2: Enum Deriver with args](#example-2-enum-deriver-with-args) 20 | 21 | ## Description 22 | 23 | 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. 24 | 25 | ### Types of Context-Free Transformations 26 | 27 | There are two main types of context-free transformations: 28 | 29 | - **[Extenders](#extenders)**: These modify the extension node by generating new code. 30 | - **[Derivers](#derivers)**: These append code after the item without changing the original item. 31 | 32 | ## Extenders 33 | :page_facing_up: [Doc](https://ocaml-ppx.github.io/ppxlib/ppxlib/driver.html#def_extenders)
34 | ⬅️ 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). 35 | 36 | 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. 37 | 38 | If an extender is broken or missing, the code will not compile. Therefore, it is important to ensure that the extender is correctly implemented. 39 | 40 | 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. 41 | 42 | Let's look at some examples to understand how this works. 43 | 44 | With extenders, we need to: 45 | 46 | - **Hook the extension.** 47 | - **Transform the payload** (if there is one). 48 | - **Create a new AST.** 49 | 50 | ### Example 1: A Simple Extender 51 | [:link: Sample Code](./context_free.ml#L5-L17) 52 | 53 | Consider the following code: 54 | 55 | ```ocaml 56 | let one = [%one] 57 | (* Output: let one = 1 *) 58 | ``` 59 | 60 | Here, `[%one]` is replaced with the integer value `1`. This is a basic example of an extender transformation. 61 | 62 | #### Steps to Implement This Extender: 63 | 64 | - **Declare the extension name:** 65 | 66 | ```ocaml 67 | let extender_name = "one" 68 | ``` 69 | 70 | - **Define the extender extractor:** 71 | Since there is no payload (additional data), we define the extractor as: 72 | 73 | ```ocaml 74 | let extender_extracter = Ast_pattern.(pstr nil) 75 | ``` 76 | 77 | - **Create the new AST:** 78 | We define the expression that will replace `[%one]`: 79 | 80 | ```ocaml 81 | let expression ~loc = [%expr 1] 82 | ``` 83 | 84 | Alternatively, you can use: 85 | 86 | ```ocaml 87 | let expression ~loc = Ast_builder.Default.eint ~loc 1 88 | ``` 89 | 90 | - **Declare the extender and register it:** 91 | 92 | ```ocaml 93 | (* Define the expansion logic *) 94 | let expand ~ctxt = 95 | let loc = Expansion_context.Extension.extension_point_loc ctxt in 96 | expression ~loc 97 | 98 | (* Define the extension *) 99 | let extension = 100 | Extension.V3.declare extender_name Extension.Context.expression 101 | extender_extracter 102 | expand 103 | 104 | (* Register the extender *) 105 | let rule = Ppxlib.Context_free.Rule.extension extension 106 | let () = Driver.register_transformation ~rules:[ rule ] extender_name 107 | ``` 108 | 109 | ### Example 2: A More Complex Extender with Payload 110 | [:link: Sample Code](./context_free.ml#L22-L47) 111 | 112 | Let's look at a more complex example, where we replace `[%emoji "grin"]` with an emoji: 113 | 114 | ```ocaml 115 | let grin = [%emoji "grin"] 116 | (* Output: let grin = "😀" *) 117 | ``` 118 | 119 | #### Steps to Implement This Extender: 120 | 121 | - **Declare the extension name and extractor:** 122 | Here, the payload is a string (the alias of the emoji): 123 | 124 | ```ocaml 125 | let extender_name = "emoji" 126 | let extender_extracter = Ast_pattern.(single_expr_payload (estring __)) 127 | ``` 128 | 129 | - **Create the new AST:** 130 | We define the expression to replace the alias with the corresponding emoji: 131 | 132 | ```ocaml 133 | let expression ~loc ~emoji = [%expr [%e estring ~loc emoji]] 134 | ``` 135 | 136 | - **Define the expansion logic:** 137 | We need to map the alias to an emoji and return the appropriate AST. If the alias isn't found, we return an error: 138 | 139 | ```ocaml 140 | let emojis = 141 | [ 142 | { emoji = "😀"; alias = "grin" }; 143 | { emoji = "😃"; alias = "smiley" }; 144 | { emoji = "😄"; alias = "smile" }; 145 | ] 146 | 147 | let expand ~ctxt emoji_text = 148 | let loc = Expansion_context.Extension.extension_point_loc ctxt in 149 | 150 | let find_emoji_by_alias alias = 151 | List.find_opt (fun emoji -> alias = emoji.alias) emojis 152 | in 153 | 154 | match find_emoji_by_alias emoji_text with 155 | | Some value -> expression ~loc ~emoji:value.emoji 156 | | None -> 157 | let ext = 158 | Location.error_extensionf ~loc "No emoji found for alias %s" emoji_text 159 | in 160 | Ast_builder.Default.pexp_extension ~loc ext 161 | ``` 162 | 163 | - **Declare the extender:** 164 | 165 | ```ocaml 166 | let extension = 167 | Extension.V3.declare extender_name Extension.Context.expression 168 | extender_extracter 169 | expand 170 | ``` 171 | 172 | --- 173 | 174 | ## Derivers 175 | :page_facing_up: [Doc](https://ocaml-ppx.github.io/ppxlib/ppxlib/driver.html#def_derivers)
176 | ⬅️ A deriver is a custom attribute provided by PPXlib. If you have any doubts about attributes, please review the AST Attributes section. 177 | 178 | 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. 179 | 180 | A simple and common example of a deriver is the `enum` deriver: 181 | 182 | ```ocaml 183 | type t = A | B [@@deriving enum] 184 | (* Output: 185 | type t = A | B 186 | let to_string = function 187 | | A -> "A" 188 | | B -> "B" 189 | let from_string = function 190 | | "A" -> A 191 | | "B" -> B 192 | | _ -> raise (Invalid_argument "Argument doesn't match t variants") 193 | *) 194 | ``` 195 | 196 | In this example, the deriver `enum` automatically generates `to_string` and `from_string` functions for a variant type. 197 | 198 | 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. 199 | 200 | 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. 201 | 202 | 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). 203 | 204 | ### Example 1: Enum Deriver 205 | [:link: Sample Code](./context_free.ml#L51-L125) 206 | 207 | The following example is more complex. Take your time; it’s explained step by step. 208 | 209 | Let's say we want to add `to_string` and `from_string` functions to a simple variant type: 210 | 211 | ```ocaml 212 | type t = A | B [@@deriving enum] 213 | (* Output: 214 | type t = A | B 215 | let to_string = function 216 | | A -> "A" 217 | | B -> "B" 218 | let from_string = function 219 | | "A" -> A 220 | | "B" -> B 221 | | _ -> raise (Invalid_argument "Argument doesn't match t variants") 222 | *) 223 | ``` 224 | 225 | #### Steps to Implement This Deriver: 226 | 227 | - **Declare the deriver name:** 228 | 229 | ```ocaml 230 | let deriver_name = "enum" 231 | ``` 232 | 233 | - **Define the arguments for the deriver:** 234 | For this example, we don't have any arguments: 235 | 236 | ```ocaml 237 | let args () = Deriving.Args.(empty) 238 | ``` 239 | 240 | - **Build the new AST:** 241 | We'll match the AST we want to transform and generate the `to_string` and `from_string` functions. 242 | 243 | - **Match the type declaration with pattern matching:** 244 | 245 | ```ocaml 246 | let enum ~ctxt ast = 247 | let loc = Expansion_context.Deriver.derived_item_loc ctxt in 248 | match ast with 249 | | ( _, 250 | [ 251 | { 252 | ptype_name = { txt = type_name; _ }; 253 | ptype_kind = Ptype_variant variants; 254 | _; 255 | }; 256 | ] ) -> (*...*) 257 | ``` 258 | 259 | - **Create functions to generate the patterns:** 260 | 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. 261 | 262 | - **Creating the `to_string` function:** 263 | 264 | ```ocaml 265 | let function_name suffix = type_name ^ suffix in 266 | let arg_pattern = [%pat? value] in 267 | let function_name_pattern = 268 | [%pat? [%p ppat_var ~loc { txt = function_name "_to_string"; loc }]] 269 | in 270 | let to_string_expr = 271 | [%stri 272 | let [%p function_name_pattern] = 273 | fun [%p arg_pattern] -> 274 | [%e 275 | pexp_match ~loc [%expr value] 276 | (List.map 277 | (fun { pcd_name = { txt = value; _ }; _ } -> 278 | case 279 | ~lhs: 280 | (ppat_construct ~loc (Located.lident ~loc value) None) 281 | ~guard:None ~rhs:(expr_string value)) 282 | variants)]] 283 | ``` 284 | 285 | - **Build the `from_string` function:** 286 | 287 | ```ocaml 288 | let else_case = 289 | case 290 | ~lhs:[%pat? [%p ppat_any ~loc]] 291 | ~guard:None 292 | ~rhs: 293 | [%expr raise (Invalid_argument "Argument doesn't match variants")] 294 | in 295 | let from_string_expr = 296 | [%stri 297 | let [%p function_name_pattern] = 298 | fun [%p arg_pattern] -> 299 | [%e 300 | pexp_match ~loc [%expr value] 301 | (List.map 302 | (fun { pcd_name = { txt = value; _ }; _ } -> 303 | case 304 | ~lhs: 305 | (ppat_constant ~loc (Pconst_string (value, loc, None))) 306 | ~guard:None ~rhs: 307 | (pexp_construct ~loc (Located.lident ~loc value) None)) 308 | variants 309 | @ [ else_case ])]] 310 | ``` 311 | 312 | - **Combine and return the functions:** 313 | 314 | ```ocaml 315 | let enum ~ctxt ast = 316 | let loc = Expansion_context.Deriver.derived_item_loc ctxt in 317 | match ast with 318 | | ( _, 319 | [ 320 | { 321 | ptype_name = { txt = type_name; _ }; 322 | ptype_kind = Ptype_variant variants; 323 | _; 324 | }; 325 | ] ) -> 326 | let function_name suffix = type_name ^ suffix in 327 | let arg_pattern = [%pat? value] in 328 | let expr_string = Ast_builder.Default.estring ~loc in 329 | let function_name_pattern = 330 | [%pat? [%p ppat_var ~loc { txt = function_name "_to_string"; loc }]] 331 | in 332 | let to_string_expr = 333 | [%stri 334 | let [%p function_name_pattern] = 335 | fun [%p arg_pattern] -> 336 | [%e 337 | pexp_match ~loc [%expr value] 338 | (List.map 339 | (fun { pcd_name = { txt = value; _ }; _ } -> 340 | case 341 | ~lhs: 342 | (ppat_construct ~loc (Located.lident ~loc value) None) 343 | ~guard:None ~rhs:(expr_string value)) 344 | variants)]] 345 | in 346 | (* Uncomment to see the generated code *) 347 | (* print_endline (Astlib.Pprintast.string_of_structure [ to_string_expr ]); *) 348 | let else_case = 349 | case 350 | ~lhs:[%pat? [%p ppat_any ~loc]] 351 | ~guard:None 352 | ~rhs: 353 | [%expr 354 | [%e 355 | pexp_apply ~loc 356 | [%expr 357 | raise 358 | (Invalid_argument 359 | [%e 360 | estring ~loc 361 | ("Argument doesn't match " ^ type_name 362 | ^ " variants")])] 363 | []]] 364 | in 365 | let function_name_pattern = 366 | [%pat? [%p ppat_var ~loc { txt = function_name "_from_string"; loc }]] 367 | in 368 | let from_string_expr = 369 | [%stri 370 | let [%p function_name_pattern] = 371 | fun [%p arg_pattern] -> 372 | [%e 373 | pexp_match ~loc [%expr value] 374 | (List.map 375 | (fun { pcd_name = { txt = value; _ }; _ } -> 376 | case 377 | ~lhs: 378 | (ppat_constant ~loc (Pconst_string (value, loc, None))) 379 | ~guard:None ~rhs: 380 | (pexp_construct ~loc (Located.lident ~loc value) None)) 381 | variants 382 | @ [ else_case ])]] 383 | in 384 | (* Uncomment to see the generated code *) 385 | (* print_endline (Astlib.Pprintast.string_of_structure [ from_string_expr ]); *) 386 | [ from_string_expr; to_string_expr ] 387 | | _ -> 388 | [%str 389 | [%ocaml.error "Ops, enum2 must be a type with variant without args"]] 390 | ``` 391 | 392 | - **Declare the deriver:** 393 | 394 | ```ocaml 395 | let generator () = 396 | Deriving.Generator.V2.make (args ()) (fun ~ctxt -> 397 | enum ~loc:Expansion_context.Deriver.derived_item_loc ctxt) 398 | let _ = Deriving.add deriver_name ~str_type_decl:(generator ()) 399 | ``` 400 | 401 | ### Example 2: Enum Deriver with args 402 | [:link: Sample Code](./context_free.ml#L126-L216) 403 | 404 | 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: 405 | 406 | ```ocaml 407 | type t = A | B [@@deriving enum2 ~opt] 408 | (* Output: 409 | type t = A | B 410 | let to_string = function 411 | | A -> "A" 412 | | B -> "B" 413 | let from_string = function 414 | | "A" -> Some A 415 | | "B" -> Some B 416 | | _ -> None 417 | *) 418 | ``` 419 | 420 | #### Steps to Implement This Deriver: 421 | 422 | This is the same as the previous example, but we need to add a new argument to the deriver: 423 | 424 | - **Declare the deriver name and arguments:** 425 | 426 | ```ocaml 427 | let deriver_name = "enum" 428 | let args () = Deriving.Args.(empty +> arg "opt" bool) 429 | ``` 430 | 431 | - **Build the new AST:** 432 | 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`: 433 | 434 | ```ocaml 435 | let else_case = 436 | case 437 | ~lhs:[%pat? [%p ppat_any ~loc]] 438 | ~guard:None 439 | ~rhs: 440 | (match opt with 441 | | true -> [%expr None] 442 | | _ -> 443 | [%expr 444 | raise (Invalid_argument "Argument doesn't match variants")]) 445 | in 446 | let function_name_pattern = 447 | [%pat? [%p ppat_var ~loc { txt = function_name "_from_string"; loc }]] 448 | in 449 | let from_string_expr = 450 | [%stri 451 | let [%p function_name_pattern] = 452 | fun [%p arg_pattern] -> 453 | [%e 454 | pexp_match ~loc [%expr value] 455 | (List.map 456 | (fun { pcd_name = { txt = value; _ }; _ } -> 457 | case 458 | ~lhs: 459 | (ppat_constant ~loc (Pconst_string (value, loc, None))) 460 | ~guard:None 461 | ~rhs: 462 | (match opt with 463 | | true -> 464 | [%expr 465 | Some 466 | [%e 467 | pexp_construct ~loc 468 | (Located.lident ~loc value) 469 | None]] 470 | | _ -> 471 | pexp_construct ~loc 472 | (Located.lident ~loc value) 473 | None)) 474 | variants 475 | @ [ else_case ])]] 476 | ``` 477 | 478 | ## Conclusion 479 | 480 | 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. 481 | 482 | ### [On the next section, we will learn more about global transformations.](../b%20-%20Global/README.md) 483 | 484 | --- 485 | 486 | **WIP** :construction: 487 | 488 | Todo: 489 | - [ ] Special Functions 490 | - [ ] Constant Rewriting 491 | 492 | --------------------------------------------------------------------------------