diff --git a/src/client/embedded/bootstrap/client_proto_programs.ml b/src/client/embedded/bootstrap/client_proto_programs.ml index 341cb5b8c..3baf1bea8 100644 --- a/src/client/embedded/bootstrap/client_proto_programs.ml +++ b/src/client/embedded/bootstrap/client_proto_programs.ml @@ -69,7 +69,6 @@ let rec print_ir ppf node = match node with | String (_, 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 (_, []) -> Format.fprintf ppf "{}" ; | Seq (_, seq) -> diff --git a/src/client/embedded/bootstrap/concrete_lexer.mll b/src/client/embedded/bootstrap/concrete_lexer.mll index 86a702153..cfaf3ad5b 100644 --- a/src/client/embedded/bootstrap/concrete_lexer.mll +++ b/src/client/embedded/bootstrap/concrete_lexer.mll @@ -73,22 +73,6 @@ let char_for_hexadecimal_code lexbuf i = in 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 *) type state = { @@ -234,11 +218,6 @@ let bin_literal = '0' ['b' 'B'] ['0'-'1'] ['0'-'1' '_']* let int_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 @@ -332,9 +311,6 @@ and raw_token st = parse | int_literal { INT (Lexing.lexeme lexbuf) } -| float_literal - { FLOAT (remove_underscores (Lexing.lexeme lexbuf)) } - | "\"" { reset_string_buffer st; let string_start = lexbuf.Lexing.lex_start_p in diff --git a/src/client/embedded/bootstrap/concrete_parser.mly b/src/client/embedded/bootstrap/concrete_parser.mly index f13270ac5..e5d137b0b 100644 --- a/src/client/embedded/bootstrap/concrete_parser.mly +++ b/src/client/embedded/bootstrap/concrete_parser.mly @@ -9,12 +9,11 @@ %token RPAREN %token SEMICOLON -%token FLOAT %token INT %token PRIM %token STRING -%left PRIM INT FLOAT LPAREN LBRACE STRING +%left PRIM INT LPAREN LBRACE STRING %left apply %start tree @@ -127,7 +126,7 @@ let expand = function let apply node arg = match node with | 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)) let rec apply_seq node = function @@ -166,7 +165,6 @@ line_node: | LBRACE nodes = nodes RBRACE { Seq (pos $startpos $endpos, nodes) } | prim = PRIM { Prim (pos $startpos $endpos, prim, []) } | i = INT { Int (pos $startpos $endpos, i) } -| f = FLOAT { Float (pos $startpos $endpos, f) } | s = STRING { String (pos $startpos $endpos, s) } %% diff --git a/src/client/embedded/bootstrap/script_located_ir.ml b/src/client/embedded/bootstrap/script_located_ir.ml index dceb0d0b4..b3b123249 100644 --- a/src/client/embedded/bootstrap/script_located_ir.ml +++ b/src/client/embedded/bootstrap/script_located_ir.ml @@ -15,14 +15,12 @@ type location = type node = | Int of location * string - | Float of location * string | String of location * string | Prim of location * string * node list | Seq of location * node list let node_location = function | Int (loc, _) - | Float (loc, _) | String (loc, _) | Prim (loc, _, _) | Seq (loc, _) -> loc @@ -57,8 +55,6 @@ let strip_locations root = match l with | Int (_, v) -> Script.Int (id, v) - | Float (_, v) -> - Script.Float (id, v) | String (_, v) -> Script.String (id, v) | Seq (_, seq) -> diff --git a/src/proto/bootstrap/docs/language.md b/src/proto/bootstrap/docs/language.md index e4e85946f..2ff123edc 100644 --- a/src/proto/bootstrap/docs/language.md +++ b/src/proto/bootstrap/docs/language.md @@ -32,7 +32,7 @@ I - Type system 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, * `identifier` for a primitive data-type, * `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. * 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` * booleans `True` and `False`, * string literals, as in `(String "contents")`, @@ -274,7 +273,7 @@ combinators, and also for branching. 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. * `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} -### 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 Strings are mostly used for naming things without having to rely on @@ -1111,14 +987,11 @@ parsing policy is described just after. ### Constants -There are three kinds of constants: +There are two kinds of constants: 1. Integers in decimal (no prefix), hexadecimal (0x prefix), octal (0o prefix) or binary (0b prefix). - 2. Floating point IEEE754 doubles in libc-style notation, with a - mandatory period character. (`3` is an `int` but `3.` is a - `float`). - 3. Strings with usual escapes `\n`, `\t`, `\b`, `\r`, `\\`, `\"`. + 2. Strings with usual escapes `\n`, `\t`, `\b`, `\r`, `\\`, `\"`. Strings are encoding agnostic sequences of bytes. Non printable characters can be escaped by 3 digits decimal codes `\ddd` or 2 digit hexadecimal codes `\xHH`. @@ -1258,8 +1131,6 @@ Capitalised. Int8 1 - Float 3.5e12 - Compound constants such as lists, in order not to repeat the same constant constructor for each element, take the type(s) of inner values as first argument(s), and then the values without their @@ -1675,7 +1546,6 @@ X - Full grammar ::= | - | | Int8 | Int16 | Int32 @@ -1710,7 +1580,6 @@ X - Full grammar ::= | | - | | | | @@ -1820,7 +1689,6 @@ X - Full grammar | uint64 | void | string - | float | tez | bool | key @@ -1845,7 +1713,6 @@ X - Full grammar | uint32 | uint64 | string - | float | tez | bool | key @@ -1880,9 +1747,9 @@ The language is implemented in OCaml as follows: interpreting the If instruction. * The input, untyped internal representation is an OCaml ADT with - the only 5 grammar constructions: `String`, `Float`, `Int`, `Seq` - and `Prim`. It is the target language for the parser, since not - all parsable programs are well typed, and thus could simply not be + the only 5 grammar constructions: `String`, `Int`, `Seq` and + `Prim`. It is the target language for the parser, since not all + parsable programs are well typed, and thus could simply not be constructed using the GADT. * The typechecker is a simple function that recognizes the abstract diff --git a/src/proto/bootstrap/script_interpreter.ml b/src/proto/bootstrap/script_interpreter.ml index 55bae920a..d7b3ac8af 100644 --- a/src/proto/bootstrap/script_interpreter.ml +++ b/src/proto/bootstrap/script_interpreter.ml @@ -65,16 +65,11 @@ type 'tys stack = | Item : 'ty * 'rest stack -> ('ty * 'rest) stack | Empty : end_of_stack stack -let is_nan x = match classify_float x with - | FP_nan -> true - | _ -> false - let eq_comparable : type a. a comparable_ty -> a -> a -> bool = fun kind x v -> match kind with | String_key -> Compare.String.(x = v) | Bool_key -> Compare.Bool.(x = v) - | Float_key -> Compare.Float.(x = v) | Tez_key -> Tez.(x = v) | Key_key -> Ed25519.Public_key_hash.(equal x v) | Int_key kind -> Script_int.(equal kind x v) @@ -235,22 +230,12 @@ let rec interp r := v ; return (rest, qta - 1, ctxt) (* 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)) -> let n = Script_int.to_int64 kind n in Lwt.return (Period.of_seconds n >>? fun p -> Timestamp.(t +? p) >>? fun res -> 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)) -> let n = Script_int.to_int64 kind n in Lwt.return @@ -273,33 +258,6 @@ let rec interp | Mul_tez' kind, Item (y, Item (x, rest)) -> Lwt.return Tez.(x *? Script_int.to_int64 kind y) >>=? fun res -> 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 *) | Or, Item (x, Item (y, rest)) -> 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 = Script_int.of_int64 Int64 (Int64.of_int cmpres) in 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)) -> let cmpres = Tez.compare a b in let cmpres = Script_int.of_int64 Int64 (Int64.of_int cmpres) in @@ -453,12 +407,6 @@ let rec interp end | Int_of_int (_, kt), Item (v, rest) -> 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 *) | Manager, Item ((_, _, contract), rest) -> Contract.get_manager ctxt contract >>=? fun manager -> diff --git a/src/proto/bootstrap/script_ir_translator.ml b/src/proto/bootstrap/script_ir_translator.ml index 944c91d21..5e9c8ee73 100644 --- a/src/proto/bootstrap/script_ir_translator.ml +++ b/src/proto/bootstrap/script_ir_translator.ml @@ -71,7 +71,6 @@ let () = let location = function | Prim (loc, _, _) - | Float (loc, _) | Int (loc, _) | String (loc, _) | Seq (loc, _) -> loc @@ -132,7 +131,6 @@ let rec ty_eq record_trace (Inconsistent_types (Ty ta, Ty tb)) | String_t, String_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 | Timestamp_t, Timestamp_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 (_, "uint64", []) -> return @@ Ex (Int_key Uint64) | Prim (_, "string", []) -> return @@ Ex String_key - | Prim (_, "float", []) -> return @@ Ex Float_key | Prim (_, "tez", []) -> return @@ Ex Tez_key | Prim (_, "bool", []) -> return @@ Ex Bool_key | Prim (_, "key", []) -> return @@ Ex Key_key | Prim (_, "timestamp", []) -> return @@ Ex Timestamp_key | Prim (loc, ("int8" | "int16" | "int32" | "int64" | "uint8" | "uint16" | "uint32" | "uint64" - | "string" | "float" | "tez" | "bool" + | "string" | "tez" | "bool" | "key" | "timestamp" as prim), l) -> fail @@ Invalid_arity (loc, Type, prim, 0, List.length l) | 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 | Prim (loc, 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 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 (_, "uint64", []) -> return @@ Ex (Int_t Uint64) | Prim (_, "string", []) -> return @@ Ex String_t - | Prim (_, "float", []) -> return @@ Ex Float_t | Prim (_, "tez", []) -> return @@ Ex Tez_t | Prim (_, "bool", []) -> return @@ Ex Bool_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" | "int8" | "int16" | "int32" | "int64" | "uint8" | "uint16" | "uint32" | "uint64" - | "string" | "float" | "tez" | "bool" + | "string" | "tez" | "bool" | "key" | "timestamp" as prim), l) -> fail @@ Invalid_arity (loc, Type, prim, 0, List.length l) | Prim (loc, 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 let ty_of_comparable_ty : type a. a comparable_ty -> a ty = function | Int_key k -> Int_t k | String_key -> String_t - | Float_key -> Float_t | Tez_key -> Tez_t | Bool_key -> Bool_t | Key_key -> Key_t @@ -298,7 +293,6 @@ let comparable_ty_of_ty : type a. a ty -> a comparable_ty tzresult = function | Int_t k -> ok (Int_key k) | String_t -> ok String_key - | Float_t -> ok Float_key | Tez_t -> ok Tez_key | Bool_t -> ok Bool_key | Key_t -> ok Key_key @@ -335,16 +329,6 @@ let rec parse_tagged_data return @@ Ex (Bool_t, v) | Prim (loc, "bool", 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 ]) -> parse_untagged_data ctxt Timestamp_t arg >>=? fun v -> return @@ Ex (Timestamp_t, v) @@ -513,24 +497,16 @@ and parse_untagged_data match ty, script_data with (* Void *) | 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") (* Strings *) | 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") - (* 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 *) | Bool_t, Prim (_, "true", []) -> return true | 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") (* Integers *) | Int_t k, Int (loc, v) -> begin try @@ -539,7 +515,7 @@ and parse_untagged_data | Some i -> return i with _ -> fail @@ Invalid_constant (loc, string_of_int_kind k) 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) (* Tez amounts *) | Tez_t, String (loc, v) -> begin try @@ -549,10 +525,10 @@ and parse_untagged_data with _ -> fail @@ Invalid_constant (loc, "tez") end - | Tez_t, (Float (loc, _) | Int (loc, _) | Prim (loc, _, _) | Seq (loc, _)) -> + | Tez_t, (Int (loc, _) | Prim (loc, _, _) | Seq (loc, _)) -> fail @@ Invalid_constant (loc, "tez") (* Timestamps *) - | Timestamp_t, (Float (loc, v) | Int (loc, v)) -> begin + | Timestamp_t, (Int (loc, v)) -> begin match (Timestamp.of_seconds v) with | Some v -> return v | None -> fail @@ Invalid_constant (loc, "timestamp") @@ -570,7 +546,7 @@ and parse_untagged_data return (Ed25519.Public_key_hash.of_b48check s) with _ -> fail @@ Invalid_constant (loc, "key") end - | Key_t, (Prim (loc, _, _) | Seq (loc, _) | Int (loc, _) | Float (loc, _)) -> + | Key_t, (Prim (loc, _, _) | Seq (loc, _) | Int (loc, _)) -> fail @@ Invalid_constant (loc, "key") (* Signatures *) | Signature_t, String (loc, s) -> begin try @@ -582,7 +558,7 @@ and parse_untagged_data with _ -> fail @@ Invalid_constant (loc, "signature") end - | Signature_t, (Prim (loc, _, _) | Int (loc, _) | Float (loc, _) | Seq (loc, _)) -> + | Signature_t, (Prim (loc, _, _) | Int (loc, _) | Seq (loc, _)) -> fail @@ Invalid_constant (loc, "signature") (* Contracts *) | Contract_t (ty1, ty2), String (loc, s) -> @@ -591,7 +567,7 @@ and parse_untagged_data (Lwt.return (Contract.of_b48check s)) >>=? fun c -> parse_contract ctxt ty1 ty2 loc c >>=? fun _ -> 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") (* Pairs *) | Pair_t (ta, tb), Prim (_, "pair", [ va; vb ]) -> @@ -600,7 +576,7 @@ and parse_untagged_data return (va, vb) | Pair_t _, Prim (loc, "pair", 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") (* Unions *) | Union_t (tl, _), Prim (_, "left", [ v ]) -> @@ -613,12 +589,12 @@ and parse_untagged_data return (R v) | Union_t _, Prim (loc, "right", 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") (* Lambdas *) | Lambda_t (ta, tr), (Seq _ as 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") (* References *) | Ref_t t, Prim (_, "ref", [ v ]) -> @@ -626,7 +602,7 @@ and parse_untagged_data return (ref v) | Ref_t _, Prim (loc, "ref", 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") (* Options *) | Option_t t, Prim (_, "some", [ v ]) -> @@ -638,7 +614,7 @@ and parse_untagged_data return None | Option_t _, Prim (loc, "none", 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") (* Lists *) | List_t t, Prim (_, "list", vs) -> @@ -647,7 +623,7 @@ and parse_untagged_data parse_untagged_data ctxt t v >>=? fun v -> return (v :: rest)) [] 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") (* Sets *) | Set_t t, Prim (_, "set", vs) -> @@ -657,7 +633,7 @@ and parse_untagged_data return (v :: rest)) [] vs >>=? fun v -> 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") (* Maps *) | Map_t (tk, tv), Prim (_, "map", vs) -> @@ -669,11 +645,11 @@ and parse_untagged_data return ((k, v) :: rest) | Prim (loc, "item", 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")) [] vs >>=? fun v -> 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") and parse_untagged_comparable_data @@ -899,13 +875,9 @@ and parse_instr | Prim (_, "nop", []), rest -> return (Typed (Nop, rest)) (* 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)) -> 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))) - | 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)) -> trace (Bad_stack_item (loc, 1)) @@ -927,33 +899,6 @@ and parse_instr (Bad_stack_item (loc, 1)) (Lwt.return (unsigned_int_kind kind)) >>=? fun (Eq _) -> 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 *) | Prim (_, "or", []), Item_t (Bool_t, 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))) | Prim (_, "compare", []), Item_t (String_t, Item_t (String_t, 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)) -> return (Typed (Compare Tez_key, Item_t (Int_t Int64, 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 | Int_t kt, Item_t (Int_t kf, 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', _) -> fail (Undefined_cast (loc, Ty ty', Ty ty)) | _, Empty_t -> @@ -1181,7 +1120,7 @@ and parse_instr (* Generic parsing errors *) | Prim (loc, prim, _), _ -> fail @@ Invalid_primitive (loc, Instr, prim) - | (Float (loc, _) | Int (loc, _) | String (loc, _)), _ -> + | (Int (loc, _) | String (loc, _)), _ -> fail @@ Invalid_expression_kind loc and parse_contract @@ -1224,7 +1163,6 @@ let unparse_comparable_ty | Int_key Uint32 -> Prim (-1, "uint32", []) | Int_key Uint64 -> Prim (-1, "uint64", []) | String_key -> Prim (-1, "string", []) - | Float_key -> Prim (-1, "float", []) | Tez_key -> Prim (-1, "tez", []) | Bool_key -> Prim (-1, "bool", []) | Key_key -> Prim (-1, "key", []) @@ -1242,7 +1180,6 @@ let rec unparse_ty | Int_t Uint32 -> Prim (-1, "uint32", []) | Int_t Uint64 -> Prim (-1, "uint64", []) | String_t -> Prim (-1, "string", []) - | Float_t -> Prim (-1, "float", []) | Tez_t -> Prim (-1, "tez", []) | Bool_t -> Prim (-1, "bool", []) | Key_t -> Prim (-1, "key", []) @@ -1290,8 +1227,6 @@ let rec unparse_untagged_data Int (-1, Int64.to_string (to_int64 k v)) | String_t, s -> String (-1, s) - | Float_t, f -> - Float (-1, string_of_float f) | Bool_t, true -> Prim (-1, "true", []) | 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))]) | String_t, s -> Prim (-1, "string", [ String (-1, s) ]) - | Float_t, f -> - Prim (-1, "float", [ String (-1, string_of_float f) ]) | Bool_t, true -> Prim (-1, "bool", [ Prim (-1, "true", []) ]) | Bool_t, false -> diff --git a/src/proto/bootstrap/script_repr.ml b/src/proto/bootstrap/script_repr.ml index da69098a2..2480e695f 100644 --- a/src/proto/bootstrap/script_repr.ml +++ b/src/proto/bootstrap/script_repr.ml @@ -29,7 +29,6 @@ let location_encoding = type expr = (* TODO: turn the location into an alpha ? *) | Int of location * string - | Float of location * string | String of location * string | Prim of location * string * expr list | Seq of location * expr list @@ -38,8 +37,6 @@ let expr_encoding = let open Data_encoding in let int_encoding = obj1 (req "int" string) in - let float_encoding = - obj1 (req "float" string) in let string_encoding = obj1 (req "string" string) in let prim_encoding expr_encoding = @@ -65,25 +62,21 @@ let expr_encoding = [ case ~tag:0 int_encoding (function Int (_, v) -> Some v | _ -> None) (fun v -> Int (-1, v)) ; - case ~tag:1 float_encoding - (function Float (_, v) -> Some v | _ -> None) - (fun v -> Float (-1, v)) ; - case ~tag:2 string_encoding + case ~tag:1 string_encoding (function String (_, v) -> Some v | _ -> None) (fun v -> String (-1, v)) ; - case ~tag:3 (prim_encoding expr_encoding) + case ~tag:2 (prim_encoding expr_encoding) (function | Prim (_, v, args) -> Some (v, args) | _ -> None) (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) (fun args -> Seq (-1, args)) ]) let update_locations ir = let rec update_locations i = function | Int (_, v) -> (Int (i, v), succ i) - | Float (_, v) -> (Float (i, v), succ i) | String (_, v) -> (String (i, v), succ i) | Prim (_, name, args) -> let (nargs, ni) = diff --git a/src/proto/bootstrap/script_repr.mli b/src/proto/bootstrap/script_repr.mli index ae1936bea..1626022bb 100644 --- a/src/proto/bootstrap/script_repr.mli +++ b/src/proto/bootstrap/script_repr.mli @@ -14,7 +14,6 @@ type location = type expr = | Int of location * string - | Float of location * string | String of location * string | Prim of location * string * expr list | Seq of location * expr list diff --git a/src/proto/bootstrap/script_typed_ir.ml b/src/proto/bootstrap/script_typed_ir.ml index 476b15c77..744701371 100644 --- a/src/proto/bootstrap/script_typed_ir.ml +++ b/src/proto/bootstrap/script_typed_ir.ml @@ -34,7 +34,6 @@ and ('arg, 'ret) typed_contract = and 'ty comparable_ty = | Int_key : ('s, 'l) int_kind -> ('s, 'l) int_val comparable_ty | String_key : string comparable_ty - | Float_key : float comparable_ty | Tez_key : Tez.t comparable_ty | Bool_key : bool 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 | Signature_t : signature ty | String_t : string ty - | Float_t : float ty | Tez_t : Tez.t ty | Key_t : public_key_hash ty | Timestamp_t : Timestamp.t ty @@ -161,12 +159,8 @@ and ('bef, 'aft) instr = | Concat : (string * (string * 'rest), string * 'rest) instr (* timestamp operations *) - | Add_period_to_timestamp : - (float * (Timestamp.t * 'rest), Timestamp.t * 'rest) instr | Add_seconds_to_timestamp : (unsigned, 'l) int_kind * Script.location -> ((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 -> (Timestamp.t * ((unsigned, 'l) int_val * 'rest), Timestamp.t * 'rest) instr (* currency operations *) @@ -178,33 +172,6 @@ and ('bef, 'aft) instr = (Tez.t * ((unsigned, 'l) int_val * 'rest), Tez.t * 'rest) instr | Mul_tez' : (unsigned, 'l) int_kind -> ((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 *) | Or : (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 | 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 - | 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 *) | Manager : (('arg, 'ret) typed_contract * 'rest, public_key_hash * 'rest) instr diff --git a/src/proto/bootstrap/tezos_context.mli b/src/proto/bootstrap/tezos_context.mli index 15a935db7..c7ae51262 100644 --- a/src/proto/bootstrap/tezos_context.mli +++ b/src/proto/bootstrap/tezos_context.mli @@ -109,7 +109,6 @@ module Script : sig type expr = | Int of location * string - | Float of location * string | String of location * string | Prim of location * string * expr list | Seq of location * expr list