Merge branch 'dev' of https://gitlab.com/ligolang/ligo into doc-failwith

.gitignore

@@ -3,6 +3,8 @@
 *.merlin
 cache/*
 Version.ml
+/result
+/result-*
 /_opam/
 /*.pp.ligo
 /*.pp.mligo

gitlab-pages/docs/demo/ligo-snippet.md

@@ -0,0 +1,170 @@
+---
+id: ligo-snippets-demo
+title: Ligo-Snippets Demo
+---
+
+import Tabs from '@theme/Tabs';
+import TabItem from '@theme/TabItem';
+
+“ligo-snippets” (https://www.npmjs.com/package/@ligolang/ligo-snippets) is a React component that can be included on any webpage to display Ligo source code to users. 
+
+The user will see Ligo code with syntax highlighting, and an action button allowing the user to open the source code in the Ligo Web IDE (https://ide.ligolang.org).
+
+Each code snippet can have preset Ligo Web IDE configurations (e.g. entrypoint, parameters or storage). These configurations are optional and will be passed onto the Ligo Web IDE when present. This will allow examples to provide the proper configurations for the reader to experiment with. 
+
+The “ligo-snippets” React component uses the CodeJar editor (https://github.com/antonmedv/codejar), which is extremely lightweight (only 2kB).  It currently supports syntax highlighting for PascaLigo, CameLigo and ReasonLigo. Additionally, it has both a light and dark theme mode. 
+
+
+
+<Tabs
+  defaultValue="pascaligo"
+  values={[
+    { label: 'PascaLIGO', value: 'pascaligo', },
+    { label: 'CameLIGO', value: 'cameligo', },
+    { label: 'ReasonLIGO', value: 'reasonligo', },
+  ]
+}>
+<TabItem value="pascaligo">
+
+```pascaligo {"name": "Ligo Introduction Example", "editor": true}
+(*_*
+  name: PascaLIGO Contract
+  language: pascaligo
+  compile:
+    entrypoint: main
+  dryRun:
+    entrypoint: main
+    parameters: Increment (1)
+    storage: 999
+  deploy:
+    entrypoint: main
+    storage: 999
+  evaluateValue:
+    entrypoint: ""
+  evaluateFunction:
+    entrypoint: add
+    parameters: (5, 6)
+  generateDeployScript:
+    entrypoint: main
+    storage: 999
+*_*)
+// variant defining pseudo multi-entrypoint actions
+type action is
+| Increment of int
+| Decrement of int
+
+function add (const a : int ; const b : int) : int is
+  block { skip } with a + b
+
+function subtract (const a : int ; const b : int) : int is
+  block { skip } with a - b
+
+// real entrypoint that re-routes the flow based
+// on the action provided
+function main (const p : action ; const s : int) :
+  (list(operation) * int) is
+  block { skip } with ((nil : list(operation)),
+  case p of
+  | Increment(n) -> add(s, n)
+  | Decrement(n) -> subtract(s, n)
+  end)
+
+```
+
+</TabItem>
+<TabItem value="cameligo">
+
+```cameligo {"name": "Ligo Introduction Example", "editor": true}
+(*_*
+  name: CameLIGO Contract
+  language: cameligo
+  compile:
+    entrypoint: main
+  dryRun:
+    entrypoint: main
+    parameters: Increment 1
+    storage: 999
+  deploy:
+    entrypoint: main
+    storage: 999
+  evaluateValue:
+    entrypoint: ""
+  evaluateFunction:
+    entrypoint: add
+    parameters: 5, 6
+  generateDeployScript:
+    entrypoint: main
+    storage: 999
+*_*)
+type storage = int
+
+(* variant defining pseudo multi-entrypoint actions *)
+
+type action =
+| Increment of int
+| Decrement of int
+
+let add (a,b: int * int) : int = a + b
+let sub (a,b: int * int) : int = a - b
+
+(* real entrypoint that re-routes the flow based on the action provided *)
+
+let main (p,s: action * storage) =
+ let storage =
+   match p with
+   | Increment n -> add (s, n)
+   | Decrement n -> sub (s, n)
+ in ([] : operation list), storage
+
+```
+
+</TabItem>
+<TabItem value="reasonligo">
+
+```reasonligo {"name": "Ligo Introduction Example", "editor": true}
+(*_*
+  name: ReasonLIGO Contract
+  language: reasonligo
+  compile:
+    entrypoint: main
+  dryRun:
+    entrypoint: main
+    parameters: Increment (1)
+    storage: 999
+  deploy:
+    entrypoint: main
+    storage: 999
+  evaluateValue:
+    entrypoint: ""
+  evaluateFunction:
+    entrypoint: add
+    parameters: (5, 6)
+  generateDeployScript:
+    entrypoint: main
+    storage: 999
+*_*)
+type storage = int;
+
+/* variant defining pseudo multi-entrypoint actions */
+
+type action =
+  | Increment(int)
+  | Decrement(int);
+
+let add = ((a,b): (int, int)): int => a + b;
+let sub = ((a,b): (int, int)): int => a - b;
+
+/* real entrypoint that re-routes the flow based on the action provided */
+
+let main = ((p,storage): (action, storage)) => {
+  let storage =
+    switch (p) {
+    | Increment(n) => add((storage, n))
+    | Decrement(n) => sub((storage, n))
+    };
+  ([]: list(operation), storage);
+};
+
+```
+</TabItem>
+</Tabs>

gitlab-pages/docs/reference/bitwise.md

@@ -9,17 +9,42 @@ import Syntax from '@theme/Syntax';
 import SyntaxTitle from '@theme/SyntaxTitle';
 
 <SyntaxTitle syntax="pascaligo">
-function and : nat -> nat -> nat
+function and : 'a -> nat -> nat
 </SyntaxTitle>
 <SyntaxTitle syntax="cameligo">
-val and :  nat -> nat -> nat
+val and : 'a -> nat -> nat
 </SyntaxTitle>
 <SyntaxTitle syntax="reasonligo">
-let and: (nat, nat) => nat
+let and: ('a, nat) => nat
 </SyntaxTitle>
 
+`'a` can either be an `int` or `nat`.
+
 A bitwise `and` operation.
 
+<Syntax syntax="pascaligo">
+
+```pascaligo
+const zero: nat = Bitwise.and(2n, 1n)
+```
+
+</Syntax>
+<Syntax syntax="cameligo">
+
+```cameligo
+let zero: nat = Bitwise.and 2n 1n
+```
+
+</Syntax>
+<Syntax syntax="reasonligo">
+
+```reasonligo
+let zero: nat = Bitwise.and(2n, 1n);
+```
+
+</Syntax>
+
+
 <SyntaxTitle syntax="pascaligo">
 function or : nat -> nat -> nat
 </SyntaxTitle>
@@ -32,6 +57,28 @@ let or: (nat, nat) => nat
 
 A bitwise `or` operation.
 
+<Syntax syntax="pascaligo">
+
+```pascaligo
+const three: nat = Bitwise.or(2n, 1n)
+```
+
+</Syntax>
+<Syntax syntax="cameligo">
+
+```cameligo
+let three: nat = Bitwise.or 2n 1n
+```
+
+</Syntax>
+<Syntax syntax="reasonligo">
+
+```reasonligo
+let three: nat = Bitwise.or(2n, 1n);
+```
+
+</Syntax>
+
 <SyntaxTitle syntax="pascaligo">
 function xor : nat -> nat -> nat
 </SyntaxTitle>
@@ -44,6 +91,28 @@ let xor: (nat, nat) => nat
 
 A bitwise `xor` operation.
 
+<Syntax syntax="pascaligo">
+
+```pascaligo
+const three: nat = Bitwise.xor(2n, 1n)
+```
+
+</Syntax>
+<Syntax syntax="cameligo">
+
+```cameligo
+let three: nat = Bitwise.xor 2n 1n
+```
+
+</Syntax>
+<Syntax syntax="reasonligo">
+
+```reasonligo
+let three: nat = Bitwise.xor(2n, 1n);
+```
+
+</Syntax>
+
 <SyntaxTitle syntax="pascaligo">
 function shift_left : nat -> nat -> nat
 </SyntaxTitle>
@@ -56,6 +125,28 @@ let shift_left: (nat, nat) => nat
 
 A bitwise shift left operation.
 
+<Syntax syntax="pascaligo">
+
+```pascaligo
+const four: nat = Bitwise.shift_left(2n, 1n)
+```
+
+</Syntax>
+<Syntax syntax="cameligo">
+
+```cameligo
+let four: nat = Bitwise.shift_left 2n 1n
+```
+
+</Syntax>
+<Syntax syntax="reasonligo">
+
+```reasonligo
+let four: nat = Bitwise.shift_left(2n, 1n);
+```
+
+</Syntax>
+
 <SyntaxTitle syntax="pascaligo">
 function shift_right : nat -> nat -> nat
 </SyntaxTitle>
@@ -67,3 +158,25 @@ let shift_right: (nat, nat) => nat
 </SyntaxTitle>
 
 A bitwise shift right operation.
+
+<Syntax syntax="pascaligo">
+
+```pascaligo
+const one: nat = Bitwise.shift_right(2n, 1n)
+```
+
+</Syntax>
+<Syntax syntax="cameligo">
+
+```cameligo
+let one: nat = Bitwise.shift_right 2n 1n
+```
+
+</Syntax>
+<Syntax syntax="reasonligo">
+
+```reasonligo
+let one: nat = Bitwise.shift_right(2n, 1n);
+```
+
+</Syntax>

gitlab-pages/website/package-lock.json

@@ -1535,6 +1535,20 @@
     "@ligo/syntax": {
       "version": "file:src/@ligo/syntax"
     },
+    "@ligolang/ligo-snippets": {
+      "version": "1.0.1",
+      "resolved": "https://registry.npmjs.org/@ligolang/ligo-snippets/-/ligo-snippets-1.0.1.tgz",
+      "integrity": "sha512-JJa69veCkdwOS+u7iUngRNHFlXBJ+3Wx5l+EfrQyhBXMGzH4Ii4onZPxghDQEiL6RzqRbhCIsOE+A8OX7NCYMA==",
+      "requires": {
+        "@types/prismjs": "^1.16.1",
+        "axios": "^0.19.2",
+        "ligo-snippets-css": "0.0.1",
+        "prism-react-renderer": "^1.1.1",
+        "prismjs": "^1.20.0",
+        "react-codejar": "^1.0.1",
+        "yaml": "^1.9.2"
+      }
+    },
     "@mdx-js/mdx": {
       "version": "1.6.5",
       "resolved": "https://registry.npmjs.org/@mdx-js/mdx/-/mdx-1.6.5.tgz",
@@ -1621,6 +1635,11 @@
       "integrity": "sha512-ljr9hGQYW3kZY1NmQbmSe4yXvgq3KDRt0FMBOB5OaDWqi4X2WzEsp6SZ02KmVrieNW1cjWlj13pgvcf0towZPw==",
       "dev": true
     },
+    "@medv/codejar": {
+      "version": "1.0.9",
+      "resolved": "https://registry.npmjs.org/@medv/codejar/-/codejar-1.0.9.tgz",
+      "integrity": "sha512-TxcSsq+TFcCvbsTDbVT5h4y9g86yBpEk+Da6tyIyd2OTJKWK0o7U5Olva4XMG4i+ExW5A9MfZAGFClwYokacIQ=="
+    },
     "@mrmlnc/readdir-enhanced": {
       "version": "2.2.1",
       "resolved": "https://registry.npmjs.org/@mrmlnc/readdir-enhanced/-/readdir-enhanced-2.2.1.tgz",
@@ -1859,6 +1878,11 @@
       "integrity": "sha512-//oorEZjL6sbPcKUaCdIGlIUeH26mgzimjBB77G6XRgnDl/L5wOnpyBGRe/Mmf5CVW3PwEBE1NjiMZ/ssFh4wA==",
       "dev": true
     },
+    "@types/prismjs": {
+      "version": "1.16.1",
+      "resolved": "https://registry.npmjs.org/@types/prismjs/-/prismjs-1.16.1.tgz",
+      "integrity": "sha512-RNgcK3FEc1GpeOkamGDq42EYkb6yZW5OWQwTS56NJIB8WL0QGISQglA7En7NUx9RGP8AC52DOe+squqbAckXlA=="
+    },
     "@types/q": {
       "version": "1.5.4",
       "resolved": "https://registry.npmjs.org/@types/q/-/q-1.5.4.tgz",
@@ -2516,6 +2540,37 @@
       "integrity": "sha512-3YDiu347mtVtjpyV3u5kVqQLP242c06zwDOgpeRnybmXlYYsLbtTrUBUm8i8srONt+FWobl5aibnU1030PeeuA==",
       "dev": true
     },
+    "axios": {
+      "version": "0.19.2",
+      "resolved": "https://registry.npmjs.org/axios/-/axios-0.19.2.tgz",
+      "integrity": "sha512-fjgm5MvRHLhx+osE2xoekY70AhARk3a6hkN+3Io1jc00jtquGvxYlKlsFUhmUET0V5te6CcZI7lcv2Ym61mjHA==",
+      "requires": {
+        "follow-redirects": "1.5.10"
+      },
+      "dependencies": {
+        "debug": {
+          "version": "3.1.0",
+          "resolved": "https://registry.npmjs.org/debug/-/debug-3.1.0.tgz",
+          "integrity": "sha512-OX8XqP7/1a9cqkxYw2yXss15f26NKWBpDXQd0/uK/KPqdQhxbPa994hnzjcE2VqQpDslf55723cKPUOGSmMY3g==",
+          "requires": {
+            "ms": "2.0.0"
+          }
+        },
+        "follow-redirects": {
+          "version": "1.5.10",
+          "resolved": "https://registry.npmjs.org/follow-redirects/-/follow-redirects-1.5.10.tgz",
+          "integrity": "sha512-0V5l4Cizzvqt5D44aTXbFZz+FtyXV1vrDN6qrelxtfYQKW0KO0W2T/hkE8xvGa/540LkZlkaUjO4ailYTFtHVQ==",
+          "requires": {
+            "debug": "=3.1.0"
+          }
+        },
+        "ms": {
+          "version": "2.0.0",
+          "resolved": "https://registry.npmjs.org/ms/-/ms-2.0.0.tgz",
+          "integrity": "sha1-VgiurfwAvmwpAd9fmGF4jeDVl8g="
+        }
+      }
+    },
     "babel-code-frame": {
       "version": "6.26.0",
       "resolved": "https://registry.npmjs.org/babel-code-frame/-/babel-code-frame-6.26.0.tgz",
@@ -3418,7 +3473,6 @@
       "version": "2.0.6",
       "resolved": "https://registry.npmjs.org/clipboard/-/clipboard-2.0.6.tgz",
       "integrity": "sha512-g5zbiixBRk/wyKakSwCKd7vQXDjFnAMGHoEyBogG/bw9kTD9GvdAvaoRR1ALcEzt3pVKxZR0pViekPMIS0QyGg==",
-      "dev": true,
       "requires": {
         "good-listener": "^1.2.2",
         "select": "^1.1.2",
@@ -4419,8 +4473,7 @@
     "delegate": {
       "version": "3.2.0",
       "resolved": "https://registry.npmjs.org/delegate/-/delegate-3.2.0.tgz",
-      "integrity": "sha512-IofjkYBZaZivn0V8nnsMJGBr4jVLxHDheKSW88PyxS5QC4Vo9ZbZVvhzlSxY87fVq3STR6r+4cGepyHkcWOQSw==",
+      "integrity": "sha512-IofjkYBZaZivn0V8nnsMJGBr4jVLxHDheKSW88PyxS5QC4Vo9ZbZVvhzlSxY87fVq3STR6r+4cGepyHkcWOQSw=="
-      "dev": true
     },
     "depd": {
       "version": "1.1.2",
@@ -5961,7 +6014,6 @@
       "version": "1.2.2",
       "resolved": "https://registry.npmjs.org/good-listener/-/good-listener-1.2.2.tgz",
       "integrity": "sha1-1TswzfkxPf+33JoNR3CWqm0UXFA=",
-      "dev": true,
       "requires": {
         "delegate": "^3.1.2"
       }
@@ -7367,6 +7419,11 @@
         "leven": "^3.1.0"
       }
     },
+    "ligo-snippets-css": {
+      "version": "0.0.1",
+      "resolved": "https://registry.npmjs.org/ligo-snippets-css/-/ligo-snippets-css-0.0.1.tgz",
+      "integrity": "sha512-8qZ3TO198MX03HJw5YzTe5am63hacUtYzZEt2DlLtLP22Iri2UvLnckVXisZEVt0w18kM6aDhtMarAz127/z4g=="
+    },
     "lines-and-columns": {
       "version": "1.1.6",
       "resolved": "https://registry.npmjs.org/lines-and-columns/-/lines-and-columns-1.1.6.tgz",
@@ -10042,14 +10099,12 @@
     "prism-react-renderer": {
       "version": "1.1.1",
       "resolved": "https://registry.npmjs.org/prism-react-renderer/-/prism-react-renderer-1.1.1.tgz",
-      "integrity": "sha512-MgMhSdHuHymNRqD6KM3eGS0PNqgK9q4QF5P0yoQQvpB6jNjeSAi3jcSAz0Sua/t9fa4xDOMar9HJbLa08gl9ug==",
+      "integrity": "sha512-MgMhSdHuHymNRqD6KM3eGS0PNqgK9q4QF5P0yoQQvpB6jNjeSAi3jcSAz0Sua/t9fa4xDOMar9HJbLa08gl9ug=="
-      "dev": true
     },
     "prismjs": {
       "version": "1.20.0",
       "resolved": "https://registry.npmjs.org/prismjs/-/prismjs-1.20.0.tgz",
       "integrity": "sha512-AEDjSrVNkynnw6A+B1DsFkd6AVdTnp+/WoUixFRULlCLZVRZlVQMVWio/16jv7G1FscUxQxOQhWwApgbnxr6kQ==",
-      "dev": true,
       "requires": {
         "clipboard": "^2.0.0"
       }
@@ -10267,6 +10322,14 @@
         "prop-types": "^15.6.2"
       }
     },
+    "react-codejar": {
+      "version": "1.0.1",
+      "resolved": "https://registry.npmjs.org/react-codejar/-/react-codejar-1.0.1.tgz",
+      "integrity": "sha512-t58v/YF4qV8w1yHi8Ylkte5tOU5ziYd5/4EIyyuJ6g/rS73ccaV113HhQBwvtoofSKTqOdKv3Rc4K5iMZ10IGg==",
+      "requires": {
+        "@medv/codejar": "^1.0.0"
+      }
+    },
     "react-dev-utils": {
       "version": "10.2.1",
       "resolved": "https://registry.npmjs.org/react-dev-utils/-/react-dev-utils-10.2.1.tgz",
@@ -11452,8 +11515,7 @@
     "select": {
       "version": "1.1.2",
       "resolved": "https://registry.npmjs.org/select/-/select-1.1.2.tgz",
-      "integrity": "sha1-DnNQrN7ICxEIUoeG7B1EGNEbOW0=",
+      "integrity": "sha1-DnNQrN7ICxEIUoeG7B1EGNEbOW0="
-      "dev": true
     },
     "select-hose": {
       "version": "2.0.0",
@@ -12678,8 +12740,7 @@
     "tiny-emitter": {
       "version": "2.1.0",
       "resolved": "https://registry.npmjs.org/tiny-emitter/-/tiny-emitter-2.1.0.tgz",
-      "integrity": "sha512-NB6Dk1A9xgQPMoGqC5CVXn123gWyte215ONT5Pp5a0yt4nlEoO1ZWeCwpncaekPHXO60i47ihFnZPiRPjRMq4Q==",
+      "integrity": "sha512-NB6Dk1A9xgQPMoGqC5CVXn123gWyte215ONT5Pp5a0yt4nlEoO1ZWeCwpncaekPHXO60i47ihFnZPiRPjRMq4Q=="
-      "dev": true
     },
     "tiny-invariant": {
       "version": "1.1.0",
@@ -14516,8 +14577,7 @@
     "yaml": {
       "version": "1.10.0",
       "resolved": "https://registry.npmjs.org/yaml/-/yaml-1.10.0.tgz",
-      "integrity": "sha512-yr2icI4glYaNG+KWONODapy2/jDdMSDnrONSjblABjD9B4Z5LgiircSt8m8sRZFNi08kG9Sm0uSHtEmP3zaEGg==",
+      "integrity": "sha512-yr2icI4glYaNG+KWONODapy2/jDdMSDnrONSjblABjD9B4Z5LgiircSt8m8sRZFNi08kG9Sm0uSHtEmP3zaEGg=="
-      "dev": true
     },
     "yargs": {
       "version": "13.3.2",

gitlab-pages/website/package.json

@@ -29,6 +29,10 @@
   },
   "dependencies": {
     "@docusaurus/plugin-sitemap": "^2.0.0-alpha.56",
-    "@ligo/syntax": "file:src/@ligo/syntax"
+    "@ligo/syntax": "file:src/@ligo/syntax",
+    "@ligolang/ligo-snippets": "^1.0.1",
+    "axios": "^0.19.2",
+    "react-codejar": "^1.0.1",
+    "yaml": "^1.10.0"
   }
 }

gitlab-pages/website/src/theme/CodeBlock/index.js

@@ -81,11 +81,13 @@ Prism.languages = {
     ]
   }
 };
+
 import defaultTheme from 'prism-react-renderer/themes/palenight';
 import Clipboard from 'clipboard';
 import rangeParser from 'parse-numeric-range';
 import useDocusaurusContext from '@docusaurus/useDocusaurusContext';
 import useThemeContext from '@theme/hooks/useThemeContext';
+import { LigoSnippet } from '@ligolang/ligo-snippets'
 
 import styles from './styles.module.css';
 
@@ -159,7 +161,8 @@ const highlightDirectiveRegex = (lang) => {
 };
 const codeBlockTitleRegex = /title=".*"/;
 
-export default ({children, className: languageClassName, metastring}) => {
+export default ({ children, className: languageClassName, metastring }) => {
+
   const {
     siteConfig: {
       themeConfig: {prism = {}},
@@ -277,6 +280,34 @@ export default ({children, className: languageClassName, metastring}) => {
     setTimeout(() => setShowCopied(false), 2000);
   };
 
+  // ligo-snippets - begin
+  if (metastring) {
+    const theme = isDarkTheme ? 'dark' : 'light';
+    let isObject = true
+    let metadata
+
+    try {
+      metadata = JSON.parse(metastring)
+    } catch (e) {
+      isObject = false
+    }
+
+    if (isObject) {
+      const snippetData = {
+        "language": language,
+        "name": metadata.name,
+        "code": children,
+        "theme": theme,
+        "height": "" // Optional 
+      }
+
+      if (metadata.editor) {
+        return <LigoSnippet data={snippetData} />
+      }
+    }
+  }
+  // ligo-snippets - end
+
   return (
     <Highlight
       {...defaultProps}

gitlab-pages/website/static/css/custom.css

@@ -242,6 +242,10 @@ p {
   border-top: none;
 }
 
+.tabs .tabs__item {
+  outline: 0;
+}
+
 .tabs .nav-tabs > div {
   font-size: 1em;
   font-weight: normal;

nix/ocaml-overlay.nix

@@ -9,11 +9,12 @@ let
   inherit (import sources."gitignore.nix" { inherit (self) lib; })
     gitignoreSource;
   # Remove list of directories or files from source (to stop unneeded rebuilds)
+  # Also, apply the gitignore here.
   filterOut = xs:
-    self.lib.cleanSourceWith {
+    gitignoreSource (self.lib.cleanSourceWith {
       filter = p: type: !(builtins.elem (builtins.baseNameOf p) xs);
       src = gitignoreSource ../.;
-    };
+    });
 in {
   ocamlPackages = self.ocaml-ng.ocamlPackages_4_07.overrideScope'
     (builtins.foldl' self.lib.composeExtensions (_: _: { }) [

src/bin/cli.ml

@@ -159,10 +159,22 @@ let preprocess =
   let doc = "Subcommand: Preprocess the source file.\nWarning: Intended for development of LIGO and can break at any time." in
   (Term.ret term, Term.info ~doc cmdname)
 
+let pretty_print =
+  let f source_file syntax display_format = (
+    toplevel ~display_format @@
+      let%bind pp =
+        Compile.Of_source.pretty_print source_file (Syntax_name syntax) in
+      ok @@ Buffer.contents pp
+  ) in
+  let term = Term.(const f $ source_file 0 $ syntax $ display_format) in
+  let cmdname = "pretty-print" in
+  let doc = "Subcommand: Pretty-print the source file."
+  in (Term.ret term, Term.info ~doc cmdname)
+
 let print_cst =
   let f source_file syntax display_format = (
     toplevel ~display_format @@
-    let%bind pp = Compile.Of_source.pretty_print source_file (Syntax_name syntax) in
+    let%bind pp = Compile.Of_source.pretty_print_cst source_file (Syntax_name syntax) in
     ok @@ Format.asprintf "%s \n" (Buffer.contents pp)
   )
   in
@@ -489,5 +501,6 @@ let run ?argv () =
     print_ast_typed ;
     print_mini_c ;
     list_declarations ;
-    preprocess
+    preprocess;
+    pretty_print
   ]

src/bin/expect_tests/help_tests.ml

@@ -57,6 +57,9 @@ let%expect_test _ =
                Subcommand: Preprocess the source file. Warning: Intended for
                development of LIGO and can break at any time.
 
+           pretty-print
+               Subcommand: Pretty-print the source file.
+
            print-ast
                Subcommand: Print the AST. Warning: Intended for development of
                LIGO and can break at any time.
@@ -148,6 +151,9 @@ let%expect_test _ =
                Subcommand: Preprocess the source file. Warning: Intended for
                development of LIGO and can break at any time.
 
+           pretty-print
+               Subcommand: Pretty-print the source file.
+
            print-ast
                Subcommand: Print the AST. Warning: Intended for development of
                LIGO and can break at any time.

src/bin/expect_tests/literals.ml

@@ -7,7 +7,7 @@ let%expect_test _ =
 let%expect_test _ =
   run_ligo_bad ["interpret" ; "(\"thisisnotasignature\":signature)" ; "--syntax=pascaligo"] ;
   [%expect {|
-    ligo: in file "", line 0, characters 1-32. Badly formatted literal: Signature thisisnotasignature {"location":"in file \"\", line 0, characters 1-32"}
+    ligo: in file "", line 0, characters 0-33. Badly formatted literal: Signature thisisnotasignature {"location":"in file \"\", line 0, characters 0-33"}
 
 
      If you're not sure how to fix this error, you can
@@ -25,7 +25,7 @@ let%expect_test _ =
 let%expect_test _ =
   run_ligo_bad ["interpret" ; "(\"thisisnotapublickey\":key)" ; "--syntax=pascaligo"] ;
   [%expect {|
-    ligo: in file "", line 0, characters 1-26. Badly formatted literal: key thisisnotapublickey {"location":"in file \"\", line 0, characters 1-26"}
+    ligo: in file "", line 0, characters 0-27. Badly formatted literal: key thisisnotapublickey {"location":"in file \"\", line 0, characters 0-27"}
 
 
      If you're not sure how to fix this error, you can

src/main/compile/helpers.ml

@@ -129,7 +129,7 @@ let parsify_string syntax source =
   let%bind applied = Self_ast_imperative.all_program parsified
   in ok applied
 
-let pretty_print_pascaligo source =
+let pretty_print_pascaligo_cst source =
   let%bind ast = Parser.Pascaligo.parse_file source in
   let buffer = Buffer.create 59 in
   let state =
@@ -137,10 +137,10 @@ let pretty_print_pascaligo source =
       ~offsets:true
       ~mode:`Byte
       ~buffer in
-  Parser_pascaligo.ParserLog.pp_ast state ast;
+  Parser_pascaligo.ParserLog.pp_cst state ast;
   ok buffer
 
-let pretty_print_cameligo source =
+let pretty_print_cameligo_cst source =
   let%bind ast = Parser.Cameligo.parse_file source in
   let buffer = Buffer.create 59 in
   let state = (* TODO: Should flow from the CLI *)
@@ -148,10 +148,10 @@ let pretty_print_cameligo source =
       ~offsets:true
       ~mode:`Point
       ~buffer in
-  Parser_cameligo.ParserLog.pp_ast state ast;
+  Parser_cameligo.ParserLog.pp_cst state ast;
   ok buffer
 
-let pretty_print_reasonligo source =
+let pretty_print_reasonligo_cst source =
   let%bind ast = Parser.Reasonligo.parse_file source in
   let buffer = Buffer.create 59 in
   let state = (* TODO: Should flow from the CLI *)
@@ -159,16 +159,16 @@ let pretty_print_reasonligo source =
       ~offsets:true
       ~mode:`Point
       ~buffer in
-  Parser_cameligo.ParserLog.pp_ast state ast;
+  Parser_cameligo.ParserLog.pp_cst state ast;
   ok buffer
 
-let pretty_print syntax source =
+let pretty_print_cst syntax source =
   let%bind v_syntax =
     syntax_to_variant syntax (Some source) in
   match v_syntax with
-    PascaLIGO  -> pretty_print_pascaligo  source
+    PascaLIGO  -> pretty_print_pascaligo_cst  source
-  | CameLIGO   -> pretty_print_cameligo   source
+  | CameLIGO   -> pretty_print_cameligo_cst   source
-  | ReasonLIGO -> pretty_print_reasonligo source
+  | ReasonLIGO -> pretty_print_reasonligo_cst source
 
 let preprocess_pascaligo = Parser.Pascaligo.preprocess
 
@@ -183,3 +183,44 @@ let preprocess syntax source =
     PascaLIGO  -> preprocess_pascaligo  source
   | CameLIGO   -> preprocess_cameligo   source
   | ReasonLIGO -> preprocess_reasonligo source
+
+let pretty_print_pascaligo source =
+  let%bind ast = Parser.Pascaligo.parse_file source in
+  let doc    = Parser_pascaligo.Pretty.print ast in
+  let buffer = Buffer.create 131 in
+  let width  =
+    match Terminal_size.get_columns () with
+      None -> 60
+    | Some c -> c in
+  let () = PPrint.ToBuffer.pretty 1.0 width buffer doc
+  in Trace.ok buffer
+
+let pretty_print_cameligo source =
+  let%bind ast = Parser.Cameligo.parse_file source in
+  let doc    = Parser_cameligo.Pretty.print ast in
+  let buffer = Buffer.create 131 in
+  let width  =
+    match Terminal_size.get_columns () with
+      None -> 60
+    | Some c -> c in
+  let () = PPrint.ToBuffer.pretty 1.0 width buffer doc
+  in Trace.ok buffer
+
+let pretty_print_reasonligo source =
+  let%bind ast = Parser.Reasonligo.parse_file source in
+  let doc    = Parser_reasonligo.Pretty.print ast in
+  let buffer = Buffer.create 131 in
+  let width  =
+    match Terminal_size.get_columns () with
+      None -> 60
+    | Some c -> c in
+  let () = PPrint.ToBuffer.pretty 1.0 width buffer doc
+  in Trace.ok buffer
+
+let pretty_print syntax source =
+  let%bind v_syntax =
+    syntax_to_variant syntax (Some source) in
+  match v_syntax with
+    PascaLIGO  -> pretty_print_pascaligo  source
+  | CameLIGO   -> pretty_print_cameligo   source
+  | ReasonLIGO -> pretty_print_reasonligo source

src/main/compile/of_source.ml

@@ -19,8 +19,11 @@ let compile_contract_input : string -> string -> v_syntax -> Ast_imperative.expr
   let%bind (storage,parameter) = bind_map_pair (compile_expression syntax) (storage,parameter) in
   ok @@ Ast_imperative.e_pair storage parameter
 
-let pretty_print source_filename syntax =
+let pretty_print_cst source_filename syntax =
-  Helpers.pretty_print syntax source_filename
+  Helpers.pretty_print_cst syntax source_filename
 
 let preprocess source_filename syntax =
   Helpers.preprocess syntax source_filename
+
+let pretty_print source_filename syntax =
+  Helpers.pretty_print syntax source_filename

src/passes/01-parser/cameligo.ml

@@ -5,6 +5,7 @@ module Scoping  = Parser_cameligo.Scoping
 module Region   = Simple_utils.Region
 module ParErr   = Parser_cameligo.ParErr
 module SSet     = Set.Make (String)
+module Pretty   = Parser_cameligo.Pretty
 
 (* Mock IOs TODO: Fill them with CLI options *)
 
@@ -19,7 +20,8 @@ module SubIO =
       ext     : string;   (* ".mligo" *)
       mode    : [`Byte | `Point];
       cmd     : EvalOpt.command;
-      mono    : bool
+      mono    : bool;
+      pretty  : bool
     >
 
     let options : options =
@@ -34,6 +36,7 @@ module SubIO =
            method mode    = `Point
            method cmd     = EvalOpt.Quiet
            method mono    = false
+           method pretty  = false
          end
 
     let make =
@@ -46,6 +49,7 @@ module SubIO =
                    ~mode:options#mode
                    ~cmd:options#cmd
                    ~mono:options#mono
+                   ~pretty:options#mono
   end
 
 module Parser =
@@ -146,3 +150,18 @@ let parse_expression source = apply (fun () -> Unit.expr_in_string source)
 (* Preprocessing a contract in a file *)
 
 let preprocess source = apply (fun () -> Unit.preprocess source)
+
+(* Pretty-print a file (after parsing it). *)
+
+let pretty_print source =
+  match parse_file source with
+    Stdlib.Error _ as e -> e
+  | Ok ast ->
+      let doc    = Pretty.print (fst ast) in
+      let buffer = Buffer.create 131 in
+      let width  =
+        match Terminal_size.get_columns () with
+          None -> 60
+        | Some c -> c in
+      let () = PPrint.ToBuffer.pretty 1.0 width buffer doc
+      in Trace.ok buffer

src/passes/01-parser/cameligo.mli

@@ -19,3 +19,6 @@ val parse_expression : string -> AST.expr Trace.result
 
 (** Preprocess a given CameLIGO file and preprocess it. *)
 val preprocess : string -> Buffer.t Trace.result
+
+(** Pretty-print a given CameLIGO file (after parsing it). *)
+val pretty_print : string -> Buffer.t Trace.result

src/passes/01-parser/cameligo/.links

@@ -19,5 +19,3 @@ $HOME/git/OCaml-build/Makefile
 ../shared/LexerUnit.ml
 ../shared/ParserUnit.mli
 ../shared/ParserUnit.ml
-
-$HOME/git/ligo/_build/default/src/passes/1-parser/cameligo/ParErr.ml

src/passes/01-parser/cameligo/AST.ml

@@ -137,11 +137,14 @@ and ast = t
 and attributes = attribute list
 
 and declaration =
-  Let      of (kwd_let * kwd_rec option * let_binding * attributes) reg
+  Let      of let_decl
 | TypeDecl of type_decl reg
 
 (* Non-recursive values *)
 
+and let_decl =
+  (kwd_let * kwd_rec option * let_binding * attributes) reg
+
 and let_binding = {
   binders  : pattern nseq;
   lhs_type : (colon * type_expr) option;
@@ -225,7 +228,7 @@ and field_pattern = {
 and expr =
   ECase   of expr case reg
 | ECond   of cond_expr reg
-| EAnnot  of (expr * colon * type_expr) par reg
+| EAnnot  of annot_expr par reg
 | ELogic  of logic_expr
 | EArith  of arith_expr
 | EString of string_expr
@@ -244,6 +247,8 @@ and expr =
 | EFun    of fun_expr reg
 | ESeq    of expr injection reg
 
+and annot_expr = expr * colon * type_expr
+
 and 'a injection = {
   compound   : compound;
   elements   : ('a, semi) sepseq;
@@ -336,18 +341,19 @@ and field_assign = {
 }
 
 and update = {
-  lbrace : lbrace;
+  lbrace   : lbrace;
-  record : path;
+  record   : path;
   kwd_with : kwd_with;
-  updates : field_path_assign reg ne_injection reg;
+  updates  : field_path_assignment reg ne_injection reg;
-  rbrace : rbrace;
+  rbrace   : rbrace
 }
 
-and field_path_assign = {
+and field_path_assignment = {
-  field_path  : (field_name, dot) nsepseq;
+  field_path : path;
   assignment : equal;
   field_expr : expr
 }
+
 and path =
   Name of variable
 | Path of projection reg

src/passes/01-parser/cameligo/LexToken.mll

@@ -431,21 +431,20 @@ type nat_err =
 | Non_canonical_zero_nat
 
 let mk_nat lexeme region =
-  match (String.index_opt lexeme 'n') with
+  match String.index_opt lexeme 'n' with
       None -> Error Invalid_natural
   | Some _ -> let z =
-               Str.(global_replace (regexp "_") "" lexeme) |>
+                Str.(global_replace (regexp "_") "" lexeme) |>
-                 Str.(global_replace (regexp "n") "") |>
+                  Str.(global_replace (regexp "n") "") |>
-                 Z.of_string in
+                  Z.of_string in
              if   Z.equal z Z.zero && lexeme <> "0n"
              then Error Non_canonical_zero_nat
              else Ok (Nat Region.{region; value = lexeme,z})
 
 let mk_mutez lexeme region =
-  let z =
+  let z = Str.(global_replace (regexp "_") "" lexeme) |>
-    Str.(global_replace (regexp "_") "" lexeme) |>
+            Str.(global_replace (regexp "mutez") "") |>
-    Str.(global_replace (regexp "mutez") "") |>
+            Z.of_string in
-    Z.of_string in
   if   Z.equal z Z.zero && lexeme <> "0mutez"
   then Error Non_canonical_zero
   else Ok (Mutez Region.{region; value = lexeme, z})

src/passes/01-parser/cameligo/Parser.mly

@@ -86,7 +86,7 @@ nsepseq(item,sep):
 (* Non-empty comma-separated values (at least two values) *)
 
 tuple(item):
-  item "," nsepseq(item,",") { let h,t = $3 in $1,($2,h)::t }
+  item "," nsepseq(item,",") { let h,t = $3 in $1, ($2,h)::t }
 
 (* Possibly empty semicolon-separated values between brackets *)
 
@@ -236,10 +236,7 @@ type_annotation:
 irrefutable:
   sub_irrefutable { $1 }
 | tuple(sub_irrefutable) {
-    let hd, tl = $1 in
+    let region = nsepseq_to_region pattern_to_region $1
-    let start  = pattern_to_region hd in
-    let stop   = last fst tl in
-    let region = cover start stop
     in PTuple {region; value=$1} }
 
 sub_irrefutable:
@@ -276,9 +273,7 @@ pattern:
     PList (PCons {region; value=$1,$2,$3})
   }
 | tuple(sub_pattern) {
-    let start  = pattern_to_region (fst $1) in
+    let region = nsepseq_to_region pattern_to_region $1
-    let stop   = last fst (snd $1) in
-    let region = cover start stop
     in PTuple {region; value=$1} }
 
 sub_pattern:
@@ -333,10 +328,7 @@ constr_pattern:
 
 ptuple:
   tuple(tail) {
-    let hd, tl = $1 in
+    let region = nsepseq_to_region pattern_to_region $1
-    let start  = pattern_to_region hd in
-    let stop   = last fst tl in
-    let region = cover start stop
     in PTuple {region; value=$1} }
 
 unit:
@@ -372,9 +364,7 @@ base_expr(right_expr):
 
 tuple_expr:
   tuple(disj_expr_level) {
-    let start  = expr_to_region (fst $1) in
+    let region = nsepseq_to_region expr_to_region $1
-    let stop   = last fst (snd $1) in
-    let region = cover start stop
     in ETuple {region; value=$1} }
 
 conditional(right_expr):
@@ -534,8 +524,7 @@ mult_expr_level:
 | unary_expr_level                                 {               $1 }
 
 unary_expr_level:
-  call_expr_level { $1 }
+  "-" call_expr_level {
-| "-" call_expr_level {
     let start = $1 in
     let stop = expr_to_region $2 in
     let region = cover start stop
@@ -547,7 +536,9 @@ unary_expr_level:
     let stop = expr_to_region $2 in
     let region = cover start stop
     and value  = {op=$1; arg=$2} in
-    ELogic (BoolExpr (Not ({region; value}))) }
+    ELogic (BoolExpr (Not ({region; value})))
+  }
+| call_expr_level { $1 }
 
 call_expr_level:
   call_expr | constr_expr | core_expr { $1 }
@@ -593,7 +584,10 @@ core_expr:
 | record_expr                         {                    ERecord $1 }
 | update_record                       {                    EUpdate $1 }
 | par(expr)                           {                       EPar $1 }
-| par(expr ":" type_expr {$1,$2,$3})  {                     EAnnot $1 }
+| par(annot_expr)                     {                     EAnnot $1 }
+
+annot_expr:
+  expr ":" type_expr { $1,$2,$3 }
 
 module_field:
   module_name "." module_fun {
@@ -602,7 +596,7 @@ module_field:
 
 module_fun:
   field_name { $1 }
-| "or"       { {value="or";  region=$1} }
+| "or"       { {value="or"; region=$1} }
 
 projection:
   struct_name "." nsepseq(selection,".") {
@@ -642,7 +636,7 @@ update_record:
       lbrace   = $1;
       record   = $2;
       kwd_with = $3;
-      updates  = {value = {compound = Braces($1,$5);
+      updates  = {value = {compound = Braces (ghost, ghost);
                            ne_elements;
                            terminator};
                   region = cover $3 $5};
@@ -650,20 +644,15 @@ update_record:
     in {region; value} }
 
 field_path_assignment :
-  nsepseq(field_name,".") "=" expr {
+  path "=" expr {
-    let start  = nsepseq_to_region (fun x -> x.region) $1 in
+    let region = cover (path_to_region $1) (expr_to_region $3)
-    let region = cover start (expr_to_region $3) in
+    and value  = {field_path=$1; assignment=$2; field_expr=$3}
-    let value  = {field_path = $1;
+    in {region; value} }
-                  assignment = $2;
-                  field_expr = $3}
-    in {region; value}}
 
 field_assignment:
   field_name "=" expr {
-    let start  = $1.region in
+    let region = cover $1.region (expr_to_region $3)
-    let stop   = expr_to_region $3 in
+    and value  = {field_name = $1;
-    let region = cover start stop in
-    let value  = {field_name = $1;
                   assignment = $2;
                   field_expr = $3}
     in {region; value} }

src/passes/01-parser/cameligo/ParserLog.ml

@@ -136,11 +136,10 @@ let rec print_tokens state {decl;eof} =
   print_token state eof "EOF"
 
 and print_attributes state attributes =
-  List.iter (
+  let apply {value = attribute; region} =
-    fun ({value = attribute; region}) ->
+    let attribute_formatted = sprintf "[@@%s]" attribute in
-      let attribute_formatted = sprintf "[@@%s]" attribute in
+    print_token state region attribute_formatted
-      print_token state region attribute_formatted
+  in List.iter apply attributes
-   ) attributes
 
 and print_statement state = function
   Let {value=kwd_let, kwd_rec, let_binding, attributes; _} ->
@@ -527,7 +526,7 @@ and print_field_assign state {value; _} =
 
 and print_field_path_assign state {value; _} =
   let {field_path; assignment; field_expr} = value in
-  print_nsepseq state "." print_var field_path;
+  print_path  state field_path;
   print_token state assignment "=";
   print_expr  state field_expr
 
@@ -616,12 +615,20 @@ let pp_node state name =
   let node = sprintf "%s%s\n" state#pad_path name
   in Buffer.add_string state#buffer node
 
-let pp_string state = pp_ident state
+let pp_string state {value=name; region} =
+  let reg  = compact state region in
+  let node = sprintf "%s%S (%s)\n" state#pad_path name reg
+  in Buffer.add_string state#buffer node
+
+let pp_verbatim state {value=name; region} =
+  let reg  = compact state region in
+  let node = sprintf "%s{|%s|} (%s)\n" state#pad_path name reg
+  in Buffer.add_string state#buffer node
 
 let pp_loc_node state name region =
   pp_ident state {value=name; region}
 
-let rec pp_ast state {decl; _} =
+let rec pp_cst state {decl; _} =
   let apply len rank =
     pp_declaration (state#pad len rank) in
   let decls = Utils.nseq_to_list decl in
@@ -704,7 +711,7 @@ and pp_pattern state = function
     pp_string (state#pad 1 0) s
 | PVerbatim v ->
     pp_node   state "PVerbatim";
-    pp_string (state#pad 1 0) v
+    pp_verbatim (state#pad 1 0) v
 | PUnit {region; _} ->
     pp_loc_node state "PUnit" region
 | PFalse region ->
@@ -938,7 +945,7 @@ and pp_projection state proj =
   List.iteri (apply len) selections
 
 and pp_update state update =
-  pp_path state update.record;
+  pp_path (state#pad 2 0) update.record;
   pp_ne_injection pp_field_path_assign state update.updates.value
 
 and pp_path state = function
@@ -963,10 +970,10 @@ and pp_field_assign state {value; _} =
   pp_expr  (state#pad 2 1) value.field_expr
 
 and pp_field_path_assign state {value; _} =
-  pp_node  state "<field path for update>";
+  let {field_path; field_expr; _} = value in
-  let path = Utils.nsepseq_to_list value.field_path in
+  pp_node state "<update>";
-  List.iter (pp_ident (state#pad 2 0)) path;
+  pp_path (state#pad 2 0) field_path;
-  pp_expr  (state#pad 2 1) value.field_expr
+  pp_expr (state#pad 2 1) field_expr
 
 and pp_constr_expr state = function
   ENone region ->
@@ -987,11 +994,11 @@ and pp_constr_app_expr state (constr, expr_opt) =
 
 and pp_list_expr state = function
   ECons {value; region} ->
-    pp_loc_node state "Cons" region;
+    pp_loc_node state "ECons" region;
     pp_expr (state#pad 2 0) value.arg1;
     pp_expr (state#pad 2 1) value.arg2
 | EListComp {value; region} ->
-    pp_loc_node state "List" region;
+    pp_loc_node state "EListComp" region;
     if   value.elements = None
     then pp_node (state#pad 1 0) "<nil>"
     else pp_injection pp_expr state value
@@ -1134,13 +1141,13 @@ and pp_type_expr state = function
       pp_type_expr (state#pad len rank) in
     let domain, _, range = value in
     List.iteri (apply 2) [domain; range]
- | TPar {value={inside;_}; region} ->
+| TPar {value={inside;_}; region} ->
     pp_loc_node  state "TPar" region;
     pp_type_expr (state#pad 1 0) inside
- | TVar v ->
+| TVar v ->
     pp_node  state "TVar";
     pp_ident (state#pad 1 0) v
- | TString s ->
+| TString s ->
     pp_node   state "TString";
     pp_string (state#pad 1 0) s
 

src/passes/01-parser/cameligo/ParserLog.mli

@@ -27,5 +27,5 @@ val expr_to_string :
 
 (** {1 Pretty-printing of AST nodes} *)
 
-val pp_ast  : state -> AST.t -> unit
+val pp_cst  : state -> AST.t -> unit
 val pp_expr : state -> AST.expr -> unit

src/passes/01-parser/cameligo/ParserMain.ml

@@ -22,7 +22,8 @@ module SubIO =
       ext     : string;
       mode    : [`Byte | `Point];
       cmd     : EvalOpt.command;
-      mono    : bool
+      mono    : bool;
+      pretty  : bool
     >
 
     let options : options =
@@ -36,6 +37,7 @@ module SubIO =
         method mode    = IO.options#mode
         method cmd     = IO.options#cmd
         method mono    = IO.options#mono
+        method pretty  = IO.options#pretty
       end
 
     let make =
@@ -48,6 +50,7 @@ module SubIO =
                    ~mode:options#mode
                    ~cmd:options#cmd
                    ~mono:options#mono
+                   ~pretty:options#pretty
   end
 
 module Parser =
@@ -67,14 +70,28 @@ module ParserLog =
 module Lexer = Lexer.Make (LexToken)
 
 module Unit =
-  ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog)(SubIO)
+  ParserUnit.Make (Lexer)(AST)(Parser)(Parser_msg)(ParserLog)(SubIO)
 
 (* Main *)
 
 let wrap = function
-  Stdlib.Ok _ -> flush_all ()
+  Stdlib.Ok ast ->
+    if IO.options#pretty then
+      begin
+        let doc = Pretty.print ast in
+        let width =
+          match Terminal_size.get_columns () with
+            None -> 60
+          | Some c -> c in
+        PPrint.ToChannel.pretty 1.0 width stdout doc;
+        print_newline ()
+      end;
+    flush_all ()
 | Error msg ->
-    (flush_all (); Printf.eprintf "\027[31m%s\027[0m%!" msg.Region.value)
+    begin
+      flush_all ();
+      Printf.eprintf "\027[31m%s\027[0m%!" msg.Region.value
+    end
 
 let () =
   match IO.options#input with

src/passes/01-parser/cameligo/Pretty.ml

@@ -0,0 +1,442 @@
+[@@@warning "-42"]
+
+open AST
+module Region = Simple_utils.Region
+open! Region
+open! PPrint
+
+let pp_par printer {value; _} =
+  string "(" ^^ nest 1 (printer value.inside ^^ string ")")
+
+let rec print ast =
+  let app decl = group (pp_declaration decl) in
+  let decl = Utils.nseq_to_list ast.decl in
+  separate_map (hardline ^^ hardline) app decl
+
+and pp_declaration = function
+  Let decl -> pp_let_decl decl
+| TypeDecl decl -> pp_type_decl decl
+
+and pp_let_decl {value; _} =
+  let _, rec_opt, binding, attr = value in
+  let let_str =
+    match rec_opt with
+        None -> "let "
+    | Some _ -> "let rec " in
+  let binding = pp_let_binding binding
+  and attr    = pp_attributes attr
+  in string let_str ^^ binding ^^ attr
+
+and pp_attributes = function
+    [] -> empty
+| attr ->
+    let make s = string "[@@" ^^ string s.value ^^ string "]" in
+    group (nest 2 (break 1 ^^ separate_map (break 0) make attr))
+
+and pp_ident {value; _} = string value
+
+and pp_string s = string "\"" ^^ pp_ident s ^^ string "\""
+
+and pp_verbatim s = string "{|" ^^ pp_ident s ^^ string "|}"
+
+and pp_let_binding (binding : let_binding) =
+  let {binders; lhs_type; let_rhs; _} = binding in
+  let head, tail = binders in
+  let patterns =
+    group (nest 2 (separate_map (break 1) pp_pattern (head::tail))) in
+  let lhs =
+    patterns ^^
+    match lhs_type with
+            None -> empty
+    | Some (_,e) -> group (break 1 ^^ string ": " ^^ pp_type_expr e)
+  in prefix 2 1 (lhs ^^ string " =") (pp_expr let_rhs)
+
+and pp_pattern = function
+  PConstr p -> pp_pconstr p
+| PUnit   _ -> string "()"
+| PFalse  _ -> string "false"
+| PTrue   _ -> string "true"
+| PVar    v -> pp_ident v
+| PInt    i -> pp_int i
+| PNat    n -> pp_nat n
+| PBytes  b -> pp_bytes b
+| PString s -> pp_string s
+| PVerbatim s -> pp_verbatim s
+| PWild   _ -> string "_"
+| PList   l -> pp_plist l
+| PTuple  t -> pp_ptuple t
+| PPar    p -> pp_ppar p
+| PRecord r -> pp_precord r
+| PTyped  t -> pp_ptyped t
+
+and pp_pconstr = function
+  PNone      _ -> string "None"
+| PSomeApp   p -> pp_patt_some p
+| PConstrApp a -> pp_pconstr_app a
+
+and pp_pconstr_app {value; _} =
+  match value with
+    constr, None -> pp_ident constr
+  | constr, Some pat ->
+      prefix 4 1 (pp_ident constr) (pp_pattern pat)
+
+and pp_patt_some {value; _} =
+  prefix 4 1 (string "Some") (pp_pattern (snd value))
+
+and pp_int {value; _} =
+  string (Z.to_string (snd value))
+
+and pp_nat {value; _} =
+  string (Z.to_string (snd value) ^ "n")
+
+and pp_bytes {value; _} =
+  string ("0x" ^ Hex.show (snd value))
+
+and pp_ppar p = pp_par pp_pattern p
+
+and pp_plist = function
+  PListComp cmp -> pp_list_comp cmp
+| PCons cons -> pp_pcons cons
+
+and pp_list_comp e = group (pp_injection pp_pattern e)
+
+and pp_pcons {value; _} =
+  let patt1, _, patt2 = value in
+  prefix 2 1 (pp_pattern patt1 ^^ string " ::") (pp_pattern patt2)
+
+and pp_ptuple {value; _} =
+  let head, tail = value in
+  let rec app = function
+    []  -> empty
+  | [p] -> group (break 1 ^^ pp_pattern p)
+  | p::items ->
+      group (break 1 ^^ pp_pattern p ^^ string ",") ^^ app items
+  in if tail = []
+     then pp_pattern head
+     else pp_pattern head ^^ string "," ^^ app (List.map snd tail)
+
+and pp_precord fields = pp_ne_injection pp_field_pattern fields
+
+and pp_field_pattern {value; _} =
+  let {field_name; pattern; _} = value in
+  prefix 2 1 (pp_ident field_name ^^ string " =") (pp_pattern pattern)
+
+and pp_ptyped {value; _} =
+  let {pattern; type_expr; _} = value in
+  group (pp_pattern pattern ^^ string " :" ^/^ pp_type_expr type_expr)
+
+and pp_type_decl decl =
+  let {name; type_expr; _} = decl.value in
+  let padding = match type_expr with TSum _ -> 0 | _ -> 2 in
+  string "type " ^^ string name.value ^^ string " ="
+  ^^ group (nest padding (break 1 ^^ pp_type_expr type_expr))
+
+and pp_expr = function
+  ECase   e -> pp_case_expr e
+| ECond   e -> group (pp_cond_expr e)
+| EAnnot  e -> pp_annot_expr e
+| ELogic  e -> group (pp_logic_expr e)
+| EArith  e -> group (pp_arith_expr e)
+| EString e -> pp_string_expr e
+| EList   e -> group (pp_list_expr e)
+| EConstr e -> pp_constr_expr e
+| ERecord e -> pp_record_expr e
+| EProj   e -> pp_projection e
+| EUpdate e -> pp_update e
+| EVar    v -> pp_ident v
+| ECall   e -> pp_call_expr e
+| EBytes  e -> pp_bytes e
+| EUnit   _ -> string "()"
+| ETuple  e -> pp_tuple_expr e
+| EPar    e -> pp_par_expr e
+| ELetIn  e -> pp_let_in e
+| EFun    e -> pp_fun e
+| ESeq    e -> pp_seq e
+
+and pp_case_expr {value; _} =
+  let {expr; cases; _} = value in
+  group (string "match " ^^ nest 6 (pp_expr expr) ^/^ string "with")
+  ^^ hardline ^^ pp_cases cases
+
+and pp_cases {value; _} =
+  let head, tail = value in
+  let head       = pp_clause head in
+  let head       = if tail = [] then head else blank 2 ^^ head in
+  let rest       = List.map snd tail in
+  let app clause = break 1 ^^ string "| " ^^ pp_clause clause
+  in  head ^^ concat_map app rest
+
+and pp_clause {value; _} =
+  let {pattern; rhs; _} = value in
+    pp_pattern pattern ^^ prefix 4 1 (string " ->") (pp_expr rhs)
+
+and pp_cond_expr {value; _} =
+  let {test; ifso; kwd_else; ifnot; _} = value in
+  let test = string "if " ^^ group (nest 3 (pp_expr test))
+  and ifso = string "then" ^^ group (nest 2 (break 1 ^^ pp_expr ifso))
+  and ifnot = string "else" ^^ group (nest 2 (break 1 ^^ pp_expr ifnot))
+  in if   kwd_else#is_ghost
+     then test ^/^ ifso
+     else test ^/^ ifso ^/^ ifnot
+
+and pp_annot_expr {value; _} =
+  let expr, _, type_expr = value.inside in
+    group (string "(" ^^ nest 1 (pp_expr expr ^/^ string ": "
+    ^^ pp_type_expr type_expr ^^ string ")"))
+
+and pp_logic_expr = function
+  BoolExpr e -> pp_bool_expr e
+| CompExpr e -> pp_comp_expr e
+
+and pp_bool_expr = function
+  Or   e  -> pp_bin_op "||" e
+| And  e  -> pp_bin_op "&&" e
+| Not  e  -> pp_un_op "not" e
+| True  _ -> string "true"
+| False _ -> string "false"
+
+and pp_bin_op op {value; _} =
+  let {arg1; arg2; _} = value
+  and length = String.length op + 1 in
+  pp_expr arg1 ^/^ string (op ^ " ") ^^ nest length (pp_expr arg2)
+
+and pp_un_op op {value; _} =
+  string (op ^ " ") ^^ pp_expr value.arg
+
+and pp_comp_expr = function
+  Lt    e -> pp_bin_op "<"  e
+| Leq   e -> pp_bin_op "<=" e
+| Gt    e -> pp_bin_op ">"  e
+| Geq   e -> pp_bin_op ">=" e
+| Equal e -> pp_bin_op "="  e
+| Neq   e -> pp_bin_op "<>" e
+
+and pp_arith_expr = function
+  Add   e -> pp_bin_op "+" e
+| Sub   e -> pp_bin_op "-" e
+| Mult  e -> pp_bin_op "*" e
+| Div   e -> pp_bin_op "/" e
+| Mod   e -> pp_bin_op "mod" e
+| Neg   e -> string "-" ^^ pp_expr e.value.arg
+| Int   e -> pp_int e
+| Nat   e -> pp_nat e
+| Mutez e -> pp_mutez e
+
+and pp_mutez {value; _} =
+  Z.to_string (snd value) ^ "mutez" |> string
+
+and pp_string_expr = function
+     Cat e -> pp_bin_op "^" e
+| String e -> pp_string e
+| Verbatim e -> pp_verbatim e
+
+and pp_list_expr = function
+      ECons e -> pp_bin_op "::" e
+| EListComp e -> group (pp_injection pp_expr e)
+
+and pp_injection :
+  'a.('a -> document) -> 'a injection reg -> document =
+  fun printer {value; _} ->
+    let {compound; elements; _} = value in
+    let sep = string ";" ^^ break 1 in
+    let elements = Utils.sepseq_to_list elements in
+    let elements = separate_map sep printer elements in
+    match pp_compound compound with
+      None -> elements
+    | Some (opening, closing) ->
+        string opening ^^ nest 1 elements ^^ string closing
+
+and pp_compound = function
+  BeginEnd (start, _) ->
+    if start#is_ghost then None else Some ("begin","end")
+| Braces (start, _) ->
+    if start#is_ghost then None else Some ("{","}")
+| Brackets (start, _) ->
+    if start#is_ghost then None else Some ("[","]")
+
+and pp_constr_expr = function
+  ENone      _ -> string "None"
+| ESomeApp   a -> pp_some a
+| EConstrApp a -> pp_constr_app a
+
+and pp_some {value=_, e; _} =
+  prefix 4 1 (string "Some") (pp_expr e)
+
+and pp_constr_app {value; _} =
+  let constr, arg = value in
+  let constr = string constr.value in
+  match arg with
+      None -> constr
+  | Some e -> prefix 2 1 constr (pp_expr e)
+
+and pp_record_expr ne_inj = group (pp_ne_injection pp_field_assign ne_inj)
+
+and pp_field_assign {value; _} =
+  let {field_name; field_expr; _} = value in
+  prefix 2 1 (pp_ident field_name ^^ string " =") (pp_expr field_expr)
+
+and pp_ne_injection :
+  'a.('a -> document) -> 'a ne_injection reg -> document =
+  fun printer {value; _} ->
+    let {compound; ne_elements; _} = value in
+    let elements = pp_nsepseq ";" printer ne_elements in
+    match pp_compound compound with
+      None -> elements
+    | Some (opening, closing) ->
+        string opening ^^ nest 1 elements ^^ string closing
+
+and pp_nsepseq :
+  'a.string -> ('a -> document) -> ('a, t) Utils.nsepseq -> document =
+  fun sep printer elements ->
+    let elems = Utils.nsepseq_to_list elements
+    and sep   = string sep ^^ break 1
+    in separate_map sep printer elems
+
+and pp_nseq : 'a.('a -> document) -> 'a Utils.nseq -> document =
+  fun printer (head, tail) -> separate_map (break 1) printer (head::tail)
+
+and pp_projection {value; _} =
+  let {struct_name; field_path; _} = value in
+  let fields = Utils.nsepseq_to_list field_path
+  and sep    = string "." ^^ break 0 in
+  let fields = separate_map sep pp_selection fields in
+  group (pp_ident struct_name ^^ string "." ^^ break 0 ^^ fields)
+
+and pp_selection = function
+  FieldName v   -> string v.value
+| Component cmp -> cmp.value |> snd |> Z.to_string |> string
+
+and pp_update {value; _} =
+  let {record; updates; _} = value in
+  let updates = group (pp_ne_injection pp_field_path_assign updates)
+  and record  = pp_path record in
+  string "{" ^^ record ^^ string " with"
+  ^^ nest 2 (break 1 ^^ updates ^^ string "}")
+
+and pp_field_path_assign {value; _} =
+  let {field_path; field_expr; _} = value in
+  let path = pp_path field_path in
+  prefix 2 1 (path ^^ string " =") (pp_expr field_expr)
+
+and pp_path = function
+  Name v -> pp_ident v
+| Path p -> pp_projection p
+
+and pp_call_expr {value; _} =
+  let lambda, arguments = value in
+  let arguments = pp_nseq pp_expr arguments in
+  group (pp_expr lambda ^^ nest 2 (break 1 ^^ arguments))
+
+and pp_tuple_expr {value; _} =
+  let head, tail = value in
+  let rec app = function
+    []  -> empty
+  | [e] -> group (break 1 ^^ pp_expr e)
+  | e::items ->
+      group (break 1 ^^ pp_expr e ^^ string ",") ^^ app items
+  in if tail = []
+     then pp_expr head
+     else pp_expr head ^^ string "," ^^ app (List.map snd tail)
+
+and pp_par_expr e = pp_par pp_expr e
+
+and pp_let_in {value; _} =
+  let {binding; kwd_rec; body; attributes; _} = value in
+  let let_str =
+    match kwd_rec with
+        None -> "let "
+    | Some _ -> "let rec " in
+  let binding = pp_let_binding binding
+  and attr    = pp_attributes attributes
+  in string let_str ^^ binding ^^ attr
+     ^^ hardline ^^ group (string "in " ^^ nest 3 (pp_expr body))
+
+and pp_fun {value; _} =
+  let {binders; lhs_type; body; _} = value in
+  let binders = pp_nseq pp_pattern binders
+  and annot   =
+    match lhs_type with
+      None -> empty
+    | Some (_,e) ->
+        group (break 1 ^^ string ": " ^^ nest 2 (break 1 ^^ pp_type_expr e))
+  in group (string "fun " ^^ nest 4 binders ^^ annot
+     ^^ string " ->" ^^ nest 2 (break 1 ^^ pp_expr body))
+
+and pp_seq {value; _} =
+  let {compound; elements; _} = value in
+  let sep = string ";" ^^ hardline in
+  let elements = Utils.sepseq_to_list elements in
+  let elements = separate_map sep pp_expr elements in
+  match pp_compound compound with
+    None -> elements
+  | Some (opening, closing) ->
+     string opening
+     ^^ nest 2 (hardline ^^ elements) ^^ hardline
+     ^^ string closing
+
+and pp_type_expr = function
+  TProd t   -> pp_cartesian t
+| TSum t    -> pp_variants t
+| TRecord t -> pp_fields t
+| TApp t    -> pp_type_app t
+| TFun t    -> pp_fun_type t
+| TPar t    -> pp_type_par t
+| TVar t    -> pp_ident t
+| TString s -> pp_string s
+
+and pp_cartesian {value; _} =
+  let head, tail = value in
+  let rec app = function
+    []  -> empty
+  | [e] -> group (break 1 ^^ pp_type_expr e)
+  | e::items ->
+      group (break 1 ^^ pp_type_expr e ^^ string " *") ^^ app items
+  in pp_type_expr head ^^ string " *" ^^ app (List.map snd tail)
+
+and pp_variants {value; _} =
+  let head, tail = value in
+  let head = pp_variant head in
+  let head = if tail = [] then head else ifflat head (blank 2 ^^ head) in
+  let rest = List.map snd tail in
+  let app variant = break 1 ^^ string "| " ^^ pp_variant variant
+  in head ^^ concat_map app rest
+
+and pp_variant {value; _} =
+  let {constr; arg} = value in
+  match arg with
+    None -> pp_ident constr
+  | Some (_, e) ->
+      prefix 4 1 (pp_ident constr ^^ string " of") (pp_type_expr e)
+
+and pp_fields fields = group (pp_ne_injection pp_field_decl fields)
+
+and pp_field_decl {value; _} =
+  let {field_name; field_type; _} = value in
+  let name = pp_ident field_name in
+  let t_expr = pp_type_expr field_type
+  in prefix 2 1 (name ^^ string " :") t_expr
+
+and pp_type_app {value = ctor, tuple; _} =
+  pp_type_tuple tuple ^^ group (nest 2 (break 1 ^^ pp_type_constr ctor))
+
+and pp_type_tuple {value; _} =
+  let head, tail = value.inside in
+  let rec app = function
+    []  -> empty
+  | [e] -> group (break 1 ^^ pp_type_expr e)
+  | e::items ->
+      group (break 1 ^^ pp_type_expr e ^^ string ",") ^^ app items in
+  if tail = []
+  then pp_type_expr head
+  else
+    let components =
+      pp_type_expr head ^^ string "," ^^ app (List.map snd tail)
+    in string "(" ^^ nest 1 (components ^^ string ")")
+
+and pp_type_constr ctor = string ctor.value
+
+and pp_fun_type {value; _} =
+  let lhs, _, rhs = value in
+  group (pp_type_expr lhs ^^ string " ->" ^/^ pp_type_expr rhs)
+
+and pp_type_par t = pp_par pp_type_expr t

src/passes/01-parser/cameligo/Tests/pp.mligo

@@ -1,29 +1,54 @@
-type q = {a: int; b: {c: string}}
+let patch_ (m : foobar) : foobar = Map.literal [(0, 5); (1, 6); (2, 7)]
-type r = int list
-type s = (int, address) map
-type t = int
-type u = {a: int; b: t * char}
-type v = int * (string * address)
-type w = timestamp * nat -> (string, address) map
-type x = A | B of t * int | C of int -> (string -> int)
 
-let x = 4
+let (greet_num : int), (greeting : string), one_more_component =
-let y : t = (if true then -3 + f x x else 0) - 1
+  different_types of_many_things + ffffff 124312
-let f (x: int) y = (x : int)
+
+type storage = int * int
+
+let main (n : int * storage)
+  : operation list * storage =
+  let x : int * int =
+    let x : int = 7
+    in x + n.0.asdasdasd.4, n.1.0 + n.1.1.1111111.aaaa.ddddddd.eeeeeee
+  in ([] : operation list), x
+
+let y : t =
+  if true then ffffffffff (-30000 * 10000 - 100000 + f x x y y y y - ((x / 4000) * -5), 103+5) else (10000 + 100000) / 10000000000
+type return = operation list * (storage * fsdgsdgf * sdfsdfsdf * ssdf)
+let xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx =
+  ttttttttttttt <= (aaaaaaaaaaaaaaaaaaaaaaaa - bbbbbbbbbbbbbbbbbbbb)
+let x = tttt * ((fffffffff /55555555) - 3455 * 5135664) - 134 * (-4)
+type x = AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA | B
+let or_true (b : bool) : bool = bbbbbbbbbbbbb || true && cccccccccccccccccc
+type x = A | B of t * int | CCC of int -> (string -> int) -> (string, address, timestamp, int) map
+let c = CCCCCCCCCCCC (aaaaa, BBBBBBBBB aaaaaaaaaaaa)
+let e = Some (a, B b)
+type w = timestamp * nat -> (string, address) map -> t
+type v = int * (a_long_type_name * (another_long_one * address * and_so_on) * more_of_a_very_long_type)
+
+type r = int list
+type t = int
+type s = (int,address,a_long_type_name, more_of_a_very_long_type * foo_bar_baz) t
+type q = {a: int; b: {c: string}; c: timestamp * (address, string) big_map -> longer_type_name}
+type u = {a: int; b: t * char; c: int * (a_long_type_name * (another_long_one * address * and_so_on) * more_of_a_very_long_type)}
+let f xxxxxxxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz ttttt : type_annotation_which_is_very_verbose = this_too_short_a_variable
+let g : type_annotation_which_is_very_verbose = fun x y z t -> this_too_short_a_variable [@@inline]
+let yyyyyyyyyyy : a_very_long_and_specific_type_of_string = "foo and bar"
+let rec x (_, (yyyyyyyyyyyyyyyy: tttttttttttttttttttttttt), very_long_variable_to_trigger_a_break) = 4
+let y {xxxxxxxxx=(_,yyyyyyyy,more_components,another_one); zzzzzzz=34444444; ttttttt=3n} = xxxxxx
 let z : (t) = y
-let w =
+let f (xxxxxxxxxxx: tttttttttttttt) y = (xxxxxxxxxxxx : tttttttttttttttttt)
-  match f 3 with
-    None -> []
-  | Some (1::[2;3]) -> [4;5]::[]
 let n : nat = 0n
 let a = A
 let b = B a
-let c = C (a, B (a))
 let d = None
-let e = Some (a, B b)
+let z = let v = "hello" ^ "world" ^ "!" in v
-let z = z.1.2
+let r = { field = 0; another = 11111111111111111; and_another_one = "dddddd"}
-let v = "hello" ^ "world" ^ "!"
+let r = { r with field = 42; another = 11111111111111111; and_another_one = "dddddddddddddddddddddd"}
-let w = Map.literal [(1,"1"); (2,"2")]
+let w = Map.literal [(11111111111111,"11111111111111"); (22222222222,"22222222222222222"); (1234567890,"1234567890")]
-
+let z = z.1.a.0.4.c.6.7.8.9.cccccccccccc.ccccccccccccccccc.ddddddddddddddddd.0.1.2
-let r = { field = 0}
+let y : t = (if true then -30000000000000 + f x x y y y y else 10000000000000000000) - 1
-let r = { r with field = 42}
+let w =
+  match f 3 with
+    None -> []
+  | Some (1::[2;3;4;5;6]) -> [4;5]::[]

src/passes/01-parser/cameligo/dune

@@ -15,8 +15,10 @@
   (name parser_cameligo)
   (public_name ligo.parser.cameligo)
   (modules
-     Scoping AST cameligo Parser ParserLog LexToken ParErr)
+     Scoping AST cameligo Parser ParserLog LexToken ParErr Pretty)
   (libraries
+     pprint
+     terminal_size
      menhirLib
      parser_shared
      str
@@ -26,8 +28,8 @@
     (pps bisect_ppx --conditional))
   (flags (:standard -open Parser_shared -open Simple_utils)))
 
-;; Build of the unlexer (for covering the
+;; Build of the unlexer (for covering the error states of the LR
-;; error states of the LR automaton)
+;; automaton)
 
 (executable
   (name Unlexer)

src/passes/01-parser/pascaligo.ml

@@ -19,7 +19,8 @@ module SubIO =
       ext     : string;   (* ".ligo" *)
       mode    : [`Byte | `Point];
       cmd     : EvalOpt.command;
-      mono    : bool
+      mono    : bool;
+      pretty  : bool
     >
 
     let options : options =
@@ -34,6 +35,7 @@ module SubIO =
            method mode    = `Point
            method cmd     = EvalOpt.Quiet
            method mono    = false
+           method pretty  = false
          end
 
     let make =
@@ -46,6 +48,7 @@ module SubIO =
                    ~mode:options#mode
                    ~cmd:options#cmd
                    ~mono:options#mono
+                   ~pretty:options#pretty
   end
 
 module Parser =

src/passes/01-parser/pascaligo/.links

@@ -21,5 +21,3 @@ $HOME/git/OCaml-build/Makefile
 ../shared/ParserUnit.mli
 ../shared/ParserUnit.ml
 ../shared/LexerLib.ml
-
-$HOME/git/ligo/_build/default/src/passes/1-parser/pascaligo/ParErr.ml

src/passes/01-parser/pascaligo/AST.ml

@@ -106,14 +106,15 @@ type eof = Region.t
 
 (* Literals *)
 
-type variable   = string reg
+type variable    = string reg
-type fun_name   = string reg
+type fun_name    = string reg
-type type_name  = string reg
+type type_name   = string reg
-type field_name = string reg
+type type_constr = string reg
-type map_name   = string reg
+type field_name  = string reg
-type set_name   = string reg
+type map_name    = string reg
-type constr     = string reg
+type set_name    = string reg
-type attribute  = string reg
+type constr      = string reg
+type attribute   = string reg
 
 (* Parentheses *)
 
@@ -181,11 +182,11 @@ and type_expr =
   TProd   of cartesian
 | TSum    of (variant reg, vbar) nsepseq reg
 | TRecord of field_decl reg ne_injection reg
-| TApp    of (type_name * type_tuple) reg
+| TApp    of (type_constr * type_tuple) reg
 | TFun    of (type_expr * arrow * type_expr) reg
 | TPar    of type_expr par reg
 | TVar    of variable
-| TStringLiteral of Lexer.lexeme reg
+| TString of Lexer.lexeme reg
 
 and cartesian = (type_expr, times) nsepseq reg
 
@@ -205,7 +206,6 @@ and type_tuple = (type_expr, comma) nsepseq par reg
 (* Function and procedure declarations *)
 
 and fun_expr = {
-  kwd_recursive: kwd_recursive option;
   kwd_function : kwd_function;
   param        : parameters;
   colon        : colon;
@@ -215,17 +215,17 @@ and fun_expr = {
 }
 
 and fun_decl = {
-  kwd_recursive: kwd_recursive option;
+  kwd_recursive : kwd_recursive option;
-  kwd_function : kwd_function;
+  kwd_function  : kwd_function;
-  fun_name     : variable;
+  fun_name      : variable;
-  param        : parameters;
+  param         : parameters;
-  colon        : colon;
+  colon         : colon;
-  ret_type     : type_expr;
+  ret_type      : type_expr;
-  kwd_is       : kwd_is;
+  kwd_is        : kwd_is;
-  block_with   : (block reg * kwd_with) option;
+  block_with    : (block reg * kwd_with) option;
-  return       : expr;
+  return        : expr;
-  terminator   : semi option;
+  terminator    : semi option;
-  attributes   : attr_decl option
+  attributes    : attr_decl option
 }
 
 and parameters = (param_decl, semi) nsepseq par reg
@@ -249,19 +249,14 @@ and param_var = {
 }
 
 and block = {
-  opening    : block_opening;
+  enclosing  : block_enclosing;
   statements : statements;
-  terminator : semi option;
+  terminator : semi option
-  closing    : block_closing
 }
 
-and block_opening =
+and block_enclosing =
-  Block of kwd_block * lbrace
+  Block    of kwd_block * lbrace * rbrace
-| Begin of kwd_begin
+| BeginEnd of kwd_begin * kwd_end
-
-and block_closing =
-  Block of rbrace
-| End   of kwd_end
 
 and statements = (statement, semi) nsepseq
 
@@ -378,10 +373,10 @@ and set_membership = {
 and 'a case = {
   kwd_case  : kwd_case;
   expr      : expr;
-  opening   : opening;
+  kwd_of    : kwd_of;
+  enclosing : enclosing;
   lead_vbar : vbar option;
-  cases     : ('a case_clause reg, vbar) nsepseq reg;
+  cases     : ('a case_clause reg, vbar) nsepseq reg
-  closing   : closing
 }
 
 and 'a case_clause = {
@@ -417,13 +412,12 @@ and for_loop =
 | ForCollect of for_collect reg
 
 and for_int = {
-  kwd_for  : kwd_for;
+  kwd_for : kwd_for;
-  assign   : var_assign reg;
+  assign  : var_assign reg;
-  kwd_to   : kwd_to;
+  kwd_to  : kwd_to;
-  bound    : expr;
+  bound   : expr;
-  kwd_step : kwd_step option;
+  step    : (kwd_step * expr) option;
-  step     : expr option;
+  block   : block reg
-  block    : block reg
 }
 
 and var_assign = {
@@ -452,7 +446,7 @@ and collection =
 and expr =
   ECase   of expr case reg
 | ECond   of cond_expr reg
-| EAnnot  of annot_expr reg
+| EAnnot  of annot_expr par reg
 | ELogic  of logic_expr
 | EArith  of arith_expr
 | EString of string_expr
@@ -471,34 +465,12 @@ and expr =
 | EPar    of expr par reg
 | EFun    of fun_expr reg
 
-and annot_expr = (expr * type_expr)
+and annot_expr = expr * colon * type_expr
 
 and set_expr =
   SetInj of expr injection reg
 | SetMem of set_membership reg
 
-and 'a injection = {
-  opening    : opening;
-  elements   : ('a, semi) sepseq;
-  terminator : semi option;
-  closing    : closing
-}
-
-and 'a ne_injection = {
-  opening     : opening;
-  ne_elements : ('a, semi) nsepseq;
-  terminator  : semi option;
-  closing     : closing
-}
-
-and opening =
-  Kwd        of keyword
-| KwdBracket of keyword * lbracket
-
-and closing =
-  End       of kwd_end
-| RBracket  of rbracket
-
 and map_expr =
   MapLookUp of map_lookup reg
 | MapInj    of binding reg injection reg
@@ -520,7 +492,7 @@ and logic_expr =
 and bool_expr =
   Or    of kwd_or  bin_op reg
 | And   of kwd_and bin_op reg
-| Not   of kwd_not un_op reg
+| Not   of kwd_not un_op  reg
 | False of c_False
 | True  of c_True
 
@@ -544,15 +516,15 @@ and comp_expr =
 | Neq   of neq   bin_op reg
 
 and arith_expr =
-  Add  of plus    bin_op reg
+  Add   of plus    bin_op reg
-| Sub  of minus   bin_op reg
+| Sub   of minus   bin_op reg
-| Mult of times   bin_op reg
+| Mult  of times   bin_op reg
-| Div  of slash   bin_op reg
+| Div   of slash   bin_op reg
-| Mod  of kwd_mod bin_op reg
+| Mod   of kwd_mod bin_op reg
-| Neg  of minus    un_op reg
+| Neg   of minus    un_op reg
-| Int  of (Lexer.lexeme * Z.t) reg
+| Int   of (Lexer.lexeme * Z.t) reg
-| Nat  of (Lexer.lexeme * Z.t) reg
+| Nat   of (Lexer.lexeme * Z.t) reg
-| Mutez  of (Lexer.lexeme * Z.t) reg
+| Mutez of (Lexer.lexeme * Z.t) reg
 
 and string_expr =
   Cat      of cat bin_op reg
@@ -569,13 +541,13 @@ and constr_expr =
 | NoneExpr  of c_None
 | ConstrApp of (constr * arguments option) reg
 
-and field_assign = {
+and field_assignment = {
   field_name : field_name;
-  equal      : equal;
+  assignment : equal;
   field_expr : expr
 }
 
-and record = field_assign reg ne_injection
+and record = field_assignment reg ne_injection
 
 and projection = {
   struct_name : variable;
@@ -584,14 +556,14 @@ and projection = {
 }
 
 and update = {
-  record : path;
+  record   : path;
   kwd_with : kwd_with;
-  updates : field_path_assign reg ne_injection reg
+  updates  : field_path_assignment reg ne_injection reg
 }
 
-and field_path_assign = {
+and field_path_assignment = {
-  field_path  : (field_name, dot) nsepseq;
+  field_path : path;
-  equal : equal;
+  assignment : equal;
   field_expr : expr
 }
 
@@ -605,6 +577,38 @@ and fun_call = (expr * arguments) reg
 
 and arguments = tuple_expr
 
+(* Injections *)
+
+and 'a injection = {
+  kind       : injection_kwd;
+  enclosing  : enclosing;
+  elements   : ('a, semi) sepseq;
+  terminator : semi option
+}
+
+and injection_kwd =
+  InjSet    of keyword
+| InjMap    of keyword
+| InjBigMap of keyword
+| InjList   of keyword
+
+and enclosing =
+  Brackets of lbracket * rbracket
+| End      of kwd_end
+
+and 'a ne_injection = {
+  kind        : ne_injection_kwd;
+  enclosing   : enclosing;
+  ne_elements : ('a, semi) nsepseq;
+  terminator  : semi option
+}
+
+and ne_injection_kwd =
+  NEInjAttr   of keyword
+| NEInjSet    of keyword
+| NEInjMap    of keyword
+| NEInjRecord of keyword
+
 (* Patterns *)
 
 and pattern =
@@ -635,7 +639,7 @@ and list_pattern =
 | PCons     of (pattern, cons) nsepseq reg
 
 
-(* Projecting regions *)
+(* PROJECTING REGIONS *)
 
 let rec last to_region = function
     [] -> Region.ghost
@@ -660,7 +664,7 @@ let type_expr_to_region = function
 | TApp    {region; _}
 | TFun    {region; _}
 | TPar    {region; _}
-| TStringLiteral {region; _}
+| TString {region; _}
 | TVar    {region; _} -> region
 
 let rec expr_to_region = function

src/passes/01-parser/pascaligo/Parser.mly

@@ -122,7 +122,8 @@ attr_decl:
   open_attr_decl ";"? { $1 }
 
 open_attr_decl:
-  ne_injection("attributes","<string>") { $1 }
+  ne_injection("attributes","<string>") {
+    $1 (fun region -> NEInjAttr region) }
 
 (* Type declarations *)
 
@@ -160,9 +161,9 @@ cartesian:
     in TProd {region; value} }
 
 core_type:
-  type_name      { TVar $1 }
+  type_name      { TVar    $1 }
-| "<string>"     { TStringLiteral $1 }
+| "<string>"     { TString $1 }
-| par(type_expr) { TPar $1 }
+| par(type_expr) { TPar    $1 }
 | type_name type_tuple {
     let region = cover $1.region $2.region
     in TApp {region; value = $1,$2}
@@ -214,19 +215,19 @@ record_type:
     let () = Utils.nsepseq_to_list ne_elements
              |> Scoping.check_fields in
     let region = cover $1 $3
-    and value  = {opening = Kwd $1;
+    and value  = {kind      = NEInjRecord $1;
+                  enclosing = End $3;
                   ne_elements;
-                  terminator;
+                  terminator}
-                  closing = End $3}
     in TRecord {region; value}
   }
 | "record" "[" sep_or_term_list(field_decl,";") "]" {
    let ne_elements, terminator = $3 in
    let region = cover $1 $4
-   and value  = {opening = KwdBracket ($1,$2);
+   and value  = {kind      = NEInjRecord $1;
+                 enclosing = Brackets ($2,$4);
                  ne_elements;
-                 terminator;
+                 terminator}
-                 closing = RBracket $4}
    in TRecord {region; value} }
 
 field_decl:
@@ -238,16 +239,15 @@ field_decl:
 
 
 fun_expr:
-  | ioption ("recursive") "function" parameters ":" type_expr "is" expr {
+  "function" parameters ":" type_expr "is" expr {
-    let stop   = expr_to_region $7 in
+    let stop   = expr_to_region $6 in
-    let region = cover $2 stop
+    let region = cover $1 stop
-    and value  = {kwd_recursive= $1;
+    and value  = {kwd_function = $1;
-                  kwd_function = $2;
+                  param        = $2;
-                  param        = $3;
+                  colon        = $3;
-                  colon        = $4;
+                  ret_type     = $4;
-                  ret_type     = $5;
+                  kwd_is       = $5;
-                  kwd_is       = $6;
+                  return       = $6}
-                  return       = $7}
     in {region; value} }
 
 (* Function declarations *)
@@ -271,7 +271,8 @@ open_fun_decl:
                   attributes   = None}
     in {region; value}
   }
-| ioption ("recursive") "function" fun_name parameters ":" type_expr "is" expr {
+| ioption ("recursive") "function" fun_name parameters ":" type_expr "is"
+  expr {
     Scoping.check_reserved_name $3;
     let stop   = expr_to_region $8 in
     let region = cover $2 stop
@@ -326,19 +327,17 @@ block:
   "begin" sep_or_term_list(statement,";") "end" {
      let statements, terminator = $2 in
      let region = cover $1 $3
-     and value  = {opening = Begin $1;
+     and value  = {enclosing = BeginEnd ($1,$3);
                    statements;
-                   terminator;
+                   terminator}
-                   closing = End $3}
      in {region; value}
   }
 | "block" "{" sep_or_term_list(statement,";") "}" {
      let statements, terminator = $3 in
      let region = cover $1 $4
-     and value  = {opening = Block ($1,$2);
+     and value  = {enclosing = Block ($1,$2,$4);
                    statements;
-                   terminator;
+                   terminator}
-                   closing = Block $4}
      in {region; value} }
 
 statement:
@@ -404,124 +403,122 @@ instruction:
 set_remove:
   "remove" expr "from" "set" path {
     let region = cover $1 (path_to_region $5) in
-    let value  = {
+    let value  = {kwd_remove = $1;
-      kwd_remove = $1;
+                  element    = $2;
-      element    = $2;
+                  kwd_from   = $3;
-      kwd_from   = $3;
+                  kwd_set    = $4;
-      kwd_set    = $4;
+                  set        = $5}
-      set        = $5}
     in {region; value} }
 
 map_remove:
   "remove" expr "from" "map" path {
     let region = cover $1 (path_to_region $5) in
-    let value  = {
+    let value  = {kwd_remove = $1;
-      kwd_remove = $1;
+                  key        = $2;
-      key        = $2;
+                  kwd_from   = $3;
-      kwd_from   = $3;
+                  kwd_map    = $4;
-      kwd_map    = $4;
+                  map        = $5}
-      map        = $5}
     in {region; value} }
 
 set_patch:
   "patch" path "with" ne_injection("set",expr) {
-    let region = cover $1 $4.region in
+    let set_inj = $4 (fun region -> NEInjSet region) in
-    let value  = {
+    let region = cover $1 set_inj.region in
-      kwd_patch = $1;
+    let value  = {kwd_patch = $1;
-      path      = $2;
+                  path      = $2;
-      kwd_with  = $3;
+                  kwd_with  = $3;
-      set_inj   = $4}
+                  set_inj}
     in {region; value} }
 
 map_patch:
   "patch" path "with" ne_injection("map",binding) {
-    let region = cover $1 $4.region in
+    let map_inj = $4 (fun region -> NEInjMap region) in
-    let value  = {
+    let region  = cover $1 map_inj.region in
-      kwd_patch = $1;
+    let value   = {kwd_patch = $1;
-      path      = $2;
+                   path      = $2;
-      kwd_with  = $3;
+                   kwd_with  = $3;
-      map_inj   = $4}
+                   map_inj}
     in {region; value} }
 
 injection(Kind,element):
   Kind sep_or_term_list(element,";") "end" {
-    let elements, terminator = $2 in
+    fun mk_kwd ->
-    let region = cover $1 $3
+      let elements, terminator = $2 in
-    and value = {
+      let region = cover $1 $3
-      opening  = Kwd $1;
+      and value  = {
-      elements = Some elements;
+        kind      = mk_kwd $1;
-      terminator;
+        enclosing = End $3;
-      closing = End $3}
+        elements  = Some elements;
-    in {region; value}
+        terminator}
+      in {region; value}
   }
 | Kind "end" {
-    let region = cover $1 $2
+    fun mk_kwd ->
-    and value = {
+      let region = cover $1 $2
-      opening    = Kwd $1;
+      and value  = {kind       = mk_kwd $1;
-      elements   = None;
+                    enclosing  = End $2;
-      terminator = None;
+                    elements   = None;
-      closing    = End $2}
+                    terminator = None}
-    in {region; value}
+      in {region; value}
   }
 | Kind "[" sep_or_term_list(element,";") "]" {
-    let elements, terminator = $3 in
+    fun mk_kwd ->
-    let region = cover $1 $4
+      let elements, terminator = $3 in
-    and value = {
+      let region = cover $1 $4
-      opening  = KwdBracket ($1,$2);
+      and value  = {kind      = mk_kwd $1;
-      elements = Some elements;
+                    enclosing = Brackets ($2,$4);
-      terminator;
+                    elements  = Some elements;
-      closing = RBracket $4}
+                    terminator}
-    in {region; value}
+      in {region; value}
   }
 | Kind "[" "]" {
-    let region = cover $1 $3
+    fun mk_kwd ->
-    and value = {
+      let region = cover $1 $3
-      opening    = KwdBracket ($1,$2);
+      and value  = {kind       = mk_kwd $1;
-      elements   = None;
+                    enclosing  = Brackets ($2,$3);
-      terminator = None;
+                    elements   = None;
-      closing    = RBracket $3}
+                    terminator = None}
-    in {region; value} }
+      in {region; value} }
 
 ne_injection(Kind,element):
   Kind sep_or_term_list(element,";") "end" {
-    let ne_elements, terminator = $2 in
+    fun mk_kwd ->
-    let region = cover $1 $3
+      let ne_elements, terminator = $2 in
-    and value = {
+      let region = cover $1 $3
-      opening  = Kwd $1;
+      and value  = {kind      = mk_kwd $1;
-      ne_elements;
+                    enclosing = End $3;
-      terminator;
+                    ne_elements;
-      closing = End $3}
+                    terminator}
-    in {region; value}
+      in {region; value}
   }
 | Kind "[" sep_or_term_list(element,";") "]" {
-    let ne_elements, terminator = $3 in
+    fun mk_kwd ->
-    let region = cover $1 $4
+      let ne_elements, terminator = $3 in
-    and value = {
+      let region = cover $1 $4
-      opening  = KwdBracket ($1,$2);
+      and value = {kind      = mk_kwd $1;
-      ne_elements;
+                   enclosing = Brackets ($2,$4);
-      terminator;
+                   ne_elements;
-      closing = RBracket $4}
+                   terminator}
-    in {region; value} }
+      in {region; value} }
 
 binding:
   expr "->" expr {
     let start  = expr_to_region $1
     and stop   = expr_to_region $3 in
     let region = cover start stop
-    and value  = {
+    and value  = {source = $1;
-      source = $1;
+                  arrow  = $2;
-      arrow  = $2;
+                  image  = $3}
-      image  = $3}
     in {region; value} }
 
 record_patch:
   "patch" path "with" ne_injection("record",field_assignment) {
-    let region = cover $1 $4.region in
+    let record_inj = $4 (fun region -> NEInjRecord region) in
-    let value  = {
+    let region = cover $1 record_inj.region in
-      kwd_patch  = $1;
+    let value  = {kwd_patch = $1;
-      path       = $2;
+                  path      = $2;
-      kwd_with   = $3;
+                  kwd_with  = $3;
-      record_inj = $4}
+                  record_inj}
     in {region; value} }
 
 proc_call:
@@ -547,12 +544,9 @@ if_clause:
 clause_block:
   block { LongBlock $1 }
 | "{" sep_or_term_list(statement,";") "}" {
-    let statements, terminator = $2 in
     let region = cover $1 $3 in
-    let value  = {lbrace = $1;
+    let value  = {lbrace=$1; inside=$2; rbrace=$3}
-                  inside = statements, terminator;
+    in ShortBlock {value; region} }
-                  rbrace = $3} in
-    ShortBlock {value; region} }
 
 case_instr:
   case(if_clause) { $1 if_clause_to_region }
@@ -563,10 +557,10 @@ case(rhs):
       let region = cover $1 $6 in
       let value  = {kwd_case  = $1;
                     expr      = $2;
-                    opening   = Kwd $3;
+                    kwd_of    = $3;
+                    enclosing = End $6;
                     lead_vbar = $4;
-                    cases     = $5 rhs_to_region;
+                    cases     = $5 rhs_to_region}
-                    closing   = End $6}
       in {region; value}
   }
 | "case" expr "of" "[" "|"? cases(rhs) "]" {
@@ -574,10 +568,10 @@ case(rhs):
       let region = cover $1 $7 in
       let value  = {kwd_case  = $1;
                     expr      = $2;
-                    opening   = KwdBracket ($3,$4);
+                    kwd_of    = $3;
+                    enclosing = Brackets ($4,$7);
                     lead_vbar = $5;
-                    cases     = $6 rhs_to_region;
+                    cases     = $6 rhs_to_region}
-                    closing   = RBracket $7}
       in {region; value} }
 
 cases(rhs):
@@ -628,7 +622,6 @@ for_loop:
                   assign   = $2;
                   kwd_to   = $3;
                   bound    = $4;
-                  kwd_step = None;
                   step     = None;
                   block    = $5}
     in For (ForInt {region; value})
@@ -639,8 +632,7 @@ for_loop:
                   assign   = $2;
                   kwd_to   = $3;
                   bound    = $4;
-                  kwd_step = Some $5;
+                  step     = Some ($5, $6);
-                  step     = Some $6;
                   block    = $7}
     in For (ForInt {region; value})
   }
@@ -854,7 +846,7 @@ core_expr:
 | "False"                       { ELogic (BoolExpr (False $1)) }
 | "True"                        { ELogic (BoolExpr (True  $1)) }
 | "Unit"                        { EUnit $1                     }
-| annot_expr                    { EAnnot $1                    }
+| par(annot_expr)               { EAnnot $1                    }
 | tuple_expr                    { ETuple $1                    }
 | list_expr                     { EList $1                     }
 | "None"                        { EConstr (NoneExpr $1)        }
@@ -896,20 +888,20 @@ fun_call_or_par_or_projection:
 | fun_call { ECall $1 }
 
 annot_expr:
-  "(" disj_expr ":" type_expr ")" {
+  disj_expr ":" type_expr { $1,$2,$3 }
-    let start  = expr_to_region $2
-    and stop   = type_expr_to_region $4 in
-    let region = cover start stop
-    and value  = $2, $4
-    in {region; value} }
 
 set_expr:
-  injection("set",expr) { SetInj $1 }
+  injection("set",expr) { SetInj ($1 (fun region -> InjSet region)) }
 
 map_expr:
-  map_lookup                   { MapLookUp $1 }
+  map_lookup {
-| injection("map",binding)     {    MapInj $1 }
+    MapLookUp $1
-| injection("big_map",binding) { BigMapInj $1 }
+  }
+| injection("map",binding) {
+    MapInj ($1 (fun region -> InjMap region))
+  }
+| injection("big_map",binding) {
+    BigMapInj ($1 (fun region -> InjBigMap region)) }
 
 map_lookup:
   path brackets(expr) {
@@ -957,41 +949,40 @@ record_expr:
   "record" sep_or_term_list(field_assignment,";") "end" {
     let ne_elements, terminator = $2 in
     let region = cover $1 $3
-    and value : field_assign AST.reg ne_injection = {
+    and value : field_assignment AST.reg ne_injection = {
-      opening = Kwd $1;
+      kind      = NEInjRecord $1;
+      enclosing = End $3;
       ne_elements;
-      terminator;
+      terminator}
-      closing = End $3}
     in {region; value}
   }
 | "record" "[" sep_or_term_list(field_assignment,";") "]" {
-   let ne_elements, terminator = $3 in
+    let ne_elements, terminator = $3 in
-   let region = cover $1 $4
+    let region = cover $1 $4
-   and value : field_assign AST.reg ne_injection = {
+    and value : field_assignment AST.reg ne_injection = {
-     opening = KwdBracket ($1,$2);
+      kind      = NEInjRecord $1;
-     ne_elements;
+      enclosing = Brackets ($2,$4);
-     terminator;
+      ne_elements;
-     closing = RBracket $4}
+      terminator}
-   in {region; value} }
+    in {region; value} }
 
 update_record:
-  path "with" ne_injection("record",field_path_assignment){
+  path "with" ne_injection("record",field_path_assignment) {
-    let region = cover (path_to_region $1) $3.region in
+    let updates = $3 (fun region -> NEInjRecord region) in
-    let value  = {record=$1; kwd_with=$2; updates=$3}
+    let region  = cover (path_to_region $1) updates.region in
+    let value   = {record=$1; kwd_with=$2; updates}
     in {region; value} }
 
 field_assignment:
   field_name "=" expr {
     let region = cover $1.region (expr_to_region $3)
-    and value  = {field_name=$1; equal=$2; field_expr=$3}
+    and value  = {field_name=$1; assignment=$2; field_expr=$3}
     in {region; value} }
 
 field_path_assignment:
-  nsepseq(field_name,".") "=" expr {
+  path "=" expr {
-    let start  = nsepseq_to_region (fun x -> x.region) $1
+    let region = cover (path_to_region $1) (expr_to_region $3)
-    and stop   = expr_to_region $3 in
+    and value  = {field_path=$1; assignment=$2; field_expr=$3}
-    let region = cover start stop
-    and value  = {field_path=$1; equal=$2; field_expr=$3}
     in {region; value} }
 
 fun_call:
@@ -1010,8 +1001,8 @@ arguments:
   par(nsepseq(expr,",")) { $1 }
 
 list_expr:
-  injection("list",expr) { EListComp $1 }
+  injection("list",expr) { EListComp ($1 (fun region -> InjList region)) }
-| "nil"                  {      ENil $1 }
+| "nil"                  { ENil $1                                     }
 
 (* Patterns *)
 
@@ -1034,9 +1025,10 @@ core_pattern:
 | constr_pattern           { PConstr $1 }
 
 list_pattern:
-  injection("list",core_pattern) { PListComp $1 }
+  "nil"                          {      PNil $1 }
-| "nil"                          {      PNil $1 }
 | par(cons_pattern)              {  PParCons $1 }
+| injection("list",core_pattern) {
+    PListComp ($1 (fun region -> InjList region)) }
 
 cons_pattern:
   core_pattern "#" pattern { $1,$2,$3 }

src/passes/01-parser/pascaligo/ParserLog.ml

@@ -27,11 +27,11 @@ let mk_state ~offsets ~mode ~buffer =
     val pad_node    = ""
     method pad_node = pad_node
 
-    (** The method [pad] updates the current padding, which is
+    (* The method [pad] updates the current padding, which is
-        comprised of two components: the padding to reach the new node
+       comprised of two components: the padding to reach the new node
-        (space before reaching a subtree, then a vertical bar for it)
+       (space before reaching a subtree, then a vertical bar for it)
-        and the padding for the new node itself (Is it the last child
+       and the padding for the new node itself (Is it the last child
-        of its parent?).
+       of its parent?).
      *)
     method pad arity rank =
       {< pad_path =
@@ -44,7 +44,7 @@ let mk_state ~offsets ~mode ~buffer =
 let compact state (region: Region.t) =
   region#compact ~offsets:state#offsets state#mode
 
-(** {1 Printing the tokens with their source regions} *)
+(* Printing the tokens with their source regions *)
 
 let print_nsepseq :
   state -> string -> (state -> 'a -> unit) ->
@@ -117,7 +117,7 @@ let rec print_tokens state ast =
   print_token state eof "EOF"
 
 and print_attr_decl state =
-  print_ne_injection state "attributes" print_string
+  print_ne_injection state print_string
 
 and print_decl state = function
   TypeDecl  decl -> print_type_decl  state decl
@@ -153,7 +153,7 @@ and print_type_expr state = function
 | TFun    type_fun    -> print_type_fun    state type_fun
 | TPar    par_type    -> print_par_type    state par_type
 | TVar    type_var    -> print_var         state type_var
-| TStringLiteral s -> print_string state s
+| TString str         -> print_string      state str
 
 and print_cartesian state {value; _} =
   print_nsepseq state "*" print_type_expr value
@@ -170,8 +170,8 @@ and print_variant state ({value; _}: variant reg) =
 and print_sum_type state {value; _} =
   print_nsepseq state "|" print_variant value
 
-and print_record_type state record_type =
+and print_record_type state =
-  print_ne_injection state "record" print_field_decl record_type
+  print_ne_injection state print_field_decl
 
 and print_type_app state {value; _} =
   let type_name, type_tuple = value in
@@ -180,9 +180,9 @@ and print_type_app state {value; _} =
 
 and print_type_fun state {value; _} =
   let type_expr_a, arrow, type_expr_b = value in
-  print_type_expr  state type_expr_a;
+  print_type_expr state type_expr_a;
-  print_token      state arrow "->";
+  print_token     state arrow "->";
-  print_type_expr  state type_expr_b
+  print_type_expr state type_expr_b
 
 and print_par_type state {value; _} =
   let {lpar; inside; rpar} = value in
@@ -206,12 +206,12 @@ and print_fun_decl state {value; _} =
   let {kwd_function; fun_name; param; colon;
        ret_type; kwd_is; block_with;
        return; terminator; _} = value in
-  print_token       state kwd_function "function";
+  print_token      state kwd_function "function";
-  print_var         state fun_name;
+  print_var        state fun_name;
-  print_parameters  state param;
+  print_parameters state param;
-  print_token       state colon ":";
+  print_token      state colon ":";
-  print_type_expr   state ret_type;
+  print_type_expr  state ret_type;
-  print_token       state kwd_is "is";
+  print_token      state kwd_is "is";
   (match block_with with
     None -> ()
   | Some (block, kwd_with) ->
@@ -221,15 +221,14 @@ and print_fun_decl state {value; _} =
   print_terminator state terminator;
 
 and print_fun_expr state {value; _} =
-  let {kwd_recursive; kwd_function; param; colon;
+  let {kwd_function; param; colon;
        ret_type; kwd_is; return} : fun_expr = value in
-  print_token_opt   state kwd_recursive "recursive";
+  print_token      state kwd_function "function";
-  print_token       state kwd_function "function";
+  print_parameters state param;
-  print_parameters  state param;
+  print_token      state colon ":";
-  print_token       state colon ":";
+  print_type_expr  state ret_type;
-  print_type_expr   state ret_type;
+  print_token      state kwd_is "is";
-  print_token       state kwd_is "is";
+  print_expr       state return
-  print_expr        state return
 
 and print_parameters state {value; _} =
   let {lpar; inside; rpar} = value in
@@ -256,22 +255,19 @@ and print_param_var state {value; _} =
   print_type_expr state param_type
 
 and print_block state block =
-  let {opening; statements; terminator; closing} = block.value in
+  let {enclosing; statements; terminator} = block.value in
-  print_block_opening state opening;
+  match enclosing with
-  print_statements    state statements;
+    Block (kwd_block, lbrace, rbrace) ->
-  print_terminator    state terminator;
+      print_token      state kwd_block "block";
-  print_block_closing state closing
+      print_token      state lbrace "{";
-
+      print_statements state statements;
-and print_block_opening state = function
+      print_terminator state terminator;
-  Block (kwd_block, lbrace) ->
+      print_token      state rbrace "}"
-    print_token state kwd_block "block";
+  | BeginEnd (kwd_begin, kwd_end) ->
-    print_token state lbrace    "{"
+      print_token      state kwd_begin "begin";
-| Begin kwd_begin ->
+      print_statements state statements;
-    print_token state kwd_begin "begin"
+      print_terminator state terminator;
-
+      print_token      state kwd_end "end"
-and print_block_closing state = function
-  Block rbrace -> print_token state rbrace  "}"
-| End kwd_end  -> print_token state kwd_end "end"
 
 and print_data_decl state = function
   LocalConst decl -> print_const_decl state decl
@@ -344,14 +340,20 @@ and print_clause_block state = function
     print_token      state rbrace "}"
 
 and print_case_instr state (node : if_clause case) =
-  let {kwd_case; expr; opening;
+  let {kwd_case; expr; kwd_of; enclosing; lead_vbar; cases} = node in
-       lead_vbar; cases; closing} = node in
   print_token       state kwd_case "case";
   print_expr        state expr;
-  print_opening     state "of" opening;
+  print_token       state kwd_of "of";
-  print_token_opt   state lead_vbar "|";
+  match enclosing with
-  print_cases_instr state cases;
+    Brackets (lbracket, rbracket) ->
-  print_closing     state closing
+      print_token       state lbracket "[";
+      print_token_opt   state lead_vbar "|";
+      print_cases_instr state cases;
+      print_token       state rbracket "]"
+  | End kwd_end ->
+      print_token_opt   state lead_vbar "|";
+      print_cases_instr state cases;
+      print_token       state kwd_end "end"
 
 and print_token_opt state = function
          None -> fun _ -> ()
@@ -393,19 +395,16 @@ and print_for_loop state = function
 | ForCollect for_collect -> print_for_collect state for_collect
 
 and print_for_int state ({value; _} : for_int reg) =
-  let {kwd_for; assign; kwd_to; bound; kwd_step; step; block} = value in
+  let {kwd_for; assign; kwd_to; bound; step; block} = value in
   print_token      state kwd_for "for";
   print_var_assign state assign;
   print_token      state kwd_to "to";
   print_expr       state bound;
-  match kwd_step with 
+  (match step with
-  | None -> ();
+     None -> ();
-  | Some kwd_step -> 
+   | Some (kwd_step, expr) ->
-  print_token      state kwd_step "step";
+       print_token  state kwd_step "step";
-  match step with
+       print_expr   state expr);
-  | None -> ();
-  | Some step ->
-  print_expr       state step;
   print_block      state block
 
 and print_var_assign state {value; _} =
@@ -461,19 +460,27 @@ and print_expr state = function
 | EPar    e -> print_par_expr state e
 | EFun    e -> print_fun_expr state e
 
-and print_annot_expr state (expr , type_expr) =
+and print_annot_expr state node =
+  let {inside; _} : annot_expr par = node in
+  let expr, _, type_expr = inside in
   print_expr state expr;
   print_type_expr state type_expr
 
 and print_case_expr state (node : expr case) =
-  let {kwd_case; expr; opening;
+  let {kwd_case; expr; kwd_of; enclosing; lead_vbar; cases} = node in
-       lead_vbar; cases; closing} = node in
   print_token      state kwd_case "case";
   print_expr       state expr;
-  print_opening    state "of" opening;
+  print_token       state kwd_of "of";
-  print_token_opt  state lead_vbar "|";
+  match enclosing with
-  print_cases_expr state cases;
+    Brackets (lbracket, rbracket) ->
-  print_closing    state closing
+      print_token      state lbracket "[";
+      print_token_opt  state lead_vbar "|";
+      print_cases_expr state cases;
+      print_token      state rbracket "]"
+  | End kwd_end ->
+      print_token_opt  state lead_vbar "|";
+      print_cases_expr state cases;
+      print_token      state kwd_end "end"
 
 and print_cases_expr state {value; _} =
   print_nsepseq state "|" print_case_clause_expr value
@@ -486,11 +493,11 @@ and print_case_clause_expr state {value; _} =
 
 and print_map_expr state = function
   MapLookUp {value; _} -> print_map_lookup state value
-| MapInj inj           -> print_injection  state "map" print_binding inj
+| MapInj inj           -> print_injection  state print_binding inj
-| BigMapInj inj        -> print_injection  state "big_map" print_binding inj
+| BigMapInj inj        -> print_injection  state print_binding inj
 
 and print_set_expr state = function
-  SetInj inj -> print_injection state "set" print_expr inj
+  SetInj inj -> print_injection state print_expr inj
 | SetMem mem -> print_set_membership state mem
 
 and print_set_membership state {value; _} =
@@ -600,7 +607,7 @@ and print_list_expr state = function
     print_expr  state arg1;
     print_token state op "#";
     print_expr  state arg2
-| EListComp e -> print_injection state "list" print_expr e
+| EListComp e -> print_injection state print_expr e
 | ENil e -> print_nil state e
 
 and print_constr_expr state = function
@@ -608,27 +615,26 @@ and print_constr_expr state = function
 | NoneExpr e  -> print_none_expr  state e
 | ConstrApp e -> print_constr_app state e
 
-and print_record_expr state e =
+and print_record_expr state =
-  print_ne_injection state "record" print_field_assign e
+  print_ne_injection state print_field_assignment
 
-and print_field_assign state {value; _} =
+and print_field_assignment state {value; _} =
-  let {field_name; equal; field_expr} = value in
+  let {field_name; assignment; field_expr} = value in
   print_var   state field_name;
-  print_token state equal "=";
+  print_token state assignment "=";
   print_expr  state field_expr
 
-and print_field_path_assign state {value; _} =
+and print_field_path_assignment state {value; _} =
-  let {field_path; equal; field_expr} = value in
+  let {field_path; assignment; field_expr} = value in
-  print_nsepseq state "field_path" print_var field_path;
+  print_path  state field_path;
-  print_token state equal "=";
+  print_token state assignment "=";
   print_expr  state field_expr
 
 and print_update_expr state {value; _} =
   let {record; kwd_with; updates} = value in
   print_path state record;
   print_token state kwd_with "with";
-  print_ne_injection state "updates field" print_field_path_assign updates
+  print_ne_injection state print_field_path_assignment updates
-
 
 and print_projection state {value; _} =
   let {struct_name; selector; field_path} = value in
@@ -648,21 +654,21 @@ and print_record_patch state node =
   print_token        state kwd_patch "patch";
   print_path         state path;
   print_token        state kwd_with "with";
-  print_ne_injection state "record" print_field_assign record_inj
+  print_ne_injection state print_field_assignment record_inj
 
 and print_set_patch state node =
   let {kwd_patch; path; kwd_with; set_inj} = node in
   print_token        state kwd_patch "patch";
   print_path         state path;
   print_token        state kwd_with "with";
-  print_ne_injection state "set" print_expr set_inj
+  print_ne_injection state print_expr set_inj
 
 and print_map_patch state node =
   let {kwd_patch; path; kwd_with; map_inj} = node in
   print_token        state kwd_patch "patch";
   print_path         state path;
   print_token        state kwd_with "with";
-  print_ne_injection state "map" print_binding map_inj
+  print_ne_injection state print_binding map_inj
 
 and print_map_remove state node =
   let {kwd_remove; key; kwd_from; kwd_map; map} = node in
@@ -681,35 +687,48 @@ and print_set_remove state node =
   print_path  state set
 
 and print_injection :
-  'a.state -> string -> (state -> 'a -> unit) ->
+  'a.state -> (state -> 'a -> unit) -> 'a injection reg -> unit =
-  'a injection reg -> unit =
+  fun state print {value; _} ->
-  fun state kwd print {value; _} ->
+    let {kind; enclosing; elements; terminator} = value in
-    let {opening; elements; terminator; closing} = value in
+    print_injection_kwd state kind;
-    print_opening    state kwd opening;
+    match enclosing with
-    print_sepseq     state ";" print elements;
+      Brackets (lbracket, rbracket) ->
-    print_terminator state terminator;
+        print_token      state lbracket "[";
-    print_closing    state closing
+        print_sepseq     state ";" print elements;
+        print_terminator state terminator;
+        print_token      state rbracket "]"
+    | End kwd_end ->
+        print_sepseq     state ";" print elements;
+        print_terminator state terminator;
+        print_token      state kwd_end "end"
+
+and print_injection_kwd state = function
+  InjSet    kwd_set     -> print_token state kwd_set "set"
+| InjMap    kwd_map     -> print_token state kwd_map "map"
+| InjBigMap kwd_big_map -> print_token state kwd_big_map "big_map"
+| InjList   kwd_list    -> print_token state kwd_list "list"
 
 and print_ne_injection :
-  'a.state -> string -> (state -> 'a -> unit) ->
+  'a.state -> (state -> 'a -> unit) -> 'a ne_injection reg -> unit =
-  'a ne_injection reg -> unit =
+  fun state print {value; _} ->
-  fun state kwd print {value; _} ->
+    let {kind; enclosing; ne_elements; terminator} = value in
-    let {opening; ne_elements; terminator; closing} = value in
+    print_ne_injection_kwd state kind;
-    print_opening    state kwd opening;
+    match enclosing with
-    print_nsepseq    state ";" print ne_elements;
+      Brackets (lbracket, rbracket) ->
-    print_terminator state terminator;
+        print_token      state lbracket "[";
-    print_closing    state closing
+        print_nsepseq     state ";" print ne_elements;
+        print_terminator state terminator;
+        print_token      state rbracket "]"
+    | End kwd_end ->
+        print_nsepseq     state ";" print ne_elements;
+        print_terminator state terminator;
+        print_token      state kwd_end "end"
 
-and print_opening state lexeme = function
+and print_ne_injection_kwd state = function
-  Kwd kwd ->
+  NEInjAttr   kwd_attributes -> print_token state kwd_attributes "attributes"
-    print_token state kwd lexeme
+| NEInjSet    kwd_set        -> print_token state kwd_set "set"
-| KwdBracket (kwd, lbracket) ->
+| NEInjMap    kwd_map        -> print_token state kwd_map "map"
-    print_token state kwd lexeme;
+| NEInjRecord kwd_record     -> print_token state kwd_record "record"
-    print_token state lbracket "["
-
-and print_closing state = function
-  RBracket rbracket -> print_token state rbracket "]"
-| End kwd_end       -> print_token state kwd_end "end"
 
 and print_binding state {value; _} =
   let {source; arrow; image} = value in
@@ -787,7 +806,7 @@ and print_patterns state {value; _} =
 
 and print_list_pattern state = function
   PListComp comp ->
-   print_injection state "list" print_pattern comp
+   print_injection state print_pattern comp
 | PNil kwd_nil ->
     print_token state kwd_nil "nil"
 | PParCons cons ->
@@ -831,7 +850,7 @@ let pattern_to_string ~offsets ~mode =
 let instruction_to_string ~offsets ~mode =
   to_string ~offsets ~mode print_instruction
 
-(** {1 Pretty-printing the AST} *)
+(* Pretty-printing the AST *)
 
 let pp_ident state {value=name; region} =
   let reg  = compact state region in
@@ -842,12 +861,20 @@ let pp_node state name =
   let node = sprintf "%s%s\n" state#pad_path name
   in Buffer.add_string state#buffer node
 
-let pp_string state = pp_ident state
+let pp_string state {value=name; region} =
+  let reg  = compact state region in
+  let node = sprintf "%s%S (%s)\n" state#pad_path name reg
+  in Buffer.add_string state#buffer node
+
+let pp_verbatim state {value=name; region} =
+  let reg  = compact state region in
+  let node = sprintf "%s{|%s|} (%s)\n" state#pad_path name reg
+  in Buffer.add_string state#buffer node
 
 let pp_loc_node state name region =
   pp_ident state {value=name; region}
 
-let rec pp_ast state {decl; _} =
+let rec pp_cst state {decl; _} =
   let apply len rank =
     pp_declaration (state#pad len rank) in
   let decls = Utils.nseq_to_list decl in
@@ -943,9 +970,9 @@ and pp_type_expr state = function
                     field_decl.value in
     let fields = Utils.nsepseq_to_list value.ne_elements in
     List.iteri (List.length fields |> apply) fields
-| TStringLiteral s ->
+| TString s ->
-  pp_node   state "String";
+    pp_node   state "TString";
-  pp_string (state#pad 1 0) s
+    pp_string (state#pad 1 0) s
 
 and pp_cartesian state {value; _} =
   let apply len rank =
@@ -1244,8 +1271,8 @@ and pp_projection state proj =
   List.iteri (apply len) selections
 
 and pp_update state update =
-  pp_path state update.record;
+  pp_path (state#pad 2 0) update.record;
-  pp_ne_injection pp_field_path_assign state update.updates.value
+  pp_ne_injection pp_field_path_assignment state update.updates.value
 
 and pp_selection state = function
   FieldName name ->
@@ -1285,17 +1312,27 @@ and pp_for_loop state = function
     pp_for_collect state value
 
 and pp_for_int state for_int =
+  let {assign; bound; step; block; _} = for_int in
+  let arity =
+    match step with None -> 3 | Some _ -> 4 in
   let () =
-    let state = state#pad 3 0 in
+    let state = state#pad arity 0 in
     pp_node state "<init>";
-    pp_var_assign state for_int.assign.value in
+    pp_var_assign state assign.value in
   let () =
-    let state = state#pad 3 1 in
+    let state = state#pad arity 1 in
     pp_node state "<bound>";
-    pp_expr (state#pad 1 0) for_int.bound in
+    pp_expr (state#pad 1 0) bound in
   let () =
-    let state = state#pad 3 2 in
+    match step with
-    let statements = for_int.block.value.statements in
+      None -> ()
+    | Some (_, expr) ->
+        let state = state#pad arity 2 in
+        pp_node state "<step>";
+        pp_expr (state#pad 1 0) expr in
+  let () =
+    let state = state#pad arity (arity-1) in
+    let statements = block.value.statements in
     pp_node state "<statements>";
     pp_statements state statements
   in ()
@@ -1318,10 +1355,10 @@ and pp_for_collect state collect =
     pp_collection (state#pad 2 0) collect.collection;
     pp_expr (state#pad 1 0) collect.expr in
   let () =
-      let state = state#pad 3 2 in
+    let state = state#pad 3 2 in
-      let statements = collect.block.value.statements in
+    let statements = collect.block.value.statements in
-      pp_node state "<statements>";
+    pp_node state "<statements>";
-      pp_statements state statements
+    pp_statements state statements
   in ()
 
 and pp_collection state = function
@@ -1343,18 +1380,18 @@ and pp_fun_call state (expr, args) =
 
 and pp_record_patch state patch =
   pp_path (state#pad 2 0) patch.path;
-  pp_ne_injection pp_field_assign state patch.record_inj.value
+  pp_ne_injection pp_field_assignment state patch.record_inj.value
 
-and pp_field_assign state {value; _} =
+and pp_field_assignment state {value; _} =
   pp_node  state "<field assignment>";
   pp_ident (state#pad 2 0) value.field_name;
   pp_expr  (state#pad 2 1) value.field_expr
 
-and pp_field_path_assign state {value; _} =
+and pp_field_path_assignment state {value; _} =
-  pp_node  state "<field path for update>";
+  let {field_path; field_expr; _} = value in
-  let path = Utils.nsepseq_to_list value.field_path in
+  pp_node state "<update>";
-  List.iter (pp_ident (state#pad 2 0)) path;
+  pp_path (state#pad 2 0) field_path;
-  pp_expr  (state#pad 2 1) value.field_expr
+  pp_expr (state#pad 2 1) field_expr
 
 and pp_map_patch state patch =
   pp_path (state#pad 2 0) patch.path;
@@ -1403,7 +1440,7 @@ and pp_expr state = function
     pp_cond_expr state value
 | EAnnot {value; region} ->
     pp_loc_node state "EAnnot" region;
-    pp_annotated state value
+    pp_annotated state value.inside
 | ELogic e_logic ->
     pp_node state "ELogic";
     pp_e_logic (state#pad 1 0) e_logic
@@ -1424,7 +1461,7 @@ and pp_expr state = function
     pp_constr_expr (state#pad 1 0) e_constr
 | ERecord {value; region} ->
     pp_loc_node state "ERecord" region;
-    pp_ne_injection pp_field_assign state value
+    pp_ne_injection pp_field_assignment state value
 | EProj {value; region} ->
     pp_loc_node state "EProj" region;
     pp_projection state value
@@ -1576,9 +1613,9 @@ and pp_string_expr state = function
     pp_string (state#pad 1 0) s
 | Verbatim v ->
     pp_node   state "Verbatim";
-    pp_string (state#pad 1 0) v
+    pp_verbatim (state#pad 1 0) v
 
-and pp_annotated state (expr, t_expr) =
+and pp_annotated state (expr, _, t_expr) =
   pp_expr      (state#pad 2 0) expr;
   pp_type_expr (state#pad 2 1) t_expr
 

src/passes/01-parser/pascaligo/ParserLog.mli

@@ -33,5 +33,5 @@ val instruction_to_string :
 
 (** {1 Pretty-printing of AST nodes} *)
 
-val pp_ast  : state -> AST.t -> unit
+val pp_cst  : state -> AST.t -> unit
 val pp_expr : state -> AST.expr -> unit

src/passes/01-parser/pascaligo/ParserMain.ml

@@ -22,7 +22,8 @@ module SubIO =
       ext     : string;
       mode    : [`Byte | `Point];
       cmd     : EvalOpt.command;
-      mono    : bool
+      mono    : bool;
+      pretty  : bool
     >
 
     let options : options =
@@ -36,6 +37,7 @@ module SubIO =
         method mode    = IO.options#mode
         method cmd     = IO.options#cmd
         method mono    = IO.options#mono
+        method pretty  = IO.options#pretty
       end
 
     let make =
@@ -48,6 +50,7 @@ module SubIO =
                    ~mode:options#mode
                    ~cmd:options#cmd
                    ~mono:options#mono
+                   ~pretty:options#pretty
   end
 
 module Parser =
@@ -67,14 +70,28 @@ module ParserLog =
 module Lexer = Lexer.Make (LexToken)
 
 module Unit =
-  ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog)(SubIO)
+  ParserUnit.Make (Lexer)(AST)(Parser)(Parser_msg)(ParserLog)(SubIO)
 
 (* Main *)
 
 let wrap = function
-  Stdlib.Ok _ -> flush_all ()
+  Stdlib.Ok ast ->
+    if IO.options#pretty then
+      begin
+        let doc = Pretty.print ast in
+        let width =
+          match Terminal_size.get_columns () with
+            None -> 60
+          | Some c -> c in
+        PPrint.ToChannel.pretty 1.0 width stdout doc;
+        print_newline ()
+      end;
+    flush_all ()
 | Error msg ->
-    (flush_all (); Printf.eprintf "\027[31m%s\027[0m%!" msg.Region.value)
+    begin
+      flush_all ();
+      Printf.eprintf "\027[31m%s\027[0m%!" msg.Region.value
+    end
 
 let () =
   match IO.options#input with

src/passes/01-parser/pascaligo/Pretty.ml

@@ -0,0 +1,632 @@
+[@@@warning "-42"]
+[@@@warning "-27"]
+[@@@warning "-26"]
+
+open AST
+module Region = Simple_utils.Region
+open! Region
+open! PPrint
+
+let pp_par : ('a -> document) -> 'a par reg -> document =
+  fun printer {value; _} ->
+    string "(" ^^ nest 1 (printer value.inside ^^ string ")")
+
+let pp_brackets : ('a -> document) -> 'a brackets reg -> document =
+  fun printer {value; _} ->
+    string "[" ^^ nest 1 (printer value.inside ^^ string "]")
+
+let pp_braces : ('a -> document) -> 'a braces reg -> document =
+  fun printer {value; _} ->
+    string "{" ^^ nest 1 (printer value.inside ^^ string "}")
+
+let rec print ast =
+  let app decl = group (pp_declaration decl) in
+  let decl = Utils.nseq_to_list ast.decl in
+  separate_map (hardline ^^ hardline) app decl
+
+and pp_declaration = function
+  TypeDecl  d -> pp_type_decl  d
+| ConstDecl d -> pp_const_decl d
+| FunDecl   d -> pp_fun_decl   d
+| AttrDecl  d -> pp_attr_decl  d
+
+and pp_attr_decl decl = pp_ne_injection pp_string decl
+
+and pp_const_decl {value; _} =
+  let {name; const_type; init; attributes; _} = value in
+  let start = string ("const " ^ name.value) in
+  let t_expr = pp_type_expr const_type in
+  let attr   = match attributes with
+                 None -> empty
+               | Some a -> hardline ^^ pp_attr_decl a in
+  group (start ^/^ nest 2 (string ": " ^^ t_expr))
+  ^^ group (break 1 ^^ nest 2 (string "= " ^^ pp_expr init))
+  ^^ attr
+
+(* Type declarations *)
+
+and pp_type_decl decl =
+  let {name; type_expr; _} = decl.value in
+  string "type " ^^ string name.value ^^ string " is"
+  ^^ group (nest 2 (break 1 ^^ pp_type_expr type_expr))
+
+and pp_type_expr = function
+  TProd t   -> pp_cartesian t
+| TSum t    -> pp_variants t
+| TRecord t -> pp_fields t
+| TApp t    -> pp_type_app t
+| TFun t    -> pp_fun_type t
+| TPar t    -> pp_type_par t
+| TVar t    -> pp_ident t
+| TString s -> pp_string s
+
+and pp_cartesian {value; _} =
+  let head, tail = value in
+  let rec app = function
+    []  -> empty
+  | [e] -> group (break 1 ^^ pp_type_expr e)
+  | e::items ->
+      group (break 1 ^^ pp_type_expr e ^^ string " *") ^^ app items
+  in pp_type_expr head ^^ string " *" ^^ app (List.map snd tail)
+
+and pp_variants {value; _} =
+  let head, tail = value in
+  let head = pp_variant head in
+  let head = if tail = [] then head
+             else ifflat head (string "  " ^^ head) in
+  let rest = List.map snd tail in
+  let app variant = break 1 ^^ string "| " ^^ pp_variant variant
+  in head ^^ concat_map app rest
+
+and pp_variant {value; _} =
+  let {constr; arg} = value in
+  match arg with
+    None -> pp_ident constr
+  | Some (_, e) ->
+      prefix 4 1 (pp_ident constr ^^ string " of") (pp_type_expr e)
+
+and pp_fields fields = pp_ne_injection pp_field_decl fields
+
+and pp_field_decl {value; _} =
+  let {field_name; field_type; _} = value in
+  let name   = pp_ident field_name in
+  let t_expr = pp_type_expr field_type
+  in prefix 2 1 (name ^^ string " :") t_expr
+
+and pp_fun_type {value; _} =
+  let lhs, _, rhs = value in
+  group (pp_type_expr lhs ^^ string " ->" ^/^ pp_type_expr rhs)
+
+and pp_type_par t = pp_par pp_type_expr t
+
+and pp_type_app {value = ctor, tuple; _} =
+  prefix 2 1 (pp_type_constr ctor) (pp_type_tuple tuple)
+
+and pp_type_constr ctor = string ctor.value
+
+and pp_type_tuple {value; _} =
+  let head, tail = value.inside in
+  let rec app = function
+    []  -> empty
+  | [e] -> group (break 1 ^^ pp_type_expr e)
+  | e::items ->
+      group (break 1 ^^ pp_type_expr e ^^ string ",") ^^ app items in
+  let components =
+    if tail = []
+    then pp_type_expr head
+    else pp_type_expr head ^^ string "," ^^ app (List.map snd tail)
+  in string "(" ^^ nest 1 (components ^^ string ")")
+
+(* Function and procedure declarations *)
+
+and pp_fun_expr {value; _} =
+  let {param; ret_type; return; _} : fun_expr = value in
+  let start = string "function" in
+  let parameters = pp_par pp_parameters param in
+  let return_t = pp_type_expr ret_type in
+  let expr = pp_expr return in
+  group (start ^^ nest 2 (break 1 ^^ parameters))
+  ^^ group (break 1 ^^ nest 2 (string ": " ^^ return_t))
+  ^^ string " is" ^^ group (nest 4 (break 1 ^^ expr))
+
+and pp_fun_decl {value; _} =
+  let {kwd_recursive; fun_name; param;
+       ret_type; block_with; return; attributes; _} = value in
+  let start =
+    match kwd_recursive with
+        None -> string "function"
+    | Some _ -> string "recursive" ^/^ string "function" in
+  let start = start ^^ group (break 1 ^^ nest 2 (pp_ident fun_name)) in
+  let parameters = pp_par pp_parameters param in
+  let return_t = pp_type_expr ret_type in
+  let expr = pp_expr return in
+  let body =
+    match block_with with
+            None -> group (nest 2 (break 1 ^^ expr))
+    | Some (b,_) -> hardline ^^ pp_block b ^^ string " with"
+                   ^^ group (nest 4 (break 1 ^^ expr))
+  and attr =
+    match attributes with
+        None -> empty
+    | Some a -> hardline ^^ pp_attr_decl a in
+  prefix 2 1 start parameters
+  ^^ group (nest 2 (break 1 ^^ string ": " ^^ nest 2 return_t ^^ string " is"))
+  ^^ body ^^ attr
+
+and pp_parameters p = pp_nsepseq ";" pp_param_decl p
+
+and pp_param_decl = function
+  ParamConst c -> pp_param_const c
+| ParamVar   v -> pp_param_var v
+
+and pp_param_const {value; _} =
+  let {var; param_type; _} : param_const = value in
+  let name   = string ("const " ^ var.value) in
+  let t_expr = pp_type_expr param_type
+  in prefix 2 1 (name ^^ string " :") t_expr
+
+and pp_param_var {value; _} =
+  let {var; param_type; _} : param_var = value in
+  let name   = string ("var " ^ var.value) in
+  let t_expr = pp_type_expr param_type
+  in prefix 2 1 (name ^^ string " :") t_expr
+
+and pp_block {value; _} =
+  string "block {"
+  ^^ nest 2 (hardline ^^ pp_statements value.statements)
+  ^^ hardline ^^ string "}"
+
+and pp_statements s = pp_nsepseq ";" pp_statement s
+
+and pp_statement = function
+  Instr s -> pp_instruction s
+| Data  s -> pp_data_decl   s
+| Attr  s -> pp_attr_decl   s
+
+and pp_data_decl = function
+  LocalConst d -> pp_const_decl d
+| LocalVar   d -> pp_var_decl   d
+| LocalFun   d -> pp_fun_decl   d
+
+and pp_var_decl {value; _} =
+  let {name; var_type; init; _} = value in
+  let start = string ("var " ^ name.value) in
+  let t_expr = pp_type_expr var_type in
+  group (start ^/^ nest 2 (string ": " ^^ t_expr))
+  ^^ group (break 1 ^^ nest 2 (string ":= " ^^ pp_expr init))
+
+and pp_instruction = function
+  Cond        i -> group (pp_conditional i)
+| CaseInstr   i -> pp_case pp_if_clause i
+| Assign      i -> pp_assignment i
+| Loop        i -> pp_loop i
+| ProcCall    i -> pp_fun_call i
+| Skip        _ -> string "skip"
+| RecordPatch i -> pp_record_patch i
+| MapPatch    i -> pp_map_patch i
+| SetPatch    i -> pp_set_patch i
+| MapRemove   i -> pp_map_remove i
+| SetRemove   i -> pp_set_remove i
+
+and pp_set_remove {value; _} =
+  let {element; set; _} : set_remove = value in
+  string "remove" ^^ group (nest 2 (break 1 ^^ pp_expr element))
+  ^^ group (break 1 ^^ prefix 2 1 (string "from set") (pp_path set))
+
+and pp_map_remove {value; _} =
+  let {key; map; _} = value in
+  string "remove" ^^ group (nest 2 (break 1 ^^ pp_expr key))
+  ^^ group (break 1 ^^ prefix 2 1 (string "from map") (pp_path map))
+
+and pp_set_patch {value; _} =
+  let {path; set_inj; _} = value in
+  let inj = pp_ne_injection pp_expr set_inj in
+  string "patch"
+  ^^ group (nest 2 (break 1 ^^ pp_path path) ^/^ string "with")
+  ^^ group (nest 2 (break 1 ^^ inj))
+
+and pp_map_patch {value; _} =
+  let {path; map_inj; _} = value in
+  let inj = pp_ne_injection pp_binding map_inj in
+  string "patch"
+  ^^ group (nest 2 (break 1 ^^ pp_path path) ^/^ string "with")
+  ^^ group (nest 2 (break 1 ^^ inj))
+
+and pp_binding {value; _} =
+  let {source; image; _} = value in
+  pp_expr source
+  ^^ string " ->" ^^ group (nest 2 (break 1 ^^ pp_expr image))
+
+and pp_record_patch {value; _} =
+  let {path; record_inj; _} = value in
+  let inj = pp_record record_inj in
+  string "patch"
+  ^^ group (nest 2 (break 1 ^^ pp_path path) ^/^ string "with")
+  ^^ group (nest 2 (break 1 ^^ inj))
+
+and pp_cond_expr {value; _} =
+  let {test; ifso; ifnot; _} : cond_expr = value in
+  let test  = string "if "  ^^ group (nest 3 (pp_expr test))
+  and ifso  = string "then" ^^ group (nest 2 (break 1 ^^ pp_expr ifso))
+  and ifnot = string "else" ^^ group (nest 2 (break 1 ^^ pp_expr ifnot))
+  in test ^/^ ifso ^/^ ifnot
+
+and pp_conditional {value; _} =
+  let {test; ifso; ifnot; _} : conditional = value in
+  let test  = string "if "  ^^ group (nest 3 (pp_expr test))
+  and ifso  = match ifso with
+                ClauseInstr _ | ClauseBlock LongBlock _ ->
+                  string "then"
+                  ^^ group (nest 2 (break 1 ^^ pp_if_clause ifso))
+              | ClauseBlock ShortBlock _ ->
+                  string "then {"
+                  ^^ group (nest 2 (hardline ^^ pp_if_clause ifso))
+                  ^^ hardline ^^ string "}"
+  and ifnot = match ifnot with
+                ClauseInstr _ | ClauseBlock LongBlock _ ->
+                  string "else"
+                  ^^ group (nest 2 (break 1 ^^ pp_if_clause ifnot))
+              | ClauseBlock ShortBlock _ ->
+                  string "else {"
+                  ^^ group (nest 2 (hardline ^^ pp_if_clause ifnot))
+                  ^^ hardline ^^ string "}"
+  in test ^/^ ifso ^/^ ifnot
+
+and pp_if_clause = function
+  ClauseInstr i -> pp_instruction i
+| ClauseBlock b -> pp_clause_block b
+
+and pp_clause_block = function
+  LongBlock b  -> pp_block b
+| ShortBlock b -> Utils.(pp_statements <@ fst) b.value.inside
+
+and pp_set_membership {value; _} =
+  let {set; element; _} : set_membership = value in
+  group (pp_expr set ^/^ string "contains" ^/^ pp_expr element)
+
+and pp_case : 'a.('a -> document) -> 'a case Region.reg -> document =
+  fun printer {value; _} ->
+    let {expr; cases; _} = value in
+    group (string "case " ^^ nest 5 (pp_expr expr) ^/^ string "of [")
+    ^^ hardline ^^ pp_cases printer cases
+    ^^ hardline ^^ string "]"
+
+and pp_cases :
+  'a.('a -> document) ->
+    ('a case_clause reg, vbar) Utils.nsepseq Region.reg ->
+    document =
+  fun printer {value; _} ->
+    let head, tail = value in
+    let head       = pp_case_clause printer head in
+    let head       = blank 2 ^^ head in
+    let rest       = List.map snd tail in
+    let app clause = break 1 ^^ string "| " ^^ pp_case_clause printer clause
+    in  head ^^ concat_map app rest
+
+and pp_case_clause :
+  'a.('a -> document) -> 'a case_clause Region.reg -> document =
+  fun printer {value; _} ->
+    let {pattern; rhs; _} = value in
+    pp_pattern pattern ^^ prefix 4 1 (string " ->") (printer rhs)
+
+and pp_assignment {value; _} =
+  let {lhs; rhs; _} = value in
+  prefix 2 1 (pp_lhs lhs ^^ string " :=") (pp_expr rhs)
+
+and pp_lhs : lhs -> document = function
+  Path p    -> pp_path p
+| MapPath p -> pp_map_lookup p
+
+and pp_loop = function
+  While l -> pp_while_loop l
+| For f   -> pp_for_loop f
+
+and pp_while_loop {value; _} =
+  let {cond; block; _} = value in
+  prefix 2 1 (string "while") (pp_expr cond) ^^ hardline ^^ pp_block block
+
+and pp_for_loop = function
+  ForInt l     -> pp_for_int l
+| ForCollect l -> pp_for_collect l
+
+and pp_for_int {value; _} =
+  let {assign; bound; step; block; _} = value in
+  let step =
+    match step with
+      None -> empty
+    | Some (_, e) -> prefix 2 1 (string " step") (pp_expr e) in
+  prefix 2 1 (string "for") (pp_var_assign assign)
+  ^^ prefix 2 1 (string " to") (pp_expr bound)
+  ^^ step ^^ hardline ^^ pp_block block
+
+and pp_var_assign {value; _} =
+  let {name; expr; _} = value in
+  prefix 2 1 (pp_ident name ^^ string " :=") (pp_expr expr)
+
+and pp_for_collect {value; _} =
+  let {var; bind_to; collection; expr; block; _} = value in
+  let binding =
+    match bind_to with
+      None -> pp_ident var
+    | Some (_, dest) -> pp_ident var ^^ string " -> " ^^ pp_ident dest in
+  prefix 2 1 (string "for") binding
+  ^^ prefix 2 1 (string " in") (pp_collection collection ^/^ pp_expr expr)
+  ^^ hardline ^^ pp_block block
+
+and pp_collection = function
+  Map  _ -> string "map"
+| Set  _ -> string "set"
+| List _ -> string "list"
+
+(* Expressions *)
+
+and pp_expr = function
+  ECase   e -> pp_case pp_expr e
+| ECond   e -> group (pp_cond_expr e)
+| EAnnot  e -> pp_annot_expr e
+| ELogic  e -> group (pp_logic_expr e)
+| EArith  e -> group (pp_arith_expr e)
+| EString e -> pp_string_expr e
+| EList   e -> group (pp_list_expr e)
+| ESet    e -> pp_set_expr e
+| EConstr e -> pp_constr_expr e
+| ERecord e -> pp_record e
+| EProj   e -> pp_projection e
+| EUpdate e -> pp_update e
+| EMap    e -> pp_map_expr e
+| EVar    e -> pp_ident e
+| ECall   e -> pp_fun_call e
+| EBytes  e -> pp_bytes e
+| EUnit   _ -> string "Unit"
+| ETuple  e -> pp_tuple_expr e
+| EPar    e -> pp_par pp_expr e
+| EFun    e -> pp_fun_expr e
+
+and pp_annot_expr {value; _} =
+  let expr, _, type_expr = value.inside in
+  group (string "(" ^^ nest 1 (pp_expr expr ^/^ string ": "
+                               ^^ pp_type_expr type_expr ^^ string ")"))
+
+and pp_set_expr = function
+  SetInj inj -> pp_injection pp_expr inj
+| SetMem mem -> pp_set_membership mem
+
+and pp_map_expr = function
+  MapLookUp fetch -> pp_map_lookup fetch
+| MapInj inj      -> pp_injection pp_binding inj
+| BigMapInj inj   -> pp_injection pp_binding inj
+
+and pp_map_lookup {value; _} =
+  prefix 2 1 (pp_path value.path) (pp_brackets pp_expr value.index)
+
+and pp_path = function
+  Name v -> pp_ident v
+| Path p -> pp_projection p
+
+and pp_logic_expr = function
+  BoolExpr e -> pp_bool_expr e
+| CompExpr e -> pp_comp_expr e
+
+and pp_bool_expr = function
+  Or   e  -> pp_bin_op "or" e
+| And  e  -> pp_bin_op "and" e
+| Not  e  -> pp_un_op "not" e
+| True  _ -> string "True"
+| False _ -> string "False"
+
+and pp_bin_op op {value; _} =
+  let {arg1; arg2; _} = value
+  and length = String.length op + 1 in
+  pp_expr arg1 ^/^ string (op ^ " ") ^^ nest length (pp_expr arg2)
+
+and pp_un_op op {value; _} =
+  string (op ^ " ") ^^ pp_expr value.arg
+
+and pp_comp_expr = function
+  Lt    e -> pp_bin_op "<"  e
+| Leq   e -> pp_bin_op "<=" e
+| Gt    e -> pp_bin_op ">"  e
+| Geq   e -> pp_bin_op ">=" e
+| Equal e -> pp_bin_op "="  e
+| Neq   e -> pp_bin_op "=/=" e
+
+and pp_arith_expr = function
+  Add   e -> pp_bin_op "+" e
+| Sub   e -> pp_bin_op "-" e
+| Mult  e -> pp_bin_op "*" e
+| Div   e -> pp_bin_op "/" e
+| Mod   e -> pp_bin_op "mod" e
+| Neg   e -> string "-" ^^ pp_expr e.value.arg
+| Int   e -> pp_int e
+| Nat   e -> pp_nat e
+| Mutez e -> pp_mutez e
+
+and pp_mutez {value; _} =
+  Z.to_string (snd value) ^ "mutez" |> string
+
+and pp_string_expr = function
+  Cat      e -> pp_bin_op "^" e
+| String   e -> pp_string e
+| Verbatim e -> pp_verbatim e
+
+and pp_ident {value; _} = string value
+
+and pp_string s = string "\"" ^^ pp_ident s ^^ string "\""
+
+and pp_verbatim s = string "{|" ^^ pp_ident s ^^ string "|}"
+
+and pp_list_expr = function
+  ECons     e -> pp_bin_op "#" e
+| EListComp e -> pp_injection pp_expr e
+| ENil      _ -> string "nil"
+
+and pp_constr_expr = function
+  SomeApp   a -> pp_some_app a
+| NoneExpr  _ -> string "None"
+| ConstrApp a -> pp_constr_app a
+
+and pp_some_app {value; _} =
+  prefix 4 1 (string "Some") (pp_arguments (snd value))
+
+and pp_constr_app {value; _} =
+  let constr, args = value in
+  let constr = string constr.value in
+  match args with
+          None -> constr
+  | Some tuple -> prefix 2 1 constr (pp_tuple_expr tuple)
+
+
+and pp_field_assign {value; _} =
+  let {field_name; field_expr; _} = value in
+  prefix 2 1 (pp_ident field_name ^^ string " =") (pp_expr field_expr)
+
+and pp_record ne_inj = group (pp_ne_injection pp_field_assign ne_inj)
+
+and pp_projection {value; _} =
+  let {struct_name; field_path; _} = value in
+  let fields = Utils.nsepseq_to_list field_path
+  and sep    = string "." ^^ break 0 in
+  let fields = separate_map sep pp_selection fields in
+  group (pp_ident struct_name ^^ string "." ^^ break 0 ^^ fields)
+
+and pp_update {value; _} =
+  let {record; updates; _} = value in
+  let updates = group (pp_ne_injection pp_field_path_assign updates)
+  and record  = pp_path record in
+  record ^^ string " with" ^^ nest 2 (break 1 ^^ updates)
+
+and pp_field_path_assign {value; _} =
+  let {field_path; field_expr; _} = value in
+  let path = pp_path field_path in
+  prefix 2 1 (path ^^ string " =") (pp_expr field_expr)
+
+and pp_selection = function
+  FieldName v   -> string v.value
+| Component cmp -> cmp.value |> snd |> Z.to_string |> string
+
+and pp_tuple_expr {value; _} =
+  let head, tail = value.inside in
+  let rec app = function
+    []  -> empty
+  | [e] -> group (break 1 ^^ pp_expr e)
+  | e::items ->
+      group (break 1 ^^ pp_expr e ^^ string ",") ^^ app items in
+  let components =
+    if tail = []
+    then pp_expr head
+    else pp_expr head ^^ string "," ^^ app (List.map snd tail)
+  in string "(" ^^ nest 1 (components ^^ string ")")
+
+and pp_fun_call {value; _} =
+  let lambda, arguments = value in
+  let arguments = pp_tuple_expr arguments in
+  group (pp_expr lambda ^^ nest 2 (break 1 ^^ arguments))
+
+and pp_arguments v = pp_tuple_expr v
+
+(* Injections *)
+
+and pp_injection :
+  'a.('a -> document) -> 'a injection reg -> document =
+  fun printer {value; _} ->
+    let {kind; elements; _} = value in
+    let sep      = string ";" ^^ break 1 in
+    let elements = Utils.sepseq_to_list elements in
+    let elements = separate_map sep printer elements in
+    let kwd      = pp_injection_kwd kind in
+    group (string (kwd ^ " [")
+           ^^ nest 2 (break 0 ^^ elements) ^^ break 0 ^^ string "]")
+
+and pp_injection_kwd = function
+  InjSet    _ -> "set"
+| InjMap    _ -> "map"
+| InjBigMap _ -> "big_map"
+| InjList   _ -> "list"
+
+and pp_ne_injection :
+  'a.('a -> document) -> 'a ne_injection reg -> document =
+  fun printer {value; _} ->
+    let {kind; ne_elements; _} = value in
+    let elements = pp_nsepseq ";" printer ne_elements in
+    let kwd      = pp_ne_injection_kwd kind in
+    group (string (kwd ^ " [")
+           ^^ group (nest 2 (break 0 ^^ elements ))
+           ^^ break 0 ^^ string "]")
+
+and pp_ne_injection_kwd = function
+  NEInjAttr   _ -> "attributes"
+| NEInjSet    _ -> "set"
+| NEInjMap    _ -> "map"
+| NEInjRecord _ -> "record"
+
+and pp_nsepseq :
+  'a.string -> ('a -> document) -> ('a, t) Utils.nsepseq -> document =
+  fun sep printer elements ->
+    let elems = Utils.nsepseq_to_list elements
+    and sep   = string sep ^^ break 1
+    in separate_map sep printer elems
+
+(* Patterns *)
+
+and pp_pattern = function
+  PConstr p -> pp_constr_pattern p
+| PVar    v -> pp_ident v
+| PWild   _ -> string "_"
+| PInt    i -> pp_int i
+| PNat    n -> pp_nat n
+| PBytes  b -> pp_bytes b
+| PString s -> pp_string s
+| PList   l -> pp_list_pattern l
+| PTuple  t -> pp_tuple_pattern t
+
+and pp_int {value; _} =
+  string (Z.to_string (snd value))
+
+and pp_nat {value; _} =
+  string (Z.to_string (snd value) ^ "n")
+
+and pp_bytes {value; _} =
+  string ("0x" ^ Hex.show (snd value))
+
+and pp_constr_pattern = function
+  PUnit      _ -> string "Unit"
+| PFalse     _ -> string "False"
+| PTrue      _ -> string "True"
+| PNone      _ -> string "None"
+| PSomeApp   a -> pp_psome a
+| PConstrApp a -> pp_pconstr_app a
+
+and pp_psome {value=_, p; _} =
+  prefix 4 1 (string "Some") (pp_par pp_pattern p)
+
+and pp_pconstr_app {value; _} =
+  match value with
+    constr, None -> pp_ident constr
+  | constr, Some ptuple ->
+      prefix 4 1 (pp_ident constr) (pp_tuple_pattern ptuple)
+
+and pp_tuple_pattern {value; _} =
+  let head, tail = value.inside in
+  let rec app = function
+    []  -> empty
+  | [e] -> group (break 1 ^^ pp_pattern e)
+  | e::items ->
+      group (break 1 ^^ pp_pattern e ^^ string ",") ^^ app items in
+  let components =
+    if   tail = []
+    then pp_pattern head
+    else pp_pattern head ^^ string "," ^^ app (List.map snd tail)
+  in string "(" ^^ nest 1 (components ^^ string ")")
+
+and pp_list_pattern = function
+  PListComp cmp -> pp_list_comp cmp
+| PNil _        -> string "nil"
+| PParCons p    -> pp_ppar_cons p
+| PCons p       -> nest 4 (pp_nsepseq " #" pp_pattern p.value)
+
+and pp_list_comp e = pp_injection pp_pattern e
+
+and pp_ppar_cons {value; _} =
+  let patt1, _, patt2 = value.inside in
+  let comp = prefix 2 1 (pp_pattern patt1 ^^ string " ::") (pp_pattern patt2)
+  in string "(" ^^ nest 1 (comp ^^ string ")")

src/passes/01-parser/pascaligo/Tests/pp.ligo

@@ -1,19 +1,23 @@
+function incr_map (const l : list (int)) : list (int) is
+  List.map (function (const i : int) : int is i + 1, l)
+
 type t is timestamp * nat -> map (string, address)
 type u is A | B of t * int | C of int -> (string -> int)
-type v is record a : t; b : record c : string end end
+type v is record aaaaaa : ttttttt; bbbbbb : record ccccccccc : string end end
 
 function back (var store : store) : list (operation) * store is
   begin
-    var operations : list (operation) := list [];
+     var operations  : list (operation) := list [];
-    const a : nat =  0n;
+    const operations : list (operation) = list [];
-    x0 := record foo = "1"; bar = 4n end;
+    const a          : nat =  0n;
-    x1 := nil;
+    x0               := record foo = "1"; bar = 4n end;
-    x2 := list end;
+    x1               := nil;
+    x2               := list end;
     x3 := 3#4# list [5; 6];
     case foo of
       10n -> skip
     end;
-    if s contains x then skip else skip;
+if saaa.0.1.2.a.b.b.x contains xxxxxxxxxxxxxxx[123] then skip else skip;
     s := set [3_000mutez; -2; 1n];
     a := A;
     b := B (a);
@@ -21,12 +25,12 @@ function back (var store : store) : list (operation) * store is
     d := None;
     e := Some (a, B (b));
     z := z.1.2;
-    x := map [1 -> "1"; 2 -> "2"];
+x := if true then map [1 -> "1"; 2 -> "2"; 3 -> "3"; 4 -> "4"; 5 -> "5555555555555555"] else Unit;
     y := a.b.c[3];
     a := "hello " ^ "world" ^ "!";
-    r := record a = 0 end;
+    r := record aaaaaaaaaaaa = 100000000; bbbbbbb = ffffff (2, aa, x, y) + 1 end;
-    r := r with record a = 42 end;
+    r := r with record aaaaaaaaaaa = 444442; bbbbbbbbb = 43 + f (z) / 234 end;
-    patch store.backers with set [(1); f(2*3)];
+    patch store.backers.8.aa.33333.5 with set [(1); f(2*3); 123124234/2345];
     remove (1,2,3) from set foo.bar;
     remove 3 from map foo.bar;
     patch store.backers with map [sender -> amount];
@@ -39,7 +43,7 @@ function back (var store : store) : list (operation) * store is
           begin
             acc := 2 - (if toggle then f(x) else Unit);
           end;
-        for i := 1n to 10n
+        for i := 1n to 10n step 2n
           begin
             acc := acc + i;
           end;
@@ -52,27 +56,32 @@ function back (var store : store) : list (operation) * store is
       | B (x, C (y,z)) -> skip
       | False#True#Unit#0xAA#"hi"#4#nil -> skip
       ]
-  end with (operations, store)
+  end with (operations, store, (more_stuff, and_here_too))
 
-function claim (var store : store) : list (operation) * store is
+  function claim (var store : store; const bar : t; const baz : u; var z : operations * store * (more_stuff * and_here_too)) : list (operation) * store * timestamp * nat -> map (string, address) is
   begin
-    var operations : list (operation) := nil;
+     const operations : list (operation * map (address, map (longname, domain))) = nilllllllllll;
+var operations : list (operation * map (address, map (longname, domain))) := nilllllllllll;
+     attributes ["foo"; "inline"];
     if now <= store.deadline then
       failwith ("Too soon.")
     else
       case store.backers[sender] of
         None ->
           failwith ("Not a backer.")
+      | Some (0) -> skip
       | Some (quantity) ->
           if balance >= store.goal or store.funded then
             failwith ("Goal reached: no refund.")
           else
             begin
-              operations.0.foo := list [transaction (unit, sender, quantity)];
+               operations.0.foo := list [transaction (unit, sender, quantity); transaction (foo, bar, bazzzzzzzzzzzzzzz)];
-              remove sender from map store.backers
+               remove sender.0099999.fffff [fiar (abaxxasfdf)] from map store.backers.foooooo.barrrrr.01.bazzzzzzz
             end
       end
-  end with (operations, store)
+  end with long_function_name (operations, store, (more_stuff, (and_here_too, well_in_here_too), hello))
+
+attributes ["inline"; "foo"]
 
 function withdraw (var store : store) : list (operation) * store is
   begin

src/passes/01-parser/pascaligo/dune

@@ -15,8 +15,10 @@
   (name parser_pascaligo)
   (public_name ligo.parser.pascaligo)
   (modules
-     Scoping AST pascaligo Parser ParserLog LexToken ParErr)
+     Scoping AST pascaligo Parser ParserLog LexToken ParErr Pretty)
   (libraries
+     pprint
+     terminal_size
      menhirLib
      parser_shared
      hex

src/passes/01-parser/reasonligo.ml

@@ -8,6 +8,7 @@ module Region      = Simple_utils.Region
 module ParErr      = Parser_reasonligo.ParErr
 module SyntaxError = Parser_reasonligo.SyntaxError
 module SSet        = Set.Make (String)
+module Pretty      = Parser_reasonligo.Pretty
 
 (* Mock IOs TODO: Fill them with CLI options *)
 
@@ -22,7 +23,8 @@ module SubIO =
       ext     : string;   (* ".religo" *)
       mode    : [`Byte | `Point];
       cmd     : EvalOpt.command;
-      mono    : bool
+      mono    : bool;
+      pretty  : bool
     >
 
     let options : options =
@@ -37,6 +39,7 @@ module SubIO =
            method mode    = `Point
            method cmd     = EvalOpt.Quiet
            method mono    = false
+           method pretty  = false
          end
 
     let make =
@@ -49,6 +52,7 @@ module SubIO =
                    ~mode:options#mode
                    ~cmd:options#cmd
                    ~mono:options#mono
+                   ~pretty:options#pretty
   end
 
 module Parser =
@@ -178,3 +182,18 @@ let parse_expression source = apply (fun () -> Unit.expr_in_string source)
 (* Preprocessing a contract in a file *)
 
 let preprocess source = apply (fun () -> Unit.preprocess source)
+
+(* Pretty-print a file (after parsing it). *)
+
+let pretty_print source =
+  match parse_file source with
+    Stdlib.Error _ as e -> e
+  | Ok ast ->
+      let doc    = Pretty.print (fst ast) in
+      let buffer = Buffer.create 131 in
+      let width  =
+        match Terminal_size.get_columns () with
+          None -> 60
+        | Some c -> c in
+      let () = PPrint.ToBuffer.pretty 1.0 width buffer doc
+      in Trace.ok buffer

src/passes/01-parser/reasonligo.mli

@@ -19,3 +19,6 @@ val parse_expression : string -> AST.expr Trace.result
 
 (** Preprocess a given ReasonLIGO file and preprocess it. *)
 val preprocess : string -> Buffer.t Trace.result
+
+(** Pretty-print a given CameLIGO file (after parsing it). *)
+val pretty_print : string -> Buffer.t Trace.result

src/passes/01-parser/reasonligo/.links

@@ -27,5 +27,3 @@ Stubs/Parser_cameligo.ml
 ../cameligo/ParserLog.ml
 ../cameligo/Scoping.mli
 ../cameligo/Scoping.ml
-
-$HOME/git/ligo/_build/default/src/passes/1-parser/reasonligo/ParErr.ml

src/passes/01-parser/reasonligo/Parser.mly

@@ -125,7 +125,7 @@ nsepseq(item,sep):
 (* Non-empty comma-separated values (at least two values) *)
 
 tuple(item):
-  item "," nsepseq(item,",") { let h,t = $3 in $1,($2,h)::t }
+  item "," nsepseq(item,",") { let h,t = $3 in $1, ($2,h)::t }
 
 (* Possibly empty semicolon-separated values between brackets *)
 
@@ -279,15 +279,12 @@ let_binding:
 | par(closed_irrefutable) type_annotation? "=" expr {
     wild_error $4;
     Scoping.check_pattern $1.value.inside;
-    {binders = PPar $1, []; lhs_type=$2; eq=$3; let_rhs=$4}
+    {binders = $1.value.inside, []; lhs_type=$2; eq=$3; let_rhs=$4}
   }
 | tuple(sub_irrefutable) type_annotation? "=" expr {
     wild_error $4;
     Utils.nsepseq_iter Scoping.check_pattern $1;
-    let hd, tl  = $1 in
+    let region  = nsepseq_to_region pattern_to_region $1 in
-    let start   = pattern_to_region hd in
-    let stop    = last fst tl in
-    let region  = cover start stop in
     let binders = PTuple {value=$1; region}, [] in
     {binders; lhs_type=$2; eq=$3; let_rhs=$4} }
 
@@ -433,7 +430,18 @@ type_expr_simple:
     TProd {region = cover $1 $3; value=$2}
   }
 | "(" type_expr_simple "=>" type_expr_simple ")" {
-    TFun {region = cover $1 $5; value=$2,$3,$4} }
+    TPar {
+      value = {
+        lpar = $1;
+        rpar = $5;
+        inside = TFun {
+          region = cover (type_expr_to_region $2) (type_expr_to_region $4);
+          value=$2,$3,$4
+        }
+      };
+      region = cover $1 $5;
+    }
+}
 
 type_annotation_simple:
   ":" type_expr_simple { $1,$2 }
@@ -456,8 +464,15 @@ fun_expr(right_expr):
         )
     | EAnnot {region; value = {inside = EVar v, colon, typ; _}} ->
         Scoping.check_reserved_name v;
-        let value = {pattern = PVar v; colon; type_expr = typ}
+        let value = {pattern = PVar v; colon; type_expr = typ} in
-        in PTyped {region; value}
+        PPar {
+          value = {
+            lpar = Region.ghost;
+            rpar = Region.ghost;
+            inside = PTyped {region; value}
+          };
+          region
+        }
     | EPar p ->
         let value =
           {p.value with inside = arg_to_pattern p.value.inside}
@@ -497,7 +512,13 @@ fun_expr(right_expr):
          (arg_to_pattern fun_arg, [])
       | EPar {value = {inside = EFun {
           value = {
-              binders = PTyped { value = { pattern; colon; type_expr }; region = fun_region }, [];
+              binders = PPar {
+                value = {
+                  inside = PTyped { value = { pattern; colon; type_expr }; region = fun_region };
+                  _
+                };
+                _
+              }, [];
               arrow;
               body;
               _
@@ -531,7 +552,7 @@ fun_expr(right_expr):
           };
           region;
         }, []
-      | EPar {value = {inside =  fun_arg; _ }; _} ->
+      | EPar {value = {inside = fun_arg; _ }; _} ->
           arg_to_pattern fun_arg, []
       | EAnnot _ as e ->
           arg_to_pattern e, []
@@ -656,7 +677,7 @@ disj_expr_level:
   disj_expr
 | conj_expr_level { $1 }
 | par(tuple(disj_expr_level)) type_annotation_simple? {
-    let region = $1.region in
+    let region = nsepseq_to_region expr_to_region $1.value.inside in
     let tuple  = ETuple {value=$1.value.inside; region} in
     let region =
       match $2 with
@@ -891,9 +912,9 @@ update_record:
       lbrace   = $1;
       record   = $3;
       kwd_with = $4;
-      updates  = {value = {compound = Braces($1,$6);
+      updates  = {value = {compound = Braces (ghost, ghost);
-                  ne_elements;
+                           ne_elements;
-                  terminator};
+                           terminator};
                   region = cover $4 $6};
       rbrace   = $6}
     in {region; value} }
@@ -921,10 +942,9 @@ exprs:
       in
       let sequence = ESeq {
         value = {
-          compound = BeginEnd(Region.ghost, Region.ghost);
+          compound   = BeginEnd (ghost, ghost);
-          elements = Some val_;
+          elements   = Some val_;
-          terminator = (snd c)
+          terminator = snd c};
-        };
         region = sequence_region
       }
       in
@@ -956,12 +976,11 @@ sequence:
   "{" exprs "}" {
     let elts, _region = $2 in
     let compound = Braces ($1, $3) in
-    let value = {compound;
+    let value    = {compound;
-                     elements = Some elts;
+                    elements = Some elts;
-                     terminator = None} in
+                    terminator = None} in
-    let region   = cover $1 $3 in  
+    let region   = cover $1 $3
-    {region; value}
+    in {region; value} }
-  }
 
 record:
   "{" field_assignment more_field_assignments? "}" {
@@ -986,46 +1005,29 @@ record:
     let ne_elements = Utils.nsepseq_cons field_name comma elts in
     let compound = Braces ($1,$4) in
     let region   = cover $1 $4 in
-    { value = {compound; ne_elements; terminator = None}; region }
+    {value = {compound; ne_elements; terminator = None}; region} }
-  }
 
 field_assignment_punning:
   (* This can only happen with multiple fields -
      one item punning does NOT work in ReasonML *)
   field_name {
-    let value = {
+    let value = {field_name = $1;
-      field_name = $1;
+                 assignment = ghost;
-      assignment = ghost;
+                 field_expr = EVar $1}
-      field_expr = EVar $1 }
     in {$1 with value}
   }
 | field_assignment { $1 }
 
 field_assignment:
   field_name ":" expr {
-    let start  = $1.region in
+    let region = cover $1.region (expr_to_region $3)
-    let stop   = expr_to_region $3 in
+    and value  = {field_name = $1;
-    let region = cover start stop in
+                  assignment = $2;
-    let value  = {
+                  field_expr = $3}
-      field_name = $1;
-      assignment = $2;
-      field_expr = $3}
     in {region; value} }
 
 field_path_assignment:
-  field_name {
+  path ":" expr {
-    let value = {
+    let region = cover (path_to_region $1) (expr_to_region $3)
-      field_path = ($1,[]);
+    and value  = {field_path=$1; assignment=$2; field_expr=$3}
-      assignment = ghost;
-      field_expr = EVar $1 }
-    in {$1 with value}
-  }
-| nsepseq(field_name,".") ":" expr {
-    let start  = nsepseq_to_region (fun x -> x.region) $1 in
-    let stop   = expr_to_region $3 in
-    let region = cover start stop in
-    let value  = {
-      field_path = $1;
-      assignment = $2;
-      field_expr = $3}
     in {region; value} }

src/passes/01-parser/reasonligo/ParserMain.ml

@@ -22,7 +22,8 @@ module SubIO =
       ext     : string;
       mode    : [`Byte | `Point];
       cmd     : EvalOpt.command;
-      mono    : bool
+      mono    : bool;
+      pretty  : bool
     >
 
     let options : options =
@@ -36,6 +37,7 @@ module SubIO =
         method mode    = IO.options#mode
         method cmd     = IO.options#cmd
         method mono    = IO.options#mono
+        method pretty  = IO.options#pretty
       end
 
     let make =
@@ -48,6 +50,7 @@ module SubIO =
                    ~mode:options#mode
                    ~cmd:options#cmd
                    ~mono:options#mono
+                   ~pretty:options#pretty
   end
 
 module Parser =
@@ -67,12 +70,23 @@ module ParserLog =
 module Lexer = Lexer.Make (LexToken)
 
 module Unit =
-  ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog)(SubIO)
+  ParserUnit.Make (Lexer)(AST)(Parser)(Parser_msg)(ParserLog)(SubIO)
 
 (* Main *)
 
 let wrap = function
-  Stdlib.Ok _ -> flush_all ()
+  Stdlib.Ok ast ->
+    if IO.options#pretty then
+      begin
+        let doc = Pretty.print ast in
+        let width =
+          match Terminal_size.get_columns () with
+            None -> 60
+          | Some c -> c in
+        PPrint.ToChannel.pretty 1.0 width stdout doc;
+        print_newline ()
+      end;
+    flush_all ()
 | Error msg ->
     (flush_all (); Printf.eprintf "\027[31m%s\027[0m%!" msg.Region.value)
 

src/passes/01-parser/reasonligo/Pretty.ml

@@ -0,0 +1,471 @@
+[@@@warning "-42"]
+
+open AST
+module Region = Simple_utils.Region
+open! Region
+open! PPrint
+
+let rec print ast =
+  let app decl = group (pp_declaration decl) in
+  separate_map (hardline ^^ hardline) app (Utils.nseq_to_list ast.decl)
+
+and pp_declaration = function
+  Let decl -> pp_let_decl decl
+| TypeDecl decl -> pp_type_decl decl
+
+and pp_let_decl = function
+| {value = (_,rec_opt, binding, attr); _} ->
+  let let_str =
+    match rec_opt with
+        None -> "let "
+    | Some _ -> "let rec " in
+  let bindings = pp_let_binding let_str binding
+  and attr    = pp_attributes attr
+  in group (attr ^^ bindings ^^ string ";")
+
+and pp_attributes = function
+    [] -> empty
+| attr ->
+    let make s = string "[@" ^^ string s.value ^^ string "]" in
+    group (break 0 ^^ separate_map (break 0) make attr) ^^ hardline
+
+and pp_ident {value; _} = string value
+
+and pp_string s = string "\"" ^^ pp_ident s ^^ string "\""
+
+and pp_verbatim s = string "{|" ^^ pp_ident s ^^ string "|}"
+
+and pp_let_binding let_ (binding : let_binding) =
+  let {binders; lhs_type; let_rhs; _} = binding in
+  let patterns = Utils.nseq_to_list binders in
+  let patterns = group (separate_map (break 0) pp_pattern patterns) in
+  let lhs =
+    string let_ ^^
+      match lhs_type with
+        None -> patterns ^^ string " = "
+      | Some (_,e) ->
+          patterns ^^ group (break 0 ^^ string ": " ^^ pp_type_expr e ^^ string " = ")
+  in
+  let rhs = pp_expr let_rhs in
+  match let_rhs with
+  | EFun _
+  | ESeq _
+  | ERecord _ -> lhs ^^ rhs
+  | _ -> prefix 2 0 lhs rhs
+
+and pp_pattern = function
+  PConstr p -> pp_pconstr p
+| PUnit   _ -> string "()"
+| PFalse  _ -> string "false"
+| PTrue   _ -> string "true"
+| PVar    v -> pp_ident v
+| PInt    i -> pp_int i
+| PNat    n -> pp_nat n
+| PBytes  b -> pp_bytes b
+| PString s -> pp_string s
+| PVerbatim s -> pp_verbatim s
+| PWild   _ -> string "_"
+| PList   l -> pp_plist l
+| PTuple  t -> pp_ptuple t
+| PPar    p -> pp_ppar p
+| PRecord r -> pp_precord r
+| PTyped  t -> pp_ptyped t
+
+and pp_pconstr = function
+  PNone      _ -> string "None"
+| PSomeApp   p -> pp_patt_some p
+| PConstrApp a -> pp_patt_c_app a
+
+and pp_patt_c_app {value; _} =
+  match value with
+    constr, None -> pp_ident constr
+  | constr, Some (PVar _ as pat) ->
+      prefix 2 1 (pp_ident constr)  (pp_pattern pat)
+  | constr, Some (_ as pat)->
+      prefix 2 0 (pp_ident constr)  (pp_pattern pat)
+
+and pp_patt_some {value; _} =
+  prefix 2 0 (string "Some") (pp_pattern (snd value))
+
+and pp_int {value; _} =
+  string (Z.to_string (snd value))
+
+and pp_nat {value; _} =
+  string (Z.to_string (snd value) ^ "n")
+
+and pp_bytes {value; _} =
+  string ("0x" ^ Hex.show (snd value))
+
+and pp_ppar {value; _} =
+  if value.lpar = Region.ghost then
+    nest 1 (pp_pattern value.inside)
+  else
+    string "(" ^^ nest 1 (pp_pattern value.inside) ^^ string ")"
+
+and pp_plist = function
+  PListComp cmp -> pp_list_comp cmp
+| PCons cons -> pp_cons cons
+
+and pp_list_comp e = group (pp_injection pp_pattern e)
+
+and pp_cons {value; _} =
+  let patt1, _, patt2 = value in
+  string "[" ^^ (pp_pattern patt1 ^^ string ", ") ^^ group ( break 0 ^^ string "..." ^^ pp_pattern patt2) ^^ string "]"
+
+and pp_ptuple {value; _} =
+  let head, tail = value in
+  let rec app = function
+    []  -> empty
+  | [p] -> group (break 1 ^^ pp_pattern p)
+  | p::items ->
+      group (break 1 ^^ pp_pattern p ^^ string ",") ^^ app items
+  in if tail = []
+     then string "(" ^^ nest 1 (pp_pattern head) ^^ string ")"
+     else string "(" ^^ nest 1 (pp_pattern head ^^ string "," ^^ app (List.map snd tail)) ^^ string ")"
+
+and pp_precord fields = pp_ne_injection pp_field_pattern fields
+
+and pp_field_pattern {value; _} =
+  let {field_name; pattern; _} = value in
+  prefix 2 1 (pp_ident field_name ^^ string " =") (pp_pattern pattern)
+
+and pp_ptyped {value; _} =
+  let {pattern; type_expr; _} = value in
+  group (pp_pattern pattern ^^ string ": " ^^ pp_type_expr type_expr)
+
+and pp_type_decl decl =
+  let {name; type_expr; _} = decl.value in
+  string "type " ^^ string name.value ^^ string " = "
+  ^^ group (pp_type_expr type_expr) ^^ string ";"
+
+and pp_expr = function
+  ECase   e -> pp_case_expr e
+| ECond   e -> group (pp_cond_expr e)
+| EAnnot  e -> pp_annot_expr e
+| ELogic  e -> pp_logic_expr e
+| EArith  e -> group (pp_arith_expr e)
+| EString e -> pp_string_expr e
+| EList   e -> group (pp_list_expr e)
+| EConstr e -> pp_constr_expr e
+| ERecord e -> pp_record_expr e
+| EProj   e -> pp_projection e
+| EUpdate e -> pp_update e
+| EVar    v -> pp_ident v
+| ECall   e -> pp_call_expr e
+| EBytes  e -> pp_bytes e
+| EUnit   _ -> string "()"
+| ETuple  e -> pp_tuple_expr e
+| EPar    e -> pp_par_expr e
+| ELetIn  e -> pp_let_in e
+| EFun    e -> pp_fun e
+| ESeq    e -> pp_seq e
+
+and pp_case_expr {value; _} =
+  let {expr; cases; _} = value in
+  group (string "switch" ^^ string "(" ^^ nest 1 (pp_expr expr)
+         ^^ string ") " ^^ string "{"
+         ^^ pp_cases cases ^^ hardline ^^ string "}")
+
+and pp_cases {value; _} =
+  let head, tail = value in
+  let rest = List.map snd tail in
+  let app clause = break 1 ^^ string "| " ^^ pp_clause clause
+  in  concat_map app (head :: rest)
+
+and pp_clause {value; _} =
+  let {pattern; rhs; _} = value in
+  prefix 4 1 (pp_pattern pattern ^^ string " =>") (pp_expr rhs)
+
+and pp_cond_expr {value; _} =
+  let {test; ifso; kwd_else; ifnot; _} = value in
+  let if_then =
+    string "if" ^^ string " (" ^^ pp_expr test ^^ string ")" ^^ string " {" ^^ break 0 
+    ^^ group (nest 2 (break 2 ^^ pp_expr ifso)) ^^ hardline ^^ string "}" in
+  if kwd_else#is_ghost then
+    if_then
+  else
+    if_then
+    ^^ string " else" ^^ string " {" ^^ break 0 ^^ group (nest 2 (break 2 ^^ pp_expr ifnot)) ^^ hardline ^^ string "}"
+
+and pp_annot_expr {value; _} =
+  let expr, _, type_expr = value.inside in
+    group (nest 1 (pp_expr expr ^/^ string ": "
+    ^^ pp_type_expr type_expr))
+
+and pp_logic_expr = function
+  BoolExpr e -> pp_bool_expr e
+| CompExpr e -> pp_comp_expr e
+
+and pp_bool_expr = function
+  Or   e  -> pp_bin_op "||" e
+| And  e  -> pp_bin_op "&&" e
+| Not  e  -> pp_un_op "!" e
+| True  _ -> string "true"
+| False _ -> string "false"
+
+and pp_bin_op op {value; _} =
+  let {arg1; arg2; _} = value
+  and length = String.length op + 1 in
+  pp_expr arg1 ^^ string " " ^^ string (op ^ " ") ^^ nest length (pp_expr arg2)
+
+and pp_un_op op {value; _} =
+  string (op ^ " ") ^^ pp_expr value.arg
+
+and pp_comp_expr = function
+  Lt    e -> pp_bin_op "<"  e
+| Leq   e -> pp_bin_op "<=" e
+| Gt    e -> pp_bin_op ">"  e
+| Geq   e -> pp_bin_op ">=" e
+| Equal e -> pp_bin_op "=="  e
+| Neq   e -> pp_bin_op "!=" e
+
+and pp_arith_expr = function
+  Add   e -> pp_bin_op "+" e
+| Sub   e -> pp_bin_op "-" e
+| Mult  e -> pp_bin_op "*" e
+| Div   e -> pp_bin_op "/" e
+| Mod   e -> pp_bin_op "mod" e
+| Neg   e -> string "-" ^^ pp_expr e.value.arg
+| Int   e -> pp_int e
+| Nat   e -> pp_nat e
+| Mutez e -> pp_mutez e
+
+and pp_mutez {value; _} =
+  Z.to_string (snd value) ^ "mutez" |> string
+
+and pp_string_expr = function
+     Cat e -> pp_bin_op "++" e
+| String e -> pp_string e
+| Verbatim e -> pp_verbatim e
+
+and pp_list_expr = function
+| ECons {value = {arg1; arg2; _}; _ } ->
+  string "[" ^^ pp_expr arg1 ^^ string "," ^^ break 1 ^^ string "..." ^^ pp_expr arg2 ^^ string "]"
+| EListComp e -> group (pp_injection pp_expr e)
+
+and pp_injection :
+  'a.('a -> document) -> 'a injection reg -> document =
+  fun printer {value; _} ->
+    let {compound; elements; _} = value in
+    let sep = (string ",") ^^ break 1 in
+    let elements = Utils.sepseq_to_list elements in
+    let elements = separate_map sep printer elements in
+    match pp_compound compound with
+      None -> elements
+    | Some (opening, closing) ->
+        string opening ^^ nest 1 elements ^^ string closing
+
+and pp_compound = function
+  BeginEnd (start, _) ->
+    if start#is_ghost then None else Some ("begin","end")
+| Braces (start, _) ->
+    if start#is_ghost then None else Some ("{","}")
+| Brackets (start, _) ->
+    if start#is_ghost then None else Some ("[","]")
+
+and pp_constr_expr = function
+  ENone      _ -> string "None"
+| ESomeApp   a -> pp_some a
+| EConstrApp a -> pp_constr_app a
+
+and pp_some {value=_, e; _} =
+  prefix 4 1 (string "Some") (pp_expr e)
+
+and pp_constr_app {value; _} =
+  let constr, arg = value in
+  let constr = string constr.value in
+  match arg with
+      None -> constr
+  | Some e -> prefix 2 1 constr (pp_expr e)
+
+and pp_record_expr ne_inj = pp_ne_injection pp_field_assign ne_inj
+
+and pp_field_assign {value; _} =
+  let {field_name; field_expr; _} = value in
+  prefix 2 1 (pp_ident field_name ^^ string ":") (pp_expr field_expr)
+
+and pp_ne_injection :
+  'a.('a -> document) -> 'a ne_injection reg -> document =
+  fun printer {value; _} ->
+    let {compound; ne_elements; _} = value in
+    let elements = pp_nsepseq "," printer ne_elements in
+    match pp_compound compound with
+      None -> elements
+    | Some (opening, closing) ->
+        string opening ^^ nest 2 (break 0 ^^ elements) ^^ break 1 ^^ string closing
+
+and pp_nsepseq :
+  'a.string -> ('a -> document) -> ('a, t) Utils.nsepseq -> document =
+  fun sep printer elements ->
+    let elems = Utils.nsepseq_to_list elements
+    and sep   = string sep ^^ break 1
+    in separate_map sep printer elems
+
+and pp_projection {value; _} =
+  let {struct_name; field_path; _} = value in
+  let subpath = Utils.nsepseq_to_list field_path in
+  let subpath = concat_map pp_selection subpath in
+  group (pp_ident struct_name ^^ subpath)
+
+and pp_selection = function
+  FieldName v   -> string "." ^^ break 0 ^^ string v.value
+| Component cmp ->
+    string "[" ^^ (cmp.value |> snd |> Z.to_string |> string) ^^ string "]"
+
+and pp_update {value; _} =
+  let {record; updates; _} = value in
+  let updates = group (pp_ne_injection pp_field_path_assign updates)
+  and record  = pp_path record in
+  string "{..." ^^ record ^^ string ","
+  ^^ nest 2 (break 1 ^^ updates ^^ string "}")
+
+and pp_field_path_assign {value; _} =
+  let {field_path; field_expr; _} = value in
+  let path = pp_path field_path in
+  prefix 2 1 (path ^^ string ":") (pp_expr field_expr)
+
+and pp_path = function
+  Name v -> pp_ident v
+| Path p -> pp_projection p
+
+and pp_call_expr {value; _} =
+  let lambda, arguments = value in
+  let arguments = Utils.nseq_to_list arguments in
+  let arguments = string "(" ^^ group (separate_map (string "," ^^ break 0 ^^ string " ") pp_expr arguments) ^^ string ")" in
+  group (break 0 ^^ pp_expr lambda ^^ nest 2 arguments)
+
+and pp_tuple_expr {value; _} =
+  let head, tail = value in
+  let rec app = function
+    []  -> empty
+  | [e] -> group (break 1 ^^ pp_expr e)
+  | e::items ->
+      group (break 1 ^^ pp_expr e ^^ string ",") ^^ app items
+  in if tail = []
+     then string "(" ^^ nest 1 (pp_expr head) ^^ string ")"
+     else string "(" ^^ nest 1 (pp_expr head ^^ string "," ^^ app (List.map snd tail)) ^^ string ")"
+
+and pp_par_expr {value; _} =
+  string "(" ^^ nest 1 (pp_expr value.inside ^^ string ")")
+
+and pp_let_in {value; _} =
+  let {binding; kwd_rec; body; attributes; _} = value in
+  let let_str =
+    match kwd_rec with
+        None -> "let "
+    | Some _ -> "let rec " in
+  let bindings = pp_let_binding let_str binding
+  and attr    = pp_attributes attributes
+  in attr ^^ bindings
+     ^^ string ";" ^^ hardline ^^ pp_expr body
+
+and pp_fun {value; _} =
+  let {binders; lhs_type; body; _} = value in
+  let patterns = Utils.nseq_to_list binders in
+  let binders = group (separate_map (string "," ^^ break 0 ^^ string " ") pp_pattern patterns)
+  and annot   =
+    match lhs_type with
+      None -> empty
+    | Some (_,e) ->
+        group (break 0 ^^ string ": " ^^ nest 2 (pp_type_expr e))
+  in
+  match body with
+  | ESeq _ -> string "(" ^^ nest 1 binders ^^ string ")" ^^ annot ^^ string " => " ^^ pp_expr body
+  | _ -> (prefix 2 0 (string "(" ^^ nest 1 binders ^^ string ")" ^^ annot
+     ^^ string " => ") (pp_expr body))
+
+and pp_seq {value; _} =
+  let {compound; elements; _} = value in
+  let sep = string ";" ^^ hardline in
+  let elements = Utils.sepseq_to_list elements in
+  let elements = separate_map sep pp_expr elements in
+  match pp_compound compound with
+    None -> elements
+  | Some (opening, closing) ->
+     string opening
+     ^^ nest 2 (hardline ^^ elements) ^^ hardline
+     ^^ string closing
+
+and pp_type_expr = function
+  TProd t   -> pp_cartesian t
+| TSum t    -> break 0 ^^ pp_variants t
+| TRecord t -> pp_fields t
+| TApp t    -> pp_type_app t
+| TFun t    -> pp_fun_type t
+| TPar t    -> pp_type_par t
+| TVar t    -> pp_ident t
+| TString s -> pp_string s
+
+and pp_cartesian {value; _} =
+  let head, tail = value in
+  let rec app = function
+    []  -> empty
+  | [e] -> group (break 1 ^^ pp_type_expr e)
+  | e::items ->
+      group (break 1 ^^ pp_type_expr e ^^ string ",") ^^ app items
+  in
+  string "(" ^^ nest 1 (pp_type_expr head ^^ (if tail <> [] then string "," else empty) ^^ app (List.map snd tail)) ^^ string ")"
+
+and pp_variants {value; _} =
+  let head, tail = value in
+  let head = pp_variant head in
+  let head = if tail = [] then head
+             else ifflat head (string "  " ^^ head) in
+  let rest = List.map snd tail in
+  let app variant = break 1 ^^ string "| " ^^ pp_variant variant
+  in head ^^ concat_map app rest
+
+and pp_variant {value; _} =
+  let {constr; arg} = value in
+  match arg with
+    None -> pp_ident constr
+  | Some (_, e) ->
+      prefix 2 0 (pp_ident constr) (string "(" ^^ pp_type_expr e ^^ string ")")
+
+and pp_fields fields = group (pp_ne_injection pp_field_decl fields)
+
+and pp_field_decl {value; _} =
+  let {field_name; field_type; _} = value in
+  let name = pp_ident field_name in
+  match field_type with
+  | TVar v when v = field_name ->
+    name
+  | _ ->
+    let t_expr = pp_type_expr field_type
+    in prefix 2 1 (name ^^ string ":") t_expr
+
+and pp_type_app {value; _} =
+  let ctor, tuple = value in
+  prefix 2 0 (pp_type_constr ctor) (string "(" ^^ nest 1 (pp_type_tuple tuple) ^^ string ")")
+
+and pp_type_tuple {value; _} =
+  let head, tail = value.inside in
+  let rec app = function
+    []  -> empty
+  | [e] -> group (break 1 ^^ pp_type_expr e)
+  | e::items ->
+      group (break 1 ^^ pp_type_expr e ^^ string ",") ^^ app items in
+  if tail = []
+  then pp_type_expr head
+  else
+    let components =
+      pp_type_expr head ^^ string "," ^^ app (List.map snd tail)
+    in components
+
+and pp_type_constr ctor = string ctor.value
+
+and pp_fun_args {value; _} =
+  let lhs, _, rhs = value in
+  match rhs with
+  | TFun tf -> group (pp_type_expr lhs ^^ string ", " ^^ pp_fun_args tf)
+  | _ -> group (pp_type_expr lhs ^^ string ")" ^^ string " =>" ^/^ pp_type_expr rhs)
+
+and pp_fun_type {value; _} =
+  let lhs, _, rhs = value in
+  match lhs, rhs with
+  | _, TFun tf -> string "(" ^^ pp_type_expr lhs ^^ string ", " ^^ pp_fun_args tf
+  | TVar _ , _ -> group (pp_type_expr lhs ^^ string " =>" ^/^ pp_type_expr rhs)
+  | _ -> group (string "(" ^^ nest 1 (pp_type_expr lhs) ^^ string ")" ^^ string " =>" ^/^ pp_type_expr rhs)
+
+and pp_type_par {value; _} =
+  string "(" ^^ nest 1 (pp_type_expr value.inside ^^ string ")")

src/passes/01-parser/reasonligo/dune

@@ -15,7 +15,7 @@
  (name parser_reasonligo)
  (public_name ligo.parser.reasonligo)
  (modules
-    SyntaxError reasonligo LexToken ParErr Parser)
+    SyntaxError reasonligo LexToken ParErr Parser Pretty)
  (libraries
     menhirLib
     parser_shared

src/passes/01-parser/shared/EvalOpt.ml

@@ -29,11 +29,12 @@ type options = <
   mode    : [`Byte | `Point];
   cmd     : command;
   mono    : bool;
-  expr    : bool
+  expr    : bool;
+  pretty  : bool
 >
 
 let make ~input ~libs ~verbose ~offsets ?block
-         ?line ~ext ~mode ~cmd ~mono ~expr : options =
+         ?line ~ext ~mode ~cmd ~mono ~expr ~pretty : options =
   object
     method input   = input
     method libs    = libs
@@ -46,6 +47,7 @@ let make ~input ~libs ~verbose ~offsets ?block
     method cmd     = cmd
     method mono    = mono
     method expr    = expr
+    method pretty  = pretty
   end
 
 (* Auxiliary functions *)
@@ -77,6 +79,7 @@ let help extension () =
   print "      --bytes            Bytes for source locations";
   print "      --mono             Use Menhir monolithic API";
   print "      --expr             Parse an expression";
+  print "      --pretty           Pretty-print the input";
   print "      --verbose=<stages> cli, preproc, ast-tokens, ast (colon-separated)";
   print "      --version          Commit hash on stdout";
   print "  -h, --help             This help";
@@ -100,6 +103,7 @@ and libs     = ref []
 and verb_str = ref ""
 and mono     = ref false
 and expr     = ref false
+and pretty   = ref false
 
 let split_at_colon = Str.(split (regexp ":"))
 
@@ -121,6 +125,7 @@ let specs extension =
     noshort, "bytes",   set bytes true, None;
     noshort, "mono",    set mono true, None;
     noshort, "expr",    set expr true, None;
+    noshort, "pretty",  set pretty true, None;
     noshort, "verbose", None, Some add_verbose;
     'h',     "help",    Some (help extension), None;
     noshort, "version", Some version, None
@@ -156,6 +161,7 @@ let print_opt () =
   printf "bytes    = %b\n" !bytes;
   printf "mono     = %b\n" !mono;
   printf "expr     = %b\n" !expr;
+  printf "pretty   = %b\n" !pretty;
   printf "verbose  = %s\n" !verb_str;
   printf "input    = %s\n" (string_of quote !input);
   printf "libs     = %s\n" (string_of_path !libs)
@@ -185,6 +191,7 @@ let check ?block ?line ~ext =
   and mono    = !mono
   and expr    = !expr
   and verbose = !verbose
+  and pretty  = !pretty
   and libs    = !libs in
 
   let () =
@@ -199,6 +206,7 @@ let check ?block ?line ~ext =
         printf "mode     = %s\n" (if mode = `Byte then "`Byte" else "`Point");
         printf "mono     = %b\n" mono;
         printf "expr     = %b\n" expr;
+        printf "pretty   = %b\n" pretty;
         printf "verbose  = %s\n" !verb_str;
         printf "input    = %s\n" (string_of quote input);
         printf "libs     = %s\n" (string_of_path libs)
@@ -214,7 +222,7 @@ let check ?block ?line ~ext =
     | _ -> abort "Choose one of -q, -c, -u, -t."
 
   in make ~input ~libs ~verbose ~offsets ~mode
-          ~cmd ~mono ~expr ?block ?line ~ext
+          ~cmd ~mono ~expr ?block ?line ~ext ~pretty
 
 (* Parsing the command-line options *)
 

src/passes/01-parser/shared/EvalOpt.mli

@@ -47,7 +47,10 @@ type command = Quiet | Copy | Units | Tokens
       {li If the field [expr] is [true], then the parser for
           expressions is used, otherwise a full-fledged contract is
           expected.}
-} *)
+
+       {li If the field [pretty] is [true], then the source is
+           pretty-printed on the standard out.}
+    } *)
 
 module SSet : Set.S with type elt = string and type t = Set.Make(String).t
 
@@ -67,7 +70,8 @@ type options = <
   mode    : [`Byte | `Point];
   cmd     : command;
   mono    : bool;
-  expr    : bool
+  expr    : bool;
+  pretty  : bool
 >
 
 val make :
@@ -82,6 +86,7 @@ val make :
   cmd:command ->
   mono:bool ->
   expr:bool ->
+  pretty:bool ->
   options
 
 (** Parsing the command-line options on stdin. *)

src/passes/01-parser/shared/ParserUnit.ml

@@ -15,7 +15,8 @@ module type SubIO =
       ext     : string;
       mode    : [`Byte | `Point];
       cmd     : EvalOpt.command;
-      mono    : bool
+      mono    : bool;
+      pretty  : bool
     >
 
     val options : options
@@ -31,7 +32,7 @@ module type Printer =
     val mk_state :
       offsets:bool -> mode:[`Point|`Byte] -> buffer:Buffer.t -> state
 
-    val pp_ast       : state -> ast -> unit
+    val pp_cst       : state -> ast -> unit
     val pp_expr      : state -> expr -> unit
     val print_tokens : state -> ast -> unit
     val print_expr   : state -> expr -> unit
@@ -145,7 +146,7 @@ module Make (Lexer: Lexer.S)
         if SSet.mem "ast" SubIO.options#verbose then
           begin
             Buffer.clear output;
-            ParserLog.pp_ast state ast;
+            ParserLog.pp_cst state ast;
             Buffer.output_buffer stdout output
           end
       in flush_all (); close (); Ok ast

src/passes/01-parser/shared/ParserUnit.mli

@@ -17,7 +17,8 @@ module type SubIO =
       ext     : string;
       mode    : [`Byte | `Point];
       cmd     : EvalOpt.command;
-      mono    : bool
+      mono    : bool;
+      pretty  : bool
     >
 
     val options : options
@@ -35,7 +36,7 @@ module type Printer =
     val mk_state :
       offsets:bool -> mode:[`Point|`Byte] -> buffer:Buffer.t -> state
 
-    val pp_ast       : state -> ast -> unit
+    val pp_cst       : state -> ast -> unit
     val pp_expr      : state -> expr -> unit
     val print_tokens : state -> ast -> unit
     val print_expr   : state -> expr -> unit

src/passes/01-parser/shared/Utils.mli

@@ -31,9 +31,9 @@ val sepseq_cons  : 'a -> 'sep -> ('a,'sep)  sepseq -> ('a,'sep) nsepseq
 
 (* Reversing *)
 
-val nseq_rev:    'a nseq -> 'a nseq
+val nseq_rev    : 'a nseq -> 'a nseq
-val nsepseq_rev: ('a,'sep) nsepseq -> ('a,'sep) nsepseq
+val nsepseq_rev : ('a,'sep) nsepseq -> ('a,'sep) nsepseq
-val sepseq_rev:  ('a,'sep)  sepseq -> ('a,'sep)  sepseq
+val sepseq_rev  : ('a,'sep)  sepseq -> ('a,'sep)  sepseq
 
 (* Rightwards iterators *)
 
@@ -55,7 +55,7 @@ val sepseq_foldr  : ('a -> 'b -> 'b) -> ('a,'c)  sepseq -> 'b -> 'b
 
 val nseq_map    : ('a -> 'b) -> 'a nseq -> 'b nseq
 val nsepseq_map : ('a -> 'b) -> ('a,'c) nsepseq -> ('b,'c) nsepseq
-val sepseq_map  : ('a -> 'b) -> ('a,'c) sepseq -> ('b,'c) sepseq
+val sepseq_map  : ('a -> 'b) -> ('a,'c)  sepseq -> ('b,'c)  sepseq
 
 (* Conversions to lists *)
 

src/passes/02-concrete_to_imperative/cameligo.ml

@@ -343,59 +343,41 @@ let rec compile_expression :
     let path' =
       let aux (s:Raw.selection) =
         match s with
-          FieldName property -> property.value
+          FieldName property -> Access_record property.value
-        | Component index -> Z.to_string (snd index.value)
+        | Component index -> Access_tuple (snd index.value)
       in
       List.map aux @@ npseq_to_list path in
-    return @@ List.fold_left (e_record_accessor ~loc ) var path'
+    return @@ e_accessor ~loc var path'
-  in
-  let compile_path : Raw.path -> string * label list = fun p ->
-    match p with
-    | Raw.Name v -> (v.value , [])
-    | Raw.Path p -> (
-        let p' = p.value in
-        let var = p'.struct_name.value in
-        let path = p'.field_path in
-        let path' =
-          let aux (s:Raw.selection) =
-            match s with
-            | FieldName property -> Label property.value
-            | Component index -> Label (Z.to_string (snd index.value))
-          in
-          List.map aux @@ npseq_to_list path in
-        (var , path')
-      )
-  in
-  let compile_update = fun (u:Raw.update Region.reg) ->
-    let (u, loc) = r_split u in
-    let (name, path) = compile_path u.record in
-    let record = match path with
-    | [] -> e_variable (Var.of_name name)
-    | _ ->
-      let aux expr (Label l) = e_record_accessor expr l in
-      List.fold_left aux (e_variable (Var.of_name name)) path in
-    let updates = u.updates.value.ne_elements in
-    let%bind updates' =
-      let aux (f:Raw.field_path_assign Raw.reg) =
-        let (f,_) = r_split f in
-        let%bind expr = compile_expression f.field_expr in
-        ok ( List.map (fun (x: _ Raw.reg) -> x.value) (npseq_to_list f.field_path), expr)
-      in
-      bind_map_list aux @@ npseq_to_list updates
-    in
-    let aux ur (path, expr) =
-      let rec aux record = function
-        | [] -> failwith "error in parsing"
-        | hd :: [] -> ok @@ e_record_update ~loc record hd expr
-        | hd :: tl ->
-          let%bind expr = (aux (e_record_accessor ~loc record hd) tl) in
-          ok @@ e_record_update ~loc record hd expr
-      in
-      aux ur path in
-    bind_fold_list aux record updates'
   in
+  let compile_selection : Raw.selection -> access = fun s ->
+    match s with
+    | FieldName property -> Access_record property.value
+    | Component index -> (Access_tuple (snd index.value)) in
 
-  trace (abstracting_expr t) @@
+  let compile_path : Raw.path -> string * access list = function
+      Raw.Name v -> v.value, []
+    | Raw.Path {value; _} ->
+       let Raw.{struct_name; field_path; _} = value in
+       let var  = struct_name.value in
+       let path = List.map compile_selection @@ npseq_to_list field_path
+       in var, path in
+
+let compile_update (u: Raw.update Region.reg) =
+  let u, loc     = r_split u in
+  let name, path = compile_path u.record in
+  let var        = e_variable (Var.of_name name) in
+  let record     = if path = [] then var else e_accessor var path in
+  let updates    = u.updates.value.ne_elements in
+  let%bind updates' =
+    let aux (f: Raw.field_path_assignment Raw.reg) =
+      let f, _ = r_split f in
+      let%bind expr = compile_expression f.field_expr
+      in ok (compile_path f.field_path, expr)
+    in bind_map_list aux @@ npseq_to_list updates in
+  let aux ur ((var, path), expr) =
+    ok @@ e_update ~loc ur (Access_record var :: path) expr
+  in bind_fold_list aux record updates'
+in trace (abstracting_expr t) @@
   match t with
     Raw.ELetIn e ->
       let Raw.{kwd_rec; binding; body; attributes; _} = e.value in
@@ -439,11 +421,11 @@ let rec compile_expression :
         | hd :: [] ->
           if (List.length prep_vars = 1)
           then e_let_in ~loc hd inline rhs_b_expr body
-          else e_let_in ~loc hd inline (e_record_accessor ~loc rhs_b_expr (string_of_int ((List.length prep_vars) - 1))) body
+          else e_let_in ~loc hd inline (e_accessor ~loc rhs_b_expr [Access_tuple (Z.of_int ((List.length prep_vars) - 1))]) body
         | hd :: tl ->
           e_let_in ~loc hd
           inline
-          (e_record_accessor ~loc rhs_b_expr (string_of_int ((List.length prep_vars) - (List.length tl) - 1)))
+          (e_accessor ~loc rhs_b_expr [Access_tuple (Z.of_int ((List.length prep_vars) - (List.length tl) - 1))])
           (chain_let_in tl body)
         | [] -> body (* Precluded by corner case assertion above *)
       in
@@ -960,7 +942,7 @@ and compile_declaration : Raw.declaration -> declaration Location.wrap list resu
       ok @@ [loc x @@ (Declaration_constant (Var.of_name var.value , lhs_type , inline, rhs'))]
     )
 
-and compile_cases : type a . (Raw.pattern * a) list -> (a, unit) matching_content result =
+and compile_cases : (Raw.pattern * expression) list -> matching_expr result =
   fun t ->
   let open Raw in
   let rec get_var (t:Raw.pattern) =
@@ -1031,7 +1013,7 @@ and compile_cases : type a . (Raw.pattern * a) list -> (a, unit) matching_conten
   match patterns with
   | [(PFalse _, f) ; (PTrue _, t)]
   | [(PTrue _, t) ; (PFalse _, f)] ->
-      ok @@ Match_variant ([((Constructor "true", Var.of_name "_"), t); ((Constructor "false", Var.of_name "_"), f)], ())
+      ok @@ Match_variant ([((Constructor "true", Var.of_name "_"), t); ((Constructor "false", Var.of_name "_"), f)])
   | [(PList (PCons c), cons); (PList (PListComp sugar_nil), nil)]
   | [(PList (PListComp sugar_nil), nil); (PList (PCons c), cons)] ->
       let%bind () =
@@ -1044,7 +1026,7 @@ and compile_cases : type a . (Raw.pattern * a) list -> (a, unit) matching_conten
         let%bind a = get_var a in
         let%bind b = get_var b in
         ok (a, b) in
-      ok @@ Match_list {match_cons=(Var.of_name a, Var.of_name b, cons, ()); match_nil=nil}
+      ok @@ Match_list {match_cons=(Var.of_name a, Var.of_name b, cons); match_nil=nil}
   | lst ->
       let error x =
         let title () = "Pattern" in
@@ -1075,7 +1057,7 @@ and compile_cases : type a . (Raw.pattern * a) list -> (a, unit) matching_conten
         | [ (("None", None), none_expr);
             (("Some", Some some_var), some_expr) ] ->
            ok @@ Match_option {
-                    match_some = (Var.of_name some_var, some_expr, ());
+                    match_some = (Var.of_name some_var, some_expr);
                     match_none = none_expr }
         | _ -> simple_fail "bad option pattern"
       in bind_or (as_option () , as_variant ())

src/passes/02-concrete_to_imperative/pascaligo.ml

@@ -152,7 +152,7 @@ let return_statement expr = ok @@ fun expr'_opt ->
   | Some expr' -> ok @@ e_sequence expr expr'
 
 let get_t_string_singleton_opt = function
-  | Raw.TStringLiteral s -> Some s.value
+  | Raw.TString s -> Some s.value
   | _ -> None
 
 
@@ -252,7 +252,7 @@ let rec compile_type_expression (t:Raw.type_expr) : type_expression result =
         @@ npseq_to_list s in
       let m = List.fold_left (fun m ((x,i), y) -> CMap.add (Constructor x) {ctor_type=y;ctor_decl_pos=i} m) CMap.empty lst in
       ok @@ make_t ~loc @@ T_sum m
-  | TStringLiteral _s -> simple_fail "we don't support singleton string type"
+  | TString _s -> simple_fail "we don't support singleton string type"
 
 and compile_list_type_expression (lst:Raw.type_expr list) : type_expression result =
   match lst with
@@ -271,31 +271,32 @@ let compile_projection : Raw.projection Region.reg -> _ = fun p ->
   let path' =
     let aux (s:Raw.selection) =
       match s with
-      | FieldName property -> property.value
+      | FieldName property -> Access_record property.value
-      | Component index -> (Z.to_string (snd index.value))
+      | Component index -> (Access_tuple (snd index.value))
     in
     List.map aux @@ npseq_to_list path in
-  ok @@ List.fold_left (e_record_accessor ~loc) var path'
+  ok @@ e_accessor ~loc var path'
 
 
 let rec compile_expression (t:Raw.expr) : expr result =
   let return x = ok x in
   match t with
   | EAnnot a -> (
-      let ((expr , type_expr) , loc) = r_split a in
+      let par, loc = r_split a in
+      let expr, _, type_expr = par.inside in
       let%bind expr' = compile_expression expr in
       let%bind type_expr' = compile_type_expression type_expr in
       return @@ e_annotation ~loc expr' type_expr'
     )
   | EVar c -> (
-      let (c' , loc) = r_split c in
+      let (c', loc) = r_split c in
       match constants c' with
       | None   -> return @@ e_variable ~loc (Var.of_name c.value)
       | Some s -> return @@ e_constant ~loc s []
     )
   | ECall x -> (
-      let ((f, args) , loc) = r_split x in
+      let ((f, args), loc) = r_split x in
-      let (args , args_loc) = r_split args in
+      let (args, args_loc) = r_split args in
       let args' = npseq_to_list args.inside in
       match f with
       | EVar name -> (
@@ -327,7 +328,8 @@ let rec compile_expression (t:Raw.expr) : expr result =
   | ERecord r ->
       let%bind fields = bind_list
         @@ List.map (fun ((k : _ Raw.reg), v) -> let%bind v = compile_expression v in ok (k.value, v))
-        @@ List.map (fun (x:Raw.field_assign Raw.reg) -> (x.value.field_name, x.value.field_expr))
+        @@ List.map (fun (x:Raw.field_assignment Raw.reg) ->
+                      (x.value.field_name, x.value.field_expr))
         @@ npseq_to_list r.value.ne_elements in
       let aux prev (k, v) = SMap.add k v prev in
       return @@ e_record (List.fold_left aux SMap.empty fields)
@@ -451,51 +453,34 @@ let rec compile_expression (t:Raw.expr) : expr result =
         | Path p -> compile_projection p
       in
       let%bind index = compile_expression lu.index.value.inside in
-      return @@ e_look_up ~loc path index
+      return @@ e_accessor ~loc path [Access_map index]
     )
   | EFun f ->
     let (f , loc) = r_split f in
     let%bind (_ty_opt, f') = compile_fun_expression ~loc f
     in return @@ f'
-
+and compile_update (u: Raw.update Region.reg) =
-
+  let u, loc     = r_split u in
-and compile_update = fun (u:Raw.update Region.reg) ->
+  let name, path = compile_path u.record in
-  let (u, loc) = r_split u in
+  let var        = e_variable (Var.of_name name) in
-  let (name, path) = compile_path u.record in
+  let record     = if path = [] then var else e_accessor var path in
-  let record = match path with
+  let updates    = u.updates.value.ne_elements in
-  | [] -> e_variable (Var.of_name name)
-  | _ -> e_accessor_list (e_variable (Var.of_name name)) path in 
-  let updates = u.updates.value.ne_elements in
   let%bind updates' =
-    let aux (f:Raw.field_path_assign Raw.reg) =
+    let aux (f: Raw.field_path_assignment Raw.reg) =
-      let (f,_) = r_split f in
+      let f, _ = r_split f in
-      let%bind expr = compile_expression f.field_expr in
+      let%bind expr = compile_expression f.field_expr
-        ok ( List.map (fun (x: _ Raw.reg) -> x.value) (npseq_to_list f.field_path), expr)
+      in ok (compile_path f.field_path, expr)
-    in
+    in bind_map_list aux @@ npseq_to_list updates in
-    bind_map_list aux @@ npseq_to_list updates
+  let aux ur ((var, path), expr) =
-  in
+    ok @@ e_update ~loc ur (Access_record var :: path) expr
-  let aux ur (path, expr) = 
+  in bind_fold_list aux record updates'
-    let rec aux record = function
-      | [] -> failwith "error in parsing"
-      | hd :: [] -> ok @@ e_record_update ~loc record hd expr
-      | hd :: tl -> 
-        let%bind expr = (aux (e_record_accessor ~loc record hd) tl) in
-        ok @@ e_record_update ~loc record hd expr 
-    in
-    aux ur path in
-  bind_fold_list aux record updates'
 
 and compile_logic_expression (t:Raw.logic_expr) : expression result =
-  let return x = ok x in
   match t with
-  | BoolExpr (False reg) -> (
+  | BoolExpr (False reg) ->
-      let loc = Location.lift reg in
+      ok @@ e_bool ~loc:(Location.lift reg) false
-      return @@ e_bool ~loc false
+  | BoolExpr (True reg) ->
-    )
+     ok @@ e_bool ~loc:(Location.lift reg) true
-  | BoolExpr (True reg) -> (
-      let loc = Location.lift reg in
-      return @@ e_bool ~loc true
-    )
   | BoolExpr (Or b) ->
       compile_binop "OR" b
   | BoolExpr (And b) ->
@@ -668,7 +653,7 @@ and compile_fun_decl :
        let%bind tpl_declarations =
          let aux = fun i (param, type_expr) ->
            let expr =
-             e_record_accessor (e_variable arguments_name) (string_of_int i) in
+             e_accessor (e_variable arguments_name) [Access_record (string_of_int i)] in
            let type_variable = Some type_expr in
            let ass = return_let_in (Var.of_name param , type_variable) inline expr in
            ass
@@ -698,7 +683,7 @@ and compile_fun_expression :
   loc:_ -> Raw.fun_expr -> (type_expression option * expression) result =
   fun ~loc x ->
   let open! Raw in
-  let {kwd_recursive;param;ret_type;return} : fun_expr = x in
+  let {param; ret_type; return; _} : fun_expr = x in
   let statements = [] in
   (match param.value.inside with
     a, [] -> (
@@ -714,10 +699,8 @@ and compile_fun_expression :
           bind_fold_right_list aux result body in
         let binder = Var.of_name binder in
         let fun_type = t_function input_type output_type in
-        let expression = match kwd_recursive with
+        let expression =
-          | None -> e_lambda ~loc binder (Some input_type)(Some output_type) result
+          e_lambda ~loc binder (Some input_type)(Some output_type) result
-          | Some _ -> e_recursive ~loc binder fun_type 
-          @@ {binder;input_type=Some input_type; output_type= Some output_type; result}
         in
         ok (Some fun_type , expression)
       )
@@ -731,7 +714,7 @@ and compile_fun_expression :
          (arguments_name , type_expression) in
        let%bind tpl_declarations =
          let aux = fun i (param, param_type) ->
-           let expr = e_record_accessor (e_variable arguments_name) (string_of_int i) in
+           let expr = e_accessor (e_variable arguments_name) [Access_tuple (Z.of_int i)] in
            let type_variable = Some param_type in
            let ass = return_let_in (Var.of_name param , type_variable) false expr in
            ass
@@ -745,10 +728,8 @@ and compile_fun_expression :
          let aux prec cur = cur (Some prec) in
          bind_fold_right_list aux result body in
       let fun_type = t_function input_type output_type in
-      let expression = match kwd_recursive with
+      let expression =
-        | None -> e_lambda ~loc binder (Some input_type)(Some output_type) result
+        e_lambda ~loc binder (Some input_type)(Some output_type) result
-        | Some _ -> e_recursive ~loc binder fun_type 
-        @@ {binder;input_type=Some input_type; output_type= Some output_type; result}
       in
       ok (Some fun_type , expression)
      )
@@ -822,7 +803,7 @@ and compile_single_instruction : Raw.instruction -> (_ -> expression result) res
       let%bind bound = compile_expression fi.bound in
       let%bind step = match fi.step with
         | None -> ok @@ e_int_z Z.one
-        | Some step -> compile_expression step in
+        | Some (_, step) -> compile_expression step in
       let%bind body = compile_block fi.block.value in
       let%bind body = body @@ None in
       return_statement @@ e_for ~loc binder start bound step body
@@ -869,23 +850,25 @@ and compile_single_instruction : Raw.instruction -> (_ -> expression result) res
       let (a , loc) = r_split a in
       let%bind value_expr = compile_expression a.rhs in
       match a.lhs with
-        | Path path -> (
+        | Path path ->
-            let (name , path') = compile_path path in
+            let name , path' = compile_path path in
-            return_statement @@ e_ez_assign ~loc name path' value_expr
+            let name = Var.of_name name in
-          )
+            return_statement @@ e_assign ~loc name path' value_expr
-        | MapPath v -> (
+        | MapPath v ->
             let v' = v.value in
             let%bind (varname,map,path) = match v'.path with
-              | Name name -> ok (name.value , e_variable (Var.of_name name.value), [])
+              | Name name ->
+                  ok (name.value ,
+                      e_variable (Var.of_name name.value), [])
               | Path p ->
-                let (name,p') = compile_path v'.path in
+                  let name, p' = compile_path v'.path in
-                let%bind accessor = compile_projection p in
+                  let%bind accessor = compile_projection p in
-                ok @@ (name , accessor , p')
+                  ok @@ (name, accessor, p') in
-            in
+            let%bind key_expr =
-            let%bind key_expr = compile_expression v'.index.value.inside in
+              compile_expression v'.index.value.inside in
             let expr' = e_map_add key_expr value_expr map in
-            return_statement @@ e_ez_assign ~loc varname path expr'
+            let varname = Var.of_name varname in
-          )
+            return_statement @@ e_assign ~loc varname path expr'
     )
   | CaseInstr c -> (
       let (c , loc) = r_split c in
@@ -901,7 +884,7 @@ and compile_single_instruction : Raw.instruction -> (_ -> expression result) res
                   LongBlock {value; _} ->
                     compile_block value
                 | ShortBlock {value; _} ->
-                  compile_statements @@ fst value.inside in
+                    compile_statements @@ fst value.inside in
           let%bind case_clause = case_clause None in
           ok (x.value.pattern, case_clause) in
         bind_list
@@ -910,26 +893,28 @@ and compile_single_instruction : Raw.instruction -> (_ -> expression result) res
       let%bind m = compile_cases cases in
       return_statement @@ e_matching ~loc expr m
     )
-  | RecordPatch r -> (
+  | RecordPatch r ->
       let reg = r.region in
-      let (r,loc) = r_split r in
+      let r, loc = r_split r in
-      let aux (fa :Raw.field_assign Raw.reg) : Raw.field_path_assign Raw.reg=
+      let aux (fa: Raw.field_assignment Raw.reg) : Raw.field_path_assignment Raw.reg =
-         {value = {field_path = (fa.value.field_name, []); equal=fa.value.equal; field_expr = fa.value.field_expr};
+        {value = {field_path = Name fa.value.field_name;
-         region = fa.region}
+                  assignment = fa.value.assignment;
-      in
+                  field_expr = fa.value.field_expr};
-      let update : Raw.field_path_assign Raw.reg Raw.ne_injection Raw.reg = {
+         region = fa.region} in
-        value = Raw.map_ne_injection aux r.record_inj.value;
+      let update : Raw.field_path_assignment Raw.reg Raw.ne_injection Raw.reg = {
-        region=r.record_inj.region
+        value  = Raw.map_ne_injection aux r.record_inj.value;
-        } in
+        region = r.record_inj.region} in
-      let u : Raw.update = {record=r.path;kwd_with=r.kwd_with; updates=update} in
+      let u : Raw.update = {
+          record   = r.path;
+          kwd_with = r.kwd_with;
+          updates  = update} in
       let%bind expr = compile_update {value=u;region=reg} in
-      let (name , access_path) = compile_path r.path in
+      let name, access_path = compile_path r.path in
-       return_statement @@ e_ez_assign ~loc name access_path expr
+      let name = Var.of_name name in
-
+      return_statement @@ e_assign ~loc name access_path expr
-  )
+  | MapPatch patch ->
-  | MapPatch patch -> (
+      let map_p, loc = r_split patch in
-      let (map_p, loc) = r_split patch in
+      let name, access_path = compile_path map_p.path in
-      let (name, access_path) = compile_path map_p.path in
       let%bind inj = bind_list
           @@ List.map (fun (x:Raw.binding Region.reg) ->
             let x = x.value in
@@ -939,19 +924,18 @@ and compile_single_instruction : Raw.instruction -> (_ -> expression result) res
             in ok @@ (key', value')
           )
         @@ npseq_to_list map_p.map_inj.value.ne_elements in
-      match inj with
+      (match inj with
       | [] -> return_statement @@ e_skip ~loc ()
       | _ :: _ ->
         let assigns = List.fold_right
             (fun (key, value) map ->  (e_map_add key value map))
             inj
-            (e_accessor_list ~loc (e_variable (Var.of_name name)) access_path)
+            (e_accessor ~loc (e_variable (Var.of_name name)) access_path)
-        in 
+        and name = Var.of_name name in
-       return_statement @@ e_ez_assign ~loc name access_path assigns
+        return_statement @@ e_assign ~loc name access_path assigns)
-    )
   | SetPatch patch -> (
-      let (setp, loc) = r_split patch in
+      let setp, loc = r_split patch in
-      let (name , access_path) = compile_path setp.path in
+      let name, access_path = compile_path setp.path in
       let%bind inj =
         bind_list @@
         List.map compile_expression @@
@@ -961,53 +945,50 @@ and compile_single_instruction : Raw.instruction -> (_ -> expression result) res
       | _ :: _ ->
         let assigns = List.fold_right
           (fun hd s -> e_constant C_SET_ADD [hd ; s])
-          inj (e_accessor_list ~loc (e_variable (Var.of_name name)) access_path) in
+          inj (e_accessor ~loc (e_variable (Var.of_name name)) access_path) in
-       return_statement @@ e_ez_assign ~loc name access_path assigns
+        let name = Var.of_name name in
+        return_statement @@ e_assign ~loc name access_path assigns
     )
-  | MapRemove r -> (
+  | MapRemove r ->
       let (v , loc) = r_split r in
       let key = v.key in
-      let%bind (varname,map,path) = match v.map with
+      let%bind (name,map,path) = match v.map with
         | Name v -> ok (v.value , e_variable (Var.of_name v.value) , [])
         | Path p ->
-          let (name,p') = compile_path v.map in
+          let name, p' = compile_path v.map in
           let%bind accessor = compile_projection p in
           ok @@ (name , accessor , p')
       in
       let%bind key' = compile_expression key in
       let expr = e_constant ~loc C_MAP_REMOVE [key' ; map] in
-       return_statement @@ e_ez_assign ~loc varname path expr
+      let name = Var.of_name name in
-    )
+      return_statement @@ e_assign ~loc name path expr
-  | SetRemove r -> (
+  | SetRemove r ->
-      let (set_rm, loc) = r_split r in
+      let set_rm, loc = r_split r in
-      let%bind (varname, set, path) = match set_rm.set with
+      let%bind (name, set, path) =
-        | Name v -> ok (v.value, e_variable (Var.of_name v.value), [])
+        match set_rm.set with
+        | Name v ->
+            ok (v.value, e_variable (Var.of_name v.value), [])
         | Path path ->
-          let(name, p') = compile_path set_rm.set in
+            let name, p' = compile_path set_rm.set in
-          let%bind accessor = compile_projection path in
+            let%bind accessor = compile_projection path in
-          ok @@ (name, accessor, p')
+            ok @@ (name, accessor, p') in
-      in
       let%bind removed' = compile_expression set_rm.element in
       let expr = e_constant ~loc C_SET_REMOVE [removed' ; set] in
-       return_statement @@ e_ez_assign ~loc varname path expr
+      let name = Var.of_name name in
-    )
+      return_statement @@ e_assign ~loc name path expr
 
-and compile_path : Raw.path -> string * string list = fun p ->
+and compile_path : Raw.path -> string * access list = function
-  match p with
+  Raw.Name v -> v.value, []
-  | Raw.Name v -> (v.value , [])
+| Raw.Path {value; _} ->
-  | Raw.Path p -> (
+    let Raw.{struct_name; field_path; _} = value in
-      let p' = p.value in
+    let var  = struct_name.value in
-      let var = p'.struct_name.value in
+    let path = List.map compile_selection @@ npseq_to_list field_path
-      let path = p'.field_path in
+    in var, path
-      let path' =
+
-        let aux (s:Raw.selection) =
+and compile_selection : Raw.selection -> access = function
-          match s with
+  FieldName property -> Access_record property.value
-          | FieldName property -> property.value
+| Component index    -> Access_tuple (snd index.value)
-          | Component index -> (Z.to_string (snd index.value))
-        in
-        List.map aux @@ npseq_to_list path in
-      (var , path')
-    )
 
 and compile_cases : (Raw.pattern * expression) list -> matching_expr result = fun t ->
   let open Raw in
@@ -1059,14 +1040,14 @@ and compile_cases : (Raw.pattern * expression) list -> matching_expr result = fu
   match patterns with
   | [(PConstr PFalse _ , f) ; (PConstr PTrue _ , t)]
   | [(PConstr PTrue _ , t) ; (PConstr PFalse _ , f)] ->
-      ok @@ Match_variant ([((Constructor "true", Var.of_name "_"), t); ((Constructor "false", Var.of_name "_"), f)], ())
+      ok @@ Match_variant ([((Constructor "true", Var.of_name "_"), t); ((Constructor "false", Var.of_name "_"), f)])
   | [(PConstr PSomeApp v , some) ; (PConstr PNone _ , none)]
   | [(PConstr PNone _ , none) ; (PConstr PSomeApp v , some)] -> (
       let (_, v) = v.value in
       let%bind v = match v.value.inside with
         | PVar v -> ok v.value
         | p -> fail @@ unsupported_deep_Some_patterns p in
-      ok @@ Match_option {match_none = none ; match_some = (Var.of_name v, some, ()) }
+      ok @@ Match_option {match_none = none ; match_some = (Var.of_name v, some) }
     )
   | [(PList PCons c, cons) ; (PList (PNil _), nil)]
   | [(PList (PNil _), nil) ; (PList PCons c, cons)] ->
@@ -1079,7 +1060,7 @@ and compile_cases : (Raw.pattern * expression) list -> matching_expr result = fu
         | _ -> fail @@ unsupported_deep_list_patterns c
 
       in
-      ok @@ Match_list {match_cons = (Var.of_name a, Var.of_name b, cons,()) ; match_nil = nil}
+      ok @@ Match_list {match_cons = (Var.of_name a, Var.of_name b, cons) ; match_nil = nil}
   | lst ->
       trace (simple_info "currently, only booleans, options, lists and \
                          user-defined constructors are supported in patterns") @@

src/passes/03-self_ast_imperative/helpers.ml

@@ -30,9 +30,6 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini
     let%bind res = bind_fold_list (bind_fold_pair self) init' lst in
     ok res
   )
-  | E_look_up ab ->
-      let%bind res = bind_fold_pair self init' ab in
-      ok res
   | E_application {lamb;args} -> (
       let ab = (lamb,args) in
       let%bind res = bind_fold_pair self init' ab in
@@ -56,15 +53,25 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini
     let%bind res = bind_fold_lmap aux (ok init') m in
     ok res
   )
-  | E_record_update {record;update} -> (
+  | E_update {record;path;update} -> (
     let%bind res = self init' record in
+    let aux res a = match a with
+    | Access_map e -> self res e 
+    | _ -> ok res
+    in
+    let%bind res = bind_fold_list aux res path in
     let%bind res = fold_expression self res update in
     ok res 
   )
-  | E_record_accessor {record} -> (
+  | E_accessor {record;path} -> (
-     let%bind res = self init' record in
+    let%bind res = self init' record in
-     ok res
+    let aux res a = match a with
-    )
+    | Access_map e -> self res e 
+    | _ -> ok res
+    in
+    let%bind res = bind_fold_list aux res path in
+    ok res
+  )
   | E_tuple t -> (
     let aux init'' expr =
       let%bind res = fold_expression self init'' expr in
@@ -73,15 +80,6 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini
     let%bind res = bind_fold_list aux (init') t in
     ok res
   )
-  | E_tuple_update {tuple;update} -> (
-    let%bind res = self init' tuple in
-    let%bind res = fold_expression self res update in
-    ok res 
-  )
-  | E_tuple_accessor {tuple} -> (
-     let%bind res = self init' tuple in
-     ok res
-    )
   | E_let_in { let_binder = _ ; rhs ; let_result } -> (
       let%bind res = self init' rhs in
       let%bind res = self res let_result in
@@ -114,31 +112,37 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini
       let%bind res = self res body in
       ok res  
 
-     
-
 and fold_cases : 'a folder -> 'a -> matching_expr -> 'a result = fun f init m ->
   match m with
-  | Match_list { match_nil ; match_cons = (_ , _ , cons, _) } -> (
+  | Match_variant lst -> (
-      let%bind res = fold_expression f init match_nil in
-      let%bind res = fold_expression f res cons in
-      ok res
-    )
-  | Match_option { match_none ; match_some = (_ , some, _) } -> (
-      let%bind res = fold_expression f init match_none in
-      let%bind res = fold_expression f res some in
-      ok res
-    )
-  | Match_tuple ((_ , e), _) -> (
-      let%bind res = fold_expression f init e in
-      ok res
-    )
-  | Match_variant (lst, _) -> (
       let aux init' ((_ , _) , e) =
         let%bind res' = fold_expression f init' e in
         ok res' in
       let%bind res = bind_fold_list aux init lst in
       ok res
     )
+  | Match_list { match_nil ; match_cons = (_ , _ , cons) } -> (
+      let%bind res = fold_expression f init match_nil in
+      let%bind res = fold_expression f res cons in
+      ok res
+    )
+  | Match_option { match_none ; match_some = (_ , some) } -> (
+      let%bind res = fold_expression f init match_none in
+      let%bind res = fold_expression f res some in
+      ok res
+    )
+  | Match_record (_, _, e) -> (
+      let%bind res = fold_expression f init e in
+      ok res
+    )
+  | Match_tuple (_, _, e) -> (
+      let%bind res = fold_expression f init e in
+      ok res
+    )
+  | Match_variable (_, _, e) -> (
+      let%bind res = fold_expression f init e in
+      ok res
+    )
 
 type exp_mapper = expression -> expression result
 type ty_exp_mapper = type_expression -> type_expression result
@@ -166,10 +170,6 @@ let rec map_expression : exp_mapper -> expression -> expression result = fun f e
     let%bind lst' = bind_map_list (bind_map_pair self) lst in
     return @@ E_big_map lst'
   )
-  | E_look_up ab -> (
-      let%bind ab' = bind_map_pair self ab in
-      return @@ E_look_up ab'
-    )
   | E_ascription ascr -> (
       let%bind e' = self ascr.anno_expr in
       return @@ E_ascription {ascr with anno_expr=e'}
@@ -179,32 +179,37 @@ let rec map_expression : exp_mapper -> expression -> expression result = fun f e
       let%bind cases' = map_cases f cases in
       return @@ E_matching {matchee=e';cases=cases'}
     )
-  | E_record_accessor acc -> (
-      let%bind e' = self acc.record in
-      return @@ E_record_accessor {acc with record = e'}
-    )
   | E_record m -> (
     let%bind m' = bind_map_lmap self m in
     return @@ E_record m'
   )
-  | E_record_update {record; path; update} -> (
+  | E_accessor {record; path} -> (
     let%bind record = self record in
+    let aux a = match a with
+    | Access_map e -> 
+      let%bind e = self e in
+      ok @@ Access_map e
+    | e -> ok @@ e
+    in
+    let%bind path = bind_map_list aux path in
+    return @@ E_accessor {record; path}
+  )
+  | E_update {record; path; update} -> (
+    let%bind record = self record in
+    let aux a = match a with
+    | Access_map e -> 
+      let%bind e = self e in
+      ok @@ Access_map e
+    | e -> ok @@ e
+    in
+    let%bind path = bind_map_list aux path in
     let%bind update = self update in
-    return @@ E_record_update {record;path;update}
+    return @@ E_update {record;path;update}
   )
   | E_tuple t -> (
     let%bind t' = bind_map_list self t in
     return @@ E_tuple t'
   )
-  | E_tuple_update {tuple; path; update} -> (
-    let%bind tuple  = self tuple in
-    let%bind update = self update in
-    return @@ E_tuple_update {tuple; path; update}
-  )
-  | E_tuple_accessor {tuple;path} -> (
-     let%bind tuple = self tuple in
-     return @@ E_tuple_accessor {tuple;path}
-    )
   | E_constructor c -> (
       let%bind e' = self c.element in
       return @@ E_constructor {c with element = e'}
@@ -284,27 +289,35 @@ and map_type_expression : ty_exp_mapper -> type_expression -> type_expression re
 
 and map_cases : exp_mapper -> matching_expr -> matching_expr result = fun f m ->
   match m with
-  | Match_list { match_nil ; match_cons = (hd , tl , cons, _) } -> (
+  | Match_variant lst -> (
-      let%bind match_nil = map_expression f match_nil in
-      let%bind cons = map_expression f cons in
-      ok @@ Match_list { match_nil ; match_cons = (hd , tl , cons, ()) }
-    )
-  | Match_option { match_none ; match_some = (name , some, _) } -> (
-      let%bind match_none = map_expression f match_none in
-      let%bind some = map_expression f some in
-      ok @@ Match_option { match_none ; match_some = (name , some, ()) }
-    )
-  | Match_tuple ((names , e), _) -> (
-      let%bind e' = map_expression f e in
-      ok @@ Match_tuple ((names , e'), [])
-    )
-  | Match_variant (lst, _) -> (
       let aux ((a , b) , e) =
         let%bind e' = map_expression f e in
         ok ((a , b) , e')
       in
       let%bind lst' = bind_map_list aux lst in
-      ok @@ Match_variant (lst', ())
+      ok @@ Match_variant lst'
+    )
+  | Match_list { match_nil ; match_cons = (hd , tl , cons) } -> (
+      let%bind match_nil = map_expression f match_nil in
+      let%bind cons = map_expression f cons in
+      ok @@ Match_list { match_nil ; match_cons = (hd , tl , cons) }
+    )
+  | Match_option { match_none ; match_some = (name , some) } -> (
+      let%bind match_none = map_expression f match_none in
+      let%bind some = map_expression f some in
+      ok @@ Match_option { match_none ; match_some = (name , some) }
+    )
+  | Match_record (names, ty_opt, e) -> (
+      let%bind e' = map_expression f e in
+      ok @@ Match_record (names, ty_opt, e')
+    )
+  | Match_tuple (names, ty_opt, e) -> (
+      let%bind e' = map_expression f e in
+      ok @@ Match_tuple (names, ty_opt, e')
+    )
+  | Match_variable (name, ty_opt, e) -> (
+      let%bind e' = map_expression f e in
+      ok @@ Match_variable (name, ty_opt, e')
     )
 
 and map_program : abs_mapper -> program -> program result = fun m p ->
@@ -347,10 +360,6 @@ let rec fold_map_expression : 'a fold_mapper -> 'a -> expression -> ('a * expres
     let%bind (res, lst') = bind_fold_map_list (bind_fold_map_pair self) init' lst in
     ok (res, return @@ E_big_map lst')
   )
-  | E_look_up ab -> (
-      let%bind (res, ab') = bind_fold_map_pair self init' ab in
-      ok (res, return @@ E_look_up ab')
-    )
   | E_ascription ascr -> (
       let%bind (res,e') = self init' ascr.anno_expr in
       ok (res, return @@ E_ascription {ascr with anno_expr=e'})
@@ -360,33 +369,38 @@ let rec fold_map_expression : 'a fold_mapper -> 'a -> expression -> ('a * expres
       let%bind (res,cases') = fold_map_cases f res cases in
       ok (res, return @@ E_matching {matchee=e';cases=cases'})
     )
-  | E_record_accessor acc -> (
-      let%bind (res, e') = self init' acc.record in
-      ok (res, return @@ E_record_accessor {acc with record = e'})
-    )
   | E_record m -> (
     let%bind (res, lst') = bind_fold_map_list (fun res (k,e) -> let%bind (res,e) = self res e in ok (res,(k,e))) init' (LMap.to_kv_list m) in
     let m' = LMap.of_list lst' in
     ok (res, return @@ E_record m')
   )
-  | E_record_update {record; path; update} -> (
+  | E_accessor {record;path} -> (
     let%bind (res, record) = self init' record in
+    let aux res a = match a with
+    | Access_map e -> 
+      let%bind (res,e) = self res e in
+      ok @@ (res,Access_map e)
+    | e -> ok @@ (res,e)
+    in
+    let%bind (res, path)   = bind_fold_map_list aux res path in
+    ok (res, return @@ E_accessor {record; path})
+  )
+  | E_update {record; path; update} -> (
+    let%bind (res, record) = self init' record in
+    let aux res a = match a with
+    | Access_map e -> 
+      let%bind (res,e) = self res e in
+      ok @@ (res,Access_map e)
+    | e -> ok @@ (res,e)
+    in
+    let%bind (res, path)   = bind_fold_map_list aux res path in
     let%bind (res, update) = self res update in
-    ok (res, return @@ E_record_update {record;path;update})
+    ok (res, return @@ E_update {record;path;update})
   )
   | E_tuple t -> (
     let%bind (res, t') = bind_fold_map_list self init' t in
     ok (res, return @@ E_tuple t')
   )
-  | E_tuple_update {tuple; path; update} -> (
-    let%bind (res, tuple) = self init' tuple in
-    let%bind (res, update) = self res update in
-    ok (res, return @@ E_tuple_update {tuple;path;update})
-  )
-  | E_tuple_accessor {tuple; path} -> (
-     let%bind (res, tuple) = self init' tuple in
-     ok (res, return @@ E_tuple_accessor {tuple; path})
-    )
   | E_constructor c -> (
       let%bind (res,e') = self init' c.element in
       ok (res, return @@ E_constructor {c with element = e'})
@@ -440,25 +454,33 @@ let rec fold_map_expression : 'a fold_mapper -> 'a -> expression -> ('a * expres
 
 and fold_map_cases : 'a fold_mapper -> 'a -> matching_expr -> ('a * matching_expr) result = fun f init m ->
   match m with
-  | Match_list { match_nil ; match_cons = (hd , tl , cons, _) } -> (
+  | Match_variant lst -> (
-      let%bind (init, match_nil) = fold_map_expression f init match_nil in
-      let%bind (init, cons) = fold_map_expression f init cons in
-      ok @@ (init, Match_list { match_nil ; match_cons = (hd , tl , cons, ()) })
-    )
-  | Match_option { match_none ; match_some = (name , some, _) } -> (
-      let%bind (init, match_none) = fold_map_expression f init match_none in
-      let%bind (init, some) = fold_map_expression f init some in
-      ok @@ (init, Match_option { match_none ; match_some = (name , some, ()) })
-    )
-  | Match_tuple ((names , e), _) -> (
-      let%bind (init, e') = fold_map_expression f init e in
-      ok @@ (init, Match_tuple ((names , e'), []))
-    )
-  | Match_variant (lst, _) -> (
       let aux init ((a , b) , e) =
         let%bind (init,e') = fold_map_expression f init e in
         ok (init, ((a , b) , e'))
       in
       let%bind (init,lst') = bind_fold_map_list aux init lst in
-      ok @@ (init, Match_variant (lst', ()))
+      ok @@ (init, Match_variant lst')
+    )
+  | Match_list { match_nil ; match_cons = (hd , tl , cons) } -> (
+      let%bind (init, match_nil) = fold_map_expression f init match_nil in
+      let%bind (init, cons) = fold_map_expression f init cons in
+      ok @@ (init, Match_list { match_nil ; match_cons = (hd , tl , cons) })
+    )
+  | Match_option { match_none ; match_some = (name , some) } -> (
+      let%bind (init, match_none) = fold_map_expression f init match_none in
+      let%bind (init, some) = fold_map_expression f init some in
+      ok @@ (init, Match_option { match_none ; match_some = (name , some) })
+    )
+  | Match_record (names, ty_opt, e) -> (
+      let%bind (init, e') = fold_map_expression f init e in
+      ok @@ (init, Match_record (names, ty_opt, e'))
+    )
+  | Match_tuple (names, ty_opt, e) -> (
+      let%bind (init, e') = fold_map_expression f init e in
+      ok @@ (init, Match_tuple (names, ty_opt, e'))
+    )
+  | Match_variable (name, ty_opt, e) -> (
+      let%bind (init, e') = fold_map_expression f init e in
+      ok @@ (init, Match_variable (name, ty_opt, e'))
     )

src/passes/04-imperative_to_sugar/imperative_to_sugar.ml

@@ -46,7 +46,7 @@ let repair_mutable_variable_in_matching (match_body : O.expression) (element_nam
             ok (true,(decl_var, free_var), O.e_let_in let_binder false false rhs let_result)
           else(
             let free_var = if (List.mem name free_var) then free_var else name::free_var in
-            let expr = O.e_let_in (env,None) false false (O.e_record_update (O.e_variable env) (O.Label (Var.to_name name)) (O.e_variable name)) let_result in
+            let expr = O.e_let_in (env,None) false false (O.e_update (O.e_variable env) [O.Access_record (Var.to_name name)] (O.e_variable name)) let_result in
             ok (true,(decl_var, free_var), O.e_let_in let_binder false  false rhs expr)
           )
         | E_constant {cons_name=C_MAP_FOLD;arguments= _}
@@ -58,9 +58,9 @@ let repair_mutable_variable_in_matching (match_body : O.expression) (element_nam
       | E_skip
       | E_literal _ | E_variable _
       | E_application _ | E_lambda _| E_recursive _
-      | E_constructor _ | E_record _| E_record_accessor _|E_record_update _
+      | E_constructor _ | E_record _| E_accessor _|E_update _
-      | E_ascription _  | E_sequence _ | E_tuple _ | E_tuple_accessor _ | E_tuple_update _
+      | E_ascription _  | E_sequence _ | E_tuple _
-      | E_map _ | E_big_map _ |E_list _ | E_set _ |E_look_up _
+      | E_map _ | E_big_map _ |E_list _ | E_set _
        -> ok (true, (decl_var, free_var),ass_exp)
     )
       (element_names,[])
@@ -87,8 +87,7 @@ and repair_mutable_variable_in_loops (for_body : O.expression) (element_names :
           else(
             let free_var = if (List.mem name free_var) then free_var else name::free_var in
             let expr = O.e_let_in (env,None) false false (
-              O.e_record_update (O.e_variable env) (Label "0") 
+              O.e_update (O.e_variable env) [O.Access_tuple Z.zero; O.Access_record (Var.to_name name)] (O.e_variable name)
-              (O.e_record_update (O.e_record_accessor (O.e_variable env) (Label "0")) (Label (Var.to_name name)) (O.e_variable name))
               )
               let_result in
             ok (true,(decl_var, free_var), O.e_let_in let_binder false  false rhs expr)
@@ -102,9 +101,9 @@ and repair_mutable_variable_in_loops (for_body : O.expression) (element_names :
       | E_skip
       | E_literal _ | E_variable _
       | E_application _ | E_lambda _| E_recursive _
-      | E_constructor _ | E_record _| E_record_accessor _|E_record_update _
+      | E_constructor _ | E_record _| E_accessor _| E_update _
-      | E_ascription _  | E_sequence _ | E_tuple _ | E_tuple_accessor _ | E_tuple_update _
+      | E_ascription _  | E_sequence _ | E_tuple _
-      | E_map _ | E_big_map _ |E_list _ | E_set _ |E_look_up _
+      | E_map _ | E_big_map _ |E_list _ | E_set _
        -> ok (true, (decl_var, free_var),ass_exp)
     )
       (element_names,[])
@@ -120,7 +119,7 @@ and store_mutable_variable (free_vars : I.expression_variable list) =
  
 and restore_mutable_variable (expr : O.expression->O.expression) (free_vars : O.expression_variable list) (env : O.expression_variable) =
   let aux (f: O.expression -> O.expression) (ev: O.expression_variable) =
-    fun expr -> f (O.e_let_in (ev,None) true false (O.e_record_accessor (O.e_variable env) (Label (Var.to_name ev))) expr)
+    fun expr -> f (O.e_let_in (ev,None) true false (O.e_accessor (O.e_variable env) [O.Access_record (Var.to_name ev)]) expr)
   in
   let ef = List.fold_left aux (fun e -> e) free_vars in
   fun e -> match e with 
@@ -234,13 +233,15 @@ and compile_expression' : I.expression -> (O.expression option -> O.expression)
         ) record
       in
       return @@ O.e_record ~loc (O.LMap.of_list record)
-    | I.E_record_accessor {record;path} ->
+    | I.E_accessor {record;path} ->
       let%bind record = compile_expression record in
-      return @@ O.e_record_accessor ~loc record path
+      let%bind path   = compile_path path in
-    | I.E_record_update {record;path;update} ->
+      return @@ O.e_accessor ~loc record path
+    | I.E_update {record;path;update} ->
       let%bind record = compile_expression record in
+      let%bind path   = compile_path path in
       let%bind update = compile_expression update in
-      return @@ O.e_record_update ~loc record path update
+      return @@ O.e_update ~loc record path update
     | I.E_map map ->
       let%bind map = bind_map_list (
         bind_map_pair compile_expression
@@ -259,9 +260,6 @@ and compile_expression' : I.expression -> (O.expression option -> O.expression)
     | I.E_set set ->
       let%bind set = bind_map_list compile_expression set in
       return @@ O.e_set ~loc set 
-    | I.E_look_up look_up ->
-      let%bind (a,b) = bind_map_pair compile_expression look_up in
-      return @@ O.e_look_up ~loc a b
     | I.E_ascription {anno_expr; type_annotation} ->
       let%bind anno_expr = compile_expression anno_expr in
       let%bind type_annotation = compile_type_expression type_annotation in
@@ -298,41 +296,10 @@ and compile_expression' : I.expression -> (O.expression option -> O.expression)
     | I.E_tuple tuple ->
       let%bind tuple = bind_map_list compile_expression tuple in
       return @@ O.e_tuple ~loc tuple
-    | I.E_tuple_accessor {tuple;path} ->
-      let%bind tuple = compile_expression tuple in
-      return @@ O.e_tuple_accessor ~loc tuple path
-    | I.E_tuple_update {tuple;path;update} ->
-      let%bind tuple = compile_expression tuple in
-      let%bind update = compile_expression update in
-      return @@ O.e_tuple_update ~loc tuple path update
     | I.E_assign {variable; access_path; expression} ->
-      let accessor ?loc s a =
+      let%bind access_path = compile_path access_path in
-        match a with 
-          I.Access_tuple _i -> failwith "adding tuple soon"
-        | I.Access_record a -> ok @@ O.e_record_accessor ?loc s (Label a)
-        | I.Access_map k -> 
-          let%bind k = compile_expression k in
-          ok @@ O.e_constant ?loc C_MAP_FIND_OPT [k;s]
-      in
-      let update ?loc (s:O.expression) a e =
-        match a with
-          I.Access_tuple _i -> failwith "adding tuple soon"      
-        | I.Access_record a -> ok @@ O.e_record_update ?loc s (Label a) e
-        | I.Access_map k ->
-          let%bind k = compile_expression k in
-          ok @@ O.e_constant ?loc C_UPDATE [k;O.e_some (e);s]
-      in
-      let aux (s, e : O.expression * _) lst =
-        let%bind s' = accessor ~loc:s.location s lst in
-        let e' = fun expr -> 
-          let%bind u = update ~loc:s.location s lst (expr)
-          in e u 
-        in
-        ok @@ (s',e')
-      in
-      let%bind (_,rhs) = bind_fold_list aux (O.e_variable variable, fun e -> ok @@ e) access_path in
       let%bind expression = compile_expression expression in
-      let%bind rhs = rhs @@ expression in
+      let rhs = O.e_update ~loc (O.e_variable ~loc variable) access_path expression in
       ok @@ fun expr -> (match expr with 
        | None -> O.e_let_in ~loc (variable,None) true false rhs (O.e_skip ())
        | Some e -> O.e_let_in ~loc (variable, None) true false rhs e
@@ -347,6 +314,16 @@ and compile_expression' : I.expression -> (O.expression option -> O.expression)
       let%bind w = compile_while w in
       ok @@ w
 
+and compile_path : I.access list -> O.access list result =
+  fun path ->
+  let aux a = match a with
+    | I.Access_record s -> ok @@ O.Access_record s
+    | I.Access_tuple  i -> ok @@ O.Access_tuple  i
+    | I.Access_map e ->
+      let%bind e = compile_expression e in
+      ok @@ O.Access_map e
+  in
+  bind_map_list aux path
 
 and compile_lambda : I.lambda -> O.lambda result =
   fun {binder;input_type;output_type;result}->
@@ -365,7 +342,7 @@ and compile_matching : I.matching -> Location.t -> (O.expression option -> O.exp
   match cases with 
     | I.Match_option {match_none;match_some} ->
       let%bind match_none' = compile_expression match_none in
-      let (n,expr,tv) = match_some in
+      let (n,expr) = match_some in
       let%bind expr' = compile_expression expr in
       let env = Var.fresh () in
       let%bind ((_,free_vars_none), match_none) = repair_mutable_variable_in_matching match_none' [] env in
@@ -374,7 +351,7 @@ and compile_matching : I.matching -> Location.t -> (O.expression option -> O.exp
       let expr       = add_to_end expr (O.e_variable env) in
       let free_vars = List.sort_uniq Var.compare @@ free_vars_none @ free_vars_some in
       if (List.length free_vars != 0) then
-        let match_expr  = O.e_matching matchee (O.Match_option {match_none; match_some=(n,expr,tv)}) in
+        let match_expr  = O.e_matching matchee (O.Match_option {match_none; match_some=(n,expr)}) in
         let return_expr = fun expr ->
           O.e_let_in (env,None) false false (store_mutable_variable free_vars) @@
           O.e_let_in (env,None) false false match_expr @@
@@ -382,19 +359,19 @@ and compile_matching : I.matching -> Location.t -> (O.expression option -> O.exp
         in
         ok @@ restore_mutable_variable return_expr free_vars env
       else
-        return @@ O.e_matching ~loc matchee @@ O.Match_option {match_none=match_none'; match_some=(n,expr',tv)}
+        return @@ O.e_matching ~loc matchee @@ O.Match_option {match_none=match_none'; match_some=(n,expr')}
     | I.Match_list {match_nil;match_cons} ->
       let%bind match_nil' = compile_expression match_nil in
-      let (hd,tl,expr,tv) = match_cons in
+      let (hd,tl,expr) = match_cons in
       let%bind expr' = compile_expression expr in
       let env = Var.fresh () in
       let%bind ((_,free_vars_nil), match_nil) = repair_mutable_variable_in_matching match_nil' [] env in
       let%bind ((_,free_vars_cons), expr) = repair_mutable_variable_in_matching expr' [hd;tl] env in
       let match_nil = add_to_end match_nil (O.e_variable env) in
-      let expr       = add_to_end expr (O.e_variable env) in
+      let expr      = add_to_end expr (O.e_variable env) in
       let free_vars = List.sort_uniq Var.compare @@ free_vars_nil @ free_vars_cons in
       if (List.length free_vars != 0) then
-        let match_expr  = O.e_matching matchee (O.Match_list {match_nil; match_cons=(hd,tl,expr,tv)}) in
+        let match_expr  = O.e_matching matchee (O.Match_list {match_nil; match_cons=(hd,tl,expr)}) in
         let return_expr = fun expr ->
           O.e_let_in (env,None) false false (store_mutable_variable free_vars) @@
           O.e_let_in (env,None) false false match_expr @@
@@ -402,11 +379,8 @@ and compile_matching : I.matching -> Location.t -> (O.expression option -> O.exp
         in
         ok @@ restore_mutable_variable return_expr free_vars env
       else
-        return @@ O.e_matching ~loc matchee @@ O.Match_list {match_nil=match_nil'; match_cons=(hd,tl,expr',tv)}
+        return @@ O.e_matching ~loc matchee @@ O.Match_list {match_nil=match_nil'; match_cons=(hd,tl,expr')}
-    | I.Match_tuple ((lst,expr), tv) ->
+    | I.Match_variant lst ->
-      let%bind expr = compile_expression expr in
-      return @@ O.e_matching ~loc matchee @@ O.Match_tuple ((lst,expr), tv)
-    | I.Match_variant (lst,tv) ->
       let env = Var.fresh () in
       let aux fv ((c,n),expr) =
         let%bind expr = compile_expression expr in
@@ -418,10 +392,10 @@ and compile_matching : I.matching -> Location.t -> (O.expression option -> O.exp
       let free_vars = List.sort_uniq Var.compare @@ List.concat fv in
       if (List.length free_vars == 0) then (
         let cases = List.map (fun case -> let (a,_,b) = case in (a,b)) cases in
-        return @@ O.e_matching ~loc matchee @@ O.Match_variant (cases,tv)
+        return @@ O.e_matching ~loc matchee @@ O.Match_variant cases
       ) else (
         let cases = List.map (fun case -> let (a,b,_) = case in (a,b)) cases in
-        let match_expr = O.e_matching matchee @@ O.Match_variant (cases,tv) in
+        let match_expr = O.e_matching matchee @@ O.Match_variant cases in
         let return_expr = fun expr ->
           O.e_let_in (env,None) false false (store_mutable_variable free_vars) @@
           O.e_let_in (env,None) false false match_expr @@
@@ -429,6 +403,18 @@ and compile_matching : I.matching -> Location.t -> (O.expression option -> O.exp
         in
         ok @@ restore_mutable_variable return_expr free_vars env
       )
+    | I.Match_record (lst,ty_opt,expr) ->
+      let%bind expr = compile_expression expr in
+      let%bind ty_opt = bind_map_option (bind_map_list compile_type_expression) ty_opt in
+      return @@ O.e_matching ~loc matchee @@ O.Match_record (lst,ty_opt,expr)
+    | I.Match_tuple (lst,ty_opt,expr) ->
+      let%bind expr = compile_expression expr in
+      let%bind ty_opt = bind_map_option (bind_map_list compile_type_expression) ty_opt in
+      return @@ O.e_matching ~loc matchee @@ O.Match_tuple (lst,ty_opt,expr)
+    | I.Match_variable (lst,ty_opt,expr) ->
+      let%bind expr = compile_expression expr in
+      let%bind ty_opt = bind_map_option compile_type_expression ty_opt in
+      return @@ O.e_matching ~loc matchee @@ O.Match_variable (lst,ty_opt,expr)
  
 and compile_while I.{condition;body} =
   let env_rec = Var.fresh () in
@@ -444,7 +430,7 @@ and compile_while I.{condition;body} =
   let for_body = add_to_end for_body ctrl in
 
   let aux name expr=
-    O.e_let_in (name,None) false false (O.e_record_accessor (O.e_record_accessor (O.e_variable binder) (Label "0")) (Label (Var.to_name name))) expr
+    O.e_let_in (name,None) false false (O.e_accessor (O.e_variable binder) [Access_tuple Z.zero; Access_record (Var.to_name name)]) expr
   in
   let init_rec = O.e_tuple [store_mutable_variable @@ captured_name_list] in
   let restore = fun expr -> List.fold_right aux captured_name_list expr in
@@ -459,7 +445,7 @@ and compile_while I.{condition;body} =
   let return_expr = fun expr -> 
     O.e_let_in let_binder false false init_rec @@
     O.e_let_in let_binder false false loop @@
-    O.e_let_in let_binder false false (O.e_record_accessor (O.e_variable env_rec) (Label"0")) @@
+    O.e_let_in let_binder false false (O.e_accessor (O.e_variable env_rec) [Access_tuple Z.zero]) @@
     expr
   in
   ok @@ restore_mutable_variable return_expr captured_name_list env_rec 
@@ -474,7 +460,7 @@ and compile_for I.{binder;start;final;increment;body} =
   let continue_expr = O.e_constant C_FOLD_CONTINUE [(O.e_variable env_rec)] in
   let ctrl = 
     O.e_let_in (binder,Some (O.t_int ())) false false (O.e_constant C_ADD [ O.e_variable binder ; step ]) @@
-    O.e_let_in (env_rec, None) false false (O.e_record_update (O.e_variable env_rec) (Label "1") @@ O.e_variable binder)@@
+    O.e_let_in (env_rec, None) false false (O.e_update (O.e_variable env_rec) [Access_tuple Z.one] @@ O.e_variable binder)@@
     continue_expr
   in
   (* Modify the body loop*)
@@ -483,7 +469,7 @@ and compile_for I.{binder;start;final;increment;body} =
   let for_body = add_to_end for_body ctrl in
 
   let aux name expr=
-    O.e_let_in (name,None) false false (O.e_record_accessor (O.e_record_accessor (O.e_variable env_rec) (Label "0")) (Label (Var.to_name name))) expr
+    O.e_let_in (name,None) false false (O.e_accessor (O.e_variable env_rec) [Access_tuple Z.zero; Access_record (Var.to_name name)]) expr
   in
 
   (* restores the initial value of the free_var*)
@@ -492,7 +478,7 @@ and compile_for I.{binder;start;final;increment;body} =
   (*Prep the lambda for the fold*)
   let stop_expr = O.e_constant C_FOLD_STOP [O.e_variable env_rec] in
   let aux_func = O.e_lambda env_rec None None @@ 
-                 O.e_let_in (binder,Some (O.t_int ())) false false (O.e_record_accessor (O.e_variable env_rec) (Label "1")) @@
+                 O.e_let_in (binder,Some (O.t_int ())) false false (O.e_accessor (O.e_variable env_rec) [Access_tuple Z.one]) @@
                  O.e_cond cond (restore for_body) (stop_expr) in
 
   (* Make the fold_while en precharge the vakye *)
@@ -505,7 +491,7 @@ and compile_for I.{binder;start;final;increment;body} =
     O.e_let_in (binder, Some (O.t_int ())) false false start @@
     O.e_let_in let_binder false false init_rec @@
     O.e_let_in let_binder false false loop @@
-    O.e_let_in let_binder false false (O.e_record_accessor (O.e_variable env_rec) (Label "0")) @@
+    O.e_let_in let_binder false false (O.e_accessor (O.e_variable env_rec) [Access_tuple Z.zero]) @@
     expr
   in
   ok @@ restore_mutable_variable return_expr captured_name_list env_rec 
@@ -521,21 +507,21 @@ and compile_for_each I.{binder;collection;collection_type; body} =
   
   let%bind body = compile_expression body in
   let%bind ((_,free_vars), body) = repair_mutable_variable_in_loops body element_names args in
-  let for_body = add_to_end body @@ (O.e_record_accessor (O.e_variable args) (Label "0")) in
+  let for_body = add_to_end body @@ (O.e_accessor (O.e_variable args) [Access_tuple Z.zero]) in
 
   let init_record = store_mutable_variable free_vars in
   let%bind collect = compile_expression collection in
   let aux name expr=
-    O.e_let_in (name,None) false false (O.e_record_accessor (O.e_record_accessor (O.e_variable args) (Label "0")) (Label (Var.to_name name))) expr
+    O.e_let_in (name,None) false false (O.e_accessor (O.e_variable args) [Access_tuple Z.zero; Access_record (Var.to_name name)]) expr
   in
   let restore = fun expr -> List.fold_right aux free_vars expr in
   let restore = match collection_type with
     | Map -> (match snd binder with 
-      | Some v -> fun expr -> restore (O.e_let_in (fst binder, None) false false (O.e_record_accessor (O.e_record_accessor (O.e_variable args) (Label "1")) (Label "0")) 
+      | Some v -> fun expr -> restore (O.e_let_in (fst binder, None) false false (O.e_accessor (O.e_variable args) [Access_tuple Z.one; Access_tuple Z.zero]) 
-                                    (O.e_let_in (v, None) false false (O.e_record_accessor (O.e_record_accessor (O.e_variable args) (Label "1")) (Label "1")) expr))
+                                    (O.e_let_in (v, None) false false (O.e_accessor (O.e_variable args) [Access_tuple Z.one; Access_tuple Z.one]) expr))
-      | None -> fun expr -> restore (O.e_let_in (fst binder, None) false false (O.e_record_accessor (O.e_record_accessor (O.e_variable args) (Label "1")) (Label "0")) expr) 
+      | None -> fun expr -> restore (O.e_let_in (fst binder, None) false false (O.e_accessor (O.e_variable args) [Access_tuple Z.one; Access_tuple Z.zero]) expr) 
     )
-    | _ -> fun expr -> restore (O.e_let_in (fst binder, None) false false (O.e_record_accessor (O.e_variable args) (Label "1")) expr)
+    | _ -> fun expr -> restore (O.e_let_in (fst binder, None) false false (O.e_accessor (O.e_variable args) [Access_tuple Z.one]) expr)
   in
   let lambda = O.e_lambda args None None (restore for_body) in
   let%bind op_name = match collection_type with
@@ -601,18 +587,18 @@ let rec uncompile_type_expression : O.type_expression -> I.type_expression resul
       let%bind lst = bind_map_list uncompile_type_expression lst in
       return @@ T_operator (type_operator, lst)
 
-let rec uncompile_expression' : O.expression -> I.expression result =
+let rec uncompile_expression : O.expression -> I.expression result =
   fun e ->
   let return expr = ok @@ I.make_e ~loc:e.location expr in
   match e.expression_content with 
     O.E_literal lit -> return @@ I.E_literal lit
   | O.E_constant {cons_name;arguments} -> 
-    let%bind arguments = bind_map_list uncompile_expression' arguments in
+    let%bind arguments = bind_map_list uncompile_expression arguments in
     return @@ I.E_constant {cons_name;arguments}
   | O.E_variable name     -> return @@ I.E_variable name
   | O.E_application {lamb; args} -> 
-    let%bind lamb = uncompile_expression' lamb in
+    let%bind lamb = uncompile_expression lamb in
-    let%bind args = uncompile_expression' args in
+    let%bind args = uncompile_expression args in
     return @@ I.E_application {lamb; args}
   | O.E_lambda lambda ->
     let%bind lambda = uncompile_lambda lambda in
@@ -624,105 +610,116 @@ let rec uncompile_expression' : O.expression -> I.expression result =
   | O.E_let_in {let_binder;inline;rhs;let_result} ->
     let (binder,ty_opt) = let_binder in
     let%bind ty_opt = bind_map_option uncompile_type_expression ty_opt in
-    let%bind rhs = uncompile_expression' rhs in
+    let%bind rhs = uncompile_expression rhs in
-    let%bind let_result = uncompile_expression' let_result in
+    let%bind let_result = uncompile_expression let_result in
     return @@ I.E_let_in {let_binder=(binder,ty_opt);inline;rhs;let_result}
   | O.E_constructor {constructor;element} ->
-    let%bind element = uncompile_expression' element in
+    let%bind element = uncompile_expression element in
     return @@ I.E_constructor {constructor;element}
   | O.E_matching {matchee; cases} ->
-    let%bind matchee = uncompile_expression' matchee in
+    let%bind matchee = uncompile_expression matchee in
     let%bind cases   = uncompile_matching cases in
     return @@ I.E_matching {matchee;cases}
   | O.E_record record ->
     let record = I.LMap.to_kv_list record in
     let%bind record = 
       bind_map_list (fun (k,v) ->
-        let%bind v = uncompile_expression' v in
+        let%bind v = uncompile_expression v in
         ok @@ (k,v)
       ) record
     in
     return @@ I.E_record (O.LMap.of_list record)
-  | O.E_record_accessor {record;path} ->
+  | O.E_accessor {record;path} ->
-    let%bind record = uncompile_expression' record in
+    let%bind record = uncompile_expression record in
-    return @@ I.E_record_accessor {record;path}
+    let%bind path = uncompile_path path in
-  | O.E_record_update {record;path;update} ->
+    return @@ I.E_accessor {record;path}
-    let%bind record = uncompile_expression' record in
+  | O.E_update {record;path;update} ->
-    let%bind update = uncompile_expression' update in
+    let%bind record = uncompile_expression record in
-    return @@ I.E_record_update {record;path;update}
+    let%bind path = uncompile_path path in
+    let%bind update = uncompile_expression update in
+    return @@ I.E_update {record;path;update}
   | O.E_tuple tuple ->
-    let%bind tuple = bind_map_list uncompile_expression' tuple in
+    let%bind tuple = bind_map_list uncompile_expression tuple in
     return @@ I.E_tuple tuple
-  | O.E_tuple_accessor {tuple;path} ->
-    let%bind tuple = uncompile_expression' tuple in
-    return @@ I.E_tuple_accessor {tuple;path}
-  | O.E_tuple_update {tuple;path;update} ->
-    let%bind tuple  = uncompile_expression' tuple in
-    let%bind update = uncompile_expression' update in
-    return @@ I.E_tuple_update {tuple;path;update}
   | O.E_map map ->
     let%bind map = bind_map_list (
-      bind_map_pair uncompile_expression'
+      bind_map_pair uncompile_expression
     ) map
     in
     return @@ I.E_map map
   | O.E_big_map big_map ->
     let%bind big_map = bind_map_list (
-      bind_map_pair uncompile_expression'
+      bind_map_pair uncompile_expression
     ) big_map
     in
     return @@ I.E_big_map big_map
   | O.E_list lst ->
-    let%bind lst = bind_map_list uncompile_expression' lst in
+    let%bind lst = bind_map_list uncompile_expression lst in
     return @@ I.E_list lst
   | O.E_set set ->
-    let%bind set = bind_map_list uncompile_expression' set in
+    let%bind set = bind_map_list uncompile_expression set in
     return @@ I.E_set set 
-  | O.E_look_up look_up ->
-    let%bind look_up = bind_map_pair uncompile_expression' look_up in
-    return @@ I.E_look_up look_up
   | O.E_ascription {anno_expr; type_annotation} ->
-    let%bind anno_expr = uncompile_expression' anno_expr in
+    let%bind anno_expr = uncompile_expression anno_expr in
     let%bind type_annotation = uncompile_type_expression type_annotation in
     return @@ I.E_ascription {anno_expr; type_annotation}
   | O.E_cond {condition;then_clause;else_clause} ->
-    let%bind condition   = uncompile_expression' condition in
+    let%bind condition   = uncompile_expression condition in
-    let%bind then_clause = uncompile_expression' then_clause in
+    let%bind then_clause = uncompile_expression then_clause in
-    let%bind else_clause = uncompile_expression' else_clause in
+    let%bind else_clause = uncompile_expression else_clause in
     return @@ I.E_cond {condition; then_clause; else_clause}
   | O.E_sequence {expr1; expr2} ->
-    let%bind expr1 = uncompile_expression' expr1 in
+    let%bind expr1 = uncompile_expression expr1 in
-    let%bind expr2 = uncompile_expression' expr2 in
+    let%bind expr2 = uncompile_expression expr2 in
     return @@ I.E_sequence {expr1; expr2}
   | O.E_skip -> return @@ I.E_skip
 
+and uncompile_path : O.access list -> I.access list result =
+  fun path -> let aux a = match a with
+    | O.Access_record s -> ok @@ I.Access_record s
+    | O.Access_tuple  i -> ok @@ I.Access_tuple  i
+    | O.Access_map e ->
+      let%bind e = uncompile_expression e in
+      ok @@ I.Access_map e
+  in
+  bind_map_list aux path
+
 and uncompile_lambda : O.lambda -> I.lambda result =
   fun {binder;input_type;output_type;result}->
     let%bind input_type = bind_map_option uncompile_type_expression input_type in
     let%bind output_type = bind_map_option uncompile_type_expression output_type in
-    let%bind result = uncompile_expression' result in
+    let%bind result = uncompile_expression result in
     ok @@ I.{binder;input_type;output_type;result}
 and uncompile_matching : O.matching_expr -> I.matching_expr result =
   fun m -> 
   match m with 
     | O.Match_list {match_nil;match_cons} ->
-      let%bind match_nil = uncompile_expression' match_nil in
+      let%bind match_nil = uncompile_expression match_nil in
-      let (hd,tl,expr,tv) = match_cons in
+      let (hd,tl,expr) = match_cons in
-      let%bind expr = uncompile_expression' expr in
+      let%bind expr = uncompile_expression expr in
-      ok @@ I.Match_list {match_nil; match_cons=(hd,tl,expr,tv)}
+      ok @@ I.Match_list {match_nil; match_cons=(hd,tl,expr)}
     | O.Match_option {match_none;match_some} ->
-      let%bind match_none = uncompile_expression' match_none in
+      let%bind match_none = uncompile_expression match_none in
-      let (n,expr,tv) = match_some in
+      let (n,expr) = match_some in
-      let%bind expr = uncompile_expression' expr in
+      let%bind expr = uncompile_expression expr in
-      ok @@ I.Match_option {match_none; match_some=(n,expr,tv)}
+      ok @@ I.Match_option {match_none; match_some=(n,expr)}
-    | O.Match_tuple ((lst,expr), tv) ->
+    | O.Match_variant lst ->
-      let%bind expr = uncompile_expression' expr in
-      ok @@ O.Match_tuple ((lst,expr), tv)
-    | O.Match_variant (lst,tv) ->
       let%bind lst = bind_map_list (
         fun ((c,n),expr) ->
-          let%bind expr = uncompile_expression' expr in
+          let%bind expr = uncompile_expression expr in
           ok @@ ((c,n),expr)
       ) lst 
       in
-      ok @@ I.Match_variant (lst,tv)
+      ok @@ I.Match_variant lst
+    | O.Match_record (lst,ty_opt,expr) ->
+      let%bind expr = uncompile_expression expr in
+      let%bind ty_opt = bind_map_option (bind_map_list uncompile_type_expression) ty_opt in
+      ok @@ I.Match_record (lst,ty_opt,expr)
+    | O.Match_tuple (lst,ty_opt,expr) ->
+      let%bind expr = uncompile_expression expr in
+      let%bind ty_opt = bind_map_option (bind_map_list uncompile_type_expression) ty_opt in
+      ok @@ I.Match_tuple (lst,ty_opt,expr)
+    | O.Match_variable (lst,ty_opt,expr) ->
+      let%bind expr = uncompile_expression expr in
+      let%bind ty_opt = bind_map_option uncompile_type_expression ty_opt in
+      ok @@ I.Match_variable (lst,ty_opt,expr)

src/passes/05-self_ast_sugar/helpers.ml

@@ -30,9 +30,6 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini
     let%bind res = bind_fold_list (bind_fold_pair self) init' lst in
     ok res
   )
-  | E_look_up ab ->
-      let%bind res = bind_fold_pair self init' ab in
-      ok res
   | E_application {lamb;args} -> (
       let ab = (lamb,args) in
       let%bind res = bind_fold_pair self init' ab in
@@ -56,15 +53,25 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini
     let%bind res = bind_fold_lmap aux (ok init') m in
     ok res
   )
-  | E_record_update {record;update} -> (
+  | E_update {record;path;update} -> (
     let%bind res = self init' record in
+    let aux res a = match a with
+    | Access_map e -> self res e 
+    | _ -> ok res
+    in
+    let%bind res = bind_fold_list aux res path in
     let%bind res = fold_expression self res update in
     ok res 
   )
-  | E_record_accessor {record} -> (
+  | E_accessor {record;path} -> (
-     let%bind res = self init' record in
+    let%bind res = self init' record in
-     ok res
+    let aux res a = match a with
-    )
+    | Access_map e -> self res e 
+    | _ -> ok res
+    in
+    let%bind res = bind_fold_list aux res path in
+    ok res
+  )
   | E_let_in { let_binder = _ ; rhs ; let_result } -> (
       let%bind res = self init' rhs in
       let%bind res = self res let_result in
@@ -90,40 +97,38 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini
     let%bind res = bind_fold_list aux (init') t in
     ok res
   )
-  | E_tuple_update {tuple;update} -> (
-    let%bind res = self init' tuple in
-    let%bind res = fold_expression self res update in
-    ok res 
-  )
-  | E_tuple_accessor {tuple} -> (
-     let%bind res = self init' tuple in
-     ok res
-    )
-     
      
 and fold_cases : 'a folder -> 'a -> matching_expr -> 'a result = fun f init m ->
   match m with
-  | Match_list { match_nil ; match_cons = (_ , _ , cons, _) } -> (
+  | Match_variant lst -> (
-      let%bind res = fold_expression f init match_nil in
-      let%bind res = fold_expression f res cons in
-      ok res
-    )
-  | Match_option { match_none ; match_some = (_ , some, _) } -> (
-      let%bind res = fold_expression f init match_none in
-      let%bind res = fold_expression f res some in
-      ok res
-    )
-  | Match_tuple ((_ , e), _) -> (
-      let%bind res = fold_expression f init e in
-      ok res
-    )
-  | Match_variant (lst, _) -> (
       let aux init' ((_ , _) , e) =
         let%bind res' = fold_expression f init' e in
         ok res' in
       let%bind res = bind_fold_list aux init lst in
       ok res
     )
+  | Match_list { match_nil ; match_cons = (_ , _ , cons) } -> (
+      let%bind res = fold_expression f init match_nil in
+      let%bind res = fold_expression f res cons in
+      ok res
+    )
+  | Match_option { match_none ; match_some = (_ , some) } -> (
+      let%bind res = fold_expression f init match_none in
+      let%bind res = fold_expression f res some in
+      ok res
+    )
+  | Match_record (_, _, e) -> (
+      let%bind res = fold_expression f init e in
+      ok res
+    )
+  | Match_tuple (_, _, e) -> (
+      let%bind res = fold_expression f init e in
+      ok res
+    )
+  | Match_variable (_, _, e) -> (
+      let%bind res = fold_expression f init e in
+      ok res
+    )
 
 type exp_mapper = expression -> expression result
 type ty_exp_mapper = type_expression -> type_expression result
@@ -151,10 +156,6 @@ let rec map_expression : exp_mapper -> expression -> expression result = fun f e
     let%bind lst' = bind_map_list (bind_map_pair self) lst in
     return @@ E_big_map lst'
   )
-  | E_look_up ab -> (
-      let%bind ab' = bind_map_pair self ab in
-      return @@ E_look_up ab'
-    )
   | E_ascription ascr -> (
       let%bind e' = self ascr.anno_expr in
       return @@ E_ascription {ascr with anno_expr=e'}
@@ -164,18 +165,32 @@ let rec map_expression : exp_mapper -> expression -> expression result = fun f e
       let%bind cases' = map_cases f cases in
       return @@ E_matching {matchee=e';cases=cases'}
     )
-  | E_record_accessor acc -> (
-      let%bind e' = self acc.record in
-      return @@ E_record_accessor {acc with record = e'}
-    )
   | E_record m -> (
     let%bind m' = bind_map_lmap self m in
     return @@ E_record m'
   )
-  | E_record_update {record; path; update} -> (
+  | E_accessor {record; path} -> (
     let%bind record = self record in
+    let aux a = match a with
+    | Access_map e -> 
+      let%bind e = self e in
+      ok @@ Access_map e
+    | e -> ok @@ e
+    in
+    let%bind path = bind_map_list aux path in
+    return @@ E_accessor {record; path}
+  )
+  | E_update {record; path; update} -> (
+    let%bind record = self record in
+    let aux a = match a with
+    | Access_map e -> 
+      let%bind e = self e in
+      ok @@ Access_map e
+    | e -> ok @@ e
+    in
+    let%bind path = bind_map_list aux path in
     let%bind update = self update in
-    return @@ E_record_update {record;path;update}
+    return @@ E_update {record;path;update}
   )
   | E_constructor c -> (
       let%bind e' = self c.element in
@@ -216,15 +231,6 @@ let rec map_expression : exp_mapper -> expression -> expression result = fun f e
     let%bind t' = bind_map_list self t in
     return @@ E_tuple t'
   )
-  | E_tuple_update {tuple; path; update} -> (
-    let%bind tuple  = self tuple in
-    let%bind update = self update in
-    return @@ E_tuple_update {tuple; path; update}
-  )
-  | E_tuple_accessor {tuple;path} -> (
-     let%bind tuple = self tuple in
-     return @@ E_tuple_accessor {tuple;path}
-    )
   | E_literal _ | E_variable _ | E_skip as e' -> return e'
 
 and map_type_expression : ty_exp_mapper -> type_expression -> type_expression result = fun f te ->
@@ -250,27 +256,35 @@ and map_type_expression : ty_exp_mapper -> type_expression -> type_expression re
 
 and map_cases : exp_mapper -> matching_expr -> matching_expr result = fun f m ->
   match m with
-  | Match_list { match_nil ; match_cons = (hd , tl , cons, _) } -> (
+  | Match_variant lst -> (
-      let%bind match_nil = map_expression f match_nil in
-      let%bind cons = map_expression f cons in
-      ok @@ Match_list { match_nil ; match_cons = (hd , tl , cons, ()) }
-    )
-  | Match_option { match_none ; match_some = (name , some, _) } -> (
-      let%bind match_none = map_expression f match_none in
-      let%bind some = map_expression f some in
-      ok @@ Match_option { match_none ; match_some = (name , some, ()) }
-    )
-  | Match_tuple ((names , e), _) -> (
-      let%bind e' = map_expression f e in
-      ok @@ Match_tuple ((names , e'), [])
-    )
-  | Match_variant (lst, _) -> (
       let aux ((a , b) , e) =
         let%bind e' = map_expression f e in
         ok ((a , b) , e')
       in
       let%bind lst' = bind_map_list aux lst in
-      ok @@ Match_variant (lst', ())
+      ok @@ Match_variant lst'
+    )
+  | Match_list { match_nil ; match_cons = (hd , tl , cons) } -> (
+      let%bind match_nil = map_expression f match_nil in
+      let%bind cons = map_expression f cons in
+      ok @@ Match_list { match_nil ; match_cons = (hd , tl , cons) }
+    )
+  | Match_option { match_none ; match_some = (name , some) } -> (
+      let%bind match_none = map_expression f match_none in
+      let%bind some = map_expression f some in
+      ok @@ Match_option { match_none ; match_some = (name , some) }
+    )
+  | Match_record (names, ty_opt, e) -> (
+      let%bind e' = map_expression f e in
+      ok @@ Match_record (names, ty_opt, e')
+    )
+  | Match_tuple (names, ty_opt, e) -> (
+      let%bind e' = map_expression f e in
+      ok @@ Match_tuple (names, ty_opt, e')
+    )
+  | Match_variable (name, ty_opt, e) -> (
+      let%bind e' = map_expression f e in
+      ok @@ Match_variable (name, ty_opt, e')
     )
 
 and map_program : abs_mapper -> program -> program result = fun m p ->
@@ -313,10 +327,6 @@ let rec fold_map_expression : 'a fold_mapper -> 'a -> expression -> ('a * expres
     let%bind (res, lst') = bind_fold_map_list (bind_fold_map_pair self) init' lst in
     ok (res, return @@ E_big_map lst')
   )
-  | E_look_up ab -> (
-      let%bind (res, ab') = bind_fold_map_pair self init' ab in
-      ok (res, return @@ E_look_up ab')
-    )
   | E_ascription ascr -> (
       let%bind (res,e') = self init' ascr.anno_expr in
       ok (res, return @@ E_ascription {ascr with anno_expr=e'})
@@ -326,33 +336,38 @@ let rec fold_map_expression : 'a fold_mapper -> 'a -> expression -> ('a * expres
       let%bind (res,cases') = fold_map_cases f res cases in
       ok (res, return @@ E_matching {matchee=e';cases=cases'})
     )
-  | E_record_accessor acc -> (
-      let%bind (res, e') = self init' acc.record in
-      ok (res, return @@ E_record_accessor {acc with record = e'})
-    )
   | E_record m -> (
     let%bind (res, lst') = bind_fold_map_list (fun res (k,e) -> let%bind (res,e) = self res e in ok (res,(k,e))) init' (LMap.to_kv_list m) in
     let m' = LMap.of_list lst' in
     ok (res, return @@ E_record m')
   )
-  | E_record_update {record; path; update} -> (
+  | E_accessor {record;path} -> (
     let%bind (res, record) = self init' record in
+    let aux res a = match a with
+    | Access_map e -> 
+      let%bind (res,e) = self res e in
+      ok @@ (res,Access_map e)
+    | e -> ok @@ (res,e)
+    in
+    let%bind (res, path)   = bind_fold_map_list aux res path in
+    ok (res, return @@ E_accessor {record; path})
+  )
+  | E_update {record; path; update} -> (
+    let%bind (res, record) = self init' record in
+    let aux res a = match a with
+    | Access_map e -> 
+      let%bind (res,e) = self res e in
+      ok @@ (res,Access_map e)
+    | e -> ok @@ (res,e)
+    in
+    let%bind (res, path)   = bind_fold_map_list aux res path in
     let%bind (res, update) = self res update in
-    ok (res, return @@ E_record_update {record;path;update})
+    ok (res, return @@ E_update {record;path;update})
   )
   | E_tuple t -> (
     let%bind (res, t') = bind_fold_map_list self init' t in
     ok (res, return @@ E_tuple t')
   )
-  | E_tuple_update {tuple; path; update} -> (
-    let%bind (res, tuple) = self init' tuple in
-    let%bind (res, update) = self res update in
-    ok (res, return @@ E_tuple_update {tuple;path;update})
-  )
-  | E_tuple_accessor {tuple; path} -> (
-     let%bind (res, tuple) = self init' tuple in
-     ok (res, return @@ E_tuple_accessor {tuple; path})
-    )
   | E_constructor c -> (
       let%bind (res,e') = self init' c.element in
       ok (res, return @@ E_constructor {c with element = e'})
@@ -389,28 +404,35 @@ let rec fold_map_expression : 'a fold_mapper -> 'a -> expression -> ('a * expres
       ok (res, return @@ E_sequence {expr1;expr2})
     )
   | E_literal _ | E_variable _ | E_skip as e' -> ok (init', return e')
-
 and fold_map_cases : 'a fold_mapper -> 'a -> matching_expr -> ('a * matching_expr) result = fun f init m ->
   match m with
-  | Match_list { match_nil ; match_cons = (hd , tl , cons, _) } -> (
+  | Match_variant lst -> (
-      let%bind (init, match_nil) = fold_map_expression f init match_nil in
-      let%bind (init, cons) = fold_map_expression f init cons in
-      ok @@ (init, Match_list { match_nil ; match_cons = (hd , tl , cons, ()) })
-    )
-  | Match_option { match_none ; match_some = (name , some, _) } -> (
-      let%bind (init, match_none) = fold_map_expression f init match_none in
-      let%bind (init, some) = fold_map_expression f init some in
-      ok @@ (init, Match_option { match_none ; match_some = (name , some, ()) })
-    )
-  | Match_tuple ((names , e), _) -> (
-      let%bind (init, e') = fold_map_expression f init e in
-      ok @@ (init, Match_tuple ((names , e'), []))
-    )
-  | Match_variant (lst, _) -> (
       let aux init ((a , b) , e) =
         let%bind (init,e') = fold_map_expression f init e in
         ok (init, ((a , b) , e'))
       in
       let%bind (init,lst') = bind_fold_map_list aux init lst in
-      ok @@ (init, Match_variant (lst', ()))
+      ok @@ (init, Match_variant lst')
+    )
+  | Match_list { match_nil ; match_cons = (hd , tl , cons) } -> (
+      let%bind (init, match_nil) = fold_map_expression f init match_nil in
+      let%bind (init, cons) = fold_map_expression f init cons in
+      ok @@ (init, Match_list { match_nil ; match_cons = (hd , tl , cons) })
+    )
+  | Match_option { match_none ; match_some = (name , some) } -> (
+      let%bind (init, match_none) = fold_map_expression f init match_none in
+      let%bind (init, some) = fold_map_expression f init some in
+      ok @@ (init, Match_option { match_none ; match_some = (name , some) })
+    )
+  | Match_record (names, ty_opt, e) -> (
+      let%bind (init, e') = fold_map_expression f init e in
+      ok @@ (init, Match_record (names, ty_opt, e'))
+    )
+  | Match_tuple (names, ty_opt, e) -> (
+      let%bind (init, e') = fold_map_expression f init e in
+      ok @@ (init, Match_tuple (names, ty_opt, e'))
+    )
+  | Match_variable (name, ty_opt, e) -> (
+      let%bind (init, e') = fold_map_expression f init e in
+      ok @@ (init, Match_variable (name, ty_opt, e'))
     )

src/passes/06-sugar_to_core/sugar_to_core.ml

@@ -2,7 +2,7 @@ module I = Ast_sugar
 module O = Ast_core
 open Trace
 
-let rec idle_type_expression : I.type_expression -> O.type_expression result =
+let rec compile_type_expression : I.type_expression -> O.type_expression result =
   fun te ->
   let return tc = ok @@ O.make_t ~loc:te.location tc in
   match te.type_content with
@@ -11,7 +11,7 @@ let rec idle_type_expression : I.type_expression -> O.type_expression result =
       let%bind sum = 
         bind_map_list (fun (k,v) ->
           let {ctor_type ; michelson_annotation ; ctor_decl_pos} : I.ctor_content = v in
-          let%bind ctor_type = idle_type_expression ctor_type in
+          let%bind ctor_type = compile_type_expression ctor_type in
           let v' : O.ctor_content = {ctor_type ; michelson_annotation ; ctor_decl_pos} in
           ok @@ (k,v')
         ) sum
@@ -22,7 +22,7 @@ let rec idle_type_expression : I.type_expression -> O.type_expression result =
       let%bind record = 
         bind_map_list (fun (k,v) ->
           let {field_type ; michelson_annotation ; field_decl_pos} : I.field_content = v in
-          let%bind field_type = idle_type_expression field_type in
+          let%bind field_type = compile_type_expression field_type in
           let v' : O.field_content = {field_type ; field_annotation=michelson_annotation ; field_decl_pos} in
           ok @@ (k,v')
         ) record
@@ -30,19 +30,19 @@ let rec idle_type_expression : I.type_expression -> O.type_expression result =
       return @@ O.T_record (O.LMap.of_list record)
     | I.T_tuple tuple ->
       let aux (i,acc) el = 
-        let%bind el = idle_type_expression el in
+        let%bind el = compile_type_expression el in
         ok @@ (i+1,(O.Label (string_of_int i), ({field_type=el;field_annotation=None;field_decl_pos=0}:O.field_content))::acc) in
       let%bind (_, lst ) = bind_fold_list aux (0,[]) tuple in
       let record = O.LMap.of_list lst in
       return @@ O.T_record record
     | I.T_arrow {type1;type2} ->
-      let%bind type1 = idle_type_expression type1 in
+      let%bind type1 = compile_type_expression type1 in
-      let%bind type2 = idle_type_expression type2 in
+      let%bind type2 = compile_type_expression type2 in
       return @@ T_arrow {type1;type2}
     | I.T_variable type_variable -> return @@ T_variable type_variable 
     | I.T_constant type_constant -> return @@ T_constant type_constant
     | I.T_operator (type_operator, lst) ->
-      let%bind lst = bind_map_list idle_type_expression lst in
+      let%bind lst = bind_map_list compile_type_expression lst in
       return @@ T_operator (type_operator, lst)
 
 let rec compile_expression : I.expression -> O.expression result =
@@ -62,12 +62,12 @@ let rec compile_expression : I.expression -> O.expression result =
       let%bind lambda = compile_lambda lambda in
       return @@ O.E_lambda lambda
     | I.E_recursive {fun_name;fun_type;lambda} ->
-      let%bind fun_type = idle_type_expression fun_type in
+      let%bind fun_type = compile_type_expression fun_type in
       let%bind lambda = compile_lambda lambda in
       return @@ O.E_recursive {fun_name;fun_type;lambda}
     | I.E_let_in {let_binder;inline;rhs;let_result} ->
       let (binder,ty_opt) = let_binder in
-      let%bind ty_opt = bind_map_option idle_type_expression ty_opt in
+      let%bind ty_opt = bind_map_option compile_type_expression ty_opt in
       let%bind rhs = compile_expression rhs in
       let%bind let_result = compile_expression let_result in
       return @@ O.E_let_in {let_binder=(binder,ty_opt);inline;rhs;let_result}
@@ -76,8 +76,7 @@ let rec compile_expression : I.expression -> O.expression result =
       return @@ O.E_constructor {constructor;element}
     | I.E_matching {matchee; cases} ->
       let%bind matchee = compile_expression matchee in
-      let%bind cases   = compile_matching cases in
+      compile_matching e.location matchee cases
-      return @@ O.E_matching {matchee;cases}
     | I.E_record record ->
       let record = I.LMap.to_kv_list record in
       let%bind record = 
@@ -87,13 +86,46 @@ let rec compile_expression : I.expression -> O.expression result =
         ) record
       in
       return @@ O.E_record (O.LMap.of_list record)
-    | I.E_record_accessor {record;path} ->
+    | I.E_accessor {record;path} ->
       let%bind record = compile_expression record in
-      return @@ O.E_record_accessor {record;path}
+      let accessor ?loc e a =
-    | I.E_record_update {record;path;update} ->
+        match a with 
+          I.Access_tuple  i -> ok @@ O.e_record_accessor ?loc e (Label (Z.to_string i))
+        | I.Access_record a -> ok @@ O.e_record_accessor ?loc e (Label a)
+        | I.Access_map k -> 
+          let%bind k = compile_expression k in
+          ok @@ O.e_constant ?loc C_MAP_FIND_OPT [k;e]
+      in
+      bind_fold_list accessor record path
+    | I.E_update {record;path;update} ->
       let%bind record = compile_expression record in
       let%bind update = compile_expression update in
-      return @@ O.E_record_update {record;path;update}
+      let accessor ?loc e a =
+        match a with 
+          I.Access_tuple  i -> ok @@ O.e_record_accessor ?loc e (Label (Z.to_string i))
+        | I.Access_record a -> ok @@ O.e_record_accessor ?loc e (Label a)
+        | I.Access_map k -> 
+          let%bind k = compile_expression k in
+          ok @@ O.e_constant ?loc C_MAP_FIND_OPT [k;e]
+      in
+      let updator ?loc (s:O.expression) a e =
+        match a with
+          I.Access_tuple  i -> ok @@ O.e_record_update ?loc s (Label (Z.to_string i)) e
+        | I.Access_record a -> ok @@ O.e_record_update ?loc s (Label a) e
+        | I.Access_map k ->
+          let%bind k = compile_expression k in
+          ok @@ O.e_constant ?loc C_UPDATE [k;O.e_some (e);s]
+      in
+      let aux (s, e : O.expression * _) lst =
+        let%bind s' = accessor ~loc:s.location s lst in
+        let e' = fun expr -> 
+          let%bind u = updator ~loc:s.location s lst (expr)
+          in e u 
+        in
+        ok @@ (s',e')
+      in
+      let%bind (_,rhs) = bind_fold_list aux (record, fun e -> ok @@ e) path in
+      rhs @@ update
     | I.E_map map -> (
       let map = List.sort_uniq compare map in
       let aux = fun prev (k, v) ->
@@ -126,18 +158,15 @@ let rec compile_expression : I.expression -> O.expression result =
       let%bind init = return @@ E_constant {cons_name=C_SET_EMPTY;arguments=[]} in
       bind_fold_list aux init lst'
       )
-    | I.E_look_up look_up ->
-      let%bind (path, index) = bind_map_pair compile_expression look_up in
-      return @@ O.E_constant {cons_name=C_MAP_FIND_OPT;arguments=[index;path]}
     | I.E_ascription {anno_expr; type_annotation} ->
       let%bind anno_expr = compile_expression anno_expr in
-      let%bind type_annotation = idle_type_expression type_annotation in
+      let%bind type_annotation = compile_type_expression type_annotation in
       return @@ O.E_ascription {anno_expr; type_annotation}
     | I.E_cond {condition; then_clause; else_clause} ->
       let%bind matchee = compile_expression condition in
       let%bind match_true = compile_expression then_clause in
       let%bind match_false = compile_expression else_clause in
-      return @@ O.E_matching {matchee; cases=Match_variant ([((Constructor "true", Var.of_name "_"),match_true);((Constructor "false", Var.of_name "_"), match_false)],())}
+      return @@ O.E_matching {matchee; cases=Match_variant ([((Constructor "true", Var.of_name "_"),match_true);((Constructor "false", Var.of_name "_"), match_false)])}
     | I.E_sequence {expr1; expr2} ->
       let%bind expr1 = compile_expression expr1 in
       let%bind expr2 = compile_expression expr2 in
@@ -150,46 +179,71 @@ let rec compile_expression : I.expression -> O.expression result =
       let%bind (_, lst ) = bind_fold_list aux (0,[]) t in
       let m = O.LMap.of_list lst in
       return @@ O.E_record m
-    | I.E_tuple_accessor {tuple;path} ->
-      let%bind record = compile_expression tuple in
-      let path        = O.Label (string_of_int path) in
-      return @@ O.E_record_accessor {record;path}
-    | I.E_tuple_update {tuple;path;update} ->
-      let%bind record = compile_expression tuple in
-      let path        = O.Label (string_of_int path) in
-      let%bind update = compile_expression update in
-      return @@ O.E_record_update {record;path;update}
 
 and compile_lambda : I.lambda -> O.lambda result =
   fun {binder;input_type;output_type;result}->
-    let%bind input_type = bind_map_option idle_type_expression input_type in
+    let%bind input_type = bind_map_option compile_type_expression input_type in
-    let%bind output_type = bind_map_option idle_type_expression output_type in
+    let%bind output_type = bind_map_option compile_type_expression output_type in
     let%bind result = compile_expression result in
     ok @@ O.{binder;input_type;output_type;result}
-and compile_matching : I.matching_expr -> O.matching_expr result =
+and compile_matching : Location.t -> O.expression -> I.matching_expr -> O.expression result =
-  fun m -> 
+  fun loc e m -> 
   match m with 
     | I.Match_list {match_nil;match_cons} ->
       let%bind match_nil = compile_expression match_nil in
-      let (hd,tl,expr,tv) = match_cons in
+      let (hd,tl,expr) = match_cons in
       let%bind expr = compile_expression expr in
-      ok @@ O.Match_list {match_nil; match_cons=(hd,tl,expr,tv)}
+      ok @@ O.e_matching ~loc e @@ O.Match_list {match_nil; match_cons=(hd,tl,expr)}
     | I.Match_option {match_none;match_some} ->
       let%bind match_none = compile_expression match_none in
-      let (n,expr,tv) = match_some in
+      let (n,expr) = match_some in
       let%bind expr = compile_expression expr in
-      ok @@ O.Match_option {match_none; match_some=(n,expr,tv)}
+      ok @@ O.e_matching ~loc e @@ O.Match_option {match_none; match_some=(n,expr)}
-    | I.Match_tuple ((lst,expr), tv) ->
+    | I.Match_variant lst ->
-      let%bind expr = compile_expression expr in
-      ok @@ O.Match_tuple ((lst,expr), tv)
-    | I.Match_variant (lst,tv) ->
       let%bind lst = bind_map_list (
         fun ((c,n),expr) ->
           let%bind expr = compile_expression expr in
           ok @@ ((c,n),expr)
       ) lst 
       in
-      ok @@ O.Match_variant (lst,tv)
+      ok @@ O.e_matching ~loc e @@ O.Match_variant lst
+    | I.Match_record (fields,field_types, expr) ->
+      let combine fields field_types =
+        match field_types with
+          Some ft -> List.combine fields @@ List.map (fun x -> Some x) ft
+        | None    -> List.map (fun x -> (x, None)) fields
+      in
+      let%bind next   = compile_expression expr in
+      let%bind field_types = bind_map_option (bind_map_list compile_type_expression) field_types in
+      let aux ((index,expr) : int * _ ) ((field,name): (O.label * (O.expression_variable * O.type_expression option))) =
+        let f = fun expr' -> O.e_let_in name false (O.e_record_accessor e field) expr' in
+        (index+1, fun expr' -> expr (f expr'))
+      in
+      let (_,header) = List.fold_left aux (0, fun e -> e) @@
+        List.map (fun ((a,b),c) -> (a,(b,c))) @@
+        combine fields field_types
+      in
+      ok @@ header next
+    | I.Match_tuple (fields,field_types, expr) ->
+      let combine fields field_types =
+        match field_types with
+          Some ft -> List.combine fields @@ List.map (fun x -> Some x) ft
+        | None    -> List.map (fun x -> (x, None)) fields
+      in
+      let%bind next   = compile_expression expr in
+      let%bind field_types = bind_map_option (bind_map_list compile_type_expression) field_types in
+      let aux ((index,expr) : int * _ ) (field: O.expression_variable * O.type_expression option) =
+        let f = fun expr' -> O.e_let_in field false (O.e_record_accessor e (Label (string_of_int index))) expr' in
+        (index+1, fun expr' -> expr (f expr'))
+      in
+      let (_,header) = List.fold_left aux (0, fun e -> e) @@
+        combine fields field_types
+      in
+      ok @@ header next
+    | I.Match_variable (a, ty_opt, expr) ->
+      let%bind ty_opt = bind_map_option compile_type_expression ty_opt in
+      let%bind expr = compile_expression expr in
+      ok @@ O.e_let_in (a,ty_opt) false e expr
  
 let compile_declaration : I.declaration Location.wrap -> _ =
   fun {wrap_content=declaration;location} ->
@@ -197,10 +251,10 @@ let compile_declaration : I.declaration Location.wrap -> _ =
   match declaration with 
   | I.Declaration_constant (n, te_opt, inline, expr) ->
     let%bind expr = compile_expression expr in
-    let%bind te_opt = bind_map_option idle_type_expression te_opt in
+    let%bind te_opt = bind_map_option compile_type_expression te_opt in
     return @@ O.Declaration_constant (n, te_opt, inline, expr)
   | I.Declaration_type (n, te) ->
-    let%bind te = idle_type_expression te in
+    let%bind te = compile_type_expression te in
     return @@ O.Declaration_type (n,te)
 
 let compile_program : I.program -> O.program result =
@@ -292,11 +346,13 @@ let rec uncompile_expression : O.expression -> I.expression result =
     return @@ I.E_record (O.LMap.of_list record)
   | O.E_record_accessor {record;path} ->
     let%bind record = uncompile_expression record in
-    return @@ I.E_record_accessor {record;path}
+    let Label path  = path in
+    return @@ I.E_accessor {record;path=[I.Access_record path]}
   | O.E_record_update {record;path;update} ->
     let%bind record = uncompile_expression record in
     let%bind update = uncompile_expression update in
-    return @@ I.E_record_update {record;path;update}
+    let Label path  = path in
+    return @@ I.E_update {record;path=[I.Access_record path];update}
   | O.E_ascription {anno_expr; type_annotation} ->
     let%bind anno_expr = uncompile_expression anno_expr in
     let%bind type_annotation = uncompile_type_expression type_annotation in
@@ -313,22 +369,19 @@ and uncompile_matching : O.matching_expr -> I.matching_expr result =
   match m with 
     | O.Match_list {match_nil;match_cons} ->
       let%bind match_nil = uncompile_expression match_nil in
-      let (hd,tl,expr,tv) = match_cons in
+      let (hd,tl,expr) = match_cons in
       let%bind expr = uncompile_expression expr in
-      ok @@ I.Match_list {match_nil; match_cons=(hd,tl,expr,tv)}
+      ok @@ I.Match_list {match_nil; match_cons=(hd,tl,expr)}
     | O.Match_option {match_none;match_some} ->
       let%bind match_none = uncompile_expression match_none in
-      let (n,expr,tv) = match_some in
+      let (n,expr) = match_some in
       let%bind expr = uncompile_expression expr in
-      ok @@ I.Match_option {match_none; match_some=(n,expr,tv)}
+      ok @@ I.Match_option {match_none; match_some=(n,expr)}
-    | O.Match_tuple ((lst,expr), tv) ->
+    | O.Match_variant lst ->
-      let%bind expr = uncompile_expression expr in
-      ok @@ O.Match_tuple ((lst,expr), tv)
-    | O.Match_variant (lst,tv) ->
       let%bind lst = bind_map_list (
         fun ((c,n),expr) ->
           let%bind expr = uncompile_expression expr in
           ok @@ ((c,n),expr)
       ) lst 
       in
-      ok @@ I.Match_variant (lst,tv)
+      ok @@ I.Match_variant lst

src/passes/07-self_ast_core/helpers.ml

@@ -72,21 +72,17 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini
 
 and fold_cases : 'a folder -> 'a -> matching_expr -> 'a result = fun f init m ->
   match m with
-  | Match_list { match_nil ; match_cons = (_ , _ , cons, _) } -> (
+  | Match_list { match_nil ; match_cons = (_ , _ , cons) } -> (
       let%bind res = fold_expression f init match_nil in
       let%bind res = fold_expression f res cons in
       ok res
     )
-  | Match_option { match_none ; match_some = (_ , some, _) } -> (
+  | Match_option { match_none ; match_some = (_ , some) } -> (
       let%bind res = fold_expression f init match_none in
       let%bind res = fold_expression f res some in
       ok res
     )
-  | Match_tuple ((_ , e), _) -> (
+  | Match_variant lst -> (
-      let%bind res = fold_expression f init e in
-      ok res
-    )
-  | Match_variant (lst, _) -> (
       let aux init' ((_ , _) , e) =
         let%bind res' = fold_expression f init' e in
         ok res' in
@@ -174,27 +170,23 @@ and map_type_expression : ty_exp_mapper -> type_expression -> type_expression re
 
 and map_cases : exp_mapper -> matching_expr -> matching_expr result = fun f m ->
   match m with
-  | Match_list { match_nil ; match_cons = (hd , tl , cons, _) } -> (
+  | Match_list { match_nil ; match_cons = (hd , tl , cons) } -> (
       let%bind match_nil = map_expression f match_nil in
       let%bind cons = map_expression f cons in
-      ok @@ Match_list { match_nil ; match_cons = (hd , tl , cons, ()) }
+      ok @@ Match_list { match_nil ; match_cons = (hd , tl , cons) }
     )
-  | Match_option { match_none ; match_some = (name , some, _) } -> (
+  | Match_option { match_none ; match_some = (name , some) } -> (
       let%bind match_none = map_expression f match_none in
       let%bind some = map_expression f some in
-      ok @@ Match_option { match_none ; match_some = (name , some, ()) }
+      ok @@ Match_option { match_none ; match_some = (name , some) }
     )
-  | Match_tuple ((names , e), _) -> (
+  | Match_variant lst -> (
-      let%bind e' = map_expression f e in
-      ok @@ Match_tuple ((names , e'), [])
-    )
-  | Match_variant (lst, _) -> (
       let aux ((a , b) , e) =
         let%bind e' = map_expression f e in
         ok ((a , b) , e')
       in
       let%bind lst' = bind_map_list aux lst in
-      ok @@ Match_variant (lst', ())
+      ok @@ Match_variant lst'
     )
 
 and map_program : abs_mapper -> program -> program result = fun m p ->
@@ -274,25 +266,21 @@ let rec fold_map_expression : 'a fold_mapper -> 'a -> expression -> ('a * expres
 
 and fold_map_cases : 'a fold_mapper -> 'a -> matching_expr -> ('a * matching_expr) result = fun f init m ->
   match m with
-  | Match_list { match_nil ; match_cons = (hd , tl , cons, _) } -> (
+  | Match_list { match_nil ; match_cons = (hd , tl , cons) } -> (
       let%bind (init, match_nil) = fold_map_expression f init match_nil in
       let%bind (init, cons) = fold_map_expression f init cons in
-      ok @@ (init, Match_list { match_nil ; match_cons = (hd , tl , cons, ()) })
+      ok @@ (init, Match_list { match_nil ; match_cons = (hd , tl , cons) })
     )
-  | Match_option { match_none ; match_some = (name , some, _) } -> (
+  | Match_option { match_none ; match_some = (name , some) } -> (
       let%bind (init, match_none) = fold_map_expression f init match_none in
       let%bind (init, some) = fold_map_expression f init some in
-      ok @@ (init, Match_option { match_none ; match_some = (name , some, ()) })
+      ok @@ (init, Match_option { match_none ; match_some = (name , some) })
     )
-  | Match_tuple ((names , e), _) -> (
+  | Match_variant lst -> (
-      let%bind (init, e') = fold_map_expression f init e in
-      ok @@ (init, Match_tuple ((names , e'), []))
-    )
-  | Match_variant (lst, _) -> (
       let aux init ((a , b) , e) =
         let%bind (init,e') = fold_map_expression f init e in
         ok (init, ((a , b) , e'))
       in
       let%bind (init,lst') = bind_fold_map_list aux init lst in
-      ok @@ (init, Match_variant (lst', ()))
+      ok @@ (init, Match_variant lst')
     )  

src/passes/08-typer-new/todo_use_fold_generator.ml

@@ -3,6 +3,7 @@ module O = Ast_typed
 
 let convert_constructor' (I.Constructor c) = O.Constructor c
 let convert_label (I.Label c) = O.Label c
+
 let convert_type_constant : I.type_constant -> O.type_constant = function
     | TC_unit -> TC_unit
     | TC_string -> TC_string

src/passes/08-typer-new/typer.ml

@@ -40,7 +40,7 @@ and type_match : environment -> O'.typer_state -> O.type_expression -> I.matchin
         trace_strong (match_error ~expected:i ~actual:t loc)
         @@ get_t_option t in
       let%bind (match_none , state') = type_expression e state match_none in
-      let (opt, b, _) = match_some in
+      let (opt, b) = match_some in
       let e' = Environment.add_ez_binder opt tv e in
       let%bind (body , state'') = type_expression e' state' b in
       ok (O.Match_option {match_none ; match_some = { opt; body; tv}} , state'')
@@ -49,23 +49,12 @@ and type_match : environment -> O'.typer_state -> O.type_expression -> I.matchin
         trace_strong (match_error ~expected:i ~actual:t loc)
         @@ get_t_list t in
       let%bind (match_nil , state') = type_expression e state match_nil in
-      let (hd, tl, b, _) = match_cons in
+      let (hd, tl, b) = match_cons in
       let e' = Environment.add_ez_binder hd t_elt e in
       let e' = Environment.add_ez_binder tl t e' in
       let%bind (body , state'') = type_expression e' state' b in
       ok (O.Match_list {match_nil ; match_cons = {hd; tl; body;tv=t}} , state'')
-    | Match_tuple ((vars, b),_) ->
+    | Match_variant lst ->
-      let%bind tvs =
-        trace_strong (match_error ~expected:i ~actual:t loc)
-        @@ get_t_tuple t in
-      let%bind lst' =
-        generic_try (match_tuple_wrong_arity tvs vars loc)
-        @@ (fun () -> List.combine vars tvs) in
-      let aux prev (name, tv) = Environment.add_ez_binder name tv prev in
-      let e' = List.fold_left aux e lst' in
-      let%bind (body , state') = type_expression e' state b in
-      ok (O.Match_tuple {vars ; body ; tvs} , state')
-    | Match_variant (lst,_) ->
       let%bind variant_opt =
         let aux acc ((constructor_name , _) , _) =
           let%bind (_ , variant) =
@@ -362,7 +351,6 @@ and type_expression : environment -> O'.typer_state -> ?tv_opt:O.type_expression
           match cur with
           | Match_list { match_nil ; match_cons = { hd=_ ; tl=_ ; body ; tv=_} } -> [ match_nil ; body ]
           | Match_option { match_none ; match_some = {opt=_; body; tv=_} } -> [ match_none ; body ]
-          | Match_tuple { vars=_ ; body ; tvs=_ } -> [ body ]
           | Match_variant { cases ; tv=_ } -> List.map (fun ({constructor=_; pattern=_; body} : O.matching_content_case) -> body) cases in
         List.map get_type_expression @@ aux m' in
       let%bind () = match tvs with

src/passes/08-typer-new/untyper.ml

@@ -264,8 +264,8 @@ let rec untype_expression (e:O.expression) : (I.expression) result =
     return (e_record @@ LMap.of_list r')
   | E_record_accessor {record; path} ->
     let%bind r' = untype_expression record in
-    let Label s = path in
+    let Label path = path in
-    return (e_record_accessor r' s)
+    return (e_record_accessor r' (Label path))
   | E_record_update {record; path; update} ->
     let%bind r' = untype_expression record in
     let%bind e = untype_expression update in 
@@ -299,22 +299,19 @@ and untype_lambda ty {binder; result} : I.lambda result =
 and untype_matching : (O.expression -> I.expression result) -> O.matching_expr -> I.matching_expr result = fun f m ->
   let open I in
   match m with
-  | Match_tuple { vars ; body ; tvs=_ } ->
-      let%bind b = f body in
-      ok @@ I.Match_tuple ((vars, b),[])
   | Match_option {match_none ; match_some = {opt; body;tv=_}} ->
       let%bind match_none = f match_none in
       let%bind some = f body in
-      let match_some = opt, some, () in
+      let match_some = opt, some in
       ok @@ Match_option {match_none ; match_some}
   | Match_list {match_nil ; match_cons = {hd;tl;body;tv=_}} ->
       let%bind match_nil = f match_nil in
       let%bind cons = f body in
-      let match_cons = hd , tl , cons, () in
+      let match_cons = hd , tl , cons in
       ok @@ Match_list {match_nil ; match_cons}
   | Match_variant { cases ; tv=_ } ->
       let aux ({constructor;pattern;body} : O.matching_content_case) =
         let%bind body = f body in
         ok ((unconvert_constructor' constructor,pattern),body) in
       let%bind lst' = bind_map_list aux cases in
-      ok @@ Match_variant (lst',())
+      ok @@ Match_variant lst'

src/passes/08-typer-old/typer.ml

@@ -125,17 +125,6 @@ module Errors = struct
     ] in
     error ~data title message ()
 
-
-  let match_tuple_wrong_arity (expected:'a list) (actual:'b list) (loc:Location.t) () =
-    let title () = "matching tuple of different size" in
-    let message () = "" in
-    let data = [
-      ("expected" , fun () -> Format.asprintf "%d" (List.length expected)) ;
-      ("actual" , fun () -> Format.asprintf "%d" (List.length actual)) ;
-      ("location" , fun () -> Format.asprintf "%a" Location.pp loc)
-    ] in
-    error ~data title message ()
-
   (* TODO: this should be a trace_info? *)
   let program_error (p:I.program) () =
     let message () = "" in
@@ -528,7 +517,7 @@ and type_match : (environment -> I.expression -> O.expression result) -> environ
         trace_strong (match_error ~expected:i ~actual:t loc)
         @@ get_t_option t in
       let%bind match_none = f e match_none in
-      let (opt, b,_) = match_some in
+      let (opt, b) = match_some in
       let e' = Environment.add_ez_binder opt tv e in
       let%bind body = f e' b in
       ok (O.Match_option {match_none ; match_some = {opt; body; tv}})
@@ -537,23 +526,12 @@ and type_match : (environment -> I.expression -> O.expression result) -> environ
         trace_strong (match_error ~expected:i ~actual:t loc)
         @@ get_t_list t in
       let%bind match_nil = f e match_nil in
-      let (hd, tl, b,_) = match_cons in
+      let (hd, tl, b) = match_cons in
       let e' = Environment.add_ez_binder hd t_elt e in
       let e' = Environment.add_ez_binder tl t e' in
       let%bind body = f e' b in
       ok (O.Match_list {match_nil ; match_cons = {hd; tl; body; tv=t_elt}})
-  | Match_tuple ((vars, b),_) ->
+  | Match_variant lst ->
-      let%bind tvs =
-        trace_strong (match_error ~expected:i ~actual:t loc)
-        @@ get_t_tuple t in
-      let%bind vars' =
-        generic_try (match_tuple_wrong_arity tvs vars loc)
-        @@ (fun () -> List.combine vars tvs) in
-      let aux prev (name, tv) = Environment.add_ez_binder name tv prev in
-      let e' = List.fold_left aux e vars' in
-      let%bind body = f e' b in
-      ok (O.Match_tuple { vars ; body ; tvs})
-  | Match_variant (lst,_) ->
       let%bind variant_cases' =
         trace (match_error ~expected:i ~actual:t loc)
         @@ Ast_typed.Combinators.get_t_sum t in
@@ -937,7 +915,6 @@ and type_expression' : environment -> ?tv_opt:O.type_expression -> I.expression
           match cur with
           | Match_list { match_nil ; match_cons = {hd=_ ; tl=_ ; body ; tv=_} } -> [ match_nil ; body ]
           | Match_option { match_none ; match_some = {opt=_ ; body ; tv=_ } } -> [ match_none ; body ]
-          | Match_tuple {vars=_;body;tvs=_} -> [ body ]
           | Match_variant {cases; tv=_} -> List.map (fun (c : O.matching_content_case) -> c.body) cases in
         List.map get_type_expression @@ aux m' in
       let aux prec cur =
@@ -1081,7 +1058,7 @@ let rec untype_expression (e:O.expression) : (I.expression) result =
   | E_record_accessor {record; path} ->
       let%bind r' = untype_expression record in
       let Label s = path in
-      return (e_record_accessor r' s)
+      return (e_record_accessor r' (Label s))
   | E_record_update {record=r; path=O.Label l; update=e} ->
     let%bind r' = untype_expression r in
     let%bind e = untype_expression e in 
@@ -1104,22 +1081,19 @@ let rec untype_expression (e:O.expression) : (I.expression) result =
 and untype_matching : (O.expression -> I.expression result) -> O.matching_expr -> I.matching_expr result = fun f m ->
   let open I in
   match m with
-  | Match_tuple {vars; body;tvs=_} ->
-      let%bind b = f body in
-      ok @@ I.Match_tuple ((vars, b),[])
   | Match_option {match_none ; match_some = {opt; body ; tv=_}} ->
       let%bind match_none = f match_none in
       let%bind some = f body in
-      let match_some = opt, some, () in
+      let match_some = opt, some in
       ok @@ Match_option {match_none ; match_some}
   | Match_list {match_nil ; match_cons = {hd ; tl ; body ; tv=_}} ->
       let%bind match_nil = f match_nil in
       let%bind cons = f body in
-      let match_cons = hd , tl , cons, () in
+      let match_cons = hd , tl , cons in
       ok @@ Match_list {match_nil ; match_cons}
   | Match_variant {cases;tv=_} ->
       let aux ({constructor;pattern;body} : O.matching_content_case) =
         let%bind c' = f body in
         ok ((unconvert_constructor' constructor,pattern),c') in
       let%bind lst' = bind_map_list aux cases in
-      ok @@ Match_variant (lst',())
+      ok @@ Match_variant lst'

src/passes/09-self_ast_typed/helpers.ml

@@ -63,10 +63,6 @@ and fold_cases : 'a . 'a folder -> 'a -> matching_expr -> 'a result = fun f init
       let%bind res = fold_expression f res body in
       ok res
     )
-  | Match_tuple {vars=_ ; body; tvs=_} -> (
-      let%bind res = fold_expression f init body in
-      ok res
-    )
   | Match_variant {cases;tv=_} -> (
       let aux init' {constructor=_; pattern=_ ; body} =
         let%bind res' = fold_expression f init' body in
@@ -140,10 +136,6 @@ and map_cases : mapper -> matching_expr -> matching_expr result = fun f m ->
       let%bind body = map_expression f body in
       ok @@ Match_option { match_none ; match_some = { opt ; body ; tv } }
     )
-  | Match_tuple { vars ; body ; tvs } -> (
-      let%bind body = map_expression f body in
-      ok @@ Match_tuple { vars ; body ; tvs }
-    )
   | Match_variant {cases;tv} -> (
       let aux { constructor ; pattern ; body } =
         let%bind body = map_expression f body in
@@ -231,10 +223,6 @@ and fold_map_cases : 'a . 'a fold_mapper -> 'a -> matching_expr -> ('a * matchin
       let%bind (init, body) = fold_map_expression f init body in
       ok @@ (init, Match_option { match_none ; match_some = { opt ; body ; tv } })
     )
-  | Match_tuple { vars ; body ; tvs } -> (
-      let%bind (init, body) = fold_map_expression f init body in
-      ok @@ (init, Match_tuple {vars ; body ; tvs })
-    )
   | Match_variant {cases ; tv} -> (
       let aux init {constructor ; pattern ; body} =
         let%bind (init, body) = fold_map_expression f init body in

src/passes/09-self_ast_typed/tail_recursion.ml

@@ -67,9 +67,6 @@ and check_recursive_call_in_matching = fun n final_path c ->
     let%bind _ = check_recursive_call n final_path match_none in
     let%bind _ = check_recursive_call n final_path body in
     ok ()
-  | Match_tuple {vars=_;body;tvs=_} ->
-    let%bind _ = check_recursive_call n final_path body in
-    ok ()
   | Match_variant {cases;tv=_} ->
     let aux {constructor=_; pattern=_; body} =
       let%bind _ = check_recursive_call n final_path body in

src/passes/10-transpiler/transpiler.ml

@@ -32,16 +32,6 @@ them. please report this to the developers." in
     let content () = Format.asprintf "%a" Var.pp name in
     error title content
 
-  let row_loc l = ("location" , fun () -> Format.asprintf "%a" Location.pp l)
-
-  let unsupported_pattern_matching kind location =
-    let title () = "unsupported pattern-matching" in
-    let content () = Format.asprintf "%s patterns aren't supported yet" kind in
-    let data = [
-        row_loc location ;
-      ] in
-    error ~data title content
-
   let not_functional_main location =
     let title () = "not functional main" in
     let content () = "main should be a function" in
@@ -615,7 +605,6 @@ and transpile_annotated_expression (ae:AST.expression) : expression result =
           trace_strong (corner_case ~loc:__LOC__ "building constructor") @@
           aux expr' tree''
        )
-      | AST.Match_tuple _ -> fail @@ unsupported_pattern_matching "tuple" ae.location
   )
 
 and transpile_lambda l (input_type , output_type) =
@@ -739,7 +728,6 @@ and transpile_recursive {fun_name; fun_type; lambda} =
           trace_strong (corner_case ~loc:__LOC__ "building constructor") @@
           aux expr tree''
        )
-      | AST.Match_tuple _ -> failwith "match_tuple not supported"
   in
   let%bind fun_type = transpile_type fun_type in
   let%bind (input_type,output_type) = get_t_function fun_type in

src/stages/1-ast_imperative/PP.ml

@@ -83,10 +83,10 @@ and expression_content ppf (ec : expression_content) =
         c.arguments
   | E_record m ->
       fprintf ppf "{%a}" (record_sep expression (const ";")) m
-  | E_record_accessor ra ->
+  | E_accessor {record;path} ->
-      fprintf ppf "%a.%a" expression ra.record label ra.path
+      fprintf ppf "%a.%a" expression record (list_sep accessor (const ".")) path
-  | E_record_update {record; path; update} ->
+  | E_update {record; path; update} ->
-      fprintf ppf "{ %a with %a = %a }" expression record label path expression update
+      fprintf ppf "{ %a with %a = %a }" expression record (list_sep accessor (const ".")) path expression update
   | E_map m ->
       fprintf ppf "map[%a]" (list_sep_d assoc_expression) m
   | E_big_map m ->
@@ -95,8 +95,6 @@ and expression_content ppf (ec : expression_content) =
       fprintf ppf "list[%a]" (list_sep_d expression) lst
   | E_set lst ->
       fprintf ppf "set[%a]" (list_sep_d expression) lst
-  | E_look_up (ds, ind) ->
-      fprintf ppf "(%a)[%a]" expression ds expression ind
   | E_lambda {binder; input_type; output_type; result} ->
       fprintf ppf "lambda (%a:%a) : %a return %a" 
         expression_variable binder
@@ -129,14 +127,10 @@ and expression_content ppf (ec : expression_content) =
       fprintf ppf "skip"
   | E_tuple t ->
       fprintf ppf "(%a)" (list_sep_d expression) t
-  | E_tuple_accessor ta ->
-      fprintf ppf "%a.%d" expression ta.tuple ta.path
-  | E_tuple_update {tuple; path; update} ->
-      fprintf ppf "{ %a with %d = %a }" expression tuple path expression update
   | E_assign {variable; access_path; expression=e} ->
       fprintf ppf "%a%a := %a" 
         expression_variable variable
-        (list_sep (fun ppf a -> fprintf ppf ".%a" accessor a) (fun ppf () -> fprintf ppf "")) access_path
+        (list_sep accessor (const ".")) access_path
         expression e
   | E_for {binder; start; final; increment; body} ->
       fprintf ppf "for %a from %a to %a by %a do %a" 
@@ -157,7 +151,7 @@ and expression_content ppf (ec : expression_content) =
     
 and accessor ppf a =
   match a with
-    | Access_tuple i  -> fprintf ppf "%d" i
+    | Access_tuple i  -> fprintf ppf "%a" Z.pp_print i
     | Access_record s -> fprintf ppf "%s" s
     | Access_map e    -> fprintf ppf "%a" expression e
 
@@ -184,27 +178,35 @@ and matching_variant_case : type a . (_ -> a -> unit) -> _ -> (constructor' * ex
   fun f ppf ((c,n),a) ->
   fprintf ppf "| %a %a -> %a" constructor c expression_variable n f a
 
-and matching : type a . (formatter -> a -> unit) -> formatter -> (a,unit) matching_content -> unit =
+and matching : (formatter -> expression -> unit) -> formatter -> matching_expr -> unit =
   fun f ppf m -> match m with
-    | Match_tuple ((lst, b), _) ->
+    | Match_variant lst ->
-        fprintf ppf "let (%a) = %a" (list_sep_d expression_variable) lst f b
-    | Match_variant (lst, _) ->
         fprintf ppf "%a" (list_sep (matching_variant_case f) (tag "@.")) lst
-    | Match_list {match_nil ; match_cons = (hd, tl, match_cons, _)} ->
+    | Match_list {match_nil ; match_cons = (hd, tl, match_cons)} ->
         fprintf ppf "| Nil -> %a @.| %a :: %a -> %a" f match_nil expression_variable hd expression_variable tl f match_cons
-    | Match_option {match_none ; match_some = (some, match_some, _)} ->
+    | Match_option {match_none ; match_some = (some, match_some)} ->
         fprintf ppf "| None -> %a @.| Some %a -> %a" f match_none expression_variable some f match_some
+    | Match_tuple (lst, _,b) ->
+        fprintf ppf "(%a) -> %a" (list_sep_d expression_variable) lst f b
+    | Match_record (lst, _,b) ->
+        fprintf ppf "{%a} -> %a" (list_sep_d (fun ppf (a,b) -> fprintf ppf "%a = %a" label a expression_variable b)) lst f b
+    | Match_variable (a, _,b) ->
+        fprintf ppf "%a -> %a" expression_variable a f b
 
 (* Shows the type expected for the matched value *)
 and matching_type ppf m = match m with
-  | Match_tuple _ ->
+  | Match_variant lst ->
-      fprintf ppf "tuple"
-  | Match_variant (lst, _) ->
       fprintf ppf "variant %a" (list_sep matching_variant_case_type (tag "@.")) lst
   | Match_list _ ->
       fprintf ppf "list"
   | Match_option _ ->
       fprintf ppf "option"
+  | Match_tuple _ ->
+      fprintf ppf "tuple"
+  | Match_record _ ->
+      fprintf ppf "record"
+  | Match_variable _ ->
+      fprintf ppf "variable"
 
 and matching_variant_case_type ppf ((c,n),_a) =
   fprintf ppf "| %a %a" constructor c expression_variable n

src/stages/1-ast_imperative/combinators.ml

@@ -119,15 +119,12 @@ let e_let_in ?loc (binder, ascr) inline rhs let_result = make_e ?loc @@ E_let_in
 let e_constructor ?loc s a : expression = make_e ?loc @@ E_constructor { constructor = Constructor s; element = a}
 let e_matching ?loc a b : expression = make_e ?loc @@ E_matching {matchee=a;cases=b}
 
-let e_record_accessor ?loc a b = make_e ?loc @@ E_record_accessor {record = a; path = Label b}
+let e_accessor ?loc record path      = make_e ?loc @@ E_accessor {record; path}
-let e_accessor_list ?loc a b  = List.fold_left (fun a b -> e_record_accessor ?loc a b) a b
+let e_update ?loc record path update = make_e ?loc @@ E_update {record; path; update}
-let e_record_update ?loc record path update = make_e ?loc @@ E_record_update {record; path=Label path; update}
 
 let e_annotation ?loc anno_expr ty = make_e ?loc @@ E_ascription {anno_expr; type_annotation = ty}
 
 let e_tuple ?loc lst : expression = make_e ?loc @@ E_tuple lst
-let e_tuple_accessor ?loc tuple path : expression = make_e ?loc @@ E_tuple_accessor {tuple; path}
-let e_tuple_update ?loc tuple path update : expression = make_e ?loc @@ E_tuple_update {tuple; path; update}
 
 let e_pair ?loc a b  : expression = e_tuple ?loc [a;b]
 let e_cond ?loc condition then_clause else_clause = make_e ?loc @@ E_cond {condition;then_clause;else_clause}
@@ -138,7 +135,6 @@ let e_list ?loc lst : expression = make_e ?loc @@ E_list lst
 let e_set ?loc lst : expression = make_e ?loc @@ E_set lst
 let e_map ?loc lst : expression = make_e ?loc @@ E_map lst
 let e_big_map ?loc lst : expression = make_e ?loc @@ E_big_map lst
-let e_look_up ?loc x y = make_e ?loc @@ E_look_up (x , y)
 
 let e_while ?loc condition body = make_e ?loc @@ E_while {condition; body}
 let e_for ?loc binder start final increment body = make_e ?loc @@ E_for {binder;start;final;increment;body}
@@ -148,9 +144,14 @@ let e_bool ?loc   b : expression = e_constructor ?loc (string_of_bool b) (e_unit
 
 let ez_match_variant (lst : ((string * string) * 'a) list) =
   let lst = List.map (fun ((c,n),a) -> ((Constructor c, Var.of_name n), a) ) lst in
-  Match_variant (lst,())
+  Match_variant lst
 let e_matching_variant ?loc a (lst : ((string * string)* 'a) list) =
   e_matching ?loc a (ez_match_variant lst)
+
+let e_matching_record   ?loc m lst ty_opt expr = e_matching ?loc m @@ Match_record   (lst,ty_opt, expr)
+let e_matching_tuple    ?loc m lst ty_opt expr = e_matching ?loc m @@ Match_tuple    (lst,ty_opt, expr)
+let e_matching_variable ?loc m var ty_opt expr = e_matching ?loc m @@ Match_variable (var,ty_opt, expr)
+
 let e_record_ez ?loc (lst : (string * expr) list) : expression =
   let map = List.fold_left (fun m (x, y) -> LMap.add (Label x) y m) LMap.empty lst in
   make_e ?loc @@ E_record map
@@ -184,14 +185,10 @@ let e_typed_set ?loc lst k = e_annotation ?loc (e_set lst) (t_set k)
 
 let e_assign ?loc variable access_path expression =
   make_e ?loc @@ E_assign {variable;access_path;expression} 
-let e_ez_assign ?loc variable access_path expression = 
-  let variable = Var.of_name variable in
-  let access_path = List.map (fun s -> Access_record s) access_path in
-  e_assign ?loc variable access_path expression 
 
 let get_e_accessor = fun t ->
   match t with
-  | E_record_accessor {record; path} -> ok (record , path)
+  | E_accessor {record; path} -> ok (record , path)
   | _ -> simple_fail "not an accessor"
 
 let assert_e_accessor = fun t ->

src/stages/1-ast_imperative/combinators.mli

@@ -98,20 +98,20 @@ val e_let_in : ?loc:Location.t -> ( expression_variable * type_expression option
 
 val e_constructor : ?loc:Location.t -> string -> expression -> expression
 val e_matching : ?loc:Location.t -> expression -> matching_expr -> expression
-val ez_match_variant : ((string * string ) * 'a ) list -> ('a,unit) matching_content
+val ez_match_variant : ((string * string ) * expression) list -> matching_expr
 val e_matching_variant : ?loc:Location.t -> expression -> ((string * string) * expression) list -> expression
+val e_matching_record  : ?loc:Location.t -> expression -> (label * expression_variable) list -> type_expression list option -> expression -> expression
+val e_matching_tuple   : ?loc:Location.t -> expression -> expression_variable list -> type_expression list option -> expression -> expression
+val e_matching_variable: ?loc:Location.t -> expression -> expression_variable -> type_expression option -> expression -> expression
 
 val e_record : ?loc:Location.t -> expr Map.String.t -> expression
 val e_record_ez  : ?loc:Location.t -> ( string * expr ) list -> expression
-val e_record_accessor : ?loc:Location.t -> expression -> string -> expression
+val e_accessor : ?loc:Location.t -> expression -> access list -> expression
-val e_accessor_list : ?loc:Location.t -> expression -> string list -> expression
+val e_update   : ?loc:Location.t -> expression -> access list -> expression -> expression
-val e_record_update : ?loc:Location.t -> expression -> string -> expression -> expression
 
 val e_annotation : ?loc:Location.t -> expression -> type_expression -> expression
 
 val e_tuple : ?loc:Location.t -> expression list -> expression
-val e_tuple_accessor : ?loc:Location.t -> expression -> int -> expression
-val e_tuple_update : ?loc:Location.t -> expression -> int -> expression -> expression
 val e_pair : ?loc:Location.t -> expression -> expression -> expression
 
 val e_cond: ?loc:Location.t -> expression -> expression -> expression -> expression
@@ -122,10 +122,8 @@ val e_list : ?loc:Location.t -> expression list -> expression
 val e_set : ?loc:Location.t -> expression list -> expression
 val e_map : ?loc:Location.t -> ( expression * expression ) list -> expression
 val e_big_map : ?loc:Location.t -> ( expr * expr ) list -> expression
-val e_look_up : ?loc:Location.t -> expression -> expression -> expression
 
 val e_assign : ?loc:Location.t -> expression_variable -> access list -> expression -> expression
-val e_ez_assign : ?loc:Location.t -> string -> string list -> expression -> expression
 
 val e_while  : ?loc:Location.t -> expression -> expression -> expression
 val e_for     : ?loc:Location.t -> expression_variable -> expression -> expression -> expression -> expression -> expression

src/stages/1-ast_imperative/types.ml

@@ -53,8 +53,8 @@ and expression_content =
   | E_matching of matching
   (* Record *)
   | E_record of expression label_map
-  | E_record_accessor of record_accessor
+  | E_accessor of accessor
-  | E_record_update   of record_update
+  | E_update   of update
   (* Advanced *)
   | E_ascription of ascription
   (* Sugar *)
@@ -62,14 +62,11 @@ and expression_content =
   | E_sequence of sequence
   | E_skip
   | E_tuple of expression list
-  | E_tuple_accessor of tuple_accessor
-  | E_tuple_update   of tuple_update
   (* Data Structures *)
   | E_map of (expression * expression) list 
   | E_big_map of (expression * expression) list
   | E_list of expression list
   | E_set of expression list
-  | E_look_up of (expression * expression)
   (* Imperative *)
   | E_assign of assign
   | E_for of for_
@@ -105,12 +102,25 @@ and let_in =
 
 and constructor = {constructor: constructor'; element: expression}
 
-and record_accessor = {record: expression; path: label}
+and accessor = {record: expression; path: access list}
-and record_update   = {record: expression; path: label ; update: expression}
+and update   = {record: expression; path: access list; update: expression}
 
 
 
-and matching_expr = (expr,unit) matching_content
+and matching_expr =
+  | Match_variant of ((constructor' * expression_variable) * expression) list
+  | Match_list of {
+      match_nil  : expression ;
+      match_cons : expression_variable * expression_variable * expression ;
+    }
+  | Match_option of {
+      match_none : expression ;
+      match_some : expression_variable * expression ;
+    }
+  | Match_tuple of expression_variable list * type_expression list option * expression
+  | Match_record of (label * expression_variable) list * type_expression list option * expression
+  | Match_variable of expression_variable * type_expression option * expression
+
 and matching =
   { matchee: expression
   ; cases: matching_expr
@@ -129,9 +139,6 @@ and sequence = {
   expr2: expression ;
   }
 
-and tuple_accessor = {tuple: expression; path: int}
-and tuple_update   = {tuple: expression; path: int ; update: expression}
-
 and assign = {
   variable : expression_variable;
   access_path : access list;
@@ -139,7 +146,7 @@ and assign = {
 }
 
 and access =
-  | Access_tuple of int
+  | Access_tuple of Z.t
   | Access_record of string
   | Access_map of expr
 

src/stages/2-ast_sugar/PP.ml

@@ -78,10 +78,10 @@ and expression_content ppf (ec : expression_content) =
         c.arguments
   | E_record m ->
       fprintf ppf "{%a}" (record_sep_expr expression (const ";")) m
-  | E_record_accessor ra ->
+  | E_accessor {record;path} ->
-      fprintf ppf "%a.%a" expression ra.record label ra.path
+      fprintf ppf "%a.%a" expression record (list_sep accessor (const ".")) path
-  | E_record_update {record; path; update} ->
+  | E_update {record; path; update} ->
-      fprintf ppf "{ %a with %a = %a }" expression record label path expression update
+      fprintf ppf "{ %a with %a = %a }" expression record (list_sep accessor (const ".")) path expression update
   | E_map m ->
       fprintf ppf "map[%a]" (list_sep_d assoc_expression) m
   | E_big_map m ->
@@ -90,8 +90,6 @@ and expression_content ppf (ec : expression_content) =
       fprintf ppf "list[%a]" (list_sep_d expression) lst
   | E_set lst ->
       fprintf ppf "set[%a]" (list_sep_d expression) lst
-  | E_look_up (ds, ind) ->
-      fprintf ppf "(%a)[%a]" expression ds expression ind
   | E_lambda {binder; input_type; output_type; result} ->
       fprintf ppf "lambda (%a:%a) : %a return %a" 
         expression_variable binder
@@ -127,10 +125,12 @@ and expression_content ppf (ec : expression_content) =
       fprintf ppf "skip"
   | E_tuple t ->
       fprintf ppf "(%a)" (list_sep_d expression) t
-  | E_tuple_accessor ta ->
+
-      fprintf ppf "%a.%d" expression ta.tuple ta.path
+and accessor ppf a =
-  | E_tuple_update {tuple; path; update} ->
+  match a with
-      fprintf ppf "{ %a with %d = %a }" expression tuple path expression update
+    | Access_tuple i  -> fprintf ppf "%a" Z.pp_print i
+    | Access_record s -> fprintf ppf "%s" s
+    | Access_map e    -> fprintf ppf "%a" expression e
 
 and option_type_name ppf
     ((n, ty_opt) : expression_variable * type_expression option) =
@@ -150,27 +150,35 @@ and matching_variant_case : type a . (_ -> a -> unit) -> _ -> (constructor' * ex
   fun f ppf ((c,n),a) ->
   fprintf ppf "| %a %a -> %a" constructor c expression_variable n f a
 
-and matching : type a . (formatter -> a -> unit) -> formatter -> (a,unit) matching_content -> unit =
+and matching : (formatter -> expression -> unit) -> formatter -> matching_expr -> unit =
   fun f ppf m -> match m with
-    | Match_tuple ((lst, b), _) ->
+    | Match_variant lst ->
-        fprintf ppf "let (%a) = %a" (list_sep_d expression_variable) lst f b
-    | Match_variant (lst, _) ->
         fprintf ppf "%a" (list_sep (matching_variant_case f) (tag "@.")) lst
-    | Match_list {match_nil ; match_cons = (hd, tl, match_cons, _)} ->
+    | Match_list {match_nil ; match_cons = (hd, tl, match_cons)} ->
         fprintf ppf "| Nil -> %a @.| %a :: %a -> %a" f match_nil expression_variable hd expression_variable tl f match_cons
-    | Match_option {match_none ; match_some = (some, match_some, _)} ->
+    | Match_option {match_none ; match_some = (some, match_some)} ->
         fprintf ppf "| None -> %a @.| Some %a -> %a" f match_none expression_variable some f match_some
+    | Match_tuple (lst, _,b) ->
+        fprintf ppf "(%a) -> %a" (list_sep_d expression_variable) lst f b
+    | Match_record (lst, _,b) ->
+        fprintf ppf "{%a} -> %a" (list_sep_d (fun ppf (a,b) -> fprintf ppf "%a = %a" label a expression_variable b)) lst f b
+    | Match_variable (a, _,b) ->
+        fprintf ppf "%a -> %a" expression_variable a f b
 
 (* Shows the type expected for the matched value *)
 and matching_type ppf m = match m with
-  | Match_tuple _ ->
+  | Match_variant lst ->
-      fprintf ppf "tuple"
-  | Match_variant (lst, _) ->
       fprintf ppf "variant %a" (list_sep matching_variant_case_type (tag "@.")) lst
   | Match_list _ ->
       fprintf ppf "list"
   | Match_option _ ->
       fprintf ppf "option"
+  | Match_tuple _ ->
+      fprintf ppf "tuple"
+  | Match_record _ ->
+      fprintf ppf "record"
+  | Match_variable _ ->
+      fprintf ppf "variable"
 
 and matching_variant_case_type ppf ((c,n),_a) =
   fprintf ppf "| %a %a" constructor c expression_variable n

src/stages/2-ast_sugar/combinators.ml

@@ -108,14 +108,12 @@ let e_constructor ?loc s a : expression = make_e ?loc @@ E_constructor { constru
 let e_matching ?loc a b : expression = make_e ?loc @@ E_matching {matchee=a;cases=b}
 
 let e_record ?loc map : expression = make_e ?loc @@ E_record map
-let e_record_accessor ?loc record path = make_e ?loc @@ E_record_accessor {record; path}
+let e_accessor ?loc record path = make_e ?loc @@ E_accessor {record; path}
-let e_record_update ?loc record path update = make_e ?loc @@ E_record_update {record; path; update}
+let e_update ?loc record path update = make_e ?loc @@ E_update {record; path; update}
 
 let e_annotation ?loc anno_expr ty = make_e ?loc @@ E_ascription {anno_expr; type_annotation = ty}
 
 let e_tuple ?loc lst : expression = make_e ?loc @@ E_tuple lst
-let e_tuple_accessor ?loc tuple path = make_e ?loc @@ E_tuple_accessor {tuple; path}
-let e_tuple_update ?loc tuple path update = make_e ?loc @@ E_tuple_update {tuple; path; update}
 let e_pair ?loc a b  : expression = e_tuple ?loc [a;b]
 
 let e_cond ?loc condition then_clause else_clause = make_e ?loc @@ E_cond {condition;then_clause;else_clause}
@@ -126,7 +124,6 @@ let e_list ?loc lst : expression = make_e ?loc @@ E_list lst
 let e_set ?loc lst : expression = make_e ?loc @@ E_set lst
 let e_map ?loc lst : expression = make_e ?loc @@ E_map lst
 let e_big_map ?loc lst : expression = make_e ?loc @@ E_big_map lst
-let e_look_up ?loc a b : expression = make_e ?loc @@ E_look_up (a,b)
 
 let e_bool ?loc   b : expression = e_constructor ?loc (Constructor (string_of_bool b)) (e_unit ())
 
@@ -150,13 +147,13 @@ let e_typed_set ?loc lst k = e_annotation ?loc (e_set lst) (t_set k)
 
 
 
-let get_e_record_accessor = fun t ->
+let get_e_accessor = fun t ->
   match t with
-  | E_record_accessor {record; path} -> ok (record, path)
+  | E_accessor {record; path} -> ok (record, path)
   | _ -> simple_fail "not a record accessor"
 
 let assert_e_accessor = fun t ->
-  let%bind _ = get_e_record_accessor t in
+  let%bind _ = get_e_accessor t in
   ok ()
 
 let get_e_pair = fun t ->

src/stages/2-ast_sugar/combinators.mli

@@ -78,15 +78,13 @@ val e_application : ?loc:Location.t -> expression -> expression -> expression
 val e_recursive : ?loc:Location.t -> expression_variable -> type_expression -> lambda -> expression
 val e_let_in : ?loc:Location.t -> ( expression_variable * type_expression option ) -> bool -> bool -> expression -> expression -> expression
 
-val e_record : ?loc:Location.t -> expr label_map -> expression
+val e_record   : ?loc:Location.t -> expr label_map -> expression
-val e_record_accessor : ?loc:Location.t -> expression -> label -> expression
+val e_accessor : ?loc:Location.t -> expression -> access list -> expression
-val e_record_update : ?loc:Location.t -> expression -> label -> expression -> expression
+val e_update   : ?loc:Location.t -> expression -> access list -> expression -> expression
 
 val e_annotation : ?loc:Location.t -> expression -> type_expression -> expression
 
 val e_tuple : ?loc:Location.t -> expression list -> expression
-val e_tuple_accessor : ?loc:Location.t -> expression -> int -> expression
-val e_tuple_update : ?loc:Location.t -> expression -> int -> expression -> expression
 val e_pair : ?loc:Location.t -> expression -> expression -> expression
 
 val e_cond: ?loc:Location.t -> expression -> expression -> expression -> expression
@@ -97,7 +95,6 @@ val e_list : ?loc:Location.t -> expression list -> expression
 val e_set : ?loc:Location.t -> expression list -> expression
 val e_map : ?loc:Location.t -> ( expression * expression ) list -> expression
 val e_big_map : ?loc:Location.t -> ( expr * expr ) list -> expression
-val e_look_up : ?loc:Location.t -> expression -> expression -> expression
 
 val e_matching : ?loc:Location.t -> expression -> matching_expr -> expression
 

src/stages/2-ast_sugar/types.ml

@@ -54,8 +54,8 @@ and expression_content =
   | E_matching of matching
   (* Record *)
   | E_record of expression label_map
-  | E_record_accessor of record_accessor
+  | E_accessor of accessor
-  | E_record_update   of record_update
+  | E_update   of update
   (* Advanced *)
   | E_ascription of ascription
   (* Sugar *)
@@ -63,14 +63,11 @@ and expression_content =
   | E_sequence of sequence
   | E_skip
   | E_tuple of expression list
-  | E_tuple_accessor of tuple_accessor
-  | E_tuple_update   of tuple_update
   (* Data Structures *)
   | E_map of (expression * expression) list 
   | E_big_map of (expression * expression) list
   | E_list of expression list
   | E_set of expression list
-  | E_look_up of (expression * expression)
 
 and constant =
   { cons_name: constant' (* this is at the end because it is huge *)
@@ -103,10 +100,28 @@ and let_in = {
 
 and constructor = {constructor: constructor'; element: expression}
 
-and record_accessor = {record: expression; path: label}
+and accessor = {record: expression; path: access list}
-and record_update   = {record: expression; path: label ; update: expression}
+and update   = {record: expression; path: access list ; update: expression}
+
+and access =
+  | Access_tuple of Z.t
+  | Access_record of string
+  | Access_map of expr
+
+and matching_expr =
+  | Match_variant of ((constructor' * expression_variable) * expression) list
+  | Match_list of {
+      match_nil  : expression ;
+      match_cons : expression_variable * expression_variable * expression ;
+    }
+  | Match_option of {
+      match_none : expression ;
+      match_some : expression_variable * expression ;
+    }
+  | Match_tuple of expression_variable list * type_expression list option * expression
+  | Match_record of (label * expression_variable) list * type_expression list option * expression
+  | Match_variable of expression_variable * type_expression option * expression
 
-and matching_expr = (expr,unit) matching_content
 and matching =
   { matchee: expression
   ; cases: matching_expr
@@ -124,9 +139,6 @@ and sequence = {
   expr2: expression ;
   }
 
-and tuple_accessor = {tuple: expression; path: int}
-and tuple_update   = {tuple: expression; path: int ; update: expression}
-
 and environment_element_definition =
   | ED_binder
   | ED_declaration of (expression * free_variables)

src/stages/3-ast_core/PP.ml

@@ -66,26 +66,22 @@ and assoc_expression ppf : expr * expr -> unit =
 and single_record_patch ppf ((p, expr) : label * expr) =
   fprintf ppf "%a <- %a" label p expression expr
 
-and matching_variant_case : type a . (_ -> a -> unit) -> _ -> (constructor' * expression_variable) * a -> unit =
+and matching_variant_case : (_ -> expression -> unit) -> _ -> (constructor' * expression_variable) * expression -> unit =
   fun f ppf ((c,n),a) ->
   fprintf ppf "| %a %a ->@;<1 2>%a@ " constructor c expression_variable n f a
 
-and matching : type a . (formatter -> a -> unit) -> formatter -> (a,unit) matching_content -> unit =
+and matching : (formatter -> expression -> unit) -> formatter -> matching_expr -> unit =
   fun f ppf m -> match m with
-    | Match_tuple ((lst, b), _) ->
+    | Match_variant lst ->
-        fprintf ppf "@[<hv>| (%a) ->@;<1 2>%a@]" (list_sep_d expression_variable) lst f b
-    | Match_variant (lst, _) ->
         fprintf ppf "@[<hv>%a@]" (list_sep (matching_variant_case f) (tag "@ ")) lst
-    | Match_list {match_nil ; match_cons = (hd, tl, match_cons, _)} ->
+    | Match_list {match_nil ; match_cons = (hd, tl, match_cons)} ->
         fprintf ppf "@[<hv>| Nil ->@;<1 2>%a@ | %a :: %a ->@;<1 2>%a@]" f match_nil expression_variable hd expression_variable tl f match_cons
-    | Match_option {match_none ; match_some = (some, match_some, _)} ->
+    | Match_option {match_none ; match_some = (some, match_some)} ->
         fprintf ppf "@[<hv>| None ->@;<1 2>%a@ | Some %a ->@;<1 2>%a@]" f match_none expression_variable some f match_some
 
 (* Shows the type expected for the matched value *)
 and matching_type ppf m = match m with
-  | Match_tuple _ ->
+  | Match_variant lst ->
-      fprintf ppf "tuple"
-  | Match_variant (lst, _) ->
       fprintf ppf "variant %a" (list_sep matching_variant_case_type (tag "@.")) lst
   | Match_list _ ->
       fprintf ppf "list"

src/stages/3-ast_core/combinators.ml

@@ -107,7 +107,7 @@ let e_constructor ?loc s a : expression = make_e ?loc @@ E_constructor { constru
 let e_matching ?loc a b : expression = make_e ?loc @@ E_matching {matchee=a;cases=b}
 
 let e_record ?loc map = make_e ?loc @@ E_record map
-let e_record_accessor ?loc a b = make_e ?loc @@ E_record_accessor {record = a; path = Label b}
+let e_record_accessor ?loc a b = make_e ?loc @@ E_record_accessor {record = a; path = b}
 let e_record_update ?loc record path update = make_e ?loc @@ E_record_update {record; path; update}
 
 let e_annotation ?loc anno_expr ty = make_e ?loc @@ E_ascription {anno_expr; type_annotation = ty}

src/stages/3-ast_core/combinators.mli

@@ -74,7 +74,7 @@ val e_string_cat : ?loc:Location.t -> expression -> expression -> expression
 val e_map_add : ?loc:Location.t -> expression -> expression ->  expression -> expression
 val e_constructor : ?loc:Location.t -> string -> expression -> expression
 val e_matching : ?loc:Location.t -> expression -> matching_expr -> expression
-val e_record_accessor : ?loc:Location.t -> expression -> string -> expression
+val e_record_accessor : ?loc:Location.t -> expression -> label -> expression
 val e_variable : ?loc:Location.t -> expression_variable -> expression
 val e_let_in : ?loc:Location.t -> ( expression_variable * type_expression option ) -> bool -> expression -> expression -> expression
 val e_annotation : ?loc:Location.t -> expression -> type_expression -> expression

src/stages/3-ast_core/types.ml

@@ -76,7 +76,17 @@ and constructor = {constructor: constructor'; element: expression}
 and record_accessor = {record: expression; path: label}
 and record_update   = {record: expression; path: label ; update: expression}
 
-and matching_expr = (expr,unit) matching_content
+and matching_expr =
+  | Match_list of {
+      match_nil  : expression ;
+      match_cons : expression_variable * expression_variable * expression ;
+    }
+  | Match_option of {
+      match_none : expression ;
+      match_some : expression_variable * expression ;
+    }
+  | Match_variant of ((constructor' * expression_variable) * expression) list
+
 and matching =
   { matchee: expression
   ; cases: matching_expr

src/stages/4-ast_typed/PP.ml

@@ -315,8 +315,6 @@ and matching_variant_case : (_ -> expression -> unit) -> _ -> matching_content_c
   fprintf ppf "| %a %a -> %a" constructor c expression_variable pattern f body
 
 and matching : (formatter -> expression -> unit) -> _ -> matching_expr -> unit = fun f ppf m -> match m with
-  | Match_tuple {vars; body; tvs=_} ->
-      fprintf ppf "let (%a) = %a" (list_sep_d expression_variable) vars f body
   | Match_variant {cases ; tv=_} ->
       fprintf ppf "%a" (list_sep (matching_variant_case f) (tag "@.")) cases
   | Match_list {match_nil ; match_cons = {hd; tl; body; tv=_}} -> 

src/stages/4-ast_typed/ast.ml

@@ -124,12 +124,6 @@ and matching_content_option = {
 and expression_variable_list = expression_variable list
 and type_expression_list = type_expression list
 
-and matching_content_tuple = {
-    vars : expression_variable_list ;
-    body : expression ;
-    tvs : type_expression_list ;
-  }
-
 and matching_content_case = {
     constructor : constructor' ;
     pattern : expression_variable ;
@@ -146,7 +140,6 @@ and matching_content_variant = {
 and matching_expr =
   | Match_list    of matching_content_list
   | Match_option  of matching_content_option
-  | Match_tuple   of matching_content_tuple
   | Match_variant of matching_content_variant
 
 and constant' =

src/stages/4-ast_typed/compute_environment.ml

@@ -92,21 +92,6 @@ and cases : environment -> matching_expr -> matching_expr = fun env cs ->
     in
     return @@ Match_option { match_none ; match_some }
   )
-  | Match_tuple c -> (
-    let var_tvs =
-      try (
-        List.combine c.vars c.tvs
-      ) with _ -> raise (Failure ("Internal error: broken invariant at " ^ __LOC__))
-    in
-    let env' =
-      let aux prev (var , tv) =
-        Environment.add_ez_binder var tv prev
-      in
-      List.fold_left aux env var_tvs
-    in
-    let body = self ~env' c.body in
-    return @@ Match_tuple { c with body }
-  )
   | Match_variant c -> (
     let variant_type = Combinators.get_t_sum_exn c.tv in
     let cases =

src/stages/4-ast_typed/misc.ml

@@ -236,8 +236,6 @@ module Free_variables = struct
     match m with
     | Match_list { match_nil = n ; match_cons = {hd; tl; body; tv=_} } -> union (f b n) (f (union (of_list [hd ; tl]) b) body)
     | Match_option { match_none = n ; match_some = {opt; body; tv=_} } -> union (f b n) (f (union (singleton opt) b) body)
-    | Match_tuple { vars ; body ; tvs=_ } ->
-       f (union (of_list vars) b) body
     | Match_variant { cases ; tv=_ } -> unions @@ List.map (matching_variant_case f b) cases
 
   and matching_expression = fun x -> matching expression x

src/stages/4-ast_typed/misc_smart.ml

@@ -90,8 +90,6 @@ module Captured_variables = struct
       let%bind n' = f b n in
       let%bind s' = f (union (singleton opt) b) body in
       ok @@ union n' s'
-    | Match_tuple { vars ; body ; tvs=_ } ->
-      f (union (of_list vars) b) body
     | Match_variant { cases ; tv=_ } ->
       let%bind lst' = bind_map_list (matching_variant_case f b) cases in
       ok @@ unions lst'

src/stages/common/ast_common.ml

@@ -1,3 +1,5 @@
+include Types 
+
 module Types = Types
 module PP = PP
 module Helpers = Helpers

src/stages/common/types.ml

@@ -11,6 +11,7 @@ type label = Label of string
 module CMap = Map.Make( struct type t = constructor' let compare (Constructor a) (Constructor b) = compare a b end)
 module LMap = Map.Make( struct type t = label let compare (Label a) (Label b) = String.compare a b end)
 
+
 type 'a label_map = 'a LMap.t
 type 'a constructor_map = 'a CMap.t
 
@@ -169,18 +170,6 @@ type literal =
   | Literal_void
   | Literal_operation of
       Memory_proto_alpha.Protocol.Alpha_context.packed_internal_operation
-and ('a,'tv) matching_content =
-  | Match_list of {
-      match_nil : 'a ;
-      match_cons : expression_variable * expression_variable * 'a * 'tv;
-    }
-  | Match_option of {
-      match_none : 'a ;
-      match_some : expression_variable * 'a * 'tv;
-    }
-  | Match_tuple of (expression_variable list * 'a) * 'tv list
-  | Match_variant of ((constructor' * expression_variable) * 'a) list * 'tv
-
 and constant' =
   | C_INT
   | C_UNIT

src/test/contracts/expected/FA1.2.ligo.expected

@@ -0,0 +1,172 @@
+type tokens is big_map (address, nat)
+
+type allowances is big_map (address * address, nat)
+
+type storage is
+  record [
+    tokens : tokens;
+    allowances : allowances;
+    total_amount : nat
+  ]
+
+type transfer is
+  record [
+    address_from : address;
+    address_to : address;
+    value : nat
+  ]
+
+type approve is record [spender : address; value : nat]
+
+type getAllowance is
+  record [
+    owner : address;
+    spender : address;
+    callback : contract (nat)
+  ]
+
+type getBalance is
+  record [owner : address; callback : contract (nat)]
+
+type getTotalSupply is record [callback : contract (nat)]
+
+type action is
+    Transfer of transfer
+  | Approve of approve
+  | GetAllowance of getAllowance
+  | GetBalance of getBalance
+  | GetTotalSupply of getTotalSupply
+
+function transfer (const p : transfer; const s : storage)
+  : list (operation) * storage is
+block {
+  var new_allowances : allowances := Big_map.empty;
+  if Tezos.sender = p.address_from
+  then {
+    new_allowances := s.allowances
+  }
+  else {
+    var authorized_value : nat
+    := case (Big_map.find_opt
+              ((Tezos.sender, p.address_from), s.allowances))
+      of [
+        Some (value) -> value
+      | None -> 0n
+      ];
+    if (authorized_value < p.value)
+    then {
+      failwith ("Not Enough Allowance")
+    }
+    else {
+      new_allowances :=
+        Big_map.update
+          ((Tezos.sender, p.address_from),
+           (Some (abs (authorized_value - p.value))),
+           s.allowances)
+    }
+  };
+  var sender_balance : nat
+  := case (Big_map.find_opt (p.address_from, s.tokens)) of [
+      Some (value) -> value
+    | None -> 0n
+    ];
+  var new_tokens : tokens := Big_map.empty;
+  if (sender_balance < p.value)
+  then {
+    failwith ("Not Enough Balance")
+  }
+  else {
+    new_tokens :=
+      Big_map.update
+        (p.address_from,
+         (Some (abs (sender_balance - p.value))), s.tokens);
+    var receiver_balance : nat
+    := case (Big_map.find_opt (p.address_to, s.tokens)) of [
+        Some (value) -> value
+      | None -> 0n
+      ];
+    new_tokens :=
+      Big_map.update
+        (p.address_to, (Some (receiver_balance + p.value)),
+         new_tokens)
+  }
+} with
+    ((nil : list (operation)),
+     s with
+       record [
+         tokens = new_tokens;
+         allowances = new_allowances
+       ])
+
+function approve (const p : approve; const s : storage)
+  : list (operation) * storage is
+block {
+  var previous_value : nat
+  := case Big_map.find_opt
+           ((p.spender, Tezos.sender), s.allowances)
+    of [
+      Some (value) -> value
+    | None -> 0n
+    ];
+  var new_allowances : allowances := Big_map.empty;
+  if previous_value > 0n and p.value > 0n
+  then {
+    failwith ("Unsafe Allowance Change")
+  }
+  else {
+    new_allowances :=
+      Big_map.update
+        ((p.spender, Tezos.sender), (Some (p.value)),
+         s.allowances)
+  }
+} with
+    ((nil : list (operation)),
+     s with
+       record [allowances = new_allowances])
+
+function getAllowance
+  (const p : getAllowance;
+   const s : storage) : list (operation) * storage is
+block {
+  var value : nat
+  := case Big_map.find_opt
+           ((p.owner, p.spender), s.allowances)
+    of [
+      Some (value) -> value
+    | None -> 0n
+    ];
+  var op : operation
+  := Tezos.transaction (value, 0mutez, p.callback)
+} with (list [op], s)
+
+function getBalance
+  (const p : getBalance;
+   const s : storage) : list (operation) * storage is
+block {
+  var value : nat
+  := case Big_map.find_opt (p.owner, s.tokens) of [
+      Some (value) -> value
+    | None -> 0n
+    ];
+  var op : operation
+  := Tezos.transaction (value, 0mutez, p.callback)
+} with (list [op], s)
+
+function getTotalSupply
+  (const p : getTotalSupply;
+   const s : storage) : list (operation) * storage is
+block {
+  var total : nat := s.total_amount;
+  var op : operation
+  := Tezos.transaction (total, 0mutez, p.callback)
+} with (list [op], s)
+
+function main (const a : action; const s : storage)
+  : list (operation) * storage is
+  case a of [
+    Transfer (p) -> transfer (p, s)
+  | Approve (p) -> approve (p, s)
+  | GetAllowance (p) -> getAllowance (p, s)
+  | GetBalance (p) -> getBalance (p, s)
+  | GetTotalSupply (p) -> getTotalSupply (p, s)
+  ]

src/test/contracts/expected/FA1.2.mligo.expected

@@ -0,0 +1,136 @@
+type tokens = (address, nat) big_map
+
+type allowances = (address * address, nat) big_map
+
+type storage =
+  {tokens : tokens;
+   allowances : allowances;
+   total_amount : nat}
+
+type transfer =
+  {address_from : address;
+   address_to : address;
+   value : nat}
+
+type approve = {spender : address; value : nat}
+
+type getAllowance =
+  {owner : address;
+   spender : address;
+   callback : nat contract}
+
+type getBalance = {owner : address; callback : nat contract}
+
+type getTotalSupply = {callback : nat contract}
+
+type action =
+  Transfer of transfer
+| Approve of approve
+| GetAllowance of getAllowance
+| GetBalance of getBalance
+| GetTotalSupply of getTotalSupply
+
+let transfer (p, s : transfer * storage)
+: operation list * storage =
+  let new_allowances =
+    if Tezos.sender = p.address_from
+    then s.allowances
+    else
+      let authorized_value =
+        match Big_map.find_opt
+                (Tezos.sender, p.address_from)
+                s.allowances
+        with
+          Some value -> value
+        | None -> 0n
+      in if (authorized_value < p.value)
+         then (failwith "Not Enough Allowance" : allowances)
+         else
+           Big_map.update
+             (Tezos.sender, p.address_from)
+             (Some (abs (authorized_value - p.value)))
+             s.allowances
+  in let sender_balance =
+       match Big_map.find_opt p.address_from s.tokens with
+         Some value -> value
+       | None -> 0n
+     in if (sender_balance < p.value)
+        then
+          (failwith "Not Enough Balance"
+           : operation list * storage)
+        else
+          let new_tokens =
+            Big_map.update
+              p.address_from
+              (Some (abs (sender_balance - p.value)))
+              s.tokens
+          in let receiver_balance =
+               match Big_map.find_opt p.address_to s.tokens
+               with
+                 Some value -> value
+               | None -> 0n
+             in let new_tokens =
+                  Big_map.update
+                    p.address_to
+                    (Some (receiver_balance + p.value))
+                    new_tokens
+                in ([] : operation list),
+                   {s with
+                     tokens = new_tokens;
+                     allowances = new_allowances}
+
+let approve (p, s : approve * storage)
+: operation list * storage =
+  let previous_value =
+    match Big_map.find_opt
+            (p.spender, Tezos.sender)
+            s.allowances
+    with
+      Some value -> value
+    | None -> 0n
+  in if previous_value > 0n && p.value > 0n
+     then
+       (failwith "Unsafe Allowance Change"
+        : operation list * storage)
+     else
+       let new_allowances =
+         Big_map.update
+           (p.spender, Tezos.sender)
+           (Some (p.value))
+           s.allowances
+       in ([] : operation list),
+          {s with
+            allowances = new_allowances}
+
+let getAllowance (p, s : getAllowance * storage)
+: operation list * storage =
+  let value =
+    match Big_map.find_opt (p.owner, p.spender) s.allowances
+    with
+      Some value -> value
+    | None -> 0n
+  in let op = Tezos.transaction value 0mutez p.callback
+     in ([op], s)
+
+let getBalance (p, s : getBalance * storage)
+: operation list * storage =
+  let value =
+    match Big_map.find_opt p.owner s.tokens with
+      Some value -> value
+    | None -> 0n
+  in let op = Tezos.transaction value 0mutez p.callback
+     in ([op], s)
+
+let getTotalSupply (p, s : getTotalSupply * storage)
+: operation list * storage =
+  let total = s.total_amount
+  in let op = Tezos.transaction total 0mutez p.callback
+     in ([op], s)
+
+let main (a, s : action * storage) =
+  match a with
+    Transfer p -> transfer (p, s)
+  | Approve p -> approve (p, s)
+  | GetAllowance p -> getAllowance (p, s)
+  | GetBalance p -> getBalance (p, s)
+  | GetTotalSupply p -> getTotalSupply (p, s)

src/test/contracts/expected/address.ligo.expected

@@ -0,0 +1,4 @@
+function main (const p : key_hash) : address is
+block {
+  const c : contract (unit) = Tezos.implicit_account (p)
+} with Tezos.address (c)

src/test/contracts/expected/address.mligo.expected

@@ -0,0 +1,3 @@
+let main (p : key_hash) =
+  let c : unit contract = Tezos.implicit_account p
+  in Tezos.address c

src/test/contracts/expected/address.religo.expected

@@ -0,0 +1,4 @@
+let main = (p: key_hash): address => {
+  let c: contract(unit) = Tezos.implicit_account(p);
+  Tezos.address(c)
+};

src/test/contracts/expected/amount.ligo.expected

@@ -0,0 +1,7 @@
+function check (const p : unit) : int is
+block {
+  var result : int := 0;
+  if amount = 100000000mutez
+  then result := 42
+  else result := 0
+} with result

src/test/contracts/expected/amount.mligo.expected

@@ -0,0 +1,2 @@
+let check_ (p : unit) : int =
+  if Tezos.amount = 100000000mutez then 42 else 0

src/test/contracts/expected/amount.religo.expected

@@ -0,0 +1,6 @@
+let check_ = (p: unit): int => 
+  if (Tezos.amount == 100000000mutez) {
+    42
+  } else {
+    0
+  };

src/test/contracts/expected/amount_lambda.mligo.expected

@@ -0,0 +1,10 @@
+let f1 (x : unit) : unit -> tez =
+  let amt : tez = Current.amount
+  in fun (x : unit) -> amt
+
+let f2 (x : unit) : unit -> tez =
+  fun (x : unit) -> Current.amount
+
+let main (b, s : bool * (unit -> tez))
+: operation list * (unit -> tez) =
+  (([] : operation list), (if b then f1 () else f2 ()))

src/test/contracts/expected/annotation.ligo.expected

@@ -0,0 +1,4 @@
+const lst : list (int) = list []
+
+const my_address : address
+= ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" : address)

src/test/contracts/expected/application.ligo.expected

@@ -0,0 +1,13 @@
+type foo is record [bar : int -> int]
+
+function f (const i : int) : int is i
+
+function g (const i : unit) : int -> int is f
+
+const r : foo = record [bar = f]
+
+const x : int = f (42)
+
+const y : int = r.bar (42)
+
+const z : int = (g (unit)) (42)

src/test/contracts/expected/arithmetic.ligo.expected

@@ -0,0 +1,16 @@
+function mod_op (const n : int) : nat is n mod 42
+
+function plus_op (const n : int) : int is n + 42
+
+function minus_op (const n : int) : int is n - 42
+
+function times_op (const n : int) : int is n * 42
+
+function div_op (const n : int) : int is n / 2
+
+function int_op (const n : nat) : int is int (n)
+
+function neg_op (const n : int) : int is -n
+
+function ediv_op (const n : int) : option (int * nat) is
+  ediv (n, 2)

src/test/contracts/expected/arithmetic.mligo.expected

@@ -0,0 +1,17 @@
+let mod_op (n : int) : nat = n mod 42
+
+let plus_op (n : int) : int = n + 42
+
+let minus_op (n : int) : int = n - 42
+
+let times_op (n : int) : int = n * 42
+
+let div_op (n : int) : int = n / 2
+
+let neg_op (n : int) : int = -n
+
+let foo (n : int) : int = n + 10
+
+let neg_op_2 (b : int) : int = -(foo b)
+
+let ediv_op (n : int) : (int * nat) option = ediv n 2

src/test/contracts/expected/arithmetic.religo.expected

@@ -0,0 +1,17 @@
+let mod_op = (n: int): nat => n mod 42;
+
+let plus_op = (n: int): int => n + 42;
+
+let minus_op = (n: int): int => n - 42;
+
+let times_op = (n: int): int => n * 42;
+
+let div_op = (n: int): int => n / 2;
+
+let neg_op = (n: int): int => -n;
+
+let foo = (n: int): int => n + 10;
+
+let neg_op_2 = (b: int): int => -foo(b);
+
+let ediv_op = (n: int): option((int, nat)) => ediv(n, 2);

src/test/contracts/expected/assert.mligo.expected

@@ -0,0 +1,3 @@
+let main (p, s : bool * unit) =
+  let u : unit = assert p
+  in ([] : operation list), s

src/test/contracts/expected/assign.ligo.expected

@@ -0,0 +1,4 @@
+function main (const i : int) : int is
+block {
+  i := i + 1
+} with i