├── .github └── workflows │ └── build.yml ├── .gitignore ├── CHANGES.md ├── LICENSE ├── Makefile ├── README.md ├── TODO ├── doc └── closures.md ├── dune ├── dune-project ├── examples ├── array │ ├── dune │ ├── example.ml │ └── example.svg ├── ast │ ├── conj │ │ ├── dune │ │ ├── example.ml │ │ └── example.svg │ └── true │ │ ├── dune │ │ ├── example.ml │ │ └── example.svg ├── atoms │ ├── dune │ ├── example.ml │ └── example.svg ├── base │ ├── dune │ ├── example.ml │ └── example.svg ├── closure │ ├── doc.ml │ ├── doc.svg │ ├── dune │ ├── example.ml │ └── example.svg ├── demo │ ├── dune │ ├── example.ml │ └── example.svg ├── dk │ ├── dune │ ├── example.ml │ └── example.svg ├── exn │ ├── dune │ ├── example.ml │ └── example.svg ├── kitty.png ├── lazy │ ├── dune │ ├── example.ml │ └── example.svg ├── list │ ├── dune │ ├── example.ml │ └── example.svg ├── object │ ├── dune │ ├── example.ml │ └── example.svg ├── record │ ├── dune │ ├── example.ml │ └── example.svg └── sum │ ├── dune │ ├── example.ml │ └── example.svg ├── memgraph.opam ├── memgraph_kitty.opam └── src ├── core ├── dot.ml ├── dot.mli ├── dune ├── index.mld ├── repr.ml └── repr.mli └── kitty ├── FiraSans-Medium.ttf ├── dune ├── memgraph_kitty.ml └── memgraph_kitty.mli /.github/workflows/build.yml: -------------------------------------------------------------------------------- 1 | # Main Workflow 2 | # ============= 3 | name: build 4 | 5 | # Configure when to run the workflows. Currently only when 6 | # it affects the `master` branch (either pushes to the branch, 7 | # or pull request against it). 8 | on: 9 | push: 10 | branches: 11 | - master 12 | pull_request: 13 | branches: 14 | - master 15 | 16 | jobs: 17 | # Main workflow 18 | # ============= 19 | # Build: 20 | # - the package, 21 | # - the doc and push it to gh-pages 22 | # - the examples and push them to the master branch 23 | build: 24 | 25 | runs-on: ${{ matrix.os }} 26 | 27 | # Build Matrix 28 | # -------------- 29 | strategy: 30 | # Do not cancel other jobs when one fails 31 | fail-fast: false 32 | 33 | matrix: 34 | # Operating system to run tests on. 35 | # TODO: add macos-latest and windows-latest 36 | os: 37 | - ubuntu-latest 38 | #- macos-latest 39 | #- windows-latest 40 | 41 | # Ocaml version to test 42 | ocaml-version: 43 | - 5.0.0 44 | - 4.14.0 45 | - 4.13.1 46 | - 4.12.1 47 | 48 | # Build ENV 49 | # --------- 50 | #env: 51 | # EXAMPLE 52 | # ENVVAR: "VALUE" 53 | 54 | # Build/test steps 55 | # ---------------- 56 | steps: 57 | # checkout the repo (full clone, necessary for push later) 58 | - name: Checkout the repo 59 | uses: actions/checkout@v2 60 | with: 61 | fetch-depth: '1' 62 | # Install graphviz to check that the generated examples correctly compiler 63 | - name: Install graphviz 64 | run: sudo apt install graphviz 65 | # Cache the opam directory for faster setups 66 | - name: Cach opam directory 67 | uses: actions/cache@v2 68 | with: 69 | path: ~/.opam 70 | key: ${{ matrix.os }}-opam-${{ matrix.ocaml-version }} 71 | # Setup ocaml/opam 72 | - name: Setup ocaml/opam 73 | uses: avsm/setup-ocaml@v1 74 | with: 75 | ocaml-version: ${{ matrix.ocaml-version }} 76 | # Pin the repo 77 | - name: Pin the repo 78 | run: opam pin add . --no-action 79 | # Install external deps 80 | #- name: Install external deps 81 | # run: opam depext memgraph --yes --with-doc --with-test 82 | # Install ocaml deps 83 | - name: Install Ocaml deps 84 | run: opam install . --deps-only --with-doc --with-test 85 | # Build the package 86 | - name: Build the package 87 | run: opam exec -- make dune 88 | # Check the doc builds 89 | - name: Build the doc 90 | run: opam exec -- make doc 91 | # Check the examples also build 92 | - name: Build the examples 93 | run: opam exec -- make ex 94 | # Un-pin the local repo to avoid polluting the cache 95 | - name: Un-pin the local repo 96 | run: opam pin remove memgraph memgraph_kitty 97 | 98 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Source directory (doc, build dir and bin) 2 | _build/ 3 | src/_build/ 4 | 5 | # Generated files 6 | .merlin 7 | *.install 8 | doc/index.html 9 | 10 | # ocamlbuild targets 11 | *.byte 12 | *.native 13 | 14 | # opam local switch 15 | _opam 16 | 17 | # swap files 18 | *.swp 19 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | 2 | v1.0 3 | ---- 4 | 5 | First release 6 | 7 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2015 Guillaume Bury 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | # copyright (c) 2020, guillaume bury 2 | 3 | COMP=dune 4 | FLAGS= 5 | 6 | all: dune 7 | 8 | watch: 9 | dune build $(FLAGS) -w @check 10 | @echo 11 | 12 | dune: 13 | dune build $(FLAGS) @install 14 | @echo 15 | 16 | doc: 17 | dune build $(FLAGS) @doc 18 | @echo 19 | 20 | doc-html: doc 21 | xdg-open _build/default/_doc/_html/index.html 22 | 23 | ex: 24 | dune build $(FLAGS) @examples 25 | @echo 26 | 27 | clean: 28 | $(COMP) clean 29 | 30 | .PHONY: all watch dune bin test doc clean 31 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ![Build](https://github.com/gbury/ocaml-memgraph/workflows/build/badge.svg) 2 | 3 | # Memgraph 4 | 5 | A small library to output memory graph for ocaml values. Memgraph can be used 6 | to generate graphs that represent the memory layout of any valid ocaml value. 7 | Memgraph can produce `.dot` files that can then be processed using the 8 | [graphviz](https://graphviz.org/) suite of tools to generate images of the 9 | memory graph of ocaml values. 10 | 11 | You can look at the [examples folder](https://github.com/Gbury/ocaml-memgraph/tree/master/examples) 12 | to see how to use memgraph. 13 | 14 | ![example](https://github.com/Gbury/ocaml-memgraph/blob/master/examples/demo/example.svg) 15 | 16 | # Memgraph & Kitty 17 | 18 | For users of the [kitty terminal emulator](https://sw.kovidgoyal.net/kitty/), you can 19 | use the `Memgraph_kitty` package and library to show the memory graph directly in a 20 | toplevel session (using `ocaml` or `utop` for instance). 21 | 22 | ![kitty](https://github.com/Gbury/ocaml-memgraph/blob/master/examples/kitty.png) 23 | 24 | WARNING: using this module in a terminal other than kitty may lead to weird behaviour, 25 | such as filling your screen with weird characters. 26 | 27 | -------------------------------------------------------------------------------- /TODO: -------------------------------------------------------------------------------- 1 | Things that could be interesting to do: 2 | - use owee to read DWARF debug info and get names of closures, and values 3 | 4 | -------------------------------------------------------------------------------- /doc/closures.md: -------------------------------------------------------------------------------- 1 | 2 | # Representation of closures 3 | 4 | 5 | ## Introduction 6 | 7 | OCaml needs to represent sets of closures, wich, in the general cases, 8 | contain: a set of mutually recursive functions and a number of environment 9 | values (also called environment variables). For instance, let's consider 10 | the following ocaml code: 11 | 12 | ```ocaml 13 | let test () = 14 | (* we use Random here to ensure that `n` is 15 | not a compile-time constant *) 16 | let n = Random.int 10 in 17 | 18 | (* Two mutually recursive functions. Since we're only interested 19 | in the representation of the closures, the runtime behaviour 20 | of the functions doesn't matter (e.g. it's not a problem that 21 | the functions do not terminate) *) 22 | let rec f x y = n + n + y + g x 23 | and g y = f y (y + 1) in 24 | 25 | f 26 | ``` 27 | 28 | In this case, we have two mutually recursive functions `f` and `g`, 29 | and one environment variable `n`. 30 | 31 | 32 | ## General layout of a set of closures 33 | 34 | A set of closures in ocaml is represented as a regular ocaml block 35 | with tag `Obj.closure_tag`. That block contains first all of the 36 | mutually recursive closures, and then[^1] will contain all of the 37 | environment values. Additionally, each closure (except for the first), 38 | is preceded by an infix header, that is an integer field that contains 39 | an offset (more on that later) and the tag `Obj.infix_tag`. 40 | 41 | [^1]: Note that starting from ocaml 4.12, this is a strict requirement 42 | on sets of closures. Indeed, starting from 4.12, sets of closures now 43 | record the offset in the block at which the environment start, and 44 | the GC will only scan the fields of the block starting form this offset. 45 | Before 4.12, the GC scanned all fields, and used the page table to 46 | distinguish code pointers. 47 | 48 | ```verbatim 49 | |----------------------------| 50 | | header (tag= closure_tag) | 51 | |----------------------------| 52 | | First closure (e.g. `f`) | <- pointer used to represent `f` 53 | | | (i.e. the first closure) 54 | | | 55 | |----------------------------| 56 | | Infix header | 57 | |----------------------------| 58 | | Second closure (e.g. `g`) | <- pointer used to represent `g` 59 | | | (i.e. the second closure) 60 | | | 61 | |----------------------------| 62 | . . 63 | . . 64 | . . 65 | |----------------------------| 66 | | Infix header | 67 | |----------------------------| 68 | | Last closure | 69 | | | 70 | | | 71 | |----------------------------| 72 | | First env value | <- start of env 73 | |----------------------------| 74 | | Second env value | 75 | |----------------------------| 76 | . . 77 | . . 78 | . . 79 | |----------------------------| 80 | | Last env value | 81 | |----------------------------| 82 | ``` 83 | 84 | TODO: add note on the potential presence of holes when using flambda2 85 | (and flambda ? ask @lthls for some precisions) 86 | 87 | 88 | 89 | ## Representation of a single closure 90 | 91 | ### General case 92 | 93 | The representation of a single closure is a bit complicated. In general, 94 | for a closure with arity strictly greateer than 1 (i.e. a function which 95 | takes at least two arguments), a closure is represented using three words: 96 | - First is a function pointer that can be used when the funciton is supplied 97 | one argument (and thus results in a partial application). Let's call 98 | this one the "currified" pointer for the closure. 99 | - Second is an integer field that encodes two integers: the arity of the 100 | function, and the offset of the start of environment for the set of closure, 101 | relative to the offset of the closure. 102 | - Lastly is a function pointer that can be used for total application, i.e. 103 | when the number of arguments provided is the same as the arity of the function. 104 | Let's call this one the "total" pointer for the closure. 105 | 106 | 107 | ```verbatim 108 | . . 109 | |--------------------------------| 110 | | header | 111 | |--------------------------------| 112 | | "currified" function pointer | <- pointer (inside the set of closures) 113 | |--------------------------------| used to represent the closure 114 | | closure info (arity+startenv) | 115 | |--------------------------------| 116 | | "total" function pointer | 117 | |--------------------------------| 118 | . . 119 | ``` 120 | 121 | ### Functions of arity 1 122 | 123 | As a special case, functions that have an arity of `1` are represented using 124 | only two words. Indeed, for these functions, the "currified" and the "total" 125 | function pointers are actually the same, and thus the last function pointer 126 | is not present. 127 | 128 | ```verbatim 129 | . . 130 | |--------------------------------| 131 | | header | 132 | |--------------------------------| 133 | | function pointer | <- pointer (inside the set of closures) 134 | |--------------------------------| used to represent the closure 135 | | closure info (arity+startenv) | 136 | |--------------------------------| 137 | . . 138 | ``` 139 | 140 | ### Closure info 141 | 142 | The closure info field of closures has a different representation depending 143 | on the version of ocaml used 144 | 145 | #### ocaml 4.11 and earlier 146 | 147 | Beofre 4.12, only the arity was encoded in the closure info field. That field was 148 | an integer field, so was represented by the tagged integer of the arity: 149 | 150 | ``` 151 | arity ((wordsize - 1) bits) . 1 152 | ``` 153 | 154 | #### ocaml 4.12 and later 155 | 156 | Starting from ocaml 4.12, the closure info field encodes both the arity of the 157 | closure, and the offset of the start of environment for the set of closures. 158 | It is still a integer field, so is represented as a tagged integer: 159 | 160 | ``` 161 | arity (8 bits) . start-of-environment ((wordsize - 9) bits) . 1 162 | ``` 163 | 164 | ## Infix headers 165 | 166 | Except for the first one, each closure representaiton in a set of closures 167 | need to be preceded by an infix header. That header is similar to a regular 168 | ocaml block header, except that is has the infix tag (e.g. `Obj.infix_tag`), 169 | and that the size information of the header is actually used to identify 170 | the start of the set of closure block. To that effect, the "size" stored in 171 | the header is actually the offset **in bytes** of the closure representation 172 | inside the set of closures. 173 | 174 | Note that this is specific to infix headers. For other header, the size 175 | is in general, the number of fields/words that make up the block (excluding 176 | the word used for the header). This is true as weel for 177 | 178 | 179 | ## Examples 180 | 181 | ### Full set of closures example 182 | 183 | Let's consider the example from the introduction: 184 | 185 | ```ocaml 186 | let test () = 187 | let n = Random.int 10 in 188 | 189 | let rec f x y = n + n + y + g x 190 | and g y = f y (y + 1) in 191 | 192 | f 193 | ``` 194 | 195 | We need to represent a set of closures that contain two functions: `f` (arity=2), 196 | and `g` (arity=1), and one env value: `n`. 197 | 198 | Assuming a 64-bit host (and thus 8 bytes per word), 199 | this results in the following layout: 200 | 201 | 202 | ```verbatim 203 | offset/field number 204 | |----------------------------| 205 | | header (closure_tag,size=6)| 206 | |----------------------------| 207 | | "caml_curry2" | 0 <- start of closure `f` (offset=0) 208 | |----------------------------| 209 | | {arity=2,startenv=6} | 1 210 | |----------------------------| 211 | | function pointer of `f` | 2 212 | |----------------------------| 213 | | header (infix_tag,size=32) | 3 :: size = 32 = 8 * 4 (offset of the start of the closure for `g`) 214 | |----------------------------| 215 | | function pointer of `g` | 4 <- start of closure `g` (offset=4) 216 | |----------------------------| 217 | | {arity=1,startenv=2} | 5 :: startenv = 2 = 6 (absolute startenv) - 4 (offset of `g`) 218 | |----------------------------| 219 | | value of | 6 <- start of env (offset=6) 220 | |----------------------------| 221 | ``` 222 | 223 | Notes: 224 | - the closure `f` starts at offset `0` 225 | - the closure `g` starts at offset `4` 226 | - the environment starts at offset `6` 227 | - the set of closures header has size 6 (since the set uses 6 words 228 | (excluding the whole block header) to be represented) 229 | - the start of env in the closure info fields are relative to the offset of the closure, 230 | so it is: 231 | - `6` for `f`, whose offset is `0`, since it is the first closure 232 | - `2` for `g`, whose offset if `4` (since the env starts 2 words after the start of `g`) 233 | - the size stored insied the infix tag is `32`, since it is interpreted as the number of 234 | bytes to substract to the start of `g` to get the start of the whole set of closures 235 | 236 | 237 | 238 | -------------------------------------------------------------------------------- /dune: -------------------------------------------------------------------------------- 1 | (env 2 | (dev (flags :standard -principal)) 3 | (release (flags (:standard -principal))) 4 | ) 5 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 2.7) 2 | 3 | ; Project info 4 | (name memgraph) 5 | (version 1.0) 6 | (license MIT) 7 | (source (github gbury/ocaml-memgraph)) 8 | (documentation https://gbury.github.io/ocaml-memgraph/) 9 | (authors "Guillaume Bury " 10 | "Armaël Guéneau ") 11 | (maintainers "Guillaume Bury " 12 | "Armaël Guéneau ") 13 | 14 | ; Project options 15 | (formatting disabled) 16 | (generate_opam_files true) 17 | (implicit_transitive_deps false) 18 | 19 | ; Memgraph package 20 | (package 21 | (name memgraph) 22 | (depends (ocaml (>= 4.12.0))) 23 | (synopsis "A small library to inspect memory representation of ocaml values") 24 | (description "Memgraph allows one to inspect an ocaml value and get a representation of its layout in memory, and helpers to dump such representation as dot files to easily print them as graphs") 25 | ) 26 | 27 | ; Memgraph_kitty package 28 | (package 29 | (name memgraph_kitty) 30 | (depends 31 | (ocaml (>= 4.12.0)) 32 | (memgraph (= :version)) 33 | (ppx_blob (and :build (>= 0.7.0))) 34 | (nanosvg (>= 0.1)) 35 | (nanosvg_text (>= 0.1)) 36 | (kittyimg (>= 0.1)) 37 | (stb_truetype (>= 0.7)) 38 | conf-graphviz) 39 | (synopsis "Display the representation of memory values in the Kitty terminal emulator") 40 | (description "Memgraph_kitty inspects ocaml values and displays their graphical representation using the graphics protocol of the kitty terminal emulator")) 41 | -------------------------------------------------------------------------------- /examples/array/dune: -------------------------------------------------------------------------------- 1 | 2 | (executable 3 | (name example) 4 | (libraries memgraph) 5 | ) 6 | 7 | (rule 8 | (target example.gv) 9 | (package memgraph) 10 | (action (with-outputs-to %{target} 11 | (with-accepted-exit-codes 0 12 | (run ./example.exe)))) 13 | ) 14 | 15 | (rule 16 | (target example.svg) 17 | (deps example.gv) 18 | (package memgraph) 19 | (mode promote) 20 | (action (with-outputs-to %{target} 21 | (with-accepted-exit-codes 0 22 | (run dot -Tsvg -o %{target} %{deps})))) 23 | ) 24 | 25 | (alias 26 | (name examples) 27 | (deps example.svg) 28 | ) 29 | -------------------------------------------------------------------------------- /examples/array/example.ml: -------------------------------------------------------------------------------- 1 | 2 | 3 | let int_array = [| 4 ; 5 ; 6 |] 4 | let int_matrix = Array.make_matrix 3 5 42 5 | let int_array_array = Array.make 3 (Array.make 5 42) 6 | 7 | let int_float_array = [| (5,8.0); (42, 1.0); (0, 1.5) |] 8 | 9 | let float_array = [| 1.0; 2.0; 3.0; 4.0 |] 10 | 11 | let () = 12 | Memgraph.Repr.(context (fun ctx -> 13 | Memgraph.Dot.print_list Format.std_formatter [ 14 | {|[\|4;5;6\|]|}, ctx.mk int_array; 15 | {|[\|1.0;2.0;3.0;4.0\|]|}, ctx.mk float_array; 16 | {|[\| (5,8.0); (42, 1.0); (0, 1.5) \|]|}, ctx.mk int_float_array; 17 | {|Array.make_matrix 3 5 42|}, ctx.mk int_matrix; 18 | {|Array.make 3 (Array.make 5 42)|}, ctx.mk int_array_array; 19 | ])) 20 | 21 | -------------------------------------------------------------------------------- /examples/array/example.svg: -------------------------------------------------------------------------------- 1 | 2 | 4 | 6 | 7 | 9 | 10 | g 11 | 12 | 13 | entry_4 14 | 15 | val : Array.make 3 (Array.make 5 42) 16 | 17 | . 18 | 19 | 20 | 21 | p1 22 | 23 | Tag : 0 24 | 25 | . 26 | 27 | . 28 | 29 | . 30 | 31 | 32 | 33 | entry_4->p1:head 34 | 35 | 36 | 37 | 38 | 39 | entry_3 40 | 41 | val : Array.make_matrix 3 5 42 42 | 43 | . 44 | 45 | 46 | 47 | p3 48 | 49 | Tag : 0 50 | 51 | . 52 | 53 | . 54 | 55 | . 56 | 57 | 58 | 59 | entry_3->p3:head 60 | 61 | 62 | 63 | 64 | 65 | entry_2 66 | 67 | val : [| (5,8.0); (42, 1.0); (0, 1.5) |] 68 | 69 | . 70 | 71 | 72 | 73 | p7 74 | 75 | Tag : 0 76 | 77 | . 78 | 79 | . 80 | 81 | . 82 | 83 | 84 | 85 | entry_2->p7:head 86 | 87 | 88 | 89 | 90 | 91 | entry_1 92 | 93 | val : [|1.0;2.0;3.0;4.0|] 94 | 95 | . 96 | 97 | 98 | 99 | p14 100 | 101 | Tag : 254 102 | 103 | 1.000000 104 | 105 | 2.000000 106 | 107 | 3.000000 108 | 109 | 4.000000 110 | 111 | 112 | 113 | entry_1->p14:head 114 | 115 | 116 | 117 | 118 | 119 | entry_0 120 | 121 | val : [|4;5;6|] 122 | 123 | . 124 | 125 | 126 | 127 | p15 128 | 129 | Tag : 0 130 | 131 | 4 132 | 133 | 5 134 | 135 | 6 136 | 137 | 138 | 139 | entry_0->p15:head 140 | 141 | 142 | 143 | 144 | 145 | p8 146 | 147 | Tag : 0 148 | 149 | 5 150 | 151 | . 152 | 153 | 154 | 155 | p7:f0->p8:head 156 | 157 | 158 | 159 | 160 | 161 | p10 162 | 163 | Tag : 0 164 | 165 | 42 166 | 167 | . 168 | 169 | 170 | 171 | p7:f1->p10:head 172 | 173 | 174 | 175 | 176 | 177 | p12 178 | 179 | Tag : 0 180 | 181 | 0 182 | 183 | . 184 | 185 | 186 | 187 | p7:f2->p12:head 188 | 189 | 190 | 191 | 192 | 193 | p9 194 | 195 | Tag : 253 196 | 197 | 8.000000 198 | 199 | 200 | 201 | p8:f1->p9:head 202 | 203 | 204 | 205 | 206 | 207 | p11 208 | 209 | Tag : 253 210 | 211 | 1.000000 212 | 213 | 214 | 215 | p10:f1->p11:head 216 | 217 | 218 | 219 | 220 | 221 | p13 222 | 223 | Tag : 253 224 | 225 | 1.500000 226 | 227 | 228 | 229 | p12:f1->p13:head 230 | 231 | 232 | 233 | 234 | 235 | p4 236 | 237 | Tag : 0 238 | 239 | 42 240 | 241 | 42 242 | 243 | 42 244 | 245 | 42 246 | 247 | 42 248 | 249 | 250 | 251 | p3:f0->p4:head 252 | 253 | 254 | 255 | 256 | 257 | p5 258 | 259 | Tag : 0 260 | 261 | 42 262 | 263 | 42 264 | 265 | 42 266 | 267 | 42 268 | 269 | 42 270 | 271 | 272 | 273 | p3:f1->p5:head 274 | 275 | 276 | 277 | 278 | 279 | p6 280 | 281 | Tag : 0 282 | 283 | 42 284 | 285 | 42 286 | 287 | 42 288 | 289 | 42 290 | 291 | 42 292 | 293 | 294 | 295 | p3:f2->p6:head 296 | 297 | 298 | 299 | 300 | 301 | p2 302 | 303 | Tag : 0 304 | 305 | 42 306 | 307 | 42 308 | 309 | 42 310 | 311 | 42 312 | 313 | 42 314 | 315 | 316 | 317 | p1:f0->p2:head 318 | 319 | 320 | 321 | 322 | 323 | p1:f1->p2:head 324 | 325 | 326 | 327 | 328 | 329 | p1:f2->p2:head 330 | 331 | 332 | 333 | 334 | 335 | -------------------------------------------------------------------------------- /examples/ast/conj/dune: -------------------------------------------------------------------------------- 1 | 2 | (executable 3 | (name example) 4 | (libraries memgraph) 5 | ) 6 | 7 | (rule 8 | (target example.gv) 9 | (package memgraph) 10 | (action (with-outputs-to %{target} 11 | (with-accepted-exit-codes 0 12 | (run ./example.exe)))) 13 | ) 14 | 15 | (rule 16 | (target example.svg) 17 | (deps example.gv) 18 | (package memgraph) 19 | (mode promote) 20 | (action (with-outputs-to %{target} 21 | (with-accepted-exit-codes 0 22 | (run dot -Tsvg -o %{target} %{deps})))) 23 | ) 24 | 25 | (alias 26 | (name examples) 27 | (deps example.svg) 28 | ) 29 | -------------------------------------------------------------------------------- /examples/ast/conj/example.ml: -------------------------------------------------------------------------------- 1 | 2 | type location = { 3 | file : string; 4 | start_line : int; 5 | start_column : int; 6 | stop_line : int; 7 | stop_column : int; 8 | } 9 | 10 | type namespace = 11 | | Var 12 | | Type 13 | | Term 14 | 15 | type id = { 16 | ns : namespace; 17 | name : string; 18 | } 19 | 20 | type builtin = 21 | | True | False 22 | | And | Or | Not 23 | 24 | type binder = 25 | | Forall | Exists 26 | 27 | type descr = 28 | | Symbol of id 29 | | Builtin of builtin 30 | | Colon of t * t 31 | | App of t * t list 32 | | Binder of binder * t list * t 33 | | Match of t * (t * t) list 34 | 35 | and t = { 36 | term : descr; 37 | attr : t list; 38 | loc : location option; 39 | } 40 | 41 | let loc_file = "example.dummy" 42 | 43 | let mk_loc l c n = { 44 | file = loc_file; 45 | start_line = l; 46 | start_column = c; 47 | stop_line = l; 48 | stop_column = c + n; 49 | } 50 | 51 | let mk ?loc term = { term; loc; attr = []; } 52 | 53 | let true_ = mk ~loc:(mk_loc 1 1 1) (Builtin True) 54 | let false_ = mk ~loc:(mk_loc 1 3 1) (Builtin False) 55 | let and_ = mk ~loc:(mk_loc 1 2 1) (Builtin And) 56 | let t = mk ~loc:(mk_loc 1 1 3) (App (and_, [true_; false_])) 57 | 58 | let () = 59 | Memgraph.Dot.print_list Format.std_formatter ( 60 | (Memgraph.Repr.context (fun ctx -> [ 61 | "true_", ctx.mk true_; 62 | "false_", ctx.mk false_; 63 | "and_", ctx.mk and_; 64 | "conjunction", ctx.mk t; 65 | ])) 66 | ) 67 | 68 | -------------------------------------------------------------------------------- /examples/ast/true/dune: -------------------------------------------------------------------------------- 1 | 2 | (executable 3 | (name example) 4 | (libraries memgraph) 5 | ) 6 | 7 | (rule 8 | (target example.gv) 9 | (package memgraph) 10 | (action (with-outputs-to %{target} 11 | (with-accepted-exit-codes 0 12 | (run ./example.exe)))) 13 | ) 14 | 15 | (rule 16 | (target example.svg) 17 | (deps example.gv) 18 | (package memgraph) 19 | (mode promote) 20 | (action (with-outputs-to %{target} 21 | (with-accepted-exit-codes 0 22 | (run dot -Tsvg -o %{target} %{deps})))) 23 | ) 24 | 25 | (alias 26 | (name examples) 27 | (deps example.svg) 28 | ) 29 | -------------------------------------------------------------------------------- /examples/ast/true/example.ml: -------------------------------------------------------------------------------- 1 | 2 | type location = { 3 | file : string; 4 | start_line : int; 5 | start_column : int; 6 | stop_line : int; 7 | stop_column : int; 8 | } 9 | 10 | type namespace = 11 | | Var 12 | | Type 13 | | Term 14 | 15 | type id = { 16 | ns : namespace; 17 | name : string; 18 | } 19 | 20 | type builtin = 21 | | True | False 22 | | And | Or | Not 23 | 24 | type binder = 25 | | Forall | Exists 26 | 27 | type descr = 28 | | Symbol of id 29 | | Builtin of builtin 30 | | Colon of t * t 31 | | App of t * t list 32 | | Binder of binder * t list * t 33 | | Match of t * (t * t) list 34 | 35 | and t = { 36 | term : descr; 37 | attr : t list; 38 | loc : location option; 39 | } 40 | 41 | let loc_file = "example.dummy" 42 | 43 | let mk_loc l c n = { 44 | file = loc_file; 45 | start_line = l; 46 | start_column = c; 47 | stop_line = l; 48 | stop_column = c + n; 49 | } 50 | 51 | let mk ?loc term = { term; loc; attr = []; } 52 | 53 | let true_ = mk ~loc:(mk_loc 1 1 1) (Builtin True) 54 | let false_ = mk ~loc:(mk_loc 1 3 1) (Builtin False) 55 | let and_ = mk ~loc:(mk_loc 1 2 1) (Builtin And) 56 | let t = mk ~loc:(mk_loc 1 1 3) (App (and_, [true_; false_])) 57 | 58 | let () = 59 | Memgraph.Dot.print_list Format.std_formatter ( 60 | (Memgraph.Repr.context (fun ctx -> [ 61 | "true", ctx.mk true_; 62 | "true_loc", ctx.mk (true_.loc); 63 | "true_desc", ctx.mk (true_.term); 64 | ])) 65 | ) 66 | 67 | -------------------------------------------------------------------------------- /examples/ast/true/example.svg: -------------------------------------------------------------------------------- 1 | 2 | 4 | 6 | 7 | 9 | 10 | g 11 | 12 | 13 | entry_2 14 | 15 | val : true_desc 16 | 17 | . 18 | 19 | 20 | 21 | p1 22 | 23 | Tag : 1 24 | 25 | 0 26 | 27 | 28 | 29 | entry_2->p1:head 30 | 31 | 32 | 33 | 34 | 35 | entry_1 36 | 37 | val : true_loc 38 | 39 | . 40 | 41 | 42 | 43 | p2 44 | 45 | Tag : 0 46 | 47 | . 48 | 49 | 50 | 51 | entry_1->p2:head 52 | 53 | 54 | 55 | 56 | 57 | entry_0 58 | 59 | val : true 60 | 61 | . 62 | 63 | 64 | 65 | p5 66 | 67 | Tag : 0 68 | 69 | . 70 | 71 | 0 72 | 73 | . 74 | 75 | 76 | 77 | entry_0->p5:head 78 | 79 | 80 | 81 | 82 | 83 | p5:f0->p1:head 84 | 85 | 86 | 87 | 88 | 89 | p5:f2->p2:head 90 | 91 | 92 | 93 | 94 | 95 | p3 96 | 97 | Tag : 0 98 | 99 | . 100 | 101 | 1 102 | 103 | 1 104 | 105 | 1 106 | 107 | 2 108 | 109 | 110 | 111 | p2:f0->p3:head 112 | 113 | 114 | 115 | 116 | 117 | p4 118 | 119 | Tag : 252 120 | 121 | 'example.dummy' 122 | 123 | 124 | 125 | p3:f0->p4:head 126 | 127 | 128 | 129 | 130 | 131 | -------------------------------------------------------------------------------- /examples/atoms/dune: -------------------------------------------------------------------------------- 1 | 2 | (executable 3 | (name example) 4 | (libraries memgraph) 5 | ) 6 | 7 | (rule 8 | (target example.gv) 9 | (package memgraph) 10 | (action (with-outputs-to %{target} 11 | (with-accepted-exit-codes 0 12 | (run ./example.exe)))) 13 | ) 14 | 15 | (rule 16 | (target example.svg) 17 | (deps example.gv) 18 | (package memgraph) 19 | (mode promote) 20 | (action (with-outputs-to %{target} 21 | (with-accepted-exit-codes 0 22 | (run dot -Tsvg -o %{target} %{deps})))) 23 | ) 24 | 25 | (alias 26 | (name examples) 27 | (deps example.svg) 28 | ) 29 | -------------------------------------------------------------------------------- /examples/atoms/example.ml: -------------------------------------------------------------------------------- 1 | 2 | let e = [| |] 3 | let f = [| |] 4 | let arr = Array.make 0 0 5 | 6 | let () = 7 | Memgraph.Repr.(context (fun ctx -> 8 | Memgraph.Dot.print_list Format.std_formatter [ 9 | {|[\| \|]|}, ctx.mk e; 10 | {|[\| \|]|}, ctx.mk f; 11 | {|Array.make 0 0|}, ctx.mk arr; 12 | ])) 13 | 14 | -------------------------------------------------------------------------------- /examples/atoms/example.svg: -------------------------------------------------------------------------------- 1 | 2 | 4 | 6 | 7 | 9 | 10 | g 11 | 12 | 13 | entry_2 14 | 15 | val : Array.make 0 0 16 | 17 | . 18 | 19 | 20 | 21 | p1 22 | 23 | Tag : 0 24 | 25 | 26 | 27 | 28 | 29 | entry_2->p1:head 30 | 31 | 32 | 33 | 34 | 35 | entry_1 36 | 37 | val : [| |] 38 | 39 | . 40 | 41 | 42 | 43 | p2 44 | 45 | Tag : 0 46 | 47 | 48 | 49 | 50 | 51 | entry_1->p2:head 52 | 53 | 54 | 55 | 56 | 57 | entry_0 58 | 59 | val : [| |] 60 | 61 | . 62 | 63 | 64 | 65 | entry_0->p2:head 66 | 67 | 68 | 69 | 70 | 71 | -------------------------------------------------------------------------------- /examples/base/dune: -------------------------------------------------------------------------------- 1 | 2 | (executable 3 | (name example) 4 | (libraries memgraph) 5 | ) 6 | 7 | (rule 8 | (target example.gv) 9 | (package memgraph) 10 | (action (with-outputs-to %{target} 11 | (with-accepted-exit-codes 0 12 | (run ./example.exe)))) 13 | ) 14 | 15 | (rule 16 | (target example.svg) 17 | (deps example.gv) 18 | (package memgraph) 19 | (mode promote) 20 | (action (with-outputs-to %{target} 21 | (with-accepted-exit-codes 0 22 | (run dot -Tsvg -o %{target} %{deps})))) 23 | ) 24 | 25 | (alias 26 | (name examples) 27 | (deps example.svg) 28 | ) 29 | -------------------------------------------------------------------------------- /examples/base/example.ml: -------------------------------------------------------------------------------- 1 | 2 | let unit = () 3 | let int = 13 4 | let bool = true 5 | let char = 'a' 6 | 7 | let () = 8 | Memgraph.Repr.(context (fun ctx -> 9 | Memgraph.Dot.print_list Format.std_formatter [ 10 | {|()|}, ctx.mk unit; 11 | {|'a'|}, ctx.mk char; 12 | {|true|}, ctx.mk bool; 13 | {|13|}, ctx.mk int; 14 | ])) 15 | 16 | -------------------------------------------------------------------------------- /examples/base/example.svg: -------------------------------------------------------------------------------- 1 | 2 | 4 | 6 | 7 | 9 | 10 | g 11 | 12 | 13 | entry_3 14 | 15 | val : 13 16 | 17 | 13 18 | 19 | 20 | 21 | entry_2 22 | 23 | val : true 24 | 25 | 1 26 | 27 | 28 | 29 | entry_1 30 | 31 | val : 'a' 32 | 33 | 97 34 | 35 | 36 | 37 | entry_0 38 | 39 | val : () 40 | 41 | 0 42 | 43 | 44 | 45 | -------------------------------------------------------------------------------- /examples/closure/doc.ml: -------------------------------------------------------------------------------- 1 | 2 | let test () = 3 | let n = Random.int 10 in 4 | 5 | let rec f x y = n + n + y + g x 6 | and g y = f y (y + 1) in 7 | 8 | f, g 9 | 10 | let () = 11 | let f, g = test () in 12 | Memgraph.Repr.(context (fun ctx -> 13 | Memgraph.Dot.print_list Format.std_formatter [ 14 | "f", ctx.mk f; 15 | "g", ctx.mk g; 16 | ])) 17 | 18 | -------------------------------------------------------------------------------- /examples/closure/doc.svg: -------------------------------------------------------------------------------- 1 | 2 | 4 | 6 | 7 | 9 | 10 | g 11 | 12 | 13 | entry_1 14 | 15 | val : g 16 | 17 | . 18 | 19 | 20 | 21 | p2 22 | 23 | Tag : 247 24 | 25 | . 26 | 27 | arity:2 / startenv:6 28 | 29 | . 30 | 31 | Infix 32 | 33 | . 34 | 35 | arity:1 / startenv:2 36 | 37 | 4 38 | 39 | 40 | 41 | entry_1->p2:f3 42 | 43 | 44 | 45 | 46 | 47 | entry_0 48 | 49 | val : f 50 | 51 | . 52 | 53 | 54 | 55 | entry_0->p2:head 56 | 57 | 58 | 59 | 60 | 61 | e93988791493824 62 | 63 | Out of heap : 0x557b7887a4c0 64 | 65 | 66 | 67 | p2:f0->e93988791493824:head 68 | 69 | 70 | 71 | 72 | 73 | e93988791495040 74 | 75 | Out of heap : 0x557b7887a980 76 | 77 | 78 | 79 | p2:f2->e93988791495040:head 80 | 81 | 82 | 83 | 84 | 85 | e93988791495104 86 | 87 | Out of heap : 0x557b7887a9c0 88 | 89 | 90 | 91 | p2:f4->e93988791495104:head 92 | 93 | 94 | 95 | 96 | 97 | -------------------------------------------------------------------------------- /examples/closure/dune: -------------------------------------------------------------------------------- 1 | 2 | (executable 3 | (name example) 4 | (modules example) 5 | (libraries memgraph) 6 | ) 7 | 8 | (rule 9 | (target example.gv) 10 | (package memgraph) 11 | (action (with-outputs-to %{target} 12 | (with-accepted-exit-codes 0 13 | (run ./example.exe)))) 14 | ) 15 | 16 | (rule 17 | (target example.svg) 18 | (deps example.gv) 19 | (package memgraph) 20 | (mode promote) 21 | (action (with-outputs-to %{target} 22 | (with-accepted-exit-codes 0 23 | (run dot -Tsvg -o %{target} %{deps})))) 24 | ) 25 | 26 | (alias 27 | (name examples) 28 | (deps example.svg) 29 | ) 30 | 31 | 32 | (executable 33 | (name doc) 34 | (modules doc) 35 | (libraries memgraph) 36 | ) 37 | 38 | (rule 39 | (target doc.gv) 40 | (package memgraph) 41 | (action (with-outputs-to %{target} 42 | (with-accepted-exit-codes 0 43 | (run ./doc.exe)))) 44 | ) 45 | 46 | (rule 47 | (target doc.svg) 48 | (deps doc.gv) 49 | (package memgraph) 50 | (mode promote) 51 | (action (with-outputs-to %{target} 52 | (with-accepted-exit-codes 0 53 | (run dot -Tsvg -o %{target} %{deps})))) 54 | ) 55 | 56 | (alias 57 | (name examples) 58 | (deps doc.svg) 59 | ) 60 | -------------------------------------------------------------------------------- /examples/closure/example.ml: -------------------------------------------------------------------------------- 1 | 2 | let f x = x + 1 3 | 4 | let g x y z = x+y+z 5 | let g1 = g 5 6 | let g2 = g 7 7 | let g3 = g1 42 8 | 9 | let env = 10 | let h = Hashtbl.create 5 in 11 | let h' = Hashtbl.create 13 in 12 | (fun (y : int) (z: int) -> Hashtbl.find h y + Hashtbl.find h' z) 13 | 14 | let rec h x1 x2 x3 = i x1 x2 x3 15 | and i y1 y2 y3 = j y1 y2 y3 16 | and j z1 z2 z3 = h z1 z2 z3 17 | 18 | let () = 19 | Memgraph.Repr.(context (fun ctx -> 20 | Memgraph.Dot.print_list Format.std_formatter [ 21 | "f x = x + 1", ctx.mk f; 22 | "List.map", ctx.mk List.map; 23 | "List.map f", ctx.mk (List.map f); 24 | "g x y z = x + y + z", ctx.mk g; 25 | "g1 = g 5", ctx.mk g1; 26 | "g2 = g 7", ctx.mk g2; 27 | "g3 = g1 42", ctx.mk g3; 28 | "h x1 x2 x3 = i x1 x2 x3", ctx.mk h; 29 | "i y1 y2 y3 = j y1 y2 y3", ctx.mk i; 30 | "j z1 z2 z3 = h z1 z2 z3", ctx.mk j; 31 | ])) 32 | 33 | -------------------------------------------------------------------------------- /examples/demo/dune: -------------------------------------------------------------------------------- 1 | 2 | (executable 3 | (name example) 4 | (libraries memgraph) 5 | ) 6 | 7 | (rule 8 | (target example.gv) 9 | (package memgraph) 10 | (action (with-outputs-to %{target} 11 | (with-accepted-exit-codes 0 12 | (run ./example.exe)))) 13 | ) 14 | 15 | (rule 16 | (target example.svg) 17 | (deps example.gv) 18 | (package memgraph) 19 | (mode promote) 20 | (action (with-outputs-to %{target} 21 | (with-accepted-exit-codes 0 22 | (run dot -Tsvg -o %{target} %{deps})))) 23 | ) 24 | 25 | (alias 26 | (name examples) 27 | (deps example.svg) 28 | ) 29 | -------------------------------------------------------------------------------- /examples/demo/example.ml: -------------------------------------------------------------------------------- 1 | 2 | let int = 13 3 | let float = 42. 4 | let int_list = [1;2;3] 5 | let int_array = [| 1 ; 2 ; 3 |] 6 | let float_array = [| 1.0; 2.0; 3.0 |] 7 | let rec cycle = 1 :: 2 :: 3 :: cycle 8 | 9 | let () = 10 | Memgraph.Repr.(context (fun ctx -> 11 | Memgraph.Dot.print_list Format.std_formatter [ 12 | {|let rec l = 1 :: 2 :: 3 :: l|}, ctx.mk cycle; 13 | {|[\|1.0;2.0;3.0;4.0\|]|}, ctx.mk float_array; 14 | {|[\|1;2;3\|]|}, ctx.mk int_array; 15 | {|[1;2;3]|}, ctx.mk int_list; 16 | {|42.0|}, ctx.mk float; 17 | {|13|}, ctx.mk int; 18 | ])) 19 | 20 | -------------------------------------------------------------------------------- /examples/demo/example.svg: -------------------------------------------------------------------------------- 1 | 2 | 4 | 6 | 7 | 9 | 10 | g 11 | 12 | 13 | entry_5 14 | 15 | val : 13 16 | 17 | 13 18 | 19 | 20 | 21 | entry_4 22 | 23 | val : 42.0 24 | 25 | . 26 | 27 | 28 | 29 | p1 30 | 31 | Tag : 253 32 | 33 | 42.000000 34 | 35 | 36 | 37 | entry_4->p1:head 38 | 39 | 40 | 41 | 42 | 43 | entry_3 44 | 45 | val : [1;2;3] 46 | 47 | . 48 | 49 | 50 | 51 | p2 52 | 53 | Tag : 0 54 | 55 | 1 56 | 57 | . 58 | 59 | 60 | 61 | entry_3->p2:head 62 | 63 | 64 | 65 | 66 | 67 | entry_2 68 | 69 | val : [|1;2;3|] 70 | 71 | . 72 | 73 | 74 | 75 | p5 76 | 77 | Tag : 0 78 | 79 | 1 80 | 81 | 2 82 | 83 | 3 84 | 85 | 86 | 87 | entry_2->p5:head 88 | 89 | 90 | 91 | 92 | 93 | entry_1 94 | 95 | val : [|1.0;2.0;3.0;4.0|] 96 | 97 | . 98 | 99 | 100 | 101 | p6 102 | 103 | Tag : 254 104 | 105 | 1.000000 106 | 107 | 2.000000 108 | 109 | 3.000000 110 | 111 | 112 | 113 | entry_1->p6:head 114 | 115 | 116 | 117 | 118 | 119 | entry_0 120 | 121 | val : let rec l = 1 :: 2 :: 3 :: l 122 | 123 | . 124 | 125 | 126 | 127 | p7 128 | 129 | Tag : 0 130 | 131 | 1 132 | 133 | . 134 | 135 | 136 | 137 | entry_0->p7:head 138 | 139 | 140 | 141 | 142 | 143 | p8 144 | 145 | Tag : 0 146 | 147 | 2 148 | 149 | . 150 | 151 | 152 | 153 | p7:f1->p8:head 154 | 155 | 156 | 157 | 158 | 159 | p9 160 | 161 | Tag : 0 162 | 163 | 3 164 | 165 | . 166 | 167 | 168 | 169 | p8:f1->p9:head 170 | 171 | 172 | 173 | 174 | 175 | p9:f1->p7:head 176 | 177 | 178 | 179 | 180 | 181 | p3 182 | 183 | Tag : 0 184 | 185 | 2 186 | 187 | . 188 | 189 | 190 | 191 | p2:f1->p3:head 192 | 193 | 194 | 195 | 196 | 197 | p4 198 | 199 | Tag : 0 200 | 201 | 3 202 | 203 | 0 204 | 205 | 206 | 207 | p3:f1->p4:head 208 | 209 | 210 | 211 | 212 | 213 | -------------------------------------------------------------------------------- /examples/dk/dune: -------------------------------------------------------------------------------- 1 | 2 | (executable 3 | (name example) 4 | (libraries memgraph) 5 | ) 6 | 7 | (rule 8 | (target example.gv) 9 | (package memgraph) 10 | (action (with-outputs-to %{target} 11 | (with-accepted-exit-codes 0 12 | (run ./example.exe)))) 13 | ) 14 | 15 | (rule 16 | (target example.svg) 17 | (deps example.gv) 18 | (package memgraph) 19 | (mode promote) 20 | (action (with-outputs-to %{target} 21 | (with-accepted-exit-codes 0 22 | (run dot -Tsvg -o %{target} %{deps})))) 23 | ) 24 | 25 | (alias 26 | (name examples) 27 | (deps example.svg) 28 | ) 29 | -------------------------------------------------------------------------------- /examples/dk/example.ml: -------------------------------------------------------------------------------- 1 | 2 | type env_tuple = { 3 | ctx : int; 4 | term : int; 5 | stack : int; 6 | reduc : (bool * env_tuple) ref; 7 | } 8 | 9 | type env_fields = { 10 | ctx : int; 11 | term : int; 12 | stack : int; 13 | mutable reduc_bool : bool; 14 | mutable reduc_state : env_fields; 15 | } 16 | 17 | let rec env_tuple = { 18 | ctx = 0; term = 1; stack = 2; 19 | reduc = { contents = (true, env_tuple); }; 20 | } 21 | 22 | let rec env_fields = { 23 | ctx = 0; term = 1; stack = 2; 24 | reduc_bool = true; 25 | reduc_state = env_fields; 26 | } 27 | 28 | let () = 29 | Memgraph.Repr.(context (fun ctx -> 30 | Memgraph.Dot.print_list Format.std_formatter [ 31 | "env_tuple", ctx.mk env_tuple; 32 | "env_fields", ctx.mk env_fields; 33 | ])) 34 | -------------------------------------------------------------------------------- /examples/dk/example.svg: -------------------------------------------------------------------------------- 1 | 2 | 4 | 6 | 7 | 9 | 10 | g 11 | 12 | 13 | entry_1 14 | 15 | val : env_fields 16 | 17 | . 18 | 19 | 20 | 21 | p1 22 | 23 | Tag : 0 24 | 25 | 0 26 | 27 | 1 28 | 29 | 2 30 | 31 | 1 32 | 33 | . 34 | 35 | 36 | 37 | entry_1->p1:head 38 | 39 | 40 | 41 | 42 | 43 | entry_0 44 | 45 | val : env_tuple 46 | 47 | . 48 | 49 | 50 | 51 | p2 52 | 53 | Tag : 0 54 | 55 | 0 56 | 57 | 1 58 | 59 | 2 60 | 61 | . 62 | 63 | 64 | 65 | entry_0->p2:head 66 | 67 | 68 | 69 | 70 | 71 | p3 72 | 73 | Tag : 0 74 | 75 | . 76 | 77 | 78 | 79 | p2:f3->p3:head 80 | 81 | 82 | 83 | 84 | 85 | p4 86 | 87 | Tag : 0 88 | 89 | 1 90 | 91 | . 92 | 93 | 94 | 95 | p3:f0->p4:head 96 | 97 | 98 | 99 | 100 | 101 | p4:f1->p2:head 102 | 103 | 104 | 105 | 106 | 107 | p1:f4->p1:head 108 | 109 | 110 | 111 | 112 | 113 | -------------------------------------------------------------------------------- /examples/exn/dune: -------------------------------------------------------------------------------- 1 | 2 | (executable 3 | (name example) 4 | (libraries memgraph) 5 | ) 6 | 7 | (rule 8 | (target example.gv) 9 | (package memgraph) 10 | (action (with-outputs-to %{target} 11 | (with-accepted-exit-codes 0 12 | (run ./example.exe)))) 13 | ) 14 | 15 | (rule 16 | (target example.svg) 17 | (deps example.gv) 18 | (package memgraph) 19 | (mode promote) 20 | (action (with-outputs-to %{target} 21 | (with-accepted-exit-codes 0 22 | (run dot -Tsvg -o %{target} %{deps})))) 23 | ) 24 | 25 | (alias 26 | (name examples) 27 | (deps example.svg) 28 | ) 29 | -------------------------------------------------------------------------------- /examples/exn/example.ml: -------------------------------------------------------------------------------- 1 | 2 | exception Exception 3 | exception Exc_int of int 4 | exception Exc_int_int of int * int 5 | 6 | let () = 7 | Memgraph.Repr.(context (fun ctx -> 8 | Memgraph.Dot.print_list Format.std_formatter [ 9 | "Exception", ctx.mk Exception; 10 | "Exc_int 0", ctx.mk (Exc_int 0); 11 | "Exc_int 123", ctx.mk (Exc_int 123); 12 | "Exc_int_int", ctx.mk (Exc_int_int (456,789)); 13 | ])) 14 | 15 | -------------------------------------------------------------------------------- /examples/exn/example.svg: -------------------------------------------------------------------------------- 1 | 2 | 4 | 6 | 7 | 9 | 10 | g 11 | 12 | 13 | entry_3 14 | 15 | val : Exc_int_int 16 | 17 | . 18 | 19 | 20 | 21 | p1 22 | 23 | Tag : 0 24 | 25 | . 26 | 27 | 456 28 | 29 | 789 30 | 31 | 32 | 33 | entry_3->p1:head 34 | 35 | 36 | 37 | 38 | 39 | entry_2 40 | 41 | val : Exc_int 123 42 | 43 | . 44 | 45 | 46 | 47 | p4 48 | 49 | Tag : 0 50 | 51 | . 52 | 53 | 123 54 | 55 | 56 | 57 | entry_2->p4:head 58 | 59 | 60 | 61 | 62 | 63 | entry_1 64 | 65 | val : Exc_int 0 66 | 67 | . 68 | 69 | 70 | 71 | p7 72 | 73 | Tag : 0 74 | 75 | . 76 | 77 | 0 78 | 79 | 80 | 81 | entry_1->p7:head 82 | 83 | 84 | 85 | 86 | 87 | entry_0 88 | 89 | val : Exception 90 | 91 | . 92 | 93 | 94 | 95 | p8 96 | 97 | Tag : 248 98 | 99 | . 100 | 101 | 11 102 | 103 | 104 | 105 | entry_0->p8:head 106 | 107 | 108 | 109 | 110 | 111 | p9 112 | 113 | Tag : 252 114 | 115 | 'Dune__exe__Example.Exception' 116 | 117 | 118 | 119 | p8:f0->p9:head 120 | 121 | 122 | 123 | 124 | 125 | p5 126 | 127 | Tag : 248 128 | 129 | . 130 | 131 | 12 132 | 133 | 134 | 135 | p7:f0->p5:head 136 | 137 | 138 | 139 | 140 | 141 | p6 142 | 143 | Tag : 252 144 | 145 | 'Dune__exe__Example.Exc_int' 146 | 147 | 148 | 149 | p5:f0->p6:head 150 | 151 | 152 | 153 | 154 | 155 | p4:f0->p5:head 156 | 157 | 158 | 159 | 160 | 161 | p2 162 | 163 | Tag : 248 164 | 165 | . 166 | 167 | 13 168 | 169 | 170 | 171 | p1:f0->p2:head 172 | 173 | 174 | 175 | 176 | 177 | p3 178 | 179 | Tag : 252 180 | 181 | 'Dune__exe__Example.Exc_int_int' 182 | 183 | 184 | 185 | p2:f0->p3:head 186 | 187 | 188 | 189 | 190 | 191 | -------------------------------------------------------------------------------- /examples/kitty.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Gbury/ocaml-memgraph/4aa70f421a2aedc7b4de25b57ba1713a236c53e3/examples/kitty.png -------------------------------------------------------------------------------- /examples/lazy/dune: -------------------------------------------------------------------------------- 1 | 2 | (executable 3 | (name example) 4 | (libraries memgraph) 5 | ) 6 | 7 | (rule 8 | (target example.gv) 9 | (package memgraph) 10 | (action (with-outputs-to %{target} 11 | (with-accepted-exit-codes 0 12 | (run ./example.exe)))) 13 | ) 14 | 15 | (rule 16 | (target example.svg) 17 | (deps example.gv) 18 | (package memgraph) 19 | (mode promote) 20 | (action (with-outputs-to %{target} 21 | (with-accepted-exit-codes 0 22 | (run dot -Tsvg -o %{target} %{deps})))) 23 | ) 24 | 25 | (alias 26 | (name examples) 27 | (deps example.svg) 28 | ) 29 | -------------------------------------------------------------------------------- /examples/lazy/example.ml: -------------------------------------------------------------------------------- 1 | 2 | (* Prelude *) 3 | 4 | let x = 5. 5 | let l = lazy (x +. 42.) 6 | 7 | let l_repr = Memgraph.Repr.repr l 8 | let l_val = Memgraph.Repr.repr (Lazy.force l) 9 | let l_forced = Memgraph.Repr.repr l 10 | 11 | ;; 12 | (* Printing *) 13 | Memgraph.Repr.(context (fun _ -> 14 | Memgraph.Dot.print_list Format.std_formatter [ 15 | "lazy: 5 + 42", l_repr; 16 | "lazy_forced", l_val; 17 | "lazy_after_forced", l_forced; 18 | ])) 19 | 20 | -------------------------------------------------------------------------------- /examples/lazy/example.svg: -------------------------------------------------------------------------------- 1 | 2 | 4 | 6 | 7 | 9 | 10 | g 11 | 12 | 13 | entry_2 14 | 15 | val : lazy_after_forced 16 | 17 | . 18 | 19 | 20 | 21 | p4 22 | 23 | Tag : 250 24 | 25 | . 26 | 27 | 28 | 29 | entry_2->p4:head 30 | 31 | 32 | 33 | 34 | 35 | entry_1 36 | 37 | val : lazy_forced 38 | 39 | . 40 | 41 | 42 | 43 | p3 44 | 45 | Tag : 253 46 | 47 | 47.000000 48 | 49 | 50 | 51 | entry_1->p3:head 52 | 53 | 54 | 55 | 56 | 57 | entry_0 58 | 59 | val : lazy: 5 + 42 60 | 61 | . 62 | 63 | 64 | 65 | p1 66 | 67 | Tag : 246 68 | 69 | . 70 | 71 | 72 | 73 | entry_0->p1:head 74 | 75 | 76 | 77 | 78 | 79 | p2 80 | 81 | Tag : 247 82 | 83 | . 84 | 85 | arity:1 / startenv:2 86 | 87 | 88 | 89 | p1:f0->p2:head 90 | 91 | 92 | 93 | 94 | 95 | e94106662500576 96 | 97 | Out of heap : 0x5596ea3078e0 98 | 99 | 100 | 101 | p2:f0->e94106662500576:head 102 | 103 | 104 | 105 | 106 | 107 | p5 108 | 109 | Tag : 253 110 | 111 | 47.000000 112 | 113 | 114 | 115 | p4:f0->p5:head 116 | 117 | 118 | 119 | 120 | 121 | -------------------------------------------------------------------------------- /examples/list/dune: -------------------------------------------------------------------------------- 1 | 2 | (executable 3 | (name example) 4 | (libraries memgraph) 5 | ) 6 | 7 | (rule 8 | (target example.gv) 9 | (package memgraph) 10 | (action (with-outputs-to %{target} 11 | (with-accepted-exit-codes 0 12 | (run ./example.exe)))) 13 | ) 14 | 15 | (rule 16 | (target example.svg) 17 | (deps example.gv) 18 | (package memgraph) 19 | (mode promote) 20 | (action (with-outputs-to %{target} 21 | (with-accepted-exit-codes 0 22 | (run dot -Tsvg -o %{target} %{deps})))) 23 | ) 24 | 25 | (alias 26 | (name examples) 27 | (deps example.svg) 28 | ) 29 | -------------------------------------------------------------------------------- /examples/list/example.ml: -------------------------------------------------------------------------------- 1 | 2 | let empty = [] 3 | let int_list = [ 1 ; 2 ; 3 ] 4 | let float_list = [ 1. ; 2. ; 3. ] 5 | 6 | let l = [42] 7 | let l1 = 1::2::l 8 | let l2 = 3::4::l 9 | 10 | let rec cyclic = 1 :: 2 :: 3 :: cyclic 11 | 12 | let () = 13 | Memgraph.Repr.(context (fun ctx -> 14 | Memgraph.Dot.print_list Format.std_formatter [ 15 | "[]", ctx.mk empty; 16 | "[1;2;3]", ctx.mk int_list; 17 | "[1.;2.;3.]", ctx.mk float_list; 18 | "l = [42]", ctx.mk l; 19 | "1 :: 2 :: l", ctx.mk l1; 20 | "3 :: 4 :: l", ctx.mk l2; 21 | "cyclic", ctx.mk cyclic; 22 | ])) 23 | -------------------------------------------------------------------------------- /examples/list/example.svg: -------------------------------------------------------------------------------- 1 | 2 | 4 | 6 | 7 | 9 | 10 | g 11 | 12 | 13 | entry_6 14 | 15 | val : cyclic 16 | 17 | . 18 | 19 | 20 | 21 | p1 22 | 23 | Tag : 0 24 | 25 | 1 26 | 27 | . 28 | 29 | 30 | 31 | entry_6->p1:head 32 | 33 | 34 | 35 | 36 | 37 | entry_5 38 | 39 | val : 3 :: 4 :: l 40 | 41 | . 42 | 43 | 44 | 45 | p4 46 | 47 | Tag : 0 48 | 49 | 3 50 | 51 | . 52 | 53 | 54 | 55 | entry_5->p4:head 56 | 57 | 58 | 59 | 60 | 61 | entry_4 62 | 63 | val : 1 :: 2 :: l 64 | 65 | . 66 | 67 | 68 | 69 | p7 70 | 71 | Tag : 0 72 | 73 | 1 74 | 75 | . 76 | 77 | 78 | 79 | entry_4->p7:head 80 | 81 | 82 | 83 | 84 | 85 | entry_3 86 | 87 | val : l = [42] 88 | 89 | . 90 | 91 | 92 | 93 | p6 94 | 95 | Tag : 0 96 | 97 | 42 98 | 99 | 0 100 | 101 | 102 | 103 | entry_3->p6:head 104 | 105 | 106 | 107 | 108 | 109 | entry_2 110 | 111 | val : [1.;2.;3.] 112 | 113 | . 114 | 115 | 116 | 117 | p9 118 | 119 | Tag : 0 120 | 121 | . 122 | 123 | . 124 | 125 | 126 | 127 | entry_2->p9:head 128 | 129 | 130 | 131 | 132 | 133 | entry_1 134 | 135 | val : [1;2;3] 136 | 137 | . 138 | 139 | 140 | 141 | p15 142 | 143 | Tag : 0 144 | 145 | 1 146 | 147 | . 148 | 149 | 150 | 151 | entry_1->p15:head 152 | 153 | 154 | 155 | 156 | 157 | entry_0 158 | 159 | val : [] 160 | 161 | 0 162 | 163 | 164 | 165 | p16 166 | 167 | Tag : 0 168 | 169 | 2 170 | 171 | . 172 | 173 | 174 | 175 | p15:f1->p16:head 176 | 177 | 178 | 179 | 180 | 181 | p17 182 | 183 | Tag : 0 184 | 185 | 3 186 | 187 | 0 188 | 189 | 190 | 191 | p16:f1->p17:head 192 | 193 | 194 | 195 | 196 | 197 | p10 198 | 199 | Tag : 253 200 | 201 | 1.000000 202 | 203 | 204 | 205 | p9:f0->p10:head 206 | 207 | 208 | 209 | 210 | 211 | p11 212 | 213 | Tag : 0 214 | 215 | . 216 | 217 | . 218 | 219 | 220 | 221 | p9:f1->p11:head 222 | 223 | 224 | 225 | 226 | 227 | p12 228 | 229 | Tag : 253 230 | 231 | 2.000000 232 | 233 | 234 | 235 | p11:f0->p12:head 236 | 237 | 238 | 239 | 240 | 241 | p13 242 | 243 | Tag : 0 244 | 245 | . 246 | 247 | 0 248 | 249 | 250 | 251 | p11:f1->p13:head 252 | 253 | 254 | 255 | 256 | 257 | p14 258 | 259 | Tag : 253 260 | 261 | 3.000000 262 | 263 | 264 | 265 | p13:f0->p14:head 266 | 267 | 268 | 269 | 270 | 271 | p8 272 | 273 | Tag : 0 274 | 275 | 2 276 | 277 | . 278 | 279 | 280 | 281 | p7:f1->p8:head 282 | 283 | 284 | 285 | 286 | 287 | p8:f1->p6:head 288 | 289 | 290 | 291 | 292 | 293 | p5 294 | 295 | Tag : 0 296 | 297 | 4 298 | 299 | . 300 | 301 | 302 | 303 | p4:f1->p5:head 304 | 305 | 306 | 307 | 308 | 309 | p5:f1->p6:head 310 | 311 | 312 | 313 | 314 | 315 | p2 316 | 317 | Tag : 0 318 | 319 | 2 320 | 321 | . 322 | 323 | 324 | 325 | p1:f1->p2:head 326 | 327 | 328 | 329 | 330 | 331 | p3 332 | 333 | Tag : 0 334 | 335 | 3 336 | 337 | . 338 | 339 | 340 | 341 | p2:f1->p3:head 342 | 343 | 344 | 345 | 346 | 347 | p3:f1->p1:head 348 | 349 | 350 | 351 | 352 | 353 | -------------------------------------------------------------------------------- /examples/object/dune: -------------------------------------------------------------------------------- 1 | 2 | (executable 3 | (name example) 4 | (libraries memgraph) 5 | ) 6 | 7 | (rule 8 | (target example.gv) 9 | (package memgraph) 10 | (action (with-outputs-to %{target} 11 | (with-accepted-exit-codes 0 12 | (run ./example.exe)))) 13 | ) 14 | 15 | (rule 16 | (target example.svg) 17 | (deps example.gv) 18 | (package memgraph) 19 | (mode promote) 20 | (action (with-outputs-to %{target} 21 | (with-accepted-exit-codes 0 22 | (run dot -Tsvg -o %{target} %{deps})))) 23 | ) 24 | 25 | (alias 26 | (name examples) 27 | (deps example.svg) 28 | ) 29 | -------------------------------------------------------------------------------- /examples/object/example.ml: -------------------------------------------------------------------------------- 1 | 2 | let x = object(self) 3 | 4 | val foo = 5 5 | 6 | method f x = 7 | self#f (x - 1) * x 8 | 9 | method g y = 10 | foo + y 11 | 12 | end 13 | 14 | let () = 15 | Memgraph.Repr.(context (fun ctx -> 16 | Memgraph.Dot.print_list Format.std_formatter [ 17 | "object", ctx.mk x; 18 | ])) 19 | -------------------------------------------------------------------------------- /examples/object/example.svg: -------------------------------------------------------------------------------- 1 | 2 | 4 | 6 | 7 | 9 | 10 | g 11 | 12 | 13 | entry_0 14 | 15 | val : object 16 | 17 | . 18 | 19 | 20 | 21 | p1 22 | 23 | Tag : 248 24 | 25 | . 26 | 27 | 11 28 | 29 | 5 30 | 31 | 32 | 33 | entry_0->p1:head 34 | 35 | 36 | 37 | 38 | 39 | p2 40 | 41 | Tag : 0 42 | 43 | 2 44 | 45 | 15 46 | 47 | . 48 | 49 | 102 50 | 51 | . 52 | 53 | 103 54 | 55 | 56 | 57 | p1:f0->p2:head 58 | 59 | 60 | 61 | 62 | 63 | p3 64 | 65 | Tag : 247 66 | 67 | . 68 | 69 | arity:2 / startenv:3 70 | 71 | . 72 | 73 | 74 | 75 | p2:f2->p3:head 76 | 77 | 78 | 79 | 80 | 81 | p4 82 | 83 | Tag : 247 84 | 85 | . 86 | 87 | arity:2 / startenv:3 88 | 89 | . 90 | 91 | 92 | 93 | p2:f4->p4:head 94 | 95 | 96 | 97 | 98 | 99 | e94057777571040 100 | 101 | Out of heap : 0x558b886ba4e0 102 | 103 | 104 | 105 | p3:f0->e94057777571040:head 106 | 107 | 108 | 109 | 110 | 111 | e94057777572208 112 | 113 | Out of heap : 0x558b886ba970 114 | 115 | 116 | 117 | p3:f2->e94057777572208:head 118 | 119 | 120 | 121 | 122 | 123 | p4:f0->e94057777571040:head 124 | 125 | 126 | 127 | 128 | 129 | e94057777572272 130 | 131 | Out of heap : 0x558b886ba9b0 132 | 133 | 134 | 135 | p4:f2->e94057777572272:head 136 | 137 | 138 | 139 | 140 | 141 | -------------------------------------------------------------------------------- /examples/record/dune: -------------------------------------------------------------------------------- 1 | 2 | (executable 3 | (name example) 4 | (libraries memgraph) 5 | ) 6 | 7 | (rule 8 | (target example.gv) 9 | (package memgraph) 10 | (action (with-outputs-to %{target} 11 | (with-accepted-exit-codes 0 12 | (run ./example.exe)))) 13 | ) 14 | 15 | (rule 16 | (target example.svg) 17 | (deps example.gv) 18 | (package memgraph) 19 | (mode promote) 20 | (action (with-outputs-to %{target} 21 | (with-accepted-exit-codes 0 22 | (run dot -Tsvg -o %{target} %{deps})))) 23 | ) 24 | 25 | (alias 26 | (name examples) 27 | (deps example.svg) 28 | ) 29 | -------------------------------------------------------------------------------- /examples/record/example.ml: -------------------------------------------------------------------------------- 1 | 2 | type foo = { 3 | a : int; 4 | b : float; 5 | c : int; 6 | d : int; 7 | } 8 | 9 | type bar = { 10 | e : float; 11 | f : float; 12 | g : float; 13 | } 14 | 15 | type foobar = { 16 | h : int; 17 | foo : foo; 18 | bar : bar; 19 | i : float; 20 | } 21 | 22 | let foo = { a = 1; b = 42.; c = 2; d = 3; } 23 | let bar = { e = 5.; f = 7.; g = 8.; } 24 | let foobar = { h = 0; foo; bar; i = 9. } 25 | 26 | let () = 27 | Memgraph.Repr.(context (fun ctx -> 28 | Memgraph.Dot.print_list Format.std_formatter [ 29 | {|foo = \{ a = 1; b = 42.; c = 2; d = 3; \}|}, ctx.mk foo; 30 | {|bar = \{ e = 5.; f = 7.; g = 8.; \}|}, ctx.mk bar; 31 | {|\{ h = 0; foo; bar; i = 9.; \}|}, ctx.mk foobar 32 | ])) 33 | 34 | -------------------------------------------------------------------------------- /examples/record/example.svg: -------------------------------------------------------------------------------- 1 | 2 | 4 | 6 | 7 | 9 | 10 | g 11 | 12 | 13 | entry_2 14 | 15 | val : { h = 0; foo; bar; i = 9.; } 16 | 17 | . 18 | 19 | 20 | 21 | p1 22 | 23 | Tag : 0 24 | 25 | 0 26 | 27 | . 28 | 29 | . 30 | 31 | . 32 | 33 | 34 | 35 | entry_2->p1:head 36 | 37 | 38 | 39 | 40 | 41 | entry_1 42 | 43 | val : bar = { e = 5.; f = 7.; g = 8.; } 44 | 45 | . 46 | 47 | 48 | 49 | p4 50 | 51 | Tag : 254 52 | 53 | 5.000000 54 | 55 | 7.000000 56 | 57 | 8.000000 58 | 59 | 60 | 61 | entry_1->p4:head 62 | 63 | 64 | 65 | 66 | 67 | entry_0 68 | 69 | val : foo = { a = 1; b = 42.; c = 2; d = 3; } 70 | 71 | . 72 | 73 | 74 | 75 | p2 76 | 77 | Tag : 0 78 | 79 | 1 80 | 81 | . 82 | 83 | 2 84 | 85 | 3 86 | 87 | 88 | 89 | entry_0->p2:head 90 | 91 | 92 | 93 | 94 | 95 | p3 96 | 97 | Tag : 253 98 | 99 | 42.000000 100 | 101 | 102 | 103 | p2:f1->p3:head 104 | 105 | 106 | 107 | 108 | 109 | p1:f1->p2:head 110 | 111 | 112 | 113 | 114 | 115 | p1:f2->p4:head 116 | 117 | 118 | 119 | 120 | 121 | p5 122 | 123 | Tag : 253 124 | 125 | 9.000000 126 | 127 | 128 | 129 | p1:f3->p5:head 130 | 131 | 132 | 133 | 134 | 135 | -------------------------------------------------------------------------------- /examples/sum/dune: -------------------------------------------------------------------------------- 1 | 2 | (executable 3 | (name example) 4 | (libraries memgraph) 5 | ) 6 | 7 | (rule 8 | (target example.gv) 9 | (package memgraph) 10 | (action (with-outputs-to %{target} 11 | (with-accepted-exit-codes 0 12 | (run ./example.exe)))) 13 | ) 14 | 15 | (rule 16 | (target example.svg) 17 | (deps example.gv) 18 | (package memgraph) 19 | (mode promote) 20 | (action (with-outputs-to %{target} 21 | (with-accepted-exit-codes 0 22 | (run dot -Tsvg -o %{target} %{deps})))) 23 | ) 24 | 25 | (alias 26 | (name examples) 27 | (deps example.svg) 28 | ) 29 | -------------------------------------------------------------------------------- /examples/sum/example.ml: -------------------------------------------------------------------------------- 1 | 2 | type t1 = 3 | | A of int * int 4 | | B of (int * int) 5 | | C of float 6 | | D 7 | | E 8 | | F of t1 9 | 10 | let a = A (1, 2) 11 | let b = B (3, 4) 12 | let c = C 42. 13 | let d = D 14 | let e = E 15 | let f = F a 16 | 17 | let g = `G 18 | let h = `H 5 19 | let i = `I d 20 | let j = `J (b, c) 21 | 22 | let () = 23 | Memgraph.Repr.(context (fun ctx -> 24 | Memgraph.Dot.print_list Format.std_formatter [ 25 | "a = A (1,2)", ctx.mk a; 26 | "b = B ((3,4))", ctx.mk b; 27 | "c = C 42.0", ctx.mk c; 28 | "d = D", ctx.mk d; 29 | "e = E", ctx.mk e; 30 | "f = F a", ctx.mk f; 31 | "g = `G", ctx.mk g; 32 | "h = `H 5", ctx.mk h; 33 | "i = `I d", ctx.mk i; 34 | "j = `J (b, c)", ctx.mk j; 35 | ])) 36 | 37 | -------------------------------------------------------------------------------- /examples/sum/example.svg: -------------------------------------------------------------------------------- 1 | 2 | 4 | 6 | 7 | 9 | 10 | g 11 | 12 | 13 | entry_9 14 | 15 | val : j = `J (b, c) 16 | 17 | . 18 | 19 | 20 | 21 | p1 22 | 23 | Tag : 0 24 | 25 | 74 26 | 27 | . 28 | 29 | 30 | 31 | entry_9->p1:head 32 | 33 | 34 | 35 | 36 | 37 | entry_8 38 | 39 | val : i = `I d 40 | 41 | . 42 | 43 | 44 | 45 | p7 46 | 47 | Tag : 0 48 | 49 | 73 50 | 51 | 0 52 | 53 | 54 | 55 | entry_8->p7:head 56 | 57 | 58 | 59 | 60 | 61 | entry_7 62 | 63 | val : h = `H 5 64 | 65 | . 66 | 67 | 68 | 69 | p8 70 | 71 | Tag : 0 72 | 73 | 72 74 | 75 | 5 76 | 77 | 78 | 79 | entry_7->p8:head 80 | 81 | 82 | 83 | 84 | 85 | entry_6 86 | 87 | val : g = `G 88 | 89 | 71 90 | 91 | 92 | 93 | entry_5 94 | 95 | val : f = F a 96 | 97 | . 98 | 99 | 100 | 101 | p9 102 | 103 | Tag : 3 104 | 105 | . 106 | 107 | 108 | 109 | entry_5->p9:head 110 | 111 | 112 | 113 | 114 | 115 | entry_4 116 | 117 | val : e = E 118 | 119 | 1 120 | 121 | 122 | 123 | entry_3 124 | 125 | val : d = D 126 | 127 | 0 128 | 129 | 130 | 131 | entry_2 132 | 133 | val : c = C 42.0 134 | 135 | . 136 | 137 | 138 | 139 | p5 140 | 141 | Tag : 2 142 | 143 | . 144 | 145 | 146 | 147 | entry_2->p5:head 148 | 149 | 150 | 151 | 152 | 153 | entry_1 154 | 155 | val : b = B ((3,4)) 156 | 157 | . 158 | 159 | 160 | 161 | p3 162 | 163 | Tag : 1 164 | 165 | . 166 | 167 | 168 | 169 | entry_1->p3:head 170 | 171 | 172 | 173 | 174 | 175 | entry_0 176 | 177 | val : a = A (1,2) 178 | 179 | . 180 | 181 | 182 | 183 | p10 184 | 185 | Tag : 0 186 | 187 | 1 188 | 189 | 2 190 | 191 | 192 | 193 | entry_0->p10:head 194 | 195 | 196 | 197 | 198 | 199 | p4 200 | 201 | Tag : 0 202 | 203 | 3 204 | 205 | 4 206 | 207 | 208 | 209 | p3:f0->p4:head 210 | 211 | 212 | 213 | 214 | 215 | p6 216 | 217 | Tag : 253 218 | 219 | 42.000000 220 | 221 | 222 | 223 | p5:f0->p6:head 224 | 225 | 226 | 227 | 228 | 229 | p9:f0->p10:head 230 | 231 | 232 | 233 | 234 | 235 | p2 236 | 237 | Tag : 0 238 | 239 | . 240 | 241 | . 242 | 243 | 244 | 245 | p1:f1->p2:head 246 | 247 | 248 | 249 | 250 | 251 | p2:f0->p3:head 252 | 253 | 254 | 255 | 256 | 257 | p2:f1->p5:head 258 | 259 | 260 | 261 | 262 | 263 | -------------------------------------------------------------------------------- /memgraph.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | version: "1.0" 4 | synopsis: "A small library to inspect memory representation of ocaml values" 5 | description: 6 | "Memgraph allows one to inspect an ocaml value and get a representation of its layout in memory, and helpers to dump such representation as dot files to easily print them as graphs" 7 | maintainer: [ 8 | "Guillaume Bury " 9 | "Armaël Guéneau " 10 | ] 11 | authors: [ 12 | "Guillaume Bury " 13 | "Armaël Guéneau " 14 | ] 15 | license: "MIT" 16 | homepage: "https://github.com/gbury/ocaml-memgraph" 17 | doc: "https://gbury.github.io/ocaml-memgraph/" 18 | bug-reports: "https://github.com/gbury/ocaml-memgraph/issues" 19 | depends: [ 20 | "dune" {>= "2.7"} 21 | "ocaml" {>= "4.12.0"} 22 | "odoc" {with-doc} 23 | ] 24 | build: [ 25 | ["dune" "subst"] {dev} 26 | [ 27 | "dune" 28 | "build" 29 | "-p" 30 | name 31 | "-j" 32 | jobs 33 | "@install" 34 | "@runtest" {with-test} 35 | "@doc" {with-doc} 36 | ] 37 | ] 38 | dev-repo: "git+https://github.com/gbury/ocaml-memgraph.git" 39 | -------------------------------------------------------------------------------- /memgraph_kitty.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | version: "1.0" 4 | synopsis: 5 | "Display the representation of memory values in the Kitty terminal emulator" 6 | description: 7 | "Memgraph_kitty inspects ocaml values and displays their graphical representation using the graphics protocol of the kitty terminal emulator" 8 | maintainer: [ 9 | "Guillaume Bury " 10 | "Armaël Guéneau " 11 | ] 12 | authors: [ 13 | "Guillaume Bury " 14 | "Armaël Guéneau " 15 | ] 16 | license: "MIT" 17 | homepage: "https://github.com/gbury/ocaml-memgraph" 18 | doc: "https://gbury.github.io/ocaml-memgraph/" 19 | bug-reports: "https://github.com/gbury/ocaml-memgraph/issues" 20 | depends: [ 21 | "dune" {>= "2.7"} 22 | "ocaml" {>= "4.12.0"} 23 | "memgraph" {= version} 24 | "ppx_blob" {build & >= "0.7.0"} 25 | "nanosvg" {>= "0.1"} 26 | "nanosvg_text" {>= "0.1"} 27 | "kittyimg" {>= "0.1"} 28 | "stb_truetype" {>= "0.7"} 29 | "conf-graphviz" 30 | "odoc" {with-doc} 31 | ] 32 | build: [ 33 | ["dune" "subst"] {dev} 34 | [ 35 | "dune" 36 | "build" 37 | "-p" 38 | name 39 | "-j" 40 | jobs 41 | "@install" 42 | "@runtest" {with-test} 43 | "@doc" {with-doc} 44 | ] 45 | ] 46 | dev-repo: "git+https://github.com/gbury/ocaml-memgraph.git" 47 | -------------------------------------------------------------------------------- /src/core/dot.ml: -------------------------------------------------------------------------------- 1 | (* Settings for the graphviz output *) 2 | 3 | type config = { 4 | external_node_color : string option; 5 | block_node_color : string option; 6 | root_node_color : string option; 7 | outline_color : string; 8 | background_color : string option; 9 | direction : [`Vertical | `Horizontal]; 10 | } 11 | 12 | let config 13 | ?(external_node_color = Some "grey") 14 | ?(block_node_color = Some "lightblue") 15 | ?(root_node_color = Some "yellow") 16 | ?(outline_color = "black") 17 | ?(background_color = None) 18 | ?(direction = `Vertical) 19 | () 20 | = 21 | { external_node_color; 22 | block_node_color; 23 | root_node_color; 24 | outline_color; 25 | background_color; 26 | direction; 27 | } 28 | 29 | let styles_with_color fmt ~color (styles: string list) = 30 | match color with 31 | | None -> 32 | if styles = [] then () 33 | else Format.fprintf fmt "style=\"%s\"" (String.concat ", " styles) 34 | | Some color -> 35 | Format.fprintf fmt "style=\"%s\" fillcolor=\"%s\"" 36 | (String.concat ", " ("filled" :: styles)) color 37 | 38 | (* External pointers *) 39 | 40 | (* Global cache to avoid printing the same external twice or more. *) 41 | let external_cache = Hashtbl.create 42 42 | 43 | (* The cache should be cleared before each printing function, 44 | in order to be local to each printing function. *) 45 | let clear_external_cache () = Hashtbl.clear external_cache 46 | 47 | let external_id fmt e = 48 | Format.fprintf fmt "e%s" (Nativeint.to_string e) 49 | 50 | let print_external_contents fmt i = 51 | Format.fprintf fmt "{ Out of heap : 0x%nx }" i 52 | 53 | let print_external cfg fmt i = 54 | if not @@ Hashtbl.mem external_cache i then begin 55 | Format.fprintf fmt 56 | "%a [label=\"%a\" shape=\"record\" %a];@\n" 57 | external_id i print_external_contents i 58 | (styles_with_color ~color:cfg.external_node_color) ["rounded"] 59 | end 60 | 61 | 62 | (** Regular blocks printing *) 63 | 64 | let node_id fmt t = 65 | Format.fprintf fmt "p%d" Repr.((t.block.addr :> int)) 66 | 67 | let node_anchor fmt t = 68 | Format.fprintf fmt "p%d:<%s>" Repr.((t.block.addr :> int)) 69 | (match Repr.(t.offset) with 70 | | 0 -> "head" 71 | | o -> Format.asprintf "f%d" (o - 1)) 72 | 73 | let print_direct_cell fmt (c : [`Direct] Repr.cell) = 74 | match c with 75 | | Repr.Int i -> Format.fprintf fmt "%d" i 76 | | Repr.Pointer _ -> Format.fprintf fmt " . " 77 | 78 | let print_inline_cell fmt (c : [`Inline] Repr.cell) = 79 | match c with 80 | | Repr.Int i -> Format.fprintf fmt "%d" i 81 | | Repr.Pointer _ -> Format.fprintf fmt " . " 82 | | Repr.External _ -> Format.fprintf fmt " . " 83 | | Repr.Double f -> Format.fprintf fmt "%f" f 84 | | Repr.Infix -> Format.fprintf fmt "Infix" 85 | | Repr.Closinfo c -> Format.fprintf fmt "arity:%d / startenv:%d" c.arity c.start_of_env 86 | 87 | let print_block_cell fmt (c: [`Block] Repr.cell) = 88 | match c with 89 | | Repr.String s -> Format.fprintf fmt "'%s'" s 90 | | Repr.Double f -> Format.fprintf fmt "%f" f 91 | 92 | let print_contents fmt t = 93 | match t.Repr.data with 94 | | Repr.Abstract -> 95 | Format.fprintf fmt {| \|} 96 | | Repr.Block c -> 97 | Format.fprintf fmt " %a" print_block_cell c 98 | | Repr.Fields a -> 99 | if Array.length a = 0 then begin 100 | Format.fprintf fmt "" 101 | end else begin 102 | Format.fprintf fmt " %a" print_inline_cell a.(0); 103 | for i = 1 to Array.length a - 1 do 104 | Format.fprintf fmt "| %a" i print_inline_cell a.(i) 105 | done 106 | end 107 | 108 | let print_contents fmt t = 109 | Format.fprintf fmt "{ Tag : %d | %a }" 110 | Repr.((t.block.tag :> int)) 111 | print_contents t.Repr.block 112 | 113 | let print_edges cfg fmt t = 114 | match Repr.(t.block.data) with 115 | | Repr.Abstract | Repr.Block _ -> () 116 | | Repr.Fields a -> 117 | for i = 0 to Array.length a - 1 do 118 | match a.(i) with 119 | | Repr.Pointer b -> 120 | Format.fprintf fmt "%a:f%d -> %a;@\n" node_id t i node_anchor (Repr.follow b) 121 | | Repr.External e -> 122 | Format.fprintf fmt "%a:f%d -> %a:;@\n" node_id t i external_id e; 123 | (print_external cfg) fmt e 124 | | _ -> () 125 | done 126 | 127 | let print_node cfg h fmt t = 128 | if not (Hashtbl.mem h Repr.(t.block.addr)) then begin 129 | Hashtbl.add h Repr.(t.block.addr) true; 130 | Format.fprintf fmt 131 | "%a [label=\"%a\" shape=\"record\" %a];@\n" 132 | node_id t print_contents t 133 | (styles_with_color ~color:cfg.block_node_color) ["rounded"]; 134 | (print_edges cfg) fmt t 135 | end 136 | 137 | let print_repr cfg h fmt n (_, t) = 138 | match t with 139 | | Repr.Pointer b -> 140 | let block = Repr.follow b in 141 | Format.fprintf fmt "entry_%d -> %a;@\n" n node_anchor block; 142 | Repr.walk (print_node cfg h fmt) block 143 | | _ -> () 144 | 145 | let print_roots cfg fmt l = 146 | let aux fmt l = 147 | let n = List.length l in 148 | List.iteri (fun i (name, t) -> 149 | Format.fprintf fmt "entry_%d [label=\"{ val : %s | %a}\" shape=\"record\" %a];@\n" 150 | (n-i-1) name print_direct_cell t 151 | (styles_with_color ~color:cfg.root_node_color) [] 152 | ) (List.rev l) 153 | 154 | in 155 | Format.fprintf fmt "{rank=source;@\n%a@\n}" aux l 156 | 157 | let print_list ?(conf = config ()) fmt l = 158 | clear_external_cache (); 159 | let print_reprs fmt l = 160 | let h = Hashtbl.create 42 in 161 | List.iteri (print_repr conf h fmt) l 162 | in 163 | Format.fprintf fmt "digraph g {@\n\ 164 | graph [bgcolor=\"%s\"]\n\ 165 | edge [color=\"%s\"]\n\ 166 | node [color=\"%s\", fontcolor=\"%s\"]\n\ 167 | rankdir=%s\n\ 168 | %a\n%a\n}@." 169 | (match conf.background_color with None -> "transparent" | Some c -> c) 170 | conf.outline_color conf.outline_color conf.outline_color 171 | (match conf.direction with `Horizontal -> "LR" | `Vertical -> "TB") 172 | (print_roots conf) l print_reprs l 173 | 174 | let to_file ?conf name l = 175 | let fd = Unix.openfile name [ Unix.O_CREAT; Unix.O_RDWR; Unix.O_EXCL ] 0o640 in 176 | let ch = Unix.out_channel_of_descr fd in 177 | let fmt = Format.formatter_of_out_channel ch in 178 | print_list ?conf fmt l 179 | -------------------------------------------------------------------------------- /src/core/dot.mli: -------------------------------------------------------------------------------- 1 | 2 | (** Dot output 3 | 4 | This module provides some helper to print the memory representation of 5 | ocaml values as graphviz graphs. *) 6 | 7 | (** {2 Settings} *) 8 | 9 | type config 10 | (** The [config] type gathers tweakable settings of the graphviz output. See the 11 | [config] function below for constructing values of type [config]. *) 12 | 13 | val config : 14 | ?external_node_color : string option -> 15 | ?block_node_color : string option -> 16 | ?root_node_color : string option -> 17 | ?outline_color : string -> 18 | ?background_color : string option -> 19 | ?direction : [`Vertical | `Horizontal] -> 20 | unit -> 21 | config 22 | (** Build a value of type [config], provided some of the following (all 23 | optional) settings. (For colors provided as a [string option], the [None] 24 | value corresponds to transparency.) 25 | 26 | - [external_node_color]: the fill color of nodes for out-of-heap pointers 27 | (default: [Some "grey"]); 28 | - [block_node_color]: the fill color of standard block nodes 29 | (default: [Some "lightblue"]); 30 | - [root_node_color]: the fill color of root notes 31 | (default: [Some "yellow"]); 32 | - [outline_color]: the color of the outlines of nodes, edges, and text 33 | (default: ["black"]); 34 | - [background_color]: the color of the background (default: [None]); 35 | - [direction]: whether to lay out successive nodes from top to bottow 36 | ([`Vertical]) or left to right ([`Horizontal]) (default: [`Vertical]). 37 | *) 38 | 39 | (** {2 Dot Printing functions} *) 40 | 41 | val print_list : ?conf:config -> Format.formatter -> (string * [`Direct] Repr.cell) list -> unit 42 | (** Print a list of reprs on the given formatter. *) 43 | 44 | val to_file : ?conf:config -> string -> (string * [`Direct] Repr.cell) list -> unit 45 | (** Print a list of reprs in the given file (the file must not exist and will be 46 | created by this function) *) 47 | -------------------------------------------------------------------------------- /src/core/dune: -------------------------------------------------------------------------------- 1 | 2 | (documentation 3 | (package memgraph) 4 | ) 5 | 6 | (library 7 | (name memgraph) 8 | (public_name memgraph) 9 | (libraries unix) 10 | (modules Repr Dot) 11 | ) 12 | 13 | -------------------------------------------------------------------------------- /src/core/index.mld: -------------------------------------------------------------------------------- 1 | {1 Memgraph} 2 | 3 | Memgraph is currently made up of two modules: {!Memgraph.Repr} and 4 | {!Memgraph.Dot}. {!Memgraph.Repr} allows one to inspect the memory 5 | representation of any ocaml value, while {!Memgraph.Dot} provides some 6 | convenience functions to export these representations as graphviz graphs. 7 | 8 | {!modules: 9 | Memgraph.Repr 10 | Memgraph.Dot 11 | } 12 | 13 | 14 | -------------------------------------------------------------------------------- /src/core/repr.ml: -------------------------------------------------------------------------------- 1 | 2 | (* This file is free software, part of memgraph. See file "LICENSE" for more information *) 3 | 4 | (* Inspecting ocaml values 5 | 6 | The implementation of this module should be safe, however it is 7 | very easy to make things become unsafe and crash or worse when 8 | using the {Obj} module, and particularly when reading fields 9 | like this module does (we're somewhat less unsafe because we 10 | only read info in this module, and do not modify anything, but 11 | still, it is delicate code). 12 | 13 | As far as I know, the current code should work across all versions 14 | of ocaml, whether it be native or bytecode. Note however that the 15 | closure representation differs from bytecode to native, so you 16 | may obtain different results depending on how you run this code. 17 | 18 | 19 | WARNING: if ever some more semantic information wanted to be 20 | extracted from ocaml values, great care must be taken 21 | to consider the changes that occurred in the 22 | representation of ocaml values accross ocaml versions. 23 | Note: such additions could be made to an additional 24 | module, rather than in this code, potentially by adding 25 | some hooks/unsafe functions in this module to allow an 26 | external module to add this information. 27 | 28 | As far as I know, these changes are: 29 | 30 | * No Naked pointers 31 | Introduced in preparation for multicore, and the only option starting 32 | from ocaml 5.0, no naked pointers does not change the representation 33 | of blocks, but restricts how we can read blocks if we do not want to 34 | produce segfaults at runtime. Particularly, code pointers cannot be 35 | read using `Obj.field` because that would result in a naked pointer. 36 | Instead, we have to read code pointers as raw_data/nativeints 37 | 38 | * Closure representation and env vars (PR#9619) 39 | Starting from ocaml 4.12, sets of closures now record 40 | the field number of the start of their environment 41 | using the same field used for arity. The arity field now goes from 42 | `arity (wordsize - 1 bit) . 1` 43 | to 44 | `arity (8 bits) . start-of-environment (wordsize - 9 bits) . 1` 45 | Note that the start_of_environment is the field number (reminder: 46 | field number start at 0), *relative* to the closure (and not the 47 | set of closures, nor the arity field itself, but the closure 48 | header (e.g. the code_ptr has offset 0, the arity field has 49 | offset 1 in that numerotation)). 50 | This means different things for the native and bytecode backends: 51 | - in native mode, the arity field simply changes 52 | - in bytecode, the arity field was not present, and is now added to 53 | the representation of all closures. 54 | Hence, if there ever was a change to add some kind of semantic info 55 | in order to extract the arity and start-of-env info from such fields, 56 | conditional compilation *MUST* be used to avoid crashing when using 57 | bytecode with ocaml < 4.12 58 | 59 | *) 60 | 61 | (** Type definitions *) 62 | 63 | type tag = int 64 | (* Ocaml tags *) 65 | 66 | type addr = int 67 | (* Abstract addresses, used for sharing *) 68 | 69 | type closinfo = { 70 | arity : int; 71 | start_of_env : int; 72 | } 73 | (* info stored in closure info fields of closures *) 74 | 75 | type block = { 76 | addr : addr; (* unique int to preserve sharing *) 77 | tag : tag; (* block tag *) 78 | data : data; (* block contents *) 79 | } 80 | 81 | and data = 82 | | Abstract 83 | | Block of [ `Block ] cell 84 | | Fields of [ `Inline ] cell array (**) 85 | 86 | and _ cell = 87 | | Int : int -> [< `Inline | `Direct ] cell (* Integers *) 88 | | Pointer : addr -> [< `Inline | `Direct ] cell (* Pointers to some block *) 89 | | External : Nativeint.t -> [< `Inline ] cell (* Out of heap pointer *) 90 | | String : string -> [< `Block ] cell (* String *) 91 | | Double : float -> [< `Block | `Inline ] cell (* A float *) 92 | | Infix : [ `Inline ] cell (* An infix header (used in closures) *) 93 | | Closinfo : closinfo -> [< `Inline ] cell 94 | 95 | type pblock = { 96 | block : block; (* The block being pointed at *) 97 | offset : int; (* The offset in the block (used in mutually rec closures) *) 98 | } 99 | (* This represents what is pointed at by a pointer. *) 100 | 101 | 102 | type env = { 103 | graph : (addr, pblock) Hashtbl.t; 104 | } 105 | (* Environment for keeping track of values we have already seen. 106 | It is a hashtabl from addresses to blocks. *) 107 | 108 | type assoc = (Obj.t * addr) list 109 | (* The type for local environments. These are used to keep track of the 110 | translated values, and accurately represent sharing. *) 111 | 112 | let env = { 113 | graph = Hashtbl.create 42; 114 | } 115 | (* The global environment used to keep track of the values we have 116 | translated. *) 117 | 118 | 119 | (** Follow a pointer, i.e. "dereference" it *) 120 | let follow b = 121 | Hashtbl.find env.graph b 122 | 123 | (** Function to iter over a block and all its descendants.. 124 | We use a hashtbl to ensure we don't loop on cyclic values *) 125 | let walk f init = 126 | let h = Hashtbl.create 42 in 127 | let s = Stack.create () in 128 | let () = Stack.push init.block.addr s in 129 | try 130 | while true do 131 | let x = Stack.pop s in 132 | if Hashtbl.mem h x then () 133 | else begin 134 | Hashtbl.add h x true; 135 | let b = follow x in 136 | let () = f b in 137 | match b.block.data with 138 | | Abstract | Block _ -> () 139 | | Fields a -> Array.iter ( 140 | function 141 | | Pointer addr -> 142 | if not (Hashtbl.mem h addr) then 143 | Stack.push addr s 144 | | _ -> () 145 | ) a 146 | end 147 | done 148 | with Stack.Empty -> () 149 | 150 | 151 | (** Creating new blocks. 152 | We use a ref to generate fresh addresses for blocks. *) 153 | let new_addr = 154 | let i = ref 0 in 155 | (fun () -> incr i; !i) 156 | 157 | let mk_block addr tag data = 158 | { addr; tag; data; } 159 | 160 | 161 | (** Converting Obj.t into blocks. 162 | Some important points: 163 | - we need to keep track of the values that we have already translated, 164 | in order to not loop on cyclic values, and to faithfully represent 165 | sharing. This is done using an association list. 166 | - Some tags must be singled out (see comments inside function). 167 | *) 168 | let rec mk_val assoc addr v = 169 | let tag = Obj.tag v in 170 | if tag = Obj.infix_tag then 171 | (* Infix closures are special pointers that actually 172 | point inside a big closure block, and 173 | their size is actually an offset rather than a number of blocks *) 174 | let offset = Obj.size v in 175 | (* Format.eprintf "Infix, offset: %d@." offset; *) 176 | (* offsets/addresses are in bytes, hence the word_size /8 mutliplication *) 177 | let super = Obj.add_offset v Int32.(neg (of_int (offset * Sys.word_size / 8))) in 178 | match mk_direct assoc super with 179 | | assoc', Pointer addr' -> 180 | let b = follow addr' in 181 | assert (b.offset = 0); 182 | (* set the infix block header in the super block *) 183 | begin match b.block.data with 184 | | Fields a -> a.(offset - 1) <- Infix 185 | | _ -> assert false 186 | end; 187 | Hashtbl.add env.graph addr { block = b.block; offset; }; 188 | (v, addr) :: assoc' 189 | | _, Int _ -> assert false 190 | else begin 191 | let data, assoc = 192 | if tag = Obj.double_tag then 193 | (* floats have a special tag *) 194 | let f : float = Obj.obj v in 195 | Block (Double f), assoc 196 | else if tag = Obj.string_tag then 197 | (* Strings store more than one char per word, so again, need to special case *) 198 | let s : string = Obj.obj v in 199 | Block (String s), assoc 200 | else if tag = Obj.double_array_tag then 201 | (* Float arrays must use special access functions *) 202 | let a = Array.init (Obj.size v) 203 | (fun i -> Double (Obj.double_field v i)) 204 | in 205 | Fields a, assoc 206 | else if tag = Obj.closure_tag then 207 | mk_closure v assoc 208 | else if tag < Obj.no_scan_tag then begin 209 | (* General case, we parse an array of fields. *) 210 | let tmp = ref assoc in 211 | (* Format.eprintf "block size (%d): %d@." tag (Obj.size v); *) 212 | let a = Array.init (Obj.size v) (fun i -> 213 | let assoc', v = mk_inline !tmp (Obj.field v i) in 214 | tmp := assoc'; 215 | v 216 | ) in 217 | Fields a, !tmp 218 | end else 219 | (* If we do not fit in the previous cases, the block's contents are unknown. *) 220 | Abstract, assoc 221 | in 222 | let block = mk_block addr tag data in 223 | Hashtbl.add env.graph addr { block; offset = 0; }; 224 | (v, addr) :: assoc 225 | end 226 | 227 | and mk_closure v assoc = 228 | match Sys.backend_type with 229 | | Native | Bytecode -> 230 | (* Out of heap pointers (such as code pointers), must be accessed using 231 | [raw_field], to avoid the Gc following them and segfault. *) 232 | let assoc, fields = mk_closure_fields assoc v (Obj.size v) 0 [] in 233 | Fields (Array.of_list (List.rev fields)), assoc 234 | | Other _ -> 235 | (* Don't attempt to inspect closures on other backends (e.g. js_of_ocaml) *) 236 | Abstract, assoc 237 | 238 | and mk_closinfo v offset = 239 | let field = Obj.field v offset in 240 | assert (Obj.is_int field); 241 | let i : int = Obj.obj field in 242 | let arity = i lsr (Sys.word_size - 9) in 243 | let start_of_env = (i lsl 8) lsr 8 in 244 | { arity; start_of_env; } 245 | 246 | and mk_closure_fields : 247 | assoc -> Obj.t -> int -> int -> [ `Inline ] cell list -> assoc * [ `Inline ] cell list 248 | = fun assoc t size offset acc -> 249 | if offset >= size then assoc, acc 250 | else begin 251 | let offset, acc = 252 | if offset > 0 then 253 | offset + 1, Infix :: acc 254 | else offset, acc 255 | in 256 | let curried_pointer = Obj.raw_field t offset in 257 | let closinfo = mk_closinfo t (offset + 1) in 258 | let acc = 259 | if closinfo.arity = 1 then 260 | Closinfo closinfo :: 261 | External curried_pointer :: 262 | acc 263 | else 264 | External (Obj.raw_field t (offset + 2)) :: 265 | Closinfo closinfo :: 266 | External curried_pointer :: 267 | acc 268 | in 269 | let next_offset = 270 | if closinfo.arity = 1 then offset + 2 else offset + 3 271 | in 272 | if (closinfo.arity = 1 && closinfo.start_of_env = 2) 273 | || (closinfo.arity > 1 && closinfo.start_of_env = 3) then 274 | mk_closure_env assoc t size next_offset acc 275 | else 276 | mk_closure_fields assoc t size next_offset acc 277 | end 278 | 279 | and mk_closure_env assoc t size offset acc = 280 | if offset >= size then assoc, acc 281 | else begin 282 | let assoc', v = mk_inline assoc (Obj.field t offset) in 283 | mk_closure_env assoc' t size (offset + 1) (v :: acc) 284 | end 285 | 286 | (** Wrapper for inline values. *) 287 | and mk_inline: assoc -> Obj.t -> assoc * [ `Inline ] cell 288 | = fun assoc t -> 289 | if Obj.is_int t then 290 | assoc, Int (Obj.obj t : int) 291 | else if Obj.tag t = Obj.out_of_heap_tag then 292 | let x : int = Obj.magic t in 293 | let y = Nativeint.(mul (of_int 2) (of_int x)) in 294 | assoc, External y 295 | else begin 296 | try 297 | assoc, Pointer (List.assq t assoc) 298 | with Not_found -> 299 | let addr = new_addr () in 300 | let assoc' = mk_val ((t, addr) :: assoc) addr t in 301 | assoc', Pointer addr 302 | end 303 | 304 | (** Wrapper for direct values *) 305 | and mk_direct: assoc -> Obj.t -> assoc * [ `Direct ] cell 306 | = fun assoc t -> 307 | if Obj.is_int t then 308 | assoc, Int (Obj.obj t : int) 309 | else begin 310 | try 311 | assoc, Pointer (List.assq t assoc) 312 | with Not_found -> 313 | let addr = new_addr () in 314 | let assoc' = mk_val ((t, addr) :: assoc) addr t in 315 | assoc', Pointer addr 316 | end 317 | 318 | (** Exported function to translate a single value. *) 319 | let repr x : [ `Direct ] cell = 320 | snd (mk_direct [] (Obj.repr x)) 321 | 322 | (** Exported function to translate mutliple values using the same context, 323 | in order to preserve the sharing of values across calls to "mk". *) 324 | type context = { mk : 'a. 'a -> [ `Direct ] cell } 325 | 326 | let context f = 327 | let assoc = ref [] in 328 | let context = { 329 | mk = function x -> 330 | let l, res = mk_direct !assoc (Obj.repr x) in 331 | assoc := l; 332 | res; 333 | } in 334 | f context 335 | 336 | 337 | -------------------------------------------------------------------------------- /src/core/repr.mli: -------------------------------------------------------------------------------- 1 | 2 | (** Representation of ocaml values 3 | 4 | This module aims at given a way to inspect the memory layout of ocaml 5 | values by providing some type to represent memory layouts, and some 6 | functions to convert arbitrary ocaml values into their explicit memory 7 | representation. 8 | *) 9 | 10 | (** {2 Type definitions} *) 11 | 12 | type tag = private int 13 | (** Ocaml tags *) 14 | 15 | type addr = private int 16 | (** Abstract addresses, used for sharing *) 17 | 18 | type closinfo = { 19 | arity : int; 20 | start_of_env : int; 21 | } 22 | (** Contents of the closure info field, stored for each closure in a 23 | set of closures. *) 24 | 25 | type block = private { 26 | addr : addr; (** unique int to preserve sharing *) 27 | tag : tag; (** Block tag *) 28 | data : data; (** Block contents *) 29 | } 30 | (** Represent OCaml blocks. 31 | - tag is the ocaml tag in the block header. 32 | - data is a high-level representation of the fields of the block. 33 | - addr is additional information used to keep track of sharing between values. 34 | *) 35 | 36 | and data = 37 | | Abstract 38 | | Block of [ `Block ] cell 39 | | Fields of [ `Inline ] cell array (**) 40 | (** To have a high-level representation of a block's fields, 41 | we distinguish three cases: 42 | - some block are abstract and thus their contents cannot be inspected 43 | - the block contain a single big value (typically a string and/or a float) 44 | - the block contains an array of values. *) 45 | 46 | and _ cell = 47 | | Int : int -> [< `Inline | `Direct ] cell (** Integers *) 48 | | Pointer : addr -> [< `Inline | `Direct ] cell (** Pointers to some block *) 49 | | External : Nativeint.t -> [< `Inline ] cell (** Out of heap pointer *) 50 | | String : string -> [< `Block ] cell (** String *) 51 | | Double : float -> [< `Block | `Inline ] cell (** A float *) 52 | | Infix : [ `Inline ] cell (** An infix header (used in closures) *) 53 | | Closinfo : closinfo -> [< `Inline ] cell (** Closure info field *) 54 | (** The actual type of memory cells containing concrete values. 55 | There are actually three type of cells: 56 | - [`Direct] cells are values that can be found in ocaml variables 57 | - [`Inline] cells are values that can be found in a block's field array 58 | - [`Block] cells are "big" values that take a whole block 59 | 60 | Obviously, some constructors can build more than one type of cells. 61 | *) 62 | 63 | type pblock = private { 64 | block : block; (** The block being pointed at *) 65 | offset : int; (** The offset in the block (used in mutually rec closures) *) 66 | } 67 | (** This represents what is pointed at by a pointer. This is useful considering that 68 | an ocaml value can point at a closure within a set of closures, and thus point 69 | in the middle of an ocaml value (since there is an infix header, the value being 70 | pointed to is also an ocaml value, but things are easier to represent this way). *) 71 | 72 | 73 | 74 | (** {2 Manipulating values} *) 75 | 76 | val follow : addr -> pblock 77 | (** Follow a pointer. *) 78 | 79 | val walk : (pblock -> unit) -> pblock -> unit 80 | (** Apply the given function to a block, and all the blocks it points to 81 | (recursively). Each block is visited exactly once (the order is left 82 | unspecified though). *) 83 | 84 | 85 | (** {2 Creating values} *) 86 | 87 | val repr : 'a -> [ `Direct ] cell 88 | (** Get the representation of a direct ocaml value. *) 89 | 90 | type context = { mk : 'a. 'a -> [ `Direct ] cell } 91 | (** A type containing a function to create cells. *) 92 | 93 | val context : (context -> 'a) -> 'a 94 | (** Allow to use the same context for creating values, i.e. 95 | all values created with [context.mk] will correctly 96 | identify shared values between translated values. *) 97 | 98 | -------------------------------------------------------------------------------- /src/kitty/FiraSans-Medium.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Gbury/ocaml-memgraph/4aa70f421a2aedc7b4de25b57ba1713a236c53e3/src/kitty/FiraSans-Medium.ttf -------------------------------------------------------------------------------- /src/kitty/dune: -------------------------------------------------------------------------------- 1 | (documentation 2 | (package memgraph_kitty) 3 | ) 4 | 5 | (library 6 | (name memgraph_kitty) 7 | (public_name memgraph_kitty) 8 | (libraries memgraph kittyimg nanosvg nanosvg_text stb_truetype) 9 | (preprocess (pps ppx_blob)) 10 | (preprocessor_deps FiraSans-Medium.ttf) 11 | ) 12 | -------------------------------------------------------------------------------- /src/kitty/memgraph_kitty.ml: -------------------------------------------------------------------------------- 1 | (* This file is free software, part of memgraph. See file "LICENSE" for more information *) 2 | 3 | let font_blob = 4 | [%blob "FiraSans-Medium.ttf"] 5 | 6 | let font = 7 | let font_buf = 8 | Bigarray.Array1.create Bigarray.int8_unsigned Bigarray.c_layout 9 | (String.length font_blob) 10 | in 11 | String.iteri (fun i c -> font_buf.{i} <- Char.code c) font_blob; 12 | let offsets = Stb_truetype.enum font_buf in 13 | Stb_truetype.init font_buf (List.hd offsets) |> Option.get 14 | 15 | type config = { 16 | scale : float; 17 | dot : Memgraph.Dot.config; 18 | } 19 | 20 | let config 21 | ?(scale = 1.1) 22 | ?(external_node_color = Some "darkslategray") 23 | ?(block_node_color = None) 24 | ?(root_node_color = None) 25 | ?(outline_color = "white") 26 | ?(background_color = None) 27 | ?(direction = `Horizontal) 28 | () 29 | = 30 | { scale = scale; 31 | dot = 32 | Memgraph.Dot.config 33 | ~external_node_color ~block_node_color ~root_node_color 34 | ~outline_color ~background_color ~direction (); } 35 | 36 | let conf = ref (config ()) 37 | 38 | let configure 39 | ?scale ?external_node_color ?block_node_color ?root_node_color 40 | ?outline_color ?background_color ?direction () 41 | = 42 | conf := 43 | config ?scale ?external_node_color ?block_node_color ?root_node_color 44 | ?outline_color ?background_color ?direction () 45 | 46 | let read_svg svgfile = 47 | match Nanosvg.parse_from_file ~units:Px svgfile with 48 | | Some img -> Ok img 49 | | None -> Error "Could not open or parse svg file" 50 | 51 | let pp reprs = 52 | let dotfile, dotout = Filename.open_temp_file "memgraph_kitty" ".dot" in 53 | let svgfile = Filename.temp_file "memgraph_kitty" ".svg" in 54 | Memgraph.Dot.print_list ~conf:!conf.dot (Format.formatter_of_out_channel dotout) reprs; 55 | let _ = Sys.command (Printf.sprintf "dot -Tsvg -o%s %s" svgfile dotfile) in 56 | begin match read_svg svgfile with 57 | | Ok svg -> 58 | let w = int_of_float (Nanosvg.Image_data.width svg *. !conf.scale) in 59 | let h = int_of_float (Nanosvg.Image_data.height svg *. !conf.scale) in 60 | let buf = Bigarray.Array1.create Bigarray.Int8_unsigned Bigarray.C_layout (w * h * 4) in 61 | Bigarray.Array1.fill buf 0; 62 | let rast = Nanosvg.Rasterizer.create () in 63 | Nanosvg.rasterize rast svg ~tx:0. ~ty:0. ~scale:!conf.scale ~dst:buf ~w ~h (); 64 | let svg_data = Nanosvg.lift svg in 65 | Nanosvg_text.rasterize_text svg_data ~get_font:(fun ~family:_ -> font) 66 | ~dst:buf ~scale:!conf.scale ~tx:0. ~ty:0. ~w ~h (); 67 | Kittyimg.send_image ~w ~h ~format:`RGBA (Kittyimg.string_of_bytes_ba buf); 68 | print_newline () 69 | | Error msg -> 70 | Printf.eprintf "%s\n" msg 71 | end; 72 | Sys.remove dotfile; 73 | Sys.remove svgfile 74 | 75 | let show vals = 76 | Memgraph.Repr.context (fun ctx -> 77 | let reprs = List.map (fun (name, v) -> (name, ctx.mk v)) vals in 78 | pp reprs 79 | ) 80 | 81 | module Poly = struct 82 | type elist = 83 | | [] : elist 84 | | (::) : ((string * 'a) * elist) -> elist 85 | 86 | let show vals = 87 | Memgraph.Repr.context (fun ctx -> 88 | let rec reprs_of : elist -> (string * [`Direct] Memgraph.Repr.cell) list = function 89 | | [] -> [] 90 | | (s, v) :: xs -> (s, ctx.mk v) :: reprs_of xs 91 | in 92 | pp (reprs_of vals) 93 | ) 94 | end 95 | -------------------------------------------------------------------------------- /src/kitty/memgraph_kitty.mli: -------------------------------------------------------------------------------- 1 | (** Display values graphically in the Kitty terminal emulator. 2 | 3 | This module provides functions to display the memory representation of OCaml 4 | values as {i images} in the terminal, by using the {{: 5 | https://sw.kovidgoyal.net/kitty/graphics-protocol}terminal graphics 6 | protocol} of the Kitty terminal emulator. The functions below thus assume 7 | that the program is running in Kitty (or any terminal emulator implementing 8 | the terminal graphics protocol). They can be called either from the toplevel 9 | loop or a compiled OCaml program. 10 | 11 | Usage: 12 | 13 | [show l] displays the memory representation of a list of values of the same 14 | type, labeled by names. 15 | 16 | Example: 17 | {[ 18 | let l = [1; 2; 3] in 19 | let l' = 0 :: l in 20 | Memgraph_kitty.show ["l", l; "l'", l'] 21 | ]} 22 | 23 | 24 | [Poly.show] is similar to [show] but can be used to display the 25 | representation of values of different OCaml types. 26 | 27 | Example (note the redefinition of the list syntax in [Poly] to implement 28 | heterogeneous lists): 29 | {[ 30 | let l = [1; 2] in 31 | let p = (l, 0 :: l) in 32 | Memgraph_kitty.Poly.(show ["l", l; "p", p]) 33 | ]} 34 | *) 35 | 36 | (** Display the memory representation of a list of labeled values *) 37 | val show : (string * 'a) list -> unit 38 | 39 | module Poly : sig 40 | type elist = 41 | | [] : elist 42 | | (::) : ((string * 'a) * elist) -> elist 43 | 44 | (** Display the memory representation of a list of labeled values, which can 45 | be of different OCaml types. *) 46 | val show : elist -> unit 47 | end 48 | 49 | (** Set display settings *) 50 | val configure : 51 | ?scale : float -> 52 | ?external_node_color : string option -> 53 | ?block_node_color : string option -> 54 | ?root_node_color : string option -> 55 | ?outline_color : string -> 56 | ?background_color : string option -> 57 | ?direction : [`Vertical | `Horizontal] -> 58 | unit -> 59 | unit 60 | --------------------------------------------------------------------------------