balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Proto: drop floats in the contract language.

Browse Source
This commit is contained in:
Benjamin Canou 2016-11-08 19:31:01 +01:00
parent b4b3aece97
commit f284714fba
11 changed files with 35 additions and 364 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
src/client/embedded/bootstrap/client_proto_programs.ml
View File

@ -69,7 +69,6 @@ let rec print_ir ppf node =
match node with match node with
| String (_, s) -> Format.fprintf ppf "%S" s | String (_, s) -> Format.fprintf ppf "%S" s
| Int (_, s) -> Format.fprintf ppf "%s" s | Int (_, s) -> Format.fprintf ppf "%s" s
| Float (_, s) -> Format.fprintf ppf "%s" s
| Seq (_, [ one ]) -> print_ir ppf one | Seq (_, [ one ]) -> print_ir ppf one
| Seq (_, []) -> Format.fprintf ppf "{}" ; | Seq (_, []) -> Format.fprintf ppf "{}" ;
| Seq (_, seq) -> | Seq (_, seq) ->

24
src/client/embedded/bootstrap/concrete_lexer.mll
View File

@ -73,22 +73,6 @@ let char_for_hexadecimal_code lexbuf i =
in in
char_of_int (val1 * 16 + val2) char_of_int (val1 * 16 + val2)
(* Remove underscores from float literals *)
let remove_underscores s =
let s = Bytes.of_string s in
let l = Bytes.length s in
let rec remove src dst =
if Compare.Int.(src >= l) then
if Compare.Int.(dst >= l) then s else Bytes.sub s 0 dst
else
match Bytes.get s src with
'_' -> remove (src + 1) dst
| c -> Bytes.set s dst c; remove (src + 1) (dst + 1)
in Bytes.to_string (remove 0 0)
(** Lexer state *) (** Lexer state *)
type state = { type state = {
@ -234,11 +218,6 @@ let bin_literal =
'0' ['b' 'B'] ['0'-'1'] ['0'-'1' '_']* '0' ['b' 'B'] ['0'-'1'] ['0'-'1' '_']*
let int_literal = let int_literal =
'-' ? ( decimal_literal | hex_literal | oct_literal | bin_literal) '-' ? ( decimal_literal | hex_literal | oct_literal | bin_literal)
let float_literal =
'-' ?
['0'-'9'] ['0'-'9' '_']*
('.' ['0'-'9' '_']* )?
(['e' 'E'] ['+' '-']? ['0'-'9'] ['0'-'9' '_']*)?
rule indent_tokens st nl = parse rule indent_tokens st nl = parse
@ -332,9 +311,6 @@ and raw_token st = parse
| int_literal | int_literal
{ INT (Lexing.lexeme lexbuf) } { INT (Lexing.lexeme lexbuf) }
| float_literal
{ FLOAT (remove_underscores (Lexing.lexeme lexbuf)) }
| "\"" | "\""
{ reset_string_buffer st; { reset_string_buffer st;
let string_start = lexbuf.Lexing.lex_start_p in let string_start = lexbuf.Lexing.lex_start_p in

6
src/client/embedded/bootstrap/concrete_parser.mly
View File

@ -9,12 +9,11 @@
%token RPAREN %token RPAREN
%token SEMICOLON %token SEMICOLON
%token <string> FLOAT
%token <string> INT %token <string> INT
%token <string> PRIM %token <string> PRIM
%token <string> STRING %token <string> STRING
%left PRIM INT FLOAT LPAREN LBRACE STRING %left PRIM INT LPAREN LBRACE STRING
%left apply %left apply
%start <Script_located_ir.node list> tree %start <Script_located_ir.node list> tree
@ -127,7 +126,7 @@ let expand = function
let apply node arg = let apply node arg =
match node with match node with
| Prim (loc, n, args) -> Prim (loc, n, args @ [arg]) | Prim (loc, n, args) -> Prim (loc, n, args @ [arg])
| Int _ | Float _ | String _ | Seq _ as _node -> | Int _ | String _ | Seq _ as _node ->
raise (Invalid_application (node_location arg)) raise (Invalid_application (node_location arg))
let rec apply_seq node = function let rec apply_seq node = function
@ -166,7 +165,6 @@ line_node:
| LBRACE nodes = nodes RBRACE { Seq (pos $startpos $endpos, nodes) } | LBRACE nodes = nodes RBRACE { Seq (pos $startpos $endpos, nodes) }
| prim = PRIM { Prim (pos $startpos $endpos, prim, []) } | prim = PRIM { Prim (pos $startpos $endpos, prim, []) }
| i = INT { Int (pos $startpos $endpos, i) } | i = INT { Int (pos $startpos $endpos, i) }
| f = FLOAT { Float (pos $startpos $endpos, f) }
| s = STRING { String (pos $startpos $endpos, s) } | s = STRING { String (pos $startpos $endpos, s) }
%% %%

4
src/client/embedded/bootstrap/script_located_ir.ml
View File

@ -15,14 +15,12 @@ type location =
type node = type node =
| Int of location * string | Int of location * string
| Float of location * string
| String of location * string | String of location * string
| Prim of location * string * node list | Prim of location * string * node list
| Seq of location * node list | Seq of location * node list
let node_location = function let node_location = function
| Int (loc, _) | Int (loc, _)
| Float (loc, _)
| String (loc, _) | String (loc, _)
| Prim (loc, _, _) | Prim (loc, _, _)
| Seq (loc, _) -> loc | Seq (loc, _) -> loc
@ -57,8 +55,6 @@ let strip_locations root =
match l with match l with
| Int (_, v) -> | Int (_, v) ->
Script.Int (id, v) Script.Int (id, v)
| Float (_, v) ->
Script.Float (id, v)
| String (_, v) -> | String (_, v) ->
Script.String (id, v) Script.String (id, v)
| Seq (_, seq) -> | Seq (_, seq) ->

147
src/proto/bootstrap/docs/language.md
View File

@ -32,7 +32,7 @@ I - Type system
The types `T` of values in the stack are written using notations The types `T` of values in the stack are written using notations
* `bool`, `string`, `void`, `u?int{8|16|32|64}`, `float`, * `bool`, `string`, `void`, `u?int{8|16|32|64}`,
the core primitive types, the core primitive types,
* `identifier` for a primitive data-type, * `identifier` for a primitive data-type,
* `T identifier` for a parametric data-type with one parameter type `T`, * `T identifier` for a parametric data-type with one parameter type `T`,
@ -94,7 +94,6 @@ the form `variable = constant, ...`.
The constants are of one of the following forms. The constants are of one of the following forms.
* integers with their sign and size, e.g. `(Uint8 3)`, * integers with their sign and size, e.g. `(Uint8 3)`,
* floats in libc-style notation, e.g. `(Float 4.5e2)`,
* `Void`, the unique value of type `void` * `Void`, the unique value of type `void`
* booleans `True` and `False`, * booleans `True` and `False`,
* string literals, as in `(String "contents")`, * string literals, as in `(String "contents")`,
@ -274,7 +273,7 @@ combinators, and also for branching.
IV - Data types IV - Data types
--------------- ---------------
* `bool`, `string`, `void`, `u?int{8|16|32|64}`, `float`: * `bool`, `string`, `void`, `u?int{8|16|32|64}`:
The core primitive types. The core primitive types.
* `list 'a`: * `list 'a`:
@ -507,129 +506,6 @@ Bitwise logical operators are also available on unsigned integers.
:: t : t : 'S -> int64 : 'S where t in uint{8|16|32|64} :: t : t : 'S -> int64 : 'S where t in uint{8|16|32|64}
### Operations on Floats
The float type uses double precision IEEE754 semantics, including NaN
and infinite values.
* `ADD`
:: float : float : 'S -> float : 'S
> ADD ; C / x : y : S => C / (x + y) : S
* `SUB`
:: float : float : 'S -> float : 'S
> SUB ; C / x : y : S => C / (x - y) : S
* `MUL`
:: float : float : 'S -> float : 'S
> MUL ; C / x : y : S => C / (x * y) : S
* `DIV`
:: float : float : 'S -> float : 'S
> DIV ; C / x : y : S => C / (x / y) : S
* `MOD`
:: float : float : 'S -> float : 'S
> MOD ; C / x : y : S => C / (fmod (x, y)) : S
* `ABS`
:: float : 'S -> float : 'S
> ABS ; C / x : S => C / (abs (x)) : S
* `NEG`
:: float : 'S -> float : 'S
> NEG ; C / x : S => C / (-x) : S
* `FLOOR`
:: float : 'S -> float : 'S
> FLOOR ; C / x : S => C / (floor (x)) : S
* `CEIL`
:: float : 'S -> float : 'S
> CEIL ; C / x : S => C / (ceil (x)) : S
* `INF`
:: 'S -> float : 'S
> INF ; C / S => C / +Inf : S
* `NAN`
:: 'S -> float : 'S
> NAN ; C / S => C / NaN : S
* `ISNAN`
:: float : 'S -> bool : 'S
> ISNAN ; C / NaN : S => C / true : S
> ISNAN ; C / _ : S => C / false : S
* `NANAN`
:: float : 'S -> 'S
> NANAN ; C / NaN : S => [FAIL]
> NANAN ; C / _ : S => C / S
* `CAST float`:
Conversion from integers.
:: t_from : 'S -> float : 'S where t_from in u?int{8|16|32|64}
> CAST float ; C / x : S => C / float (x) : S
* `CAST t_to` where `t_to in u?int{8|16|32|64}`:
Conversion to integers.
:: float : 'S -> t_to : 'S
> CAST t_to ; C / NaN : S => C / t_to (0) : S
> CAST t_to ; C / +/-Inf : S => C / t_to (0) : S
> CAST t_to ; C / x : S => C / t_to (floor (x)) : S
* `CHECKED_CAST float`:
Conversion from integers with overflow checking.
:: t_from : 'S -> float : 'S where t_from in u?int{8|16|32|64}
> CHECKED_CAST float ; C / x : S => [FAIL] on overflow
> CHECKED_CAST float ; C / x : S => C / float (x) : S
* `CHECKED_CAST t_to` where `t_to in u?int{8|16|32|64}`:
Conversion to integers with overflow checking.
:: float : 'S -> t_to : 'S
> CHECKED_CAST t_to ; C / x : S => [FAIL] on overflow or NaN
> CHECKED_CAST t_to ; C / x : S => C / t_to (floor (x)) : S
* `COMPARE`:
IEEE754 comparison
:: float : float : 'S -> int64 : 'S
### Operations on strings ### Operations on strings
Strings are mostly used for naming things without having to rely on Strings are mostly used for naming things without having to rely on
@ -1111,14 +987,11 @@ parsing policy is described just after.
### Constants ### Constants
There are three kinds of constants: There are two kinds of constants:
1. Integers in decimal (no prefix), hexadecimal (0x prefix), octal 1. Integers in decimal (no prefix), hexadecimal (0x prefix), octal
(0o prefix) or binary (0b prefix). (0o prefix) or binary (0b prefix).
2. Floating point IEEE754 doubles in libc-style notation, with a 2. Strings with usual escapes `\n`, `\t`, `\b`, `\r`, `\\`, `\"`.
mandatory period character. (`3` is an `int` but `3.` is a
`float`).
3. Strings with usual escapes `\n`, `\t`, `\b`, `\r`, `\\`, `\"`.
Strings are encoding agnostic sequences of bytes. Non printable Strings are encoding agnostic sequences of bytes. Non printable
characters can be escaped by 3 digits decimal codes `\ddd` or characters can be escaped by 3 digits decimal codes `\ddd` or
2 digit hexadecimal codes `\xHH`. 2 digit hexadecimal codes `\xHH`.
@ -1258,8 +1131,6 @@ Capitalised.
Int8 1 Int8 1
Float 3.5e12
Compound constants such as lists, in order not to repeat the same Compound constants such as lists, in order not to repeat the same
constant constructor for each element, take the type(s) of inner constant constructor for each element, take the type(s) of inner
values as first argument(s), and then the values without their values as first argument(s), and then the values without their
@ -1675,7 +1546,6 @@ X - Full grammar
<tagged data> ::= <tagged data> ::=
| <string constant> | <string constant>
| <float constant>
| Int8 <int constant> | Int8 <int constant>
| Int16 <int constant> | Int16 <int constant>
| Int32 <int constant> | Int32 <int constant>
@ -1710,7 +1580,6 @@ X - Full grammar
<untagged data> ::= <untagged data> ::=
| <int constant> | <int constant>
| <string constant> | <string constant>
| <float constant>
| <timestamp string constant> | <timestamp string constant>
| <signature string constant> | <signature string constant>
| <key string constant> | <key string constant>
@ -1820,7 +1689,6 @@ X - Full grammar
| uint64 | uint64
| void | void
| string | string
| float
| tez | tez
| bool | bool
| key | key
@ -1845,7 +1713,6 @@ X - Full grammar
| uint32 | uint32
| uint64 | uint64
| string | string
| float
| tez | tez
| bool | bool
| key | key
@ -1880,9 +1747,9 @@ The language is implemented in OCaml as follows:
interpreting the If instruction. interpreting the If instruction.
* The input, untyped internal representation is an OCaml ADT with * The input, untyped internal representation is an OCaml ADT with
the only 5 grammar constructions: `String`, `Float`, `Int`, `Seq` the only 5 grammar constructions: `String`, `Int`, `Seq` and
and `Prim`. It is the target language for the parser, since not `Prim`. It is the target language for the parser, since not all
all parsable programs are well typed, and thus could simply not be parsable programs are well typed, and thus could simply not be
constructed using the GADT. constructed using the GADT.
* The typechecker is a simple function that recognizes the abstract * The typechecker is a simple function that recognizes the abstract

52
src/proto/bootstrap/script_interpreter.ml
View File

@ -65,16 +65,11 @@ type 'tys stack =
| Item : 'ty * 'rest stack -> ('ty * 'rest) stack | Item : 'ty * 'rest stack -> ('ty * 'rest) stack
| Empty : end_of_stack stack | Empty : end_of_stack stack
let is_nan x = match classify_float x with
| FP_nan -> true
| _ -> false
let eq_comparable let eq_comparable
: type a. a comparable_ty -> a -> a -> bool : type a. a comparable_ty -> a -> a -> bool
= fun kind x v -> match kind with = fun kind x v -> match kind with
| String_key -> Compare.String.(x = v) | String_key -> Compare.String.(x = v)
| Bool_key -> Compare.Bool.(x = v) | Bool_key -> Compare.Bool.(x = v)
| Float_key -> Compare.Float.(x = v)
| Tez_key -> Tez.(x = v) | Tez_key -> Tez.(x = v)
| Key_key -> Ed25519.Public_key_hash.(equal x v) | Key_key -> Ed25519.Public_key_hash.(equal x v)
| Int_key kind -> Script_int.(equal kind x v) | Int_key kind -> Script_int.(equal kind x v)
@ -235,22 +230,12 @@ let rec interp
r := v ; r := v ;
return (rest, qta - 1, ctxt) return (rest, qta - 1, ctxt)
(* timestamp operations *) (* timestamp operations *)
| Add_period_to_timestamp, Item (p, Item (t, rest)) ->
Lwt.return
(Period.of_seconds (Int64.of_float p) >>? fun p ->
Timestamp.(t +? p) >>? fun res ->
Ok (Item (res, rest), qta - 1, ctxt))
| Add_seconds_to_timestamp (kind, _pos), Item (n, Item (t, rest)) -> | Add_seconds_to_timestamp (kind, _pos), Item (n, Item (t, rest)) ->
let n = Script_int.to_int64 kind n in let n = Script_int.to_int64 kind n in
Lwt.return Lwt.return
(Period.of_seconds n >>? fun p -> (Period.of_seconds n >>? fun p ->
Timestamp.(t +? p) >>? fun res -> Timestamp.(t +? p) >>? fun res ->
Ok (Item (res, rest), qta - 1, ctxt)) Ok (Item (res, rest), qta - 1, ctxt))
| Add_timestamp_to_period, Item (t, Item (p, rest)) ->
Lwt.return
(Period.of_seconds (Int64.of_float p) >>? fun p ->
Timestamp.(t +? p) >>? fun res ->
Ok (Item (res, rest), qta - 1, ctxt))
| Add_timestamp_to_seconds (kind, _pos), Item (t, Item (n, rest)) -> | Add_timestamp_to_seconds (kind, _pos), Item (t, Item (n, rest)) ->
let n = Script_int.to_int64 kind n in let n = Script_int.to_int64 kind n in
Lwt.return Lwt.return
@ -273,33 +258,6 @@ let rec interp
| Mul_tez' kind, Item (y, Item (x, rest)) -> | Mul_tez' kind, Item (y, Item (x, rest)) ->
Lwt.return Tez.(x *? Script_int.to_int64 kind y) >>=? fun res -> Lwt.return Tez.(x *? Script_int.to_int64 kind y) >>=? fun res ->
return (Item (res, rest), qta - 1, ctxt) return (Item (res, rest), qta - 1, ctxt)
(* float operations *)
| Floor, Item (x, rest) ->
return (Item (floor x, rest), qta - 1, ctxt)
| Ceil, Item (x, rest) ->
return (Item (ceil x, rest), qta - 1, ctxt)
| Inf, rest ->
return (Item (infinity, rest), qta - 1, ctxt)
| NaN, rest ->
return (Item (nan, rest), qta - 1, ctxt)
| IsNaN, Item (x, rest) ->
return (Item (is_nan x, rest), qta - 1, ctxt)
| NaNaN pos, Item (x, rest) ->
if is_nan x then fail (Reject pos) else return (rest, qta - 1, ctxt)
| Abs_float, Item (x, rest) ->
return (Item (abs_float x, rest), qta - 1, ctxt)
| Neg_float, Item (x, rest) ->
return (Item (0. -. x, rest), qta - 1, ctxt)
| Add_float, Item (x, Item (y, rest)) ->
return (Item (x +. y, rest), qta - 1, ctxt)
| Sub_float, Item (x, Item (y, rest)) ->
return (Item (x -. y, rest), qta - 1, ctxt)
| Mul_float, Item (x, Item (y, rest)) ->
return (Item (x *. y, rest), qta - 1, ctxt)
| Div_float, Item (x, Item (y, rest)) ->
return (Item (x /. y, rest), qta - 1, ctxt)
| Mod_float, Item (x, Item (y, rest)) ->
return (Item (mod_float x y, rest), qta - 1, ctxt)
(* boolean operations *) (* boolean operations *)
| Or, Item (x, Item (y, rest)) -> | Or, Item (x, Item (y, rest)) ->
return (Item (x || y, rest), qta - 1, ctxt) return (Item (x || y, rest), qta - 1, ctxt)
@ -401,10 +359,6 @@ let rec interp
let cmpres = Compare.String.compare a b in let cmpres = Compare.String.compare a b in
let cmpres = Script_int.of_int64 Int64 (Int64.of_int cmpres) in let cmpres = Script_int.of_int64 Int64 (Int64.of_int cmpres) in
return (Item (cmpres, rest), qta - 1, ctxt) return (Item (cmpres, rest), qta - 1, ctxt)
| Compare Float_key, Item (a, Item (b, rest)) ->
let cmpres = Compare.Float.compare a b in
let cmpres = Script_int.of_int64 Int64 (Int64.of_int cmpres) in
return (Item (cmpres, rest), qta - 1, ctxt)
| Compare Tez_key, Item (a, Item (b, rest)) -> | Compare Tez_key, Item (a, Item (b, rest)) ->
let cmpres = Tez.compare a b in let cmpres = Tez.compare a b in
let cmpres = Script_int.of_int64 Int64 (Int64.of_int cmpres) in let cmpres = Script_int.of_int64 Int64 (Int64.of_int cmpres) in
@ -453,12 +407,6 @@ let rec interp
end end
| Int_of_int (_, kt), Item (v, rest) -> | Int_of_int (_, kt), Item (v, rest) ->
return (Item (Script_int.cast kt v, rest), qta - 1, ctxt) return (Item (Script_int.cast kt v, rest), qta - 1, ctxt)
| Int_of_float kt, Item (v, rest) ->
let v = Int64.of_float v in
return (Item (Script_int.of_int64 kt v, rest), qta - 1, ctxt)
| Float_of_int kf, Item (v, rest) ->
let v = Int64.to_float (Script_int.to_int64 kf v) in
return (Item (v, rest), qta - 1, ctxt)
(* protocol *) (* protocol *)
| Manager, Item ((_, _, contract), rest) -> | Manager, Item ((_, _, contract), rest) ->
Contract.get_manager ctxt contract >>=? fun manager -> Contract.get_manager ctxt contract >>=? fun manager ->

113
src/proto/bootstrap/script_ir_translator.ml
View File

@ -71,7 +71,6 @@ let () =
let location = function let location = function
| Prim (loc, _, _) | Prim (loc, _, _)
| Float (loc, _)
| Int (loc, _) | Int (loc, _)
| String (loc, _) | String (loc, _)
| Seq (loc, _) -> loc | Seq (loc, _) -> loc
@ -132,7 +131,6 @@ let rec ty_eq
record_trace (Inconsistent_types (Ty ta, Ty tb)) record_trace (Inconsistent_types (Ty ta, Ty tb))
| String_t, String_t -> eq ta tb | String_t, String_t -> eq ta tb
| Signature_t, Signature_t -> eq ta tb | Signature_t, Signature_t -> eq ta tb
| Float_t, Float_t -> eq ta tb
| Tez_t, Tez_t -> eq ta tb | Tez_t, Tez_t -> eq ta tb
| Timestamp_t, Timestamp_t -> eq ta tb | Timestamp_t, Timestamp_t -> eq ta tb
| Bool_t, Bool_t -> eq ta tb | Bool_t, Bool_t -> eq ta tb
@ -201,14 +199,13 @@ let parse_comparable_ty : Script.expr -> ex_comparable_ty tzresult Lwt.t = funct
| Prim (_, "uint32", []) -> return @@ Ex (Int_key Uint32) | Prim (_, "uint32", []) -> return @@ Ex (Int_key Uint32)
| Prim (_, "uint64", []) -> return @@ Ex (Int_key Uint64) | Prim (_, "uint64", []) -> return @@ Ex (Int_key Uint64)
| Prim (_, "string", []) -> return @@ Ex String_key | Prim (_, "string", []) -> return @@ Ex String_key
| Prim (_, "float", []) -> return @@ Ex Float_key
| Prim (_, "tez", []) -> return @@ Ex Tez_key | Prim (_, "tez", []) -> return @@ Ex Tez_key
| Prim (_, "bool", []) -> return @@ Ex Bool_key | Prim (_, "bool", []) -> return @@ Ex Bool_key
| Prim (_, "key", []) -> return @@ Ex Key_key | Prim (_, "key", []) -> return @@ Ex Key_key
| Prim (_, "timestamp", []) -> return @@ Ex Timestamp_key | Prim (_, "timestamp", []) -> return @@ Ex Timestamp_key
| Prim (loc, ("int8" | "int16" | "int32" | "int64" | Prim (loc, ("int8" | "int16" | "int32" | "int64"
| "uint8" | "uint16" | "uint32" | "uint64" | "uint8" | "uint16" | "uint32" | "uint64"
| "string" | "float" | "tez" | "bool" | "string" | "tez" | "bool"
| "key" | "timestamp" as prim), l) -> | "key" | "timestamp" as prim), l) ->
fail @@ Invalid_arity (loc, Type, prim, 0, List.length l) fail @@ Invalid_arity (loc, Type, prim, 0, List.length l)
| Prim (loc, ("pair" | "union" | "set" | "map" | Prim (loc, ("pair" | "union" | "set" | "map"
@ -217,7 +214,7 @@ let parse_comparable_ty : Script.expr -> ex_comparable_ty tzresult Lwt.t = funct
fail @@ Comparable_type_expected loc fail @@ Comparable_type_expected loc
| Prim (loc, prim, _) -> | Prim (loc, prim, _) ->
fail @@ Invalid_primitive (loc, Type, prim) fail @@ Invalid_primitive (loc, Type, prim)
| Float (loc, _) | Int (loc, _) | String (loc, _) | Seq (loc, _) -> | Int (loc, _) | String (loc, _) | Seq (loc, _) ->
fail @@ Invalid_expression_kind loc fail @@ Invalid_expression_kind loc
type ex_ty = Ex : 'a ty -> ex_ty type ex_ty = Ex : 'a ty -> ex_ty
@ -233,7 +230,6 @@ let rec parse_ty : Script.expr -> ex_ty tzresult Lwt.t = function
| Prim (_, "uint32", []) -> return @@ Ex (Int_t Uint32) | Prim (_, "uint32", []) -> return @@ Ex (Int_t Uint32)
| Prim (_, "uint64", []) -> return @@ Ex (Int_t Uint64) | Prim (_, "uint64", []) -> return @@ Ex (Int_t Uint64)
| Prim (_, "string", []) -> return @@ Ex String_t | Prim (_, "string", []) -> return @@ Ex String_t
| Prim (_, "float", []) -> return @@ Ex Float_t
| Prim (_, "tez", []) -> return @@ Ex Tez_t | Prim (_, "tez", []) -> return @@ Ex Tez_t
| Prim (_, "bool", []) -> return @@ Ex Bool_t | Prim (_, "bool", []) -> return @@ Ex Bool_t
| Prim (_, "key", []) -> return @@ Ex Key_t | Prim (_, "key", []) -> return @@ Ex Key_t
@ -276,19 +272,18 @@ let rec parse_ty : Script.expr -> ex_ty tzresult Lwt.t = function
| "void" | "signature" | "contract" | "void" | "signature" | "contract"
| "int8" | "int16" | "int32" | "int64" | "int8" | "int16" | "int32" | "int64"
| "uint8" | "uint16" | "uint32" | "uint64" | "uint8" | "uint16" | "uint32" | "uint64"
| "string" | "float" | "tez" | "bool" | "string" | "tez" | "bool"
| "key" | "timestamp" as prim), l) -> | "key" | "timestamp" as prim), l) ->
fail @@ Invalid_arity (loc, Type, prim, 0, List.length l) fail @@ Invalid_arity (loc, Type, prim, 0, List.length l)
| Prim (loc, prim, _) -> | Prim (loc, prim, _) ->
fail @@ Invalid_primitive (loc, Type, prim) fail @@ Invalid_primitive (loc, Type, prim)
| Float (loc, _) | Int (loc, _) | String (loc, _) | Seq (loc, _) -> | Int (loc, _) | String (loc, _) | Seq (loc, _) ->
fail @@ Invalid_expression_kind loc fail @@ Invalid_expression_kind loc
let ty_of_comparable_ty let ty_of_comparable_ty
: type a. a comparable_ty -> a ty = function : type a. a comparable_ty -> a ty = function
| Int_key k -> Int_t k | Int_key k -> Int_t k
| String_key -> String_t | String_key -> String_t
| Float_key -> Float_t
| Tez_key -> Tez_t | Tez_key -> Tez_t
| Bool_key -> Bool_t | Bool_key -> Bool_t
| Key_key -> Key_t | Key_key -> Key_t
@ -298,7 +293,6 @@ let comparable_ty_of_ty
: type a. a ty -> a comparable_ty tzresult = function : type a. a ty -> a comparable_ty tzresult = function
| Int_t k -> ok (Int_key k) | Int_t k -> ok (Int_key k)
| String_t -> ok String_key | String_t -> ok String_key
| Float_t -> ok Float_key
| Tez_t -> ok Tez_key | Tez_t -> ok Tez_key
| Bool_t -> ok Bool_key | Bool_t -> ok Bool_key
| Key_t -> ok Key_key | Key_t -> ok Key_key
@ -335,16 +329,6 @@ let rec parse_tagged_data
return @@ Ex (Bool_t, v) return @@ Ex (Bool_t, v)
| Prim (loc, "bool", l) -> | Prim (loc, "bool", l) ->
fail @@ Invalid_arity (loc, Constant, "bool", 1, List.length l) fail @@ Invalid_arity (loc, Constant, "bool", 1, List.length l)
| Float (loc, v) -> begin try
return (Ex (Float_t, float_of_string v))
with _ ->
fail @@ Invalid_constant (loc, "float")
end
| Prim (_, "float", [ arg ]) ->
parse_untagged_data ctxt Float_t arg >>=? fun v ->
return @@ Ex (Float_t, v)
| Prim (loc, "float", l) ->
fail @@ Invalid_arity (loc, Constant, "float", 1, List.length l)
| Prim (_, "timestamp", [ arg ]) -> | Prim (_, "timestamp", [ arg ]) ->
parse_untagged_data ctxt Timestamp_t arg >>=? fun v -> parse_untagged_data ctxt Timestamp_t arg >>=? fun v ->
return @@ Ex (Timestamp_t, v) return @@ Ex (Timestamp_t, v)
@ -513,24 +497,16 @@ and parse_untagged_data
match ty, script_data with match ty, script_data with
(* Void *) (* Void *)
| Void_t, Prim (_, "void", []) -> return () | Void_t, Prim (_, "void", []) -> return ()
| Void_t, (Prim (loc, _, _) | Int (loc, _) | String (loc, _) | Float (loc, _) | Seq (loc, _)) -> | Void_t, (Prim (loc, _, _) | Int (loc, _) | String (loc, _) | Seq (loc, _)) ->
fail @@ Invalid_constant (loc, "void") fail @@ Invalid_constant (loc, "void")
(* Strings *) (* Strings *)
| String_t, String (_, v) -> return v | String_t, String (_, v) -> return v
| String_t, (Prim (loc, _, _) | Int (loc, _) | Float (loc, _) | Seq (loc, _)) -> | String_t, (Prim (loc, _, _) | Int (loc, _) | Seq (loc, _)) ->
fail @@ Invalid_constant (loc, "string") fail @@ Invalid_constant (loc, "string")
(* Floats *)
| Float_t, Float (loc, v) -> begin try
return (float_of_string v)
with _ ->
fail @@ Invalid_constant (loc, "float")
end
| Float_t, (Prim (loc, _, _) | Int (loc, _) | String (loc, _) | Seq (loc, _)) ->
fail @@ Invalid_constant (loc, "float")
(* Booleans *) (* Booleans *)
| Bool_t, Prim (_, "true", []) -> return true | Bool_t, Prim (_, "true", []) -> return true
| Bool_t, Prim (_, "false", []) -> return false | Bool_t, Prim (_, "false", []) -> return false
| Bool_t, (Prim (loc, _, _) | Float (loc, _) | Int (loc, _) | String (loc, _) | Seq (loc, _)) -> | Bool_t, (Prim (loc, _, _) | Int (loc, _) | String (loc, _) | Seq (loc, _)) ->
fail @@ Invalid_constant (loc, "bool") fail @@ Invalid_constant (loc, "bool")
(* Integers *) (* Integers *)
| Int_t k, Int (loc, v) -> begin try | Int_t k, Int (loc, v) -> begin try
@ -539,7 +515,7 @@ and parse_untagged_data
| Some i -> return i | Some i -> return i
with _ -> fail @@ Invalid_constant (loc, string_of_int_kind k) with _ -> fail @@ Invalid_constant (loc, string_of_int_kind k)
end end
| Int_t k, (Float (loc, _) | Prim (loc, _, _) | String (loc, _) | Seq (loc, _)) -> | Int_t k, (Prim (loc, _, _) | String (loc, _) | Seq (loc, _)) ->
fail @@ Invalid_constant (loc, string_of_int_kind k) fail @@ Invalid_constant (loc, string_of_int_kind k)
(* Tez amounts *) (* Tez amounts *)
| Tez_t, String (loc, v) -> begin try | Tez_t, String (loc, v) -> begin try
@ -549,10 +525,10 @@ and parse_untagged_data
with _ -> with _ ->
fail @@ Invalid_constant (loc, "tez") fail @@ Invalid_constant (loc, "tez")
end end
| Tez_t, (Float (loc, _) | Int (loc, _) | Prim (loc, _, _) | Seq (loc, _)) -> | Tez_t, (Int (loc, _) | Prim (loc, _, _) | Seq (loc, _)) ->
fail @@ Invalid_constant (loc, "tez") fail @@ Invalid_constant (loc, "tez")
(* Timestamps *) (* Timestamps *)
| Timestamp_t, (Float (loc, v) | Int (loc, v)) -> begin | Timestamp_t, (Int (loc, v)) -> begin
match (Timestamp.of_seconds v) with match (Timestamp.of_seconds v) with
| Some v -> return v | Some v -> return v
| None -> fail @@ Invalid_constant (loc, "timestamp") | None -> fail @@ Invalid_constant (loc, "timestamp")
@ -570,7 +546,7 @@ and parse_untagged_data
return (Ed25519.Public_key_hash.of_b48check s) return (Ed25519.Public_key_hash.of_b48check s)
with _ -> fail @@ Invalid_constant (loc, "key") with _ -> fail @@ Invalid_constant (loc, "key")
end end
| Key_t, (Prim (loc, _, _) | Seq (loc, _) | Int (loc, _) | Float (loc, _)) -> | Key_t, (Prim (loc, _, _) | Seq (loc, _) | Int (loc, _)) ->
fail @@ Invalid_constant (loc, "key") fail @@ Invalid_constant (loc, "key")
(* Signatures *) (* Signatures *)
| Signature_t, String (loc, s) -> begin try | Signature_t, String (loc, s) -> begin try
@ -582,7 +558,7 @@ and parse_untagged_data
with _ -> with _ ->
fail @@ Invalid_constant (loc, "signature") fail @@ Invalid_constant (loc, "signature")
end end
| Signature_t, (Prim (loc, _, _) | Int (loc, _) | Float (loc, _) | Seq (loc, _)) -> | Signature_t, (Prim (loc, _, _) | Int (loc, _) | Seq (loc, _)) ->
fail @@ Invalid_constant (loc, "signature") fail @@ Invalid_constant (loc, "signature")
(* Contracts *) (* Contracts *)
| Contract_t (ty1, ty2), String (loc, s) -> | Contract_t (ty1, ty2), String (loc, s) ->
@ -591,7 +567,7 @@ and parse_untagged_data
(Lwt.return (Contract.of_b48check s)) >>=? fun c -> (Lwt.return (Contract.of_b48check s)) >>=? fun c ->
parse_contract ctxt ty1 ty2 loc c >>=? fun _ -> parse_contract ctxt ty1 ty2 loc c >>=? fun _ ->
return (ty1, ty2, c) return (ty1, ty2, c)
| Contract_t _, (Prim (loc, _, _) | Int (loc, _) | Float (loc, _) | Seq (loc, _)) -> | Contract_t _, (Prim (loc, _, _) | Int (loc, _) | Seq (loc, _)) ->
fail @@ Invalid_constant (loc, "contract") fail @@ Invalid_constant (loc, "contract")
(* Pairs *) (* Pairs *)
| Pair_t (ta, tb), Prim (_, "pair", [ va; vb ]) -> | Pair_t (ta, tb), Prim (_, "pair", [ va; vb ]) ->
@ -600,7 +576,7 @@ and parse_untagged_data
return (va, vb) return (va, vb)
| Pair_t _, Prim (loc, "pair", l) -> | Pair_t _, Prim (loc, "pair", l) ->
fail @@ Invalid_arity (loc, Constant, "pair", 2, List.length l) fail @@ Invalid_arity (loc, Constant, "pair", 2, List.length l)
| Pair_t _, (Prim (loc, _, _) | Float (loc, _) | Int (loc, _) | String (loc, _) | Seq (loc, _)) -> | Pair_t _, (Prim (loc, _, _) | Int (loc, _) | String (loc, _) | Seq (loc, _)) ->
fail @@ Invalid_constant (loc, "pair") fail @@ Invalid_constant (loc, "pair")
(* Unions *) (* Unions *)
| Union_t (tl, _), Prim (_, "left", [ v ]) -> | Union_t (tl, _), Prim (_, "left", [ v ]) ->
@ -613,12 +589,12 @@ and parse_untagged_data
return (R v) return (R v)
| Union_t _, Prim (loc, "right", l) -> | Union_t _, Prim (loc, "right", l) ->
fail @@ Invalid_arity (loc, Constant, "right", 1, List.length l) fail @@ Invalid_arity (loc, Constant, "right", 1, List.length l)
| Union_t _, (Prim (loc, _, _) | Float (loc, _) | Int (loc, _) | String (loc, _) | Seq (loc, _)) -> | Union_t _, (Prim (loc, _, _) | Int (loc, _) | String (loc, _) | Seq (loc, _)) ->
fail @@ Invalid_constant (loc, "union") fail @@ Invalid_constant (loc, "union")
(* Lambdas *) (* Lambdas *)
| Lambda_t (ta, tr), (Seq _ as script_instr) -> | Lambda_t (ta, tr), (Seq _ as script_instr) ->
parse_lambda ctxt ta tr script_instr parse_lambda ctxt ta tr script_instr
| Lambda_t (_, _), (Prim (loc, _, _) | Float (loc, _) | Int (loc, _) | String (loc, _)) -> | Lambda_t (_, _), (Prim (loc, _, _) | Int (loc, _) | String (loc, _)) ->
fail @@ Invalid_constant (loc, "lambda") fail @@ Invalid_constant (loc, "lambda")
(* References *) (* References *)
| Ref_t t, Prim (_, "ref", [ v ]) -> | Ref_t t, Prim (_, "ref", [ v ]) ->
@ -626,7 +602,7 @@ and parse_untagged_data
return (ref v) return (ref v)
| Ref_t _, Prim (loc, "ref", l) -> | Ref_t _, Prim (loc, "ref", l) ->
fail @@ Invalid_arity (loc, Constant, "ref", 1, List.length l) fail @@ Invalid_arity (loc, Constant, "ref", 1, List.length l)
| Ref_t _, (Prim (loc, _, _) | Float (loc, _) | Int (loc, _) | String (loc, _) | Seq (loc, _)) -> | Ref_t _, (Prim (loc, _, _) | Int (loc, _) | String (loc, _) | Seq (loc, _)) ->
fail @@ Invalid_constant (loc, "ref") fail @@ Invalid_constant (loc, "ref")
(* Options *) (* Options *)
| Option_t t, Prim (_, "some", [ v ]) -> | Option_t t, Prim (_, "some", [ v ]) ->
@ -638,7 +614,7 @@ and parse_untagged_data
return None return None
| Option_t _, Prim (loc, "none", l) -> | Option_t _, Prim (loc, "none", l) ->
fail @@ Invalid_arity (loc, Constant, "none", 0, List.length l) fail @@ Invalid_arity (loc, Constant, "none", 0, List.length l)
| Option_t _, (Prim (loc, _, _) | Float (loc, _) | Int (loc, _) | String (loc, _) | Seq (loc, _)) -> | Option_t _, (Prim (loc, _, _) | Int (loc, _) | String (loc, _) | Seq (loc, _)) ->
fail @@ Invalid_constant (loc, "option") fail @@ Invalid_constant (loc, "option")
(* Lists *) (* Lists *)
| List_t t, Prim (_, "list", vs) -> | List_t t, Prim (_, "list", vs) ->
@ -647,7 +623,7 @@ and parse_untagged_data
parse_untagged_data ctxt t v >>=? fun v -> parse_untagged_data ctxt t v >>=? fun v ->
return (v :: rest)) return (v :: rest))
[] vs [] vs
| List_t _, (Prim (loc, _, _) | Float (loc, _) | Int (loc, _) | String (loc, _) | Seq (loc, _)) -> | List_t _, (Prim (loc, _, _) | Int (loc, _) | String (loc, _) | Seq (loc, _)) ->
fail @@ Invalid_constant (loc, "list") fail @@ Invalid_constant (loc, "list")
(* Sets *) (* Sets *)
| Set_t t, Prim (_, "set", vs) -> | Set_t t, Prim (_, "set", vs) ->
@ -657,7 +633,7 @@ and parse_untagged_data
return (v :: rest)) return (v :: rest))
[] vs >>=? fun v -> [] vs >>=? fun v ->
return (ref v, t) return (ref v, t)
| Set_t _, (Prim (loc, _, _) | Float (loc, _) | Int (loc, _) | String (loc, _) | Seq (loc, _)) -> | Set_t _, (Prim (loc, _, _) | Int (loc, _) | String (loc, _) | Seq (loc, _)) ->
fail @@ Invalid_constant (loc, "set") fail @@ Invalid_constant (loc, "set")
(* Maps *) (* Maps *)
| Map_t (tk, tv), Prim (_, "map", vs) -> | Map_t (tk, tv), Prim (_, "map", vs) ->
@ -669,11 +645,11 @@ and parse_untagged_data
return ((k, v) :: rest) return ((k, v) :: rest)
| Prim (loc, "item", l) -> | Prim (loc, "item", l) ->
fail @@ Invalid_arity (loc, Constant, "item", 2, List.length l) fail @@ Invalid_arity (loc, Constant, "item", 2, List.length l)
| Prim (loc, _, _) | Float (loc, _) | Int (loc, _) | String (loc, _) | Seq (loc, _) -> | Prim (loc, _, _) | Int (loc, _) | String (loc, _) | Seq (loc, _) ->
fail @@ Invalid_constant (loc, "item")) fail @@ Invalid_constant (loc, "item"))
[] vs >>=? fun v -> [] vs >>=? fun v ->
return (ref v, tk) return (ref v, tk)
| Map_t _, (Prim (loc, _, _) | Float (loc, _) | Int (loc, _) | String (loc, _) | Seq (loc, _)) -> | Map_t _, (Prim (loc, _, _) | Int (loc, _) | String (loc, _) | Seq (loc, _)) ->
fail @@ Invalid_constant (loc, "map") fail @@ Invalid_constant (loc, "map")
and parse_untagged_comparable_data and parse_untagged_comparable_data
@ -899,13 +875,9 @@ and parse_instr
| Prim (_, "nop", []), rest -> | Prim (_, "nop", []), rest ->
return (Typed (Nop, rest)) return (Typed (Nop, rest))
(* timestamp operations *) (* timestamp operations *)
| Prim (_, "add", []), Item_t (Timestamp_t, Item_t (Float_t, rest)) ->
return (Typed (Add_timestamp_to_period, Item_t (Timestamp_t, rest)))
| Prim (loc, "add", []), Item_t (Timestamp_t, Item_t (Int_t kind, rest)) -> | Prim (loc, "add", []), Item_t (Timestamp_t, Item_t (Int_t kind, rest)) ->
trace (Bad_stack_item (loc, 2)) (Lwt.return (unsigned_int_kind kind)) >>=? fun (Eq _) -> trace (Bad_stack_item (loc, 2)) (Lwt.return (unsigned_int_kind kind)) >>=? fun (Eq _) ->
return (Typed (Add_timestamp_to_seconds (kind, loc), Item_t (Timestamp_t, rest))) return (Typed (Add_timestamp_to_seconds (kind, loc), Item_t (Timestamp_t, rest)))
| Prim (_, "add", []), Item_t (Float_t, Item_t (Timestamp_t, rest)) ->
return (Typed (Add_period_to_timestamp, Item_t (Timestamp_t, rest)))
| Prim (loc, "add", []), Item_t (Int_t kind, Item_t (Timestamp_t, rest)) -> | Prim (loc, "add", []), Item_t (Int_t kind, Item_t (Timestamp_t, rest)) ->
trace trace
(Bad_stack_item (loc, 1)) (Bad_stack_item (loc, 1))
@ -927,33 +899,6 @@ and parse_instr
(Bad_stack_item (loc, 1)) (Bad_stack_item (loc, 1))
(Lwt.return (unsigned_int_kind kind)) >>=? fun (Eq _) -> (Lwt.return (unsigned_int_kind kind)) >>=? fun (Eq _) ->
return (Typed (Mul_tez' kind, Item_t (Tez_t, rest))) return (Typed (Mul_tez' kind, Item_t (Tez_t, rest)))
(* float operations *)
| Prim (_, "floor", []), Item_t (Float_t, rest) ->
return (Typed (Floor, Item_t (Float_t, rest)))
| Prim (_, "ceil", []), Item_t (Float_t, rest) ->
return (Typed (Ceil, Item_t (Float_t, rest)))
| Prim (_, "inf", []), rest ->
return (Typed (Inf, Item_t (Float_t, rest)))
| Prim (_, "nan", []), rest ->
return (Typed (NaN, Item_t (Float_t, rest)))
| Prim (_, "isnan", []), Item_t (Float_t, rest) ->
return (Typed (IsNaN, Item_t (Bool_t, rest)))
| Prim (loc, "nanan", []), Item_t (Float_t, rest) ->
return (Typed (NaNaN loc, rest))
| Prim (_, "abs", []), Item_t (Float_t, rest) ->
return (Typed (Abs_float, Item_t (Float_t, rest)))
| Prim (_, "neg", []), Item_t (Float_t, rest) ->
return (Typed (Neg_float, Item_t (Float_t, rest)))
| Prim (_, "add", []), Item_t (Float_t, Item_t (Float_t, rest)) ->
return (Typed (Add_float, Item_t (Float_t, rest)))
| Prim (_, "sub", []), Item_t (Float_t, Item_t (Float_t, rest)) ->
return (Typed (Sub_float, Item_t (Float_t, rest)))
| Prim (_, "mul", []), Item_t (Float_t, Item_t (Float_t, rest)) ->
return (Typed (Mul_float, Item_t (Float_t, rest)))
| Prim (_, "div", []), Item_t (Float_t, Item_t (Float_t, rest)) ->
return (Typed (Div_float, Item_t (Float_t, rest)))
| Prim (_, "mod", []), Item_t (Float_t, Item_t (Float_t, rest)) ->
return (Typed (Mod_float, Item_t (Float_t, rest)))
(* boolean operations *) (* boolean operations *)
| Prim (_, "or", []), Item_t (Bool_t, Item_t (Bool_t, rest)) -> | Prim (_, "or", []), Item_t (Bool_t, Item_t (Bool_t, rest)) ->
return (Typed (Or, Item_t (Bool_t, rest))) return (Typed (Or, Item_t (Bool_t, rest)))
@ -1029,8 +974,6 @@ and parse_instr
return (Typed (Compare Bool_key, Item_t (Int_t Int64, rest))) return (Typed (Compare Bool_key, Item_t (Int_t Int64, rest)))
| Prim (_, "compare", []), Item_t (String_t, Item_t (String_t, rest)) -> | Prim (_, "compare", []), Item_t (String_t, Item_t (String_t, rest)) ->
return (Typed (Compare String_key, Item_t (Int_t Int64, rest))) return (Typed (Compare String_key, Item_t (Int_t Int64, rest)))
| Prim (_, "compare", []), Item_t (Float_t, Item_t (Float_t, rest)) ->
return (Typed (Compare Float_key, Item_t (Int_t Int64, rest)))
| Prim (_, "compare", []), Item_t (Tez_t, Item_t (Tez_t, rest)) -> | Prim (_, "compare", []), Item_t (Tez_t, Item_t (Tez_t, rest)) ->
return (Typed (Compare Tez_key, Item_t (Int_t Int64, rest))) return (Typed (Compare Tez_key, Item_t (Int_t Int64, rest)))
| Prim (_, "compare", []), Item_t (Key_t, Item_t (Key_t, rest)) -> | Prim (_, "compare", []), Item_t (Key_t, Item_t (Key_t, rest)) ->
@ -1064,10 +1007,6 @@ and parse_instr
parse_ty t >>=? fun (Ex ty) -> begin match ty,stack_ty with parse_ty t >>=? fun (Ex ty) -> begin match ty,stack_ty with
| Int_t kt, Item_t (Int_t kf, rest) -> | Int_t kt, Item_t (Int_t kf, rest) ->
return (Typed (Int_of_int (kf, kt), Item_t (Int_t kt, rest))) return (Typed (Int_of_int (kf, kt), Item_t (Int_t kt, rest)))
| Float_t, Item_t (Int_t kf, rest) ->
return (Typed (Float_of_int kf, Item_t (Float_t, rest)))
| Int_t kt, Item_t (Float_t, rest) ->
return (Typed (Int_of_float kt, Item_t (Int_t kt, rest)))
| ty, Item_t (ty', _) -> | ty, Item_t (ty', _) ->
fail (Undefined_cast (loc, Ty ty', Ty ty)) fail (Undefined_cast (loc, Ty ty', Ty ty))
| _, Empty_t -> | _, Empty_t ->
@ -1181,7 +1120,7 @@ and parse_instr
(* Generic parsing errors *) (* Generic parsing errors *)
| Prim (loc, prim, _), _ -> | Prim (loc, prim, _), _ ->
fail @@ Invalid_primitive (loc, Instr, prim) fail @@ Invalid_primitive (loc, Instr, prim)
| (Float (loc, _) | Int (loc, _) | String (loc, _)), _ -> | (Int (loc, _) | String (loc, _)), _ ->
fail @@ Invalid_expression_kind loc fail @@ Invalid_expression_kind loc
and parse_contract and parse_contract
@ -1224,7 +1163,6 @@ let unparse_comparable_ty
| Int_key Uint32 -> Prim (-1, "uint32", []) | Int_key Uint32 -> Prim (-1, "uint32", [])
| Int_key Uint64 -> Prim (-1, "uint64", []) | Int_key Uint64 -> Prim (-1, "uint64", [])
| String_key -> Prim (-1, "string", []) | String_key -> Prim (-1, "string", [])
| Float_key -> Prim (-1, "float", [])
| Tez_key -> Prim (-1, "tez", []) | Tez_key -> Prim (-1, "tez", [])
| Bool_key -> Prim (-1, "bool", []) | Bool_key -> Prim (-1, "bool", [])
| Key_key -> Prim (-1, "key", []) | Key_key -> Prim (-1, "key", [])
@ -1242,7 +1180,6 @@ let rec unparse_ty
| Int_t Uint32 -> Prim (-1, "uint32", []) | Int_t Uint32 -> Prim (-1, "uint32", [])
| Int_t Uint64 -> Prim (-1, "uint64", []) | Int_t Uint64 -> Prim (-1, "uint64", [])
| String_t -> Prim (-1, "string", []) | String_t -> Prim (-1, "string", [])
| Float_t -> Prim (-1, "float", [])
| Tez_t -> Prim (-1, "tez", []) | Tez_t -> Prim (-1, "tez", [])
| Bool_t -> Prim (-1, "bool", []) | Bool_t -> Prim (-1, "bool", [])
| Key_t -> Prim (-1, "key", []) | Key_t -> Prim (-1, "key", [])
@ -1290,8 +1227,6 @@ let rec unparse_untagged_data
Int (-1, Int64.to_string (to_int64 k v)) Int (-1, Int64.to_string (to_int64 k v))
| String_t, s -> | String_t, s ->
String (-1, s) String (-1, s)
| Float_t, f ->
Float (-1, string_of_float f)
| Bool_t, true -> | Bool_t, true ->
Prim (-1, "true", []) Prim (-1, "true", [])
| Bool_t, false -> | Bool_t, false ->
@ -1355,8 +1290,6 @@ let rec unparse_tagged_data
Prim (-1, string_of_int_kind k, [ String (-1, Int64.to_string (to_int64 k v))]) Prim (-1, string_of_int_kind k, [ String (-1, Int64.to_string (to_int64 k v))])
| String_t, s -> | String_t, s ->
Prim (-1, "string", [ String (-1, s) ]) Prim (-1, "string", [ String (-1, s) ])
| Float_t, f ->
Prim (-1, "float", [ String (-1, string_of_float f) ])
| Bool_t, true -> | Bool_t, true ->
Prim (-1, "bool", [ Prim (-1, "true", []) ]) Prim (-1, "bool", [ Prim (-1, "true", []) ])
| Bool_t, false -> | Bool_t, false ->

13
src/proto/bootstrap/script_repr.ml
View File

@ -29,7 +29,6 @@ let location_encoding =
type expr = (* TODO: turn the location into an alpha ? *) type expr = (* TODO: turn the location into an alpha ? *)
| Int of location * string | Int of location * string
| Float of location * string
| String of location * string | String of location * string
| Prim of location * string * expr list | Prim of location * string * expr list
| Seq of location * expr list | Seq of location * expr list
@ -38,8 +37,6 @@ let expr_encoding =
let open Data_encoding in let open Data_encoding in
let int_encoding = let int_encoding =
obj1 (req "int" string) in obj1 (req "int" string) in
let float_encoding =
obj1 (req "float" string) in
let string_encoding = let string_encoding =
obj1 (req "string" string) in obj1 (req "string" string) in
let prim_encoding expr_encoding = let prim_encoding expr_encoding =
@ -65,25 +62,21 @@ let expr_encoding =
[ case ~tag:0 int_encoding [ case ~tag:0 int_encoding
(function Int (_, v) -> Some v | _ -> None) (function Int (_, v) -> Some v | _ -> None)
(fun v -> Int (-1, v)) ; (fun v -> Int (-1, v)) ;
case ~tag:1 float_encoding case ~tag:1 string_encoding
(function Float (_, v) -> Some v | _ -> None)
(fun v -> Float (-1, v)) ;
case ~tag:2 string_encoding
(function String (_, v) -> Some v | _ -> None) (function String (_, v) -> Some v | _ -> None)
(fun v -> String (-1, v)) ; (fun v -> String (-1, v)) ;
case ~tag:3 (prim_encoding expr_encoding) case ~tag:2 (prim_encoding expr_encoding)
(function (function
| Prim (_, v, args) -> Some (v, args) | Prim (_, v, args) -> Some (v, args)
| _ -> None) | _ -> None)
(function (prim, args) -> Prim (-1, prim, args)) ; (function (prim, args) -> Prim (-1, prim, args)) ;
case ~tag:4 (seq_encoding expr_encoding) case ~tag:3 (seq_encoding expr_encoding)
(function Seq (_, v) -> Some v | _ -> None) (function Seq (_, v) -> Some v | _ -> None)
(fun args -> Seq (-1, args)) ]) (fun args -> Seq (-1, args)) ])
let update_locations ir = let update_locations ir =
let rec update_locations i = function let rec update_locations i = function
| Int (_, v) -> (Int (i, v), succ i) | Int (_, v) -> (Int (i, v), succ i)
| Float (_, v) -> (Float (i, v), succ i)
| String (_, v) -> (String (i, v), succ i) | String (_, v) -> (String (i, v), succ i)
| Prim (_, name, args) -> | Prim (_, name, args) ->
let (nargs, ni) = let (nargs, ni) =

1
src/proto/bootstrap/script_repr.mli
View File

@ -14,7 +14,6 @@ type location =
type expr = type expr =
| Int of location * string | Int of location * string
| Float of location * string
| String of location * string | String of location * string
| Prim of location * string * expr list | Prim of location * string * expr list
| Seq of location * expr list | Seq of location * expr list

37
src/proto/bootstrap/script_typed_ir.ml
View File

@ -34,7 +34,6 @@ and ('arg, 'ret) typed_contract =
and 'ty comparable_ty = and 'ty comparable_ty =
| Int_key : ('s, 'l) int_kind -> ('s, 'l) int_val comparable_ty | Int_key : ('s, 'l) int_kind -> ('s, 'l) int_val comparable_ty
| String_key : string comparable_ty | String_key : string comparable_ty
| Float_key : float comparable_ty
| Tez_key : Tez.t comparable_ty | Tez_key : Tez.t comparable_ty
| Bool_key : bool comparable_ty | Bool_key : bool comparable_ty
| Key_key : public_key_hash comparable_ty | Key_key : public_key_hash comparable_ty
@ -45,7 +44,6 @@ and 'ty ty =
| Int_t : ('s, 'l) int_kind -> ('s, 'l) int_val ty | Int_t : ('s, 'l) int_kind -> ('s, 'l) int_val ty
| Signature_t : signature ty | Signature_t : signature ty
| String_t : string ty | String_t : string ty
| Float_t : float ty
| Tez_t : Tez.t ty | Tez_t : Tez.t ty
| Key_t : public_key_hash ty | Key_t : public_key_hash ty
| Timestamp_t : Timestamp.t ty | Timestamp_t : Timestamp.t ty
@ -161,12 +159,8 @@ and ('bef, 'aft) instr =
| Concat : | Concat :
(string * (string * 'rest), string * 'rest) instr (string * (string * 'rest), string * 'rest) instr
(* timestamp operations *) (* timestamp operations *)
| Add_period_to_timestamp :
(float * (Timestamp.t * 'rest), Timestamp.t * 'rest) instr
| Add_seconds_to_timestamp : (unsigned, 'l) int_kind * Script.location -> | Add_seconds_to_timestamp : (unsigned, 'l) int_kind * Script.location ->
((unsigned, 'l) int_val * (Timestamp.t * 'rest), Timestamp.t * 'rest) instr ((unsigned, 'l) int_val * (Timestamp.t * 'rest), Timestamp.t * 'rest) instr
| Add_timestamp_to_period :
(Timestamp.t * (float * 'rest), Timestamp.t * 'rest) instr
| Add_timestamp_to_seconds : (unsigned, 'l) int_kind * Script.location -> | Add_timestamp_to_seconds : (unsigned, 'l) int_kind * Script.location ->
(Timestamp.t * ((unsigned, 'l) int_val * 'rest), Timestamp.t * 'rest) instr (Timestamp.t * ((unsigned, 'l) int_val * 'rest), Timestamp.t * 'rest) instr
(* currency operations *) (* currency operations *)
@ -178,33 +172,6 @@ and ('bef, 'aft) instr =
(Tez.t * ((unsigned, 'l) int_val * 'rest), Tez.t * 'rest) instr (Tez.t * ((unsigned, 'l) int_val * 'rest), Tez.t * 'rest) instr
| Mul_tez' : (unsigned, 'l) int_kind -> | Mul_tez' : (unsigned, 'l) int_kind ->
((unsigned, 'l) int_val * (Tez.t * 'rest), Tez.t * 'rest) instr ((unsigned, 'l) int_val * (Tez.t * 'rest), Tez.t * 'rest) instr
(* float operations *)
| Neg_float :
(float * 'rest, float * 'rest) instr
| Abs_float :
(float * 'rest, float * 'rest) instr
| Add_float :
(float * (float * 'rest), float * 'rest) instr
| Sub_float :
(float * (float * 'rest), float * 'rest) instr
| Mul_float :
(float * (float * 'rest), float * 'rest) instr
| Div_float :
(float * (float * 'rest), float * 'rest) instr
| Mod_float :
(float * (float * 'rest), float * 'rest) instr
| Floor :
(float * 'rest, float * 'rest) instr
| Ceil :
(float * 'rest, float * 'rest) instr
| Inf :
('rest, float * 'rest) instr
| NaN :
('rest, float * 'rest) instr
| IsNaN :
(float * 'rest, bool * 'rest) instr
| NaNaN : Script.location ->
(float * 'rest, 'rest) instr
(* boolean operations *) (* boolean operations *)
| Or : | Or :
(bool * (bool * 'rest), bool * 'rest) instr (bool * (bool * 'rest), bool * 'rest) instr
@ -289,10 +256,6 @@ and ('bef, 'aft) instr =
(('sf, 'lf) int_val * 'rest, ('st, 'lt) int_val * 'rest) instr (('sf, 'lf) int_val * 'rest, ('st, 'lt) int_val * 'rest) instr
| Checked_int_of_int : ('sf, 'lf) int_kind * ('st, 'lt) int_kind * Script.location -> | Checked_int_of_int : ('sf, 'lf) int_kind * ('st, 'lt) int_kind * Script.location ->
(('sf, 'lf) int_val * 'rest, ('st, 'lt) int_val * 'rest) instr (('sf, 'lf) int_val * 'rest, ('st, 'lt) int_val * 'rest) instr
| Int_of_float : ('st, 'lt) int_kind ->
(float * 'rest, ('st, 'lt) int_val * 'rest) instr
| Float_of_int : ('sf, 'lf) int_kind ->
(('sf, 'lf) int_val * 'rest, float * 'rest) instr
(* protocol *) (* protocol *)
| Manager : | Manager :
(('arg, 'ret) typed_contract * 'rest, public_key_hash * 'rest) instr (('arg, 'ret) typed_contract * 'rest, public_key_hash * 'rest) instr

1
src/proto/bootstrap/tezos_context.mli
View File

@ -109,7 +109,6 @@ module Script : sig
type expr = type expr =
| Int of location * string | Int of location * string
| Float of location * string
| String of location * string | String of location * string
| Prim of location * string * expr list | Prim of location * string * expr list
| Seq of location * expr list | Seq of location * expr list