Merge pull request #5 from AdrienChampion/master

better mutez error detection + fixed links in readme

.travis.sh

@@ -28,7 +28,7 @@ opam switch create techelson 4.07.1
 eval $(opam config env)
 
 opam update
-opam install dune menhir zarith ptime
+opam install dune menhir zarith ptime stdint
 
 opam --version
 

README.md

@@ -37,7 +37,7 @@ and run
 Techelson relies on the [dune] build system and a few other libraries:
 
 ```bash
-> opam install dune menhir zarith ptime
+> opam install dune menhir zarith ptime stdint
 ```
 
 (This list of dependencies might be out-of-date. Check `.travis.sh` for the latest version.) Finally, build Techelson with `make`. The binary will be `./bin/techelson`.
@@ -66,5 +66,5 @@ For example
 [dune]: https://github.com/ocaml/dune
 [mdbook]: https://github.com/rust-lang-nursery/mdBook
 [Liquidity]: http://www.liquidity-lang.org/
-[adrienchampion.github.io/blog]: https://adrienchampion.github.io/blog
-[the main repository's github pages]: https://adrienchampion.github.io/blog/tezos/techelson/with_liquidity/index.html
+[adrienchampion.github.io/blog]: https://adrienchampion.github.io/blog/tezos/techelson/with_liquidity/index.html
+[the main repository's github pages]: https://ocamlpro.github.io/techelson/user_doc/

docs/index.md

@@ -37,7 +37,7 @@ and run
 Techelson relies on the [dune] build system and a few other libraries:
 
 ```bash
-> opam install dune menhir zarith ptime
+> opam install dune menhir zarith ptime stdint
 ```
 
 (This list of dependencies might be out-of-date. Check `.travis.sh` for the latest version.) Finally, build Techelson with `make`. The binary will be `./bin/techelson`.
@@ -66,5 +66,5 @@ For example
 [dune]: https://github.com/ocaml/dune
 [mdbook]: https://github.com/rust-lang-nursery/mdBook
 [Liquidity]: http://www.liquidity-lang.org/
-[adrienchampion.github.io/blog]: https://adrienchampion.github.io/blog
-[the main repository's github pages]: https://adrienchampion.github.io/blog/tezos/techelson/with_liquidity/index.html
+[adrienchampion.github.io/blog]: https://adrienchampion.github.io/blog/tezos/techelson/with_liquidity/index.html
+[the main repository's github pages]: https://ocamlpro.github.io/techelson/user_doc/

docs/user_doc/index.html

@@ -141,7 +141,7 @@ <h1 class="menu-title">Techelson User Documentation</h1>
                 <div id="content" class="content">
                     <main>
                         <a class="header" href="#techelson" id="techelson"><h1>Techelson</h1></a>
-<p><strong>Techelson</strong> is a <strong>T</strong>est <strong>E</strong>xecution <strong>E</strong>nvironment (TEE) for <a href="https://tezos.gitlab.io/master/whitedoc/michelson.html" title="Michelson documentation page">Michelson smart contracts</a>.
+<p><strong><a href="https://ocamlpro.github.io/techelson" title="Techelson's homepage">Techelson</a></strong> is a <strong>T</strong>est <strong>E</strong>xecution <strong>E</strong>nvironment (TEE) for <a href="https://tezos.gitlab.io/master/whitedoc/michelson.html" title="Michelson documentation page">Michelson smart contracts</a>.
 Michelson is the stack-based language used by the <a href="https://tezos.com" title="Tezos official page">tezos blockchain</a>. Techelson is open
 source and <a href="https://github.com/OCamlPro/techelson" title="Techelson on github.com">hosted on github</a>, where you can find the build instructions.</p>
 <p>Techelson emulates just enough of the tezos blockchain protocol to be able to create smart

docs/user_doc/print.html

@@ -141,7 +141,7 @@ <h1 class="menu-title">Techelson User Documentation</h1>
                 <div id="content" class="content">
                     <main>
                         <a class="header" href="#techelson" id="techelson"><h1>Techelson</h1></a>
-<p><strong>Techelson</strong> is a <strong>T</strong>est <strong>E</strong>xecution <strong>E</strong>nvironment (TEE) for <a href="https://tezos.gitlab.io/master/whitedoc/michelson.html" title="Michelson documentation page">Michelson smart contracts</a>.
+<p><strong><a href="https://ocamlpro.github.io/techelson" title="Techelson's homepage">Techelson</a></strong> is a <strong>T</strong>est <strong>E</strong>xecution <strong>E</strong>nvironment (TEE) for <a href="https://tezos.gitlab.io/master/whitedoc/michelson.html" title="Michelson documentation page">Michelson smart contracts</a>.
 Michelson is the stack-based language used by the <a href="https://tezos.com" title="Tezos official page">tezos blockchain</a>. Techelson is open
 source and <a href="https://github.com/OCamlPro/techelson" title="Techelson on github.com">hosted on github</a>, where you can find the build instructions.</p>
 <p>Techelson emulates just enough of the tezos blockchain protocol to be able to create smart
@@ -463,7 +463,7 @@ <h1 class="menu-title">Techelson User Documentation</h1>
 stack:
 |==================================================================================================|
 |                                                                                         @storage |
-| 0                                                                                                |
+| 0p                                                                                               |
 | nat                                                                                              |
 |--------------------------------------------------------------------------------------------------|
 |                                                                                          @amount |
@@ -699,7 +699,7 @@ <h1 class="menu-title">Techelson User Documentation</h1>
 running test script...
 stack:
 |==================================================================================================|
-| 0                                                                                                |
+| 0p                                                                                               |
 | nat                                                                                              |
 |==================================================================================================|
 
@@ -817,7 +817,7 @@ <h1 class="menu-title">Techelson User Documentation</h1>
 running test script...
 stack:
 |==================================================================================================|
-| 0                                                                                                |
+| 0p                                                                                               |
 | nat                                                                                              |
 |==================================================================================================|
 
@@ -939,7 +939,7 @@ <h1 class="menu-title">Techelson User Documentation</h1>
 running test script...
 stack:
 |==================================================================================================|
-| 1                                                                                                |
+| 1p                                                                                               |
 | nat                                                                                              |
 |==================================================================================================|
 

docs/user_doc/testing/anonymous.html

@@ -246,7 +246,7 @@ <h1 class="menu-title">Techelson User Documentation</h1>
 running test script...
 stack:
 |==================================================================================================|
-| 0                                                                                                |
+| 0p                                                                                               |
 | nat                                                                                              |
 |==================================================================================================|
 

docs/user_doc/testing/contracts.html

@@ -212,7 +212,7 @@ <h1 class="menu-title">Techelson User Documentation</h1>
 stack:
 |==================================================================================================|
 |                                                                                         @storage |
-| 0                                                                                                |
+| 0p                                                                                               |
 | nat                                                                                              |
 |--------------------------------------------------------------------------------------------------|
 |                                                                                          @amount |

docs/user_doc/testing/inspection.html

@@ -233,7 +233,7 @@ <h1 class="menu-title">Techelson User Documentation</h1>
 running test script...
 stack:
 |==================================================================================================|
-| 0                                                                                                |
+| 0p                                                                                               |
 | nat                                                                                              |
 |==================================================================================================|
 

docs/user_doc/testing/transfers.html

@@ -250,7 +250,7 @@ <h1 class="menu-title">Techelson User Documentation</h1>
 running test script...
 stack:
 |==================================================================================================|
-| 1                                                                                                |
+| 1p                                                                                               |
 | nat                                                                                              |
 |==================================================================================================|
 

src/1_base/common.ml

@@ -223,19 +223,33 @@ let rec indent (fmt : formatter) (count : int) : unit =
         count - 1 |> indent fmt
     ) else ()
 
-let log (lvl : int) (args : ('a, formatter, unit) format) : 'a =
+let log (must_indent : bool) (lvl : int) (args : ('a, formatter, unit) format) : 'a =
     if lvl <= (!conf_ref).verb then (
-        (lvl - 1) * 4 |> indent out;
+        if lvl > 0 && must_indent then (
+            (lvl - 1) * 4 |> indent out
+        );
         fprintf out args;
     ) else (
         ifprintf out args
     )
 
-let log_0 (args : ('a, Format.formatter, unit) format) : 'a = log 0 args
-let log_1 (args : ('a, Format.formatter, unit) format) : 'a = log 1 args
-let log_2 (args : ('a, Format.formatter, unit) format) : 'a = log 2 args
-let log_3 (args : ('a, Format.formatter, unit) format) : 'a = log 3 args
-let log_4 (args : ('a, Format.formatter, unit) format) : 'a = log 4 args
+let log_0 (args : ('a, Format.formatter, unit) format) : 'a = log false 0 args
+let log_1 (args : ('a, Format.formatter, unit) format) : 'a = log false 1 args
+let log_2
+    ?indent:(indent=true)
+    (args : ('a, Format.formatter, unit) format)
+    : 'a
+= log indent 2 args
+let log_3
+    ?indent:(indent=true)
+    (args : ('a, Format.formatter, unit) format)
+    : 'a
+= log indent 3 args
+let log_4
+    ?indent:(indent=true)
+    (args : ('a, Format.formatter, unit) format)
+    : 'a
+= log indent 4 args
 
 let catch_exn (f : unit -> 'a) : ('a, exn) Either.t =
     try f () |> Either.lft with

src/1_base/common.mli

@@ -219,8 +219,11 @@ val catch_internal_exn : (unit -> 'a) -> ('a, Exc.Internal.t) Either.t
 
 (** Logs something at some log level.
 
-    Actually output if the configuration's log level is `>=` the level. *)
-val log : int -> ('a, formatter, unit) format -> 'a
+    If the first argument is true, then the output will be indented based on the log level.
+
+    Actually output if the configuration's log level is `>=` the level.
+*)
+val log : bool -> int -> ('a, formatter, unit) format -> 'a
 
 (** Logs something at log level 0 (always active). *)
 val log_0 : ('a, Format.formatter, unit) format -> 'a
@@ -229,13 +232,13 @@ val log_0 : ('a, Format.formatter, unit) format -> 'a
 val log_1 : ('a, Format.formatter, unit) format -> 'a
 
 (** Logs something at log level 2. *)
-val log_2 : ('a, Format.formatter, unit) format -> 'a
+val log_2 : ?indent : bool -> ('a, Format.formatter, unit) format -> 'a
 
 (** Logs something at log level 3. *)
-val log_3 : ('a, Format.formatter, unit) format -> 'a
+val log_3 : ?indent : bool -> ('a, Format.formatter, unit) format -> 'a
 
 (** Logs something at log level 4. *)
-val log_4 : ('a, Format.formatter, unit) format -> 'a
+val log_4 : ?indent : bool -> ('a, Format.formatter, unit) format -> 'a
 
 (** Random number generator, all bounds are exclusive.
 

src/1_base/exc.ml

@@ -20,13 +20,26 @@ module Protocol = struct
     | Failure of string
     | TooPoor of string * string * Int64.t
     | MutezOvrflw of string
+    | MutezUdrflw of string
+    | DivZero of string
     | Tezos of string
 
     let fmt (fmt : formatter) (self : t) : unit =
         match self with
         | Failure blah -> fprintf fmt "Failure on value %s" blah
         | Tezos blah -> fprintf fmt "%s" blah
-        | MutezOvrflw blah -> fprintf fmt "mutez operation overflow: %s" blah
+        | MutezOvrflw blah -> (
+            fprintf fmt "mutez operation overflow";
+            if blah <> "" then fprintf fmt ": %s" blah
+        )
+        | MutezUdrflw blah -> (
+            fprintf fmt "mutez operation underflow";
+            if blah <> "" then fprintf fmt ": %s" blah
+        )
+        | DivZero blah -> (
+            fprintf fmt "division by zero";
+            if blah <> "" then fprintf fmt ": %s" blah
+        )
         | TooPoor (src, tgt, mutez) ->
             fprintf fmt
                 "@[<hov>insufficient balance to process transaction of %s mutez"
@@ -62,6 +75,12 @@ module Throw = struct
 
     let mutez_overflow (blah : string) : 'a =
         Exc (Protocol (Protocol.MutezOvrflw blah)) |> raise
+
+    let mutez_underflow (blah : string) : 'a =
+        Exc (Protocol (Protocol.MutezUdrflw blah)) |> raise
+
+    let div_zero (blah : string) : 'a =
+        Exc (Protocol (Protocol.DivZero blah)) |> raise
 end
 
 let rec fmt (fmtt : formatter) (e : exn) : unit =

src/1_base/exc.mli

@@ -38,6 +38,13 @@ module Protocol : sig
 
         Can happen either during a transfer or during operations on mutez.
     *)
+    | MutezUdrflw of string
+    (** Mutez underflow.
+
+        Can happen either during a transfer or during operations on mutez.
+    *)
+    | DivZero of string
+    (** Division by zero. *)
     | Tezos of string
     (** Something went wrong in the protocol.
 
@@ -79,6 +86,12 @@ module Throw : sig
 
     (** Raises a mutez overflow error. *)
     val mutez_overflow : string -> 'a
+
+    (** Raises a mutez underflow error. *)
+    val mutez_underflow : string -> 'a
+
+    (** Raises a division by zero error. *)
+    val div_zero : string -> 'a
 end
 
 (** Raises an exception from a single trace frame. *)

src/4_theory/bigArith.ml

@@ -28,6 +28,8 @@ end
 module BNat = struct
     include BigInt
 
+    let fmt fmt n = fprintf fmt "%ap" Z.pp_print n
+
     let of_string (s : string) : t =
         let nat = Z.of_string s in
         if Z.geq nat Z.zero then nat

src/4_theory/dune

@@ -6,7 +6,8 @@
     (libraries
         base
         parse
-        zarith
         ptime
+        stdint
+        zarith
     )
 )