From 0b9a4a63131ad0e5b6aef3b9de22448d829e2fdc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Guido=20Mart=C3=ADnez?= Date: Wed, 10 Jan 2018 12:07:44 -0800 Subject: [PATCH] snap --- src/ocaml-output/FStar_Errors.ml | 357 +- src/ocaml-output/FStar_Extraction_Kremlin.ml | 1379 ++-- src/ocaml-output/FStar_Extraction_ML_Code.ml | 713 +- src/ocaml-output/FStar_Extraction_ML_Modul.ml | 1020 +-- .../FStar_Extraction_ML_Syntax.ml | 137 +- src/ocaml-output/FStar_Extraction_ML_Term.ml | 1553 ++-- src/ocaml-output/FStar_Options.ml | 1977 ++--- src/ocaml-output/FStar_Parser_Const.ml | 1 + src/ocaml-output/FStar_SMTEncoding_Encode.ml | 7149 +++++++++-------- src/ocaml-output/FStar_SMTEncoding_Z3.ml | 4 +- src/ocaml-output/FStar_Syntax_Print.ml | 4 +- src/ocaml-output/FStar_Syntax_Resugar.ml | 1491 ++-- src/ocaml-output/FStar_Syntax_Subst.ml | 242 +- src/ocaml-output/FStar_Syntax_Syntax.ml | 560 +- src/ocaml-output/FStar_Syntax_Util.ml | 1994 ++--- src/ocaml-output/FStar_TypeChecker_DMFF.ml | 1662 ++-- src/ocaml-output/FStar_TypeChecker_Env.ml | 2121 ++--- .../FStar_TypeChecker_Normalize.ml | 4700 +++++------ src/ocaml-output/FStar_TypeChecker_Rel.ml | 1045 ++- src/ocaml-output/FStar_TypeChecker_Tc.ml | 1224 +-- src/ocaml-output/FStar_TypeChecker_TcTerm.ml | 6078 +++++++------- src/ocaml-output/FStar_TypeChecker_Util.ml | 4731 ++++++----- 22 files changed, 20149 insertions(+), 19993 deletions(-) diff --git a/src/ocaml-output/FStar_Errors.ml b/src/ocaml-output/FStar_Errors.ml index 8977a4dc5cc..4c3dd930e03 100644 --- a/src/ocaml-output/FStar_Errors.ml +++ b/src/ocaml-output/FStar_Errors.ml @@ -143,7 +143,7 @@ type raw_error = | Fatal_NonSingletonTopLevelModule | Fatal_NonTopRecFunctionNotFullyEncoded | Fatal_NonTrivialPreConditionInPrims - | Fatal_NonVaribleInductiveTypeParameter + | Fatal_NonVariableInductiveTypeParameter | Fatal_NotApplicationOrFv | Fatal_NotEnoughArgsToEffect | Fatal_NotEnoughArgumentsForEffect @@ -284,6 +284,7 @@ type raw_error = | Warning_MissingInterfaceOrImplementation | Warning_ConstructorBuildsUnexpectedType | Warning_ModuleOrFileNotFoundWarning + | Error_NoLetMutable | Error_BadImplicit[@@deriving show] let uu___is_Error_DependencyAnalysisFailed: raw_error -> Prims.bool = fun projectee -> @@ -981,10 +982,11 @@ let uu___is_Fatal_NonTrivialPreConditionInPrims: raw_error -> Prims.bool = match projectee with | Fatal_NonTrivialPreConditionInPrims -> true | uu____572 -> false -let uu___is_Fatal_NonVaribleInductiveTypeParameter: raw_error -> Prims.bool = +let uu___is_Fatal_NonVariableInductiveTypeParameter: raw_error -> Prims.bool + = fun projectee -> match projectee with - | Fatal_NonVaribleInductiveTypeParameter -> true + | Fatal_NonVariableInductiveTypeParameter -> true | uu____576 -> false let uu___is_Fatal_NotApplicationOrFv: raw_error -> Prims.bool = fun projectee -> @@ -1663,9 +1665,12 @@ let uu___is_Warning_ModuleOrFileNotFoundWarning: raw_error -> Prims.bool = match projectee with | Warning_ModuleOrFileNotFoundWarning -> true | uu____1136 -> false +let uu___is_Error_NoLetMutable: raw_error -> Prims.bool = + fun projectee -> + match projectee with | Error_NoLetMutable -> true | uu____1140 -> false let uu___is_Error_BadImplicit: raw_error -> Prims.bool = fun projectee -> - match projectee with | Error_BadImplicit -> true | uu____1140 -> false + match projectee with | Error_BadImplicit -> true | uu____1144 -> false type flag = | CError | CFatal @@ -1673,16 +1678,16 @@ type flag = | CSilent[@@deriving show] let uu___is_CError: flag -> Prims.bool = fun projectee -> - match projectee with | CError -> true | uu____1144 -> false + match projectee with | CError -> true | uu____1148 -> false let uu___is_CFatal: flag -> Prims.bool = fun projectee -> - match projectee with | CFatal -> true | uu____1148 -> false + match projectee with | CFatal -> true | uu____1152 -> false let uu___is_CWarning: flag -> Prims.bool = fun projectee -> - match projectee with | CWarning -> true | uu____1152 -> false + match projectee with | CWarning -> true | uu____1156 -> false let uu___is_CSilent: flag -> Prims.bool = fun projectee -> - match projectee with | CSilent -> true | uu____1156 -> false + match projectee with | CSilent -> true | uu____1160 -> false let default_flags: (raw_error,flag) FStar_Pervasives_Native.tuple2 Prims.list = [(Error_DependencyAnalysisFailed, CError); @@ -1828,7 +1833,7 @@ let default_flags: (raw_error,flag) FStar_Pervasives_Native.tuple2 Prims.list (Fatal_NonSingletonTopLevelModule, CFatal); (Fatal_NonTopRecFunctionNotFullyEncoded, CFatal); (Fatal_NonTrivialPreConditionInPrims, CFatal); - (Fatal_NonVaribleInductiveTypeParameter, CFatal); + (Fatal_NonVariableInductiveTypeParameter, CFatal); (Fatal_NotApplicationOrFv, CFatal); (Fatal_NotEnoughArgsToEffect, CFatal); (Fatal_NotEnoughArgumentsForEffect, CFatal); @@ -1973,36 +1978,36 @@ let default_flags: (raw_error,flag) FStar_Pervasives_Native.tuple2 Prims.list exception Err of (raw_error,Prims.string) FStar_Pervasives_Native.tuple2 let uu___is_Err: Prims.exn -> Prims.bool = fun projectee -> - match projectee with | Err uu____2317 -> true | uu____2322 -> false + match projectee with | Err uu____2321 -> true | uu____2326 -> false let __proj__Err__item__uu___: Prims.exn -> (raw_error,Prims.string) FStar_Pervasives_Native.tuple2 = - fun projectee -> match projectee with | Err uu____2337 -> uu____2337 + fun projectee -> match projectee with | Err uu____2341 -> uu____2341 exception Error of (raw_error,Prims.string,FStar_Range.range) FStar_Pervasives_Native.tuple3 let uu___is_Error: Prims.exn -> Prims.bool = fun projectee -> - match projectee with | Error uu____2354 -> true | uu____2361 -> false + match projectee with | Error uu____2358 -> true | uu____2365 -> false let __proj__Error__item__uu___: Prims.exn -> (raw_error,Prims.string,FStar_Range.range) FStar_Pervasives_Native.tuple3 - = fun projectee -> match projectee with | Error uu____2380 -> uu____2380 + = fun projectee -> match projectee with | Error uu____2384 -> uu____2384 exception Warning of (raw_error,Prims.string,FStar_Range.range) FStar_Pervasives_Native.tuple3 let uu___is_Warning: Prims.exn -> Prims.bool = fun projectee -> - match projectee with | Warning uu____2399 -> true | uu____2406 -> false + match projectee with | Warning uu____2403 -> true | uu____2410 -> false let __proj__Warning__item__uu___: Prims.exn -> (raw_error,Prims.string,FStar_Range.range) FStar_Pervasives_Native.tuple3 - = fun projectee -> match projectee with | Warning uu____2425 -> uu____2425 + = fun projectee -> match projectee with | Warning uu____2429 -> uu____2429 exception Stop let uu___is_Stop: Prims.exn -> Prims.bool = fun projectee -> - match projectee with | Stop -> true | uu____2435 -> false + match projectee with | Stop -> true | uu____2439 -> false exception Empty_frag let uu___is_Empty_frag: Prims.exn -> Prims.bool = fun projectee -> - match projectee with | Empty_frag -> true | uu____2439 -> false + match projectee with | Empty_frag -> true | uu____2443 -> false type issue_level = | ENotImplemented | EInfo @@ -2010,16 +2015,16 @@ type issue_level = | EError[@@deriving show] let uu___is_ENotImplemented: issue_level -> Prims.bool = fun projectee -> - match projectee with | ENotImplemented -> true | uu____2443 -> false + match projectee with | ENotImplemented -> true | uu____2447 -> false let uu___is_EInfo: issue_level -> Prims.bool = fun projectee -> - match projectee with | EInfo -> true | uu____2447 -> false + match projectee with | EInfo -> true | uu____2451 -> false let uu___is_EWarning: issue_level -> Prims.bool = fun projectee -> - match projectee with | EWarning -> true | uu____2451 -> false + match projectee with | EWarning -> true | uu____2455 -> false let uu___is_EError: issue_level -> Prims.bool = fun projectee -> - match projectee with | EError -> true | uu____2455 -> false + match projectee with | EError -> true | uu____2459 -> false type issue = { issue_message: Prims.string; @@ -2102,32 +2107,32 @@ let format_issue: issue -> Prims.string = | EWarning -> "Warning" | EError -> "Error" | ENotImplemented -> "Feature not yet implemented: " in - let uu____2654 = + let uu____2658 = match issue.issue_range with | FStar_Pervasives_Native.None -> ("", "") | FStar_Pervasives_Native.Some r -> - let uu____2664 = - let uu____2665 = FStar_Range.string_of_use_range r in - FStar_Util.format1 "%s: " uu____2665 in - let uu____2666 = - let uu____2667 = - let uu____2668 = FStar_Range.use_range r in - let uu____2669 = FStar_Range.def_range r in - uu____2668 = uu____2669 in - if uu____2667 + let uu____2668 = + let uu____2669 = FStar_Range.string_of_use_range r in + FStar_Util.format1 "%s: " uu____2669 in + let uu____2670 = + let uu____2671 = + let uu____2672 = FStar_Range.use_range r in + let uu____2673 = FStar_Range.def_range r in + uu____2672 = uu____2673 in + if uu____2671 then "" else - (let uu____2671 = FStar_Range.string_of_range r in - FStar_Util.format1 " (see also %s)" uu____2671) in - (uu____2664, uu____2666) in - match uu____2654 with + (let uu____2675 = FStar_Range.string_of_range r in + FStar_Util.format1 " (see also %s)" uu____2675) in + (uu____2668, uu____2670) in + match uu____2658 with | (range_str,see_also_str) -> let issue_number = match issue.issue_number with | FStar_Pervasives_Native.None -> "" | FStar_Pervasives_Native.Some n1 -> - let uu____2676 = FStar_Util.string_of_int n1 in - FStar_Util.format1 " %s" uu____2676 in + let uu____2680 = FStar_Util.string_of_int n1 in + FStar_Util.format1 " %s" uu____2680 in FStar_Util.format5 "%s(%s%s) %s%s\n" range_str level_header issue_number issue.issue_message see_also_str let print_issue: issue -> Prims.unit = @@ -2138,7 +2143,7 @@ let print_issue: issue -> Prims.unit = | EWarning -> FStar_Util.print_warning | EError -> FStar_Util.print_error | ENotImplemented -> FStar_Util.print_error in - let uu____2685 = format_issue issue in printer uu____2685 + let uu____2689 = format_issue issue in printer uu____2689 let compare_issues: issue -> issue -> Prims.int = fun i1 -> fun i2 -> @@ -2146,8 +2151,8 @@ let compare_issues: issue -> issue -> Prims.int = | (FStar_Pervasives_Native.None ,FStar_Pervasives_Native.None ) -> Prims.parse_int "0" | (FStar_Pervasives_Native.None ,FStar_Pervasives_Native.Some - uu____2700) -> - (Prims.parse_int "1") - | (FStar_Pervasives_Native.Some uu____2705,FStar_Pervasives_Native.None + uu____2704) -> - (Prims.parse_int "1") + | (FStar_Pervasives_Native.Some uu____2709,FStar_Pervasives_Native.None ) -> Prims.parse_int "1" | (FStar_Pervasives_Native.Some r1,FStar_Pervasives_Native.Some r2) -> FStar_Range.compare_use_range r1 r2 @@ -2156,18 +2161,18 @@ let default_handler: error_handler = let add_one e = match e.issue_level with | EError -> - let uu____2727 = - let uu____2730 = FStar_ST.op_Bang errs in e :: uu____2730 in - FStar_ST.op_Colon_Equals errs uu____2727 - | uu____2881 -> print_issue e in - let count_errors uu____2885 = - let uu____2886 = FStar_ST.op_Bang errs in FStar_List.length uu____2886 in - let report uu____2968 = + let uu____2731 = + let uu____2734 = FStar_ST.op_Bang errs in e :: uu____2734 in + FStar_ST.op_Colon_Equals errs uu____2731 + | uu____2885 -> print_issue e in + let count_errors uu____2889 = + let uu____2890 = FStar_ST.op_Bang errs in FStar_List.length uu____2890 in + let report uu____2972 = let sorted1 = - let uu____2972 = FStar_ST.op_Bang errs in - FStar_List.sortWith compare_issues uu____2972 in + let uu____2976 = FStar_ST.op_Bang errs in + FStar_List.sortWith compare_issues uu____2976 in FStar_List.iter print_issue sorted1; sorted1 in - let clear1 uu____3053 = FStar_ST.op_Colon_Equals errs [] in + let clear1 uu____3057 = FStar_ST.op_Colon_Equals errs [] in { eh_add_one = add_one; eh_count_errors = count_errors; @@ -2192,39 +2197,39 @@ let mk_issue: issue_number = n1 } let get_err_count: Prims.unit -> Prims.int = - fun uu____3167 -> - let uu____3168 = - let uu____3171 = FStar_ST.op_Bang current_handler in - uu____3171.eh_count_errors in - uu____3168 () + fun uu____3171 -> + let uu____3172 = + let uu____3175 = FStar_ST.op_Bang current_handler in + uu____3175.eh_count_errors in + uu____3172 () let add_one: issue -> Prims.unit = fun issue -> FStar_Util.atomically - (fun uu____3225 -> - let uu____3226 = - let uu____3229 = FStar_ST.op_Bang current_handler in - uu____3229.eh_add_one in - uu____3226 issue) + (fun uu____3229 -> + let uu____3230 = + let uu____3233 = FStar_ST.op_Bang current_handler in + uu____3233.eh_add_one in + uu____3230 issue) let add_many: issue Prims.list -> Prims.unit = fun issues -> FStar_Util.atomically - (fun uu____3287 -> - let uu____3288 = - let uu____3291 = FStar_ST.op_Bang current_handler in - uu____3291.eh_add_one in - FStar_List.iter uu____3288 issues) + (fun uu____3291 -> + let uu____3292 = + let uu____3295 = FStar_ST.op_Bang current_handler in + uu____3295.eh_add_one in + FStar_List.iter uu____3292 issues) let report_all: Prims.unit -> issue Prims.list = - fun uu____3344 -> - let uu____3345 = - let uu____3350 = FStar_ST.op_Bang current_handler in - uu____3350.eh_report in - uu____3345 () + fun uu____3348 -> + let uu____3349 = + let uu____3354 = FStar_ST.op_Bang current_handler in + uu____3354.eh_report in + uu____3349 () let clear: Prims.unit -> Prims.unit = - fun uu____3401 -> - let uu____3402 = - let uu____3405 = FStar_ST.op_Bang current_handler in - uu____3405.eh_clear in - uu____3402 () + fun uu____3405 -> + let uu____3406 = + let uu____3409 = FStar_ST.op_Bang current_handler in + uu____3409.eh_clear in + uu____3406 () let set_handler: error_handler -> Prims.unit = fun handler -> let issues = report_all () in @@ -2261,40 +2266,40 @@ let message_prefix: error_message_prefix = let pfx = FStar_Util.mk_ref FStar_Pervasives_Native.None in let set_prefix s = FStar_ST.op_Colon_Equals pfx (FStar_Pervasives_Native.Some s) in - let clear_prefix uu____3670 = + let clear_prefix uu____3674 = FStar_ST.op_Colon_Equals pfx FStar_Pervasives_Native.None in let append_prefix s = - let uu____3749 = FStar_ST.op_Bang pfx in - match uu____3749 with + let uu____3753 = FStar_ST.op_Bang pfx in + match uu____3753 with | FStar_Pervasives_Native.None -> s | FStar_Pervasives_Native.Some p -> Prims.strcat p (Prims.strcat ": " s) in { set_prefix; append_prefix; clear_prefix } let findIndex: - 'Auu____3831 'Auu____3832 . - ('Auu____3832,'Auu____3831) FStar_Pervasives_Native.tuple2 Prims.list -> - 'Auu____3832 -> Prims.int + 'Auu____3835 'Auu____3836 . + ('Auu____3836,'Auu____3835) FStar_Pervasives_Native.tuple2 Prims.list -> + 'Auu____3836 -> Prims.int = fun l -> fun v1 -> FStar_All.pipe_right l (FStar_List.index - (fun uu___25_3866 -> - match uu___25_3866 with - | (e,uu____3872) when e = v1 -> true - | uu____3873 -> false)) + (fun uu___25_3870 -> + match uu___25_3870 with + | (e,uu____3876) when e = v1 -> true + | uu____3877 -> false)) let errno_of_error: raw_error -> Prims.int = fun e -> findIndex default_flags e let flags: flag Prims.list FStar_ST.ref = FStar_Util.mk_ref [] let init_warn_error_flags: Prims.unit = let rec aux r l = match l with | [] -> r | (e,f)::tl1 -> aux (FStar_List.append r [f]) tl1 in - let uu____3942 = aux [] default_flags in - FStar_ST.op_Colon_Equals flags uu____3942 + let uu____3946 = aux [] default_flags in + FStar_ST.op_Colon_Equals flags uu____3946 let diag: FStar_Range.range -> Prims.string -> Prims.unit = fun r -> fun msg -> - let uu____4003 = FStar_Options.debug_any () in - if uu____4003 + let uu____4007 = FStar_Options.debug_any () in + if uu____4007 then add_one (mk_issue EInfo (FStar_Pervasives_Native.Some r) msg @@ -2305,14 +2310,14 @@ let log_issue: (raw_error,Prims.string) FStar_Pervasives_Native.tuple2 -> Prims.unit = fun r -> - fun uu____4014 -> - match uu____4014 with + fun uu____4018 -> + match uu____4018 with | (e,msg) -> let errno = errno_of_error e in - let uu____4022 = - let uu____4023 = FStar_ST.op_Bang flags in - FStar_List.nth uu____4023 errno in - (match uu____4022 with + let uu____4026 = + let uu____4027 = FStar_ST.op_Bang flags in + FStar_List.nth uu____4027 errno in + (match uu____4026 with | CError -> add_one (mk_issue EError (FStar_Pervasives_Native.Some r) msg @@ -2326,98 +2331,98 @@ let log_issue: let i = mk_issue EError (FStar_Pervasives_Native.Some r) msg (FStar_Pervasives_Native.Some errno) in - let uu____4079 = FStar_Options.ide () in - if uu____4079 + let uu____4083 = FStar_Options.ide () in + if uu____4083 then add_one i else - (let uu____4081 = - let uu____4082 = format_issue i in + (let uu____4085 = + let uu____4086 = format_issue i in Prims.strcat "don't use log_issue to report fatal error, should use raise_error: " - uu____4082 in - failwith uu____4081)) + uu____4086 in + failwith uu____4085)) let add_errors: (raw_error,Prims.string,FStar_Range.range) FStar_Pervasives_Native.tuple3 Prims.list -> Prims.unit = fun errs -> FStar_Util.atomically - (fun uu____4103 -> + (fun uu____4107 -> FStar_List.iter - (fun uu____4115 -> - match uu____4115 with + (fun uu____4119 -> + match uu____4119 with | (e,msg,r) -> - let uu____4125 = - let uu____4130 = message_prefix.append_prefix msg in - (e, uu____4130) in - log_issue r uu____4125) errs) + let uu____4129 = + let uu____4134 = message_prefix.append_prefix msg in + (e, uu____4134) in + log_issue r uu____4129) errs) let issue_of_exn: Prims.exn -> issue FStar_Pervasives_Native.option = - fun uu___26_4135 -> - match uu___26_4135 with + fun uu___26_4139 -> + match uu___26_4139 with | Error (e,msg,r) -> let errno = errno_of_error e in - let uu____4142 = - let uu____4143 = message_prefix.append_prefix msg in - mk_issue EError (FStar_Pervasives_Native.Some r) uu____4143 + let uu____4146 = + let uu____4147 = message_prefix.append_prefix msg in + mk_issue EError (FStar_Pervasives_Native.Some r) uu____4147 (FStar_Pervasives_Native.Some errno) in - FStar_Pervasives_Native.Some uu____4142 + FStar_Pervasives_Native.Some uu____4146 | FStar_Util.NYI msg -> - let uu____4145 = - let uu____4146 = message_prefix.append_prefix msg in - mk_issue ENotImplemented FStar_Pervasives_Native.None uu____4146 + let uu____4149 = + let uu____4150 = message_prefix.append_prefix msg in + mk_issue ENotImplemented FStar_Pervasives_Native.None uu____4150 FStar_Pervasives_Native.None in - FStar_Pervasives_Native.Some uu____4145 + FStar_Pervasives_Native.Some uu____4149 | Err (e,msg) -> let errno = errno_of_error e in - let uu____4150 = - let uu____4151 = message_prefix.append_prefix msg in - mk_issue EError FStar_Pervasives_Native.None uu____4151 + let uu____4154 = + let uu____4155 = message_prefix.append_prefix msg in + mk_issue EError FStar_Pervasives_Native.None uu____4155 (FStar_Pervasives_Native.Some errno) in - FStar_Pervasives_Native.Some uu____4150 - | uu____4152 -> FStar_Pervasives_Native.None + FStar_Pervasives_Native.Some uu____4154 + | uu____4156 -> FStar_Pervasives_Native.None let err_exn: Prims.exn -> Prims.unit = fun exn -> if exn = Stop then () else - (let uu____4157 = issue_of_exn exn in - match uu____4157 with + (let uu____4161 = issue_of_exn exn in + match uu____4161 with | FStar_Pervasives_Native.Some issue -> add_one issue | FStar_Pervasives_Native.None -> FStar_Exn.raise exn) let handleable: Prims.exn -> Prims.bool = - fun uu___27_4163 -> - match uu___27_4163 with - | Error uu____4164 -> true - | FStar_Util.NYI uu____4171 -> true + fun uu___27_4167 -> + match uu___27_4167 with + | Error uu____4168 -> true + | FStar_Util.NYI uu____4175 -> true | Stop -> true - | Err uu____4172 -> true - | uu____4177 -> false + | Err uu____4176 -> true + | uu____4181 -> false let stop_if_err: Prims.unit -> Prims.unit = - fun uu____4180 -> - let uu____4181 = - let uu____4182 = get_err_count () in uu____4182 > (Prims.parse_int "0") in - if uu____4181 then FStar_Exn.raise Stop else () + fun uu____4184 -> + let uu____4185 = + let uu____4186 = get_err_count () in uu____4186 > (Prims.parse_int "0") in + if uu____4185 then FStar_Exn.raise Stop else () let raise_error: - 'Auu____4187 . + 'Auu____4191 . (raw_error,Prims.string) FStar_Pervasives_Native.tuple2 -> - FStar_Range.range -> 'Auu____4187 + FStar_Range.range -> 'Auu____4191 = - fun uu____4198 -> + fun uu____4202 -> fun r -> - match uu____4198 with | (e,msg) -> FStar_Exn.raise (Error (e, msg, r)) + match uu____4202 with | (e,msg) -> FStar_Exn.raise (Error (e, msg, r)) let raise_err: - 'Auu____4208 . - (raw_error,Prims.string) FStar_Pervasives_Native.tuple2 -> 'Auu____4208 + 'Auu____4212 . + (raw_error,Prims.string) FStar_Pervasives_Native.tuple2 -> 'Auu____4212 = - fun uu____4216 -> - match uu____4216 with | (e,msg) -> FStar_Exn.raise (Err (e, msg)) + fun uu____4220 -> + match uu____4220 with | (e,msg) -> FStar_Exn.raise (Err (e, msg)) let update_flags: (flag,Prims.string) FStar_Pervasives_Native.tuple2 Prims.list -> Prims.unit = fun l -> - let compare1 uu____4259 uu____4260 = - match (uu____4259, uu____4260) with - | ((uu____4293,(a,uu____4295)),(uu____4296,(b,uu____4298))) -> + let compare1 uu____4263 uu____4264 = + match (uu____4263, uu____4264) with + | ((uu____4297,(a,uu____4299)),(uu____4300,(b,uu____4302))) -> if a > b then Prims.parse_int "1" else if a < b then - (Prims.parse_int "1") else Prims.parse_int "0" in @@ -2430,15 +2435,15 @@ let update_flags: | (CSilent ,CError ) -> raise_err (Fatal_InvalidWarnErrorSetting, "cannot silence an error") - | (uu____4332,CFatal ) -> + | (uu____4336,CFatal ) -> raise_err (Fatal_InvalidWarnErrorSetting, "cannot reset the error level of a fatal error") - | uu____4333 -> f in + | uu____4337 -> f in let rec set_flag i l1 = let d = - let uu____4366 = FStar_ST.op_Bang flags in - FStar_List.nth uu____4366 i in + let uu____4370 = FStar_ST.op_Bang flags in + FStar_List.nth uu____4370 i in match l1 with | [] -> d | (f,(l2,h))::tl1 -> @@ -2449,47 +2454,47 @@ let update_flags: match l1 with | [] -> f | hd1::tl1 -> - let uu____4506 = - let uu____4509 = - let uu____4512 = set_flag i sorted1 in [uu____4512] in - FStar_List.append f uu____4509 in - aux uu____4506 (i + (Prims.parse_int "1")) tl1 sorted1 in + let uu____4510 = + let uu____4513 = + let uu____4516 = set_flag i sorted1 in [uu____4516] in + FStar_List.append f uu____4513 in + aux uu____4510 (i + (Prims.parse_int "1")) tl1 sorted1 in let rec compute_range result l1 = match l1 with | [] -> result | (f,s)::tl1 -> let r = FStar_Util.split s ".." in - let uu____4592 = + let uu____4596 = match r with | r1::r2::[] -> - let uu____4603 = FStar_Util.int_of_string r1 in - let uu____4604 = FStar_Util.int_of_string r2 in - (uu____4603, uu____4604) - | uu____4605 -> - let uu____4608 = - let uu____4613 = + let uu____4607 = FStar_Util.int_of_string r1 in + let uu____4608 = FStar_Util.int_of_string r2 in + (uu____4607, uu____4608) + | uu____4609 -> + let uu____4612 = + let uu____4617 = FStar_Util.format1 "Malformed warn-error range %s" s in - (Fatal_InvalidWarnErrorSetting, uu____4613) in - raise_err uu____4608 in - (match uu____4592 with + (Fatal_InvalidWarnErrorSetting, uu____4617) in + raise_err uu____4612 in + (match uu____4596 with | (l2,h) -> (if (l2 < (Prims.parse_int "0")) || (h >= (FStar_List.length default_flags)) then - (let uu____4635 = - let uu____4640 = - let uu____4641 = FStar_Util.string_of_int l2 in - let uu____4642 = FStar_Util.string_of_int h in + (let uu____4639 = + let uu____4644 = + let uu____4645 = FStar_Util.string_of_int l2 in + let uu____4646 = FStar_Util.string_of_int h in FStar_Util.format2 "No error for warn_error %s..%s" - uu____4641 uu____4642 in - (Fatal_InvalidWarnErrorSetting, uu____4640) in - raise_err uu____4635) + uu____4645 uu____4646 in + (Fatal_InvalidWarnErrorSetting, uu____4644) in + raise_err uu____4639) else (); compute_range (FStar_List.append result [(f, (l2, h))]) tl1)) in let range = compute_range [] l in let sorted1 = FStar_List.sortWith compare1 range in - let uu____4710 = - let uu____4713 = FStar_ST.op_Bang flags in - aux [] (Prims.parse_int "0") uu____4713 sorted1 in - FStar_ST.op_Colon_Equals flags uu____4710 \ No newline at end of file + let uu____4714 = + let uu____4717 = FStar_ST.op_Bang flags in + aux [] (Prims.parse_int "0") uu____4717 sorted1 in + FStar_ST.op_Colon_Equals flags uu____4714 \ No newline at end of file diff --git a/src/ocaml-output/FStar_Extraction_Kremlin.ml b/src/ocaml-output/FStar_Extraction_Kremlin.ml index e7ea0ba0846..bbc1d55b92b 100644 --- a/src/ocaml-output/FStar_Extraction_Kremlin.ml +++ b/src/ocaml-output/FStar_Extraction_Kremlin.ml @@ -833,26 +833,26 @@ let add_binders: match uu____2982 with | (name,uu____2988) -> extend env1 name false) env binders let rec translate: FStar_Extraction_ML_Syntax.mllib -> file Prims.list = - fun uu____3131 -> - match uu____3131 with + fun uu____3129 -> + match uu____3129 with | FStar_Extraction_ML_Syntax.MLLib modules -> FStar_List.filter_map (fun m -> let m_name = - let uu____3179 = m in - match uu____3179 with - | (path,uu____3193,uu____3194) -> + let uu____3177 = m in + match uu____3177 with + | (path,uu____3191,uu____3192) -> FStar_Extraction_ML_Syntax.string_of_mlpath path in try FStar_Util.print1 "Attempting to translate module %s\n" m_name; - (let uu____3216 = translate_module m in - FStar_Pervasives_Native.Some uu____3216) + (let uu____3214 = translate_module m in + FStar_Pervasives_Native.Some uu____3214) with | e -> - ((let uu____3225 = FStar_Util.print_exn e in + ((let uu____3223 = FStar_Util.print_exn e in FStar_Util.print2 "Unable to translate module: %s because:\n %s\n" m_name - uu____3225); + uu____3223); FStar_Pervasives_Native.None)) modules and translate_module: (FStar_Extraction_ML_Syntax.mlpath,(FStar_Extraction_ML_Syntax.mlsig, @@ -862,9 +862,9 @@ and translate_module: FStar_Extraction_ML_Syntax.mllib) FStar_Pervasives_Native.tuple3 -> file = - fun uu____3226 -> - match uu____3226 with - | (module_name,modul,uu____3241) -> + fun uu____3224 -> + match uu____3224 with + | (module_name,modul,uu____3239) -> let module_name1 = FStar_List.append (FStar_Pervasives_Native.fst module_name) [FStar_Pervasives_Native.snd module_name] in @@ -872,15 +872,15 @@ and translate_module: match modul with | FStar_Pervasives_Native.Some (_signature,decls) -> FStar_List.collect (translate_decl (empty module_name1)) decls - | uu____3272 -> + | uu____3270 -> failwith "Unexpected standalone interface or nested modules" in ((FStar_String.concat "_" module_name1), program) and translate_flags: FStar_Extraction_ML_Syntax.meta Prims.list -> flag Prims.list = fun flags1 -> FStar_List.choose - (fun uu___36_3287 -> - match uu___36_3287 with + (fun uu___36_3285 -> + match uu___36_3285 with | FStar_Extraction_ML_Syntax.Private -> FStar_Pervasives_Native.Some Private | FStar_Extraction_ML_Syntax.NoExtract -> @@ -893,286 +893,287 @@ and translate_flags: FStar_Pervasives_Native.Some GCType | FStar_Extraction_ML_Syntax.Comment s -> FStar_Pervasives_Native.Some (Comment s) - | uu____3291 -> FStar_Pervasives_Native.None) flags1 + | FStar_Extraction_ML_Syntax.StackInline -> + FStar_Pervasives_Native.Some MustDisappear + | uu____3289 -> FStar_Pervasives_Native.None) flags1 and translate_decl: env -> FStar_Extraction_ML_Syntax.mlmodule1 -> decl Prims.list = fun env -> fun d -> match d with - | FStar_Extraction_ML_Syntax.MLM_Let (flavor,flags1,lbs) -> - FStar_List.choose (translate_let env flavor flags1) lbs - | FStar_Extraction_ML_Syntax.MLM_Loc uu____3303 -> [] + | FStar_Extraction_ML_Syntax.MLM_Let (flavor,lbs) -> + FStar_List.choose (translate_let env flavor) lbs + | FStar_Extraction_ML_Syntax.MLM_Loc uu____3300 -> [] | FStar_Extraction_ML_Syntax.MLM_Ty tys -> FStar_List.choose (translate_type_decl env) tys - | FStar_Extraction_ML_Syntax.MLM_Top uu____3305 -> + | FStar_Extraction_ML_Syntax.MLM_Top uu____3302 -> failwith "todo: translate_decl [MLM_Top]" - | FStar_Extraction_ML_Syntax.MLM_Exn (m,uu____3309) -> + | FStar_Extraction_ML_Syntax.MLM_Exn (m,uu____3306) -> (FStar_Util.print1_warning "Skipping the translation of exception: %s\n" m; []) and translate_let: env -> FStar_Extraction_ML_Syntax.mlletflavor -> - FStar_Extraction_ML_Syntax.metadata -> - FStar_Extraction_ML_Syntax.mllb -> - decl FStar_Pervasives_Native.option + FStar_Extraction_ML_Syntax.mllb -> decl FStar_Pervasives_Native.option = fun env -> fun flavor -> - fun flags1 -> - fun lb -> - match lb with - | { FStar_Extraction_ML_Syntax.mllb_name = name; - FStar_Extraction_ML_Syntax.mllb_tysc = - FStar_Pervasives_Native.Some (tvars,t0); - FStar_Extraction_ML_Syntax.mllb_add_unit = uu____3332; - FStar_Extraction_ML_Syntax.mllb_def = - { - FStar_Extraction_ML_Syntax.expr = - FStar_Extraction_ML_Syntax.MLE_Fun (args,body); - FStar_Extraction_ML_Syntax.mlty = uu____3335; - FStar_Extraction_ML_Syntax.loc = uu____3336;_}; - FStar_Extraction_ML_Syntax.print_typ = uu____3337;_} -> - let assumed = - FStar_Util.for_some - (fun uu___37_3356 -> - match uu___37_3356 with - | FStar_Extraction_ML_Syntax.Assumed -> true - | uu____3357 -> false) flags1 in - let env1 = - if flavor = FStar_Extraction_ML_Syntax.Rec - then extend env name false - else env in - let env2 = - FStar_List.fold_left - (fun env2 -> fun name1 -> extend_t env2 name1) env1 tvars in - let rec find_return_type eff i uu___38_3378 = - match uu___38_3378 with - | FStar_Extraction_ML_Syntax.MLTY_Fun (uu____3383,eff1,t) - when i > (Prims.parse_int "0") -> - find_return_type eff1 (i - (Prims.parse_int "1")) t - | t -> (eff, t) in - let uu____3387 = - find_return_type FStar_Extraction_ML_Syntax.E_PURE - (FStar_List.length args) t0 in - (match uu____3387 with - | (eff,t) -> - let t1 = translate_type env2 t in - let binders = translate_binders env2 args in - let env3 = add_binders env2 args in - let name1 = ((env3.module_name), name) in - let flags2 = - match (eff, t1) with - | (FStar_Extraction_ML_Syntax.E_GHOST ,uu____3419) -> - let uu____3420 = translate_flags flags1 in - MustDisappear :: uu____3420 - | (FStar_Extraction_ML_Syntax.E_PURE ,TUnit ) -> - let uu____3423 = translate_flags flags1 in - MustDisappear :: uu____3423 - | uu____3426 -> translate_flags flags1 in - if assumed - then - (if (FStar_List.length tvars) = (Prims.parse_int "0") - then - let uu____3435 = - let uu____3436 = - let uu____3455 = translate_type env3 t0 in - (FStar_Pervasives_Native.None, flags2, name1, - uu____3455) in - DExternal uu____3436 in - FStar_Pervasives_Native.Some uu____3435 - else - ((let uu____3468 = - FStar_Extraction_ML_Syntax.string_of_mlpath name1 in - FStar_Util.print1_warning - "No writing anything for %s (polymorphic assume)\n" - uu____3468); - FStar_Pervasives_Native.None)) - else - (try - let body1 = translate_expr env3 body in - FStar_Pervasives_Native.Some - (DFunction - (FStar_Pervasives_Native.None, flags2, - (FStar_List.length tvars), t1, name1, binders, - body1)) - with - | e -> - let msg = FStar_Util.print_exn e in - ((let uu____3501 = - let uu____3506 = - let uu____3507 = - FStar_Extraction_ML_Syntax.string_of_mlpath - name1 in - FStar_Util.format2 - "Writing a stub for %s (%s)\n" uu____3507 - msg in - (FStar_Errors.Warning_FunctionNotExtacted, - uu____3506) in - FStar_Errors.log_issue FStar_Range.dummyRange - uu____3501); - (let msg1 = - Prims.strcat - "This function was not extracted:\n" msg in - FStar_Pervasives_Native.Some - (DFunction - (FStar_Pervasives_Native.None, flags2, - (FStar_List.length tvars), t1, name1, - binders, (EAbortS msg1))))))) - | { FStar_Extraction_ML_Syntax.mllb_name = name; - FStar_Extraction_ML_Syntax.mllb_tysc = - FStar_Pervasives_Native.Some (tvars,t0); - FStar_Extraction_ML_Syntax.mllb_add_unit = uu____3524; - FStar_Extraction_ML_Syntax.mllb_def = - { - FStar_Extraction_ML_Syntax.expr = - FStar_Extraction_ML_Syntax.MLE_Coerce - ({ - FStar_Extraction_ML_Syntax.expr = - FStar_Extraction_ML_Syntax.MLE_Fun (args,body); - FStar_Extraction_ML_Syntax.mlty = uu____3527; - FStar_Extraction_ML_Syntax.loc = uu____3528;_},uu____3529,uu____3530); - FStar_Extraction_ML_Syntax.mlty = uu____3531; - FStar_Extraction_ML_Syntax.loc = uu____3532;_}; - FStar_Extraction_ML_Syntax.print_typ = uu____3533;_} -> - let assumed = - FStar_Util.for_some - (fun uu___37_3552 -> - match uu___37_3552 with - | FStar_Extraction_ML_Syntax.Assumed -> true - | uu____3553 -> false) flags1 in - let env1 = - if flavor = FStar_Extraction_ML_Syntax.Rec - then extend env name false - else env in - let env2 = - FStar_List.fold_left - (fun env2 -> fun name1 -> extend_t env2 name1) env1 tvars in - let rec find_return_type eff i uu___38_3574 = - match uu___38_3574 with - | FStar_Extraction_ML_Syntax.MLTY_Fun (uu____3579,eff1,t) - when i > (Prims.parse_int "0") -> - find_return_type eff1 (i - (Prims.parse_int "1")) t - | t -> (eff, t) in - let uu____3583 = - find_return_type FStar_Extraction_ML_Syntax.E_PURE - (FStar_List.length args) t0 in - (match uu____3583 with - | (eff,t) -> - let t1 = translate_type env2 t in - let binders = translate_binders env2 args in - let env3 = add_binders env2 args in - let name1 = ((env3.module_name), name) in - let flags2 = - match (eff, t1) with - | (FStar_Extraction_ML_Syntax.E_GHOST ,uu____3615) -> - let uu____3616 = translate_flags flags1 in - MustDisappear :: uu____3616 - | (FStar_Extraction_ML_Syntax.E_PURE ,TUnit ) -> - let uu____3619 = translate_flags flags1 in - MustDisappear :: uu____3619 - | uu____3622 -> translate_flags flags1 in - if assumed - then - (if (FStar_List.length tvars) = (Prims.parse_int "0") - then - let uu____3631 = - let uu____3632 = - let uu____3651 = translate_type env3 t0 in - (FStar_Pervasives_Native.None, flags2, name1, - uu____3651) in - DExternal uu____3632 in - FStar_Pervasives_Native.Some uu____3631 - else - ((let uu____3664 = - FStar_Extraction_ML_Syntax.string_of_mlpath name1 in - FStar_Util.print1_warning - "No writing anything for %s (polymorphic assume)\n" - uu____3664); - FStar_Pervasives_Native.None)) - else - (try - let body1 = translate_expr env3 body in - FStar_Pervasives_Native.Some - (DFunction - (FStar_Pervasives_Native.None, flags2, - (FStar_List.length tvars), t1, name1, binders, - body1)) - with - | e -> - let msg = FStar_Util.print_exn e in - ((let uu____3697 = - let uu____3702 = - let uu____3703 = - FStar_Extraction_ML_Syntax.string_of_mlpath - name1 in - FStar_Util.format2 - "Writing a stub for %s (%s)\n" uu____3703 - msg in - (FStar_Errors.Warning_FunctionNotExtacted, - uu____3702) in - FStar_Errors.log_issue FStar_Range.dummyRange - uu____3697); - (let msg1 = - Prims.strcat - "This function was not extracted:\n" msg in - FStar_Pervasives_Native.Some - (DFunction - (FStar_Pervasives_Native.None, flags2, - (FStar_List.length tvars), t1, name1, - binders, (EAbortS msg1))))))) - | { FStar_Extraction_ML_Syntax.mllb_name = name; - FStar_Extraction_ML_Syntax.mllb_tysc = - FStar_Pervasives_Native.Some (tvars,t); - FStar_Extraction_ML_Syntax.mllb_add_unit = uu____3720; - FStar_Extraction_ML_Syntax.mllb_def = expr; - FStar_Extraction_ML_Syntax.print_typ = uu____3722;_} -> - let flags2 = translate_flags flags1 in - let env1 = - FStar_List.fold_left - (fun env1 -> fun name1 -> extend_t env1 name1) env tvars in - let t1 = translate_type env1 t in - let name1 = ((env1.module_name), name) in - (try - let expr1 = translate_expr env1 expr in - FStar_Pervasives_Native.Some - (DGlobal - (flags2, name1, (FStar_List.length tvars), t1, expr1)) - with - | e -> - ((let uu____3769 = + fun lb -> + match lb with + | { FStar_Extraction_ML_Syntax.mllb_name = name; + FStar_Extraction_ML_Syntax.mllb_tysc = + FStar_Pervasives_Native.Some (tvars,t0); + FStar_Extraction_ML_Syntax.mllb_add_unit = uu____3328; + FStar_Extraction_ML_Syntax.mllb_def = + { + FStar_Extraction_ML_Syntax.expr = + FStar_Extraction_ML_Syntax.MLE_Fun (args,body); + FStar_Extraction_ML_Syntax.mlty = uu____3331; + FStar_Extraction_ML_Syntax.loc = uu____3332;_}; + FStar_Extraction_ML_Syntax.mllb_meta = meta; + FStar_Extraction_ML_Syntax.print_typ = uu____3334;_} -> + let assumed = + FStar_Util.for_some + (fun uu___37_3353 -> + match uu___37_3353 with + | FStar_Extraction_ML_Syntax.Assumed -> true + | uu____3354 -> false) meta in + let env1 = + if flavor = FStar_Extraction_ML_Syntax.Rec + then extend env name false + else env in + let env2 = + FStar_List.fold_left + (fun env2 -> fun name1 -> extend_t env2 name1) env1 tvars in + let rec find_return_type eff i uu___38_3375 = + match uu___38_3375 with + | FStar_Extraction_ML_Syntax.MLTY_Fun (uu____3380,eff1,t) when + i > (Prims.parse_int "0") -> + find_return_type eff1 (i - (Prims.parse_int "1")) t + | t -> (eff, t) in + let uu____3384 = + find_return_type FStar_Extraction_ML_Syntax.E_PURE + (FStar_List.length args) t0 in + (match uu____3384 with + | (eff,t) -> + let t1 = translate_type env2 t in + let binders = translate_binders env2 args in + let env3 = add_binders env2 args in + let name1 = ((env3.module_name), name) in + let meta1 = + match (eff, t1) with + | (FStar_Extraction_ML_Syntax.E_GHOST ,uu____3416) -> + let uu____3417 = translate_flags meta in MustDisappear + :: uu____3417 + | (FStar_Extraction_ML_Syntax.E_PURE ,TUnit ) -> + let uu____3420 = translate_flags meta in MustDisappear + :: uu____3420 + | uu____3423 -> translate_flags meta in + if assumed + then + (if (FStar_List.length tvars) = (Prims.parse_int "0") + then + let uu____3432 = + let uu____3433 = + let uu____3452 = translate_type env3 t0 in + (FStar_Pervasives_Native.None, meta1, name1, + uu____3452) in + DExternal uu____3433 in + FStar_Pervasives_Native.Some uu____3432 + else + ((let uu____3465 = + FStar_Extraction_ML_Syntax.string_of_mlpath name1 in + FStar_Util.print1_warning + "No writing anything for %s (polymorphic assume)\n" + uu____3465); + FStar_Pervasives_Native.None)) + else + (try + let body1 = translate_expr env3 body in + FStar_Pervasives_Native.Some + (DFunction + (FStar_Pervasives_Native.None, meta1, + (FStar_List.length tvars), t1, name1, binders, + body1)) + with + | e -> + let msg = FStar_Util.print_exn e in + ((let uu____3498 = + let uu____3503 = + let uu____3504 = + FStar_Extraction_ML_Syntax.string_of_mlpath + name1 in + FStar_Util.format2 + "Writing a stub for %s (%s)\n" uu____3504 msg in + (FStar_Errors.Warning_FunctionNotExtacted, + uu____3503) in + FStar_Errors.log_issue FStar_Range.dummyRange + uu____3498); + (let msg1 = + Prims.strcat "This function was not extracted:\n" + msg in + FStar_Pervasives_Native.Some + (DFunction + (FStar_Pervasives_Native.None, meta1, + (FStar_List.length tvars), t1, name1, + binders, (EAbortS msg1))))))) + | { FStar_Extraction_ML_Syntax.mllb_name = name; + FStar_Extraction_ML_Syntax.mllb_tysc = + FStar_Pervasives_Native.Some (tvars,t0); + FStar_Extraction_ML_Syntax.mllb_add_unit = uu____3521; + FStar_Extraction_ML_Syntax.mllb_def = + { + FStar_Extraction_ML_Syntax.expr = + FStar_Extraction_ML_Syntax.MLE_Coerce + ({ + FStar_Extraction_ML_Syntax.expr = + FStar_Extraction_ML_Syntax.MLE_Fun (args,body); + FStar_Extraction_ML_Syntax.mlty = uu____3524; + FStar_Extraction_ML_Syntax.loc = uu____3525;_},uu____3526,uu____3527); + FStar_Extraction_ML_Syntax.mlty = uu____3528; + FStar_Extraction_ML_Syntax.loc = uu____3529;_}; + FStar_Extraction_ML_Syntax.mllb_meta = meta; + FStar_Extraction_ML_Syntax.print_typ = uu____3531;_} -> + let assumed = + FStar_Util.for_some + (fun uu___37_3550 -> + match uu___37_3550 with + | FStar_Extraction_ML_Syntax.Assumed -> true + | uu____3551 -> false) meta in + let env1 = + if flavor = FStar_Extraction_ML_Syntax.Rec + then extend env name false + else env in + let env2 = + FStar_List.fold_left + (fun env2 -> fun name1 -> extend_t env2 name1) env1 tvars in + let rec find_return_type eff i uu___38_3572 = + match uu___38_3572 with + | FStar_Extraction_ML_Syntax.MLTY_Fun (uu____3577,eff1,t) when + i > (Prims.parse_int "0") -> + find_return_type eff1 (i - (Prims.parse_int "1")) t + | t -> (eff, t) in + let uu____3581 = + find_return_type FStar_Extraction_ML_Syntax.E_PURE + (FStar_List.length args) t0 in + (match uu____3581 with + | (eff,t) -> + let t1 = translate_type env2 t in + let binders = translate_binders env2 args in + let env3 = add_binders env2 args in + let name1 = ((env3.module_name), name) in + let meta1 = + match (eff, t1) with + | (FStar_Extraction_ML_Syntax.E_GHOST ,uu____3613) -> + let uu____3614 = translate_flags meta in MustDisappear + :: uu____3614 + | (FStar_Extraction_ML_Syntax.E_PURE ,TUnit ) -> + let uu____3617 = translate_flags meta in MustDisappear + :: uu____3617 + | uu____3620 -> translate_flags meta in + if assumed + then + (if (FStar_List.length tvars) = (Prims.parse_int "0") + then + let uu____3629 = + let uu____3630 = + let uu____3649 = translate_type env3 t0 in + (FStar_Pervasives_Native.None, meta1, name1, + uu____3649) in + DExternal uu____3630 in + FStar_Pervasives_Native.Some uu____3629 + else + ((let uu____3662 = + FStar_Extraction_ML_Syntax.string_of_mlpath name1 in + FStar_Util.print1_warning + "No writing anything for %s (polymorphic assume)\n" + uu____3662); + FStar_Pervasives_Native.None)) + else + (try + let body1 = translate_expr env3 body in + FStar_Pervasives_Native.Some + (DFunction + (FStar_Pervasives_Native.None, meta1, + (FStar_List.length tvars), t1, name1, binders, + body1)) + with + | e -> + let msg = FStar_Util.print_exn e in + ((let uu____3695 = + let uu____3700 = + let uu____3701 = + FStar_Extraction_ML_Syntax.string_of_mlpath + name1 in + FStar_Util.format2 + "Writing a stub for %s (%s)\n" uu____3701 msg in + (FStar_Errors.Warning_FunctionNotExtacted, + uu____3700) in + FStar_Errors.log_issue FStar_Range.dummyRange + uu____3695); + (let msg1 = + Prims.strcat "This function was not extracted:\n" + msg in + FStar_Pervasives_Native.Some + (DFunction + (FStar_Pervasives_Native.None, meta1, + (FStar_List.length tvars), t1, name1, + binders, (EAbortS msg1))))))) + | { FStar_Extraction_ML_Syntax.mllb_name = name; + FStar_Extraction_ML_Syntax.mllb_tysc = + FStar_Pervasives_Native.Some (tvars,t); + FStar_Extraction_ML_Syntax.mllb_add_unit = uu____3718; + FStar_Extraction_ML_Syntax.mllb_def = expr; + FStar_Extraction_ML_Syntax.mllb_meta = meta; + FStar_Extraction_ML_Syntax.print_typ = uu____3721;_} -> + let meta1 = translate_flags meta in + let env1 = + FStar_List.fold_left + (fun env1 -> fun name1 -> extend_t env1 name1) env tvars in + let t1 = translate_type env1 t in + let name1 = ((env1.module_name), name) in + (try + let expr1 = translate_expr env1 expr in + FStar_Pervasives_Native.Some + (DGlobal + (meta1, name1, (FStar_List.length tvars), t1, expr1)) + with + | e -> + ((let uu____3768 = + let uu____3773 = let uu____3774 = - let uu____3775 = - FStar_Extraction_ML_Syntax.string_of_mlpath name1 in - let uu____3776 = FStar_Util.print_exn e in - FStar_Util.format2 - "Not translating definition for %s (%s)\n" - uu____3775 uu____3776 in - (FStar_Errors.Warning_DefinitionNotTranslated, - uu____3774) in - FStar_Errors.log_issue FStar_Range.dummyRange uu____3769); - FStar_Pervasives_Native.Some - (DGlobal - (flags2, name1, (FStar_List.length tvars), t1, EAny)))) - | { FStar_Extraction_ML_Syntax.mllb_name = name; - FStar_Extraction_ML_Syntax.mllb_tysc = ts; - FStar_Extraction_ML_Syntax.mllb_add_unit = uu____3787; - FStar_Extraction_ML_Syntax.mllb_def = uu____3788; - FStar_Extraction_ML_Syntax.print_typ = uu____3789;_} -> - ((let uu____3793 = - let uu____3798 = - FStar_Util.format1 "Not translating definition for %s\n" - name in - (FStar_Errors.Warning_DefinitionNotTranslated, uu____3798) in - FStar_Errors.log_issue FStar_Range.dummyRange uu____3793); - (match ts with - | FStar_Pervasives_Native.Some (idents,t) -> - let uu____3806 = - FStar_Extraction_ML_Code.string_of_mlty ([], "") t in - FStar_Util.print2 "Type scheme is: forall %s. %s\n" - (FStar_String.concat ", " idents) uu____3806 - | FStar_Pervasives_Native.None -> ()); - FStar_Pervasives_Native.None) + FStar_Extraction_ML_Syntax.string_of_mlpath name1 in + let uu____3775 = FStar_Util.print_exn e in + FStar_Util.format2 + "Not translating definition for %s (%s)\n" + uu____3774 uu____3775 in + (FStar_Errors.Warning_DefinitionNotTranslated, + uu____3773) in + FStar_Errors.log_issue FStar_Range.dummyRange uu____3768); + FStar_Pervasives_Native.Some + (DGlobal + (meta1, name1, (FStar_List.length tvars), t1, EAny)))) + | { FStar_Extraction_ML_Syntax.mllb_name = name; + FStar_Extraction_ML_Syntax.mllb_tysc = ts; + FStar_Extraction_ML_Syntax.mllb_add_unit = uu____3786; + FStar_Extraction_ML_Syntax.mllb_def = uu____3787; + FStar_Extraction_ML_Syntax.mllb_meta = uu____3788; + FStar_Extraction_ML_Syntax.print_typ = uu____3789;_} -> + ((let uu____3793 = + let uu____3798 = + FStar_Util.format1 "Not translating definition for %s\n" + name in + (FStar_Errors.Warning_DefinitionNotTranslated, uu____3798) in + FStar_Errors.log_issue FStar_Range.dummyRange uu____3793); + (match ts with + | FStar_Pervasives_Native.Some (idents,t) -> + let uu____3806 = + FStar_Extraction_ML_Code.string_of_mlty ([], "") t in + FStar_Util.print2 "Type scheme is: forall %s. %s\n" + (FStar_String.concat ", " idents) uu____3806 + | FStar_Pervasives_Native.None -> ()); + FStar_Pervasives_Native.None) and translate_type_decl: env -> FStar_Extraction_ML_Syntax.one_mltydecl -> @@ -1446,64 +1447,64 @@ and translate_expr: env -> FStar_Extraction_ML_Syntax.mlexpr -> expr = EOp uu____4520 | FStar_Extraction_ML_Syntax.MLE_Name n1 -> EQualified n1 | FStar_Extraction_ML_Syntax.MLE_Let - ((flavor,flags1,{ FStar_Extraction_ML_Syntax.mllb_name = name; - FStar_Extraction_ML_Syntax.mllb_tysc = - FStar_Pervasives_Native.Some ([],typ); - FStar_Extraction_ML_Syntax.mllb_add_unit = - add_unit; - FStar_Extraction_ML_Syntax.mllb_def = body; - FStar_Extraction_ML_Syntax.print_typ = print7;_}::[]),continuation) + ((flavor,{ FStar_Extraction_ML_Syntax.mllb_name = name; + FStar_Extraction_ML_Syntax.mllb_tysc = + FStar_Pervasives_Native.Some ([],typ); + FStar_Extraction_ML_Syntax.mllb_add_unit = add_unit; + FStar_Extraction_ML_Syntax.mllb_def = body; + FStar_Extraction_ML_Syntax.mllb_meta = flags1; + FStar_Extraction_ML_Syntax.print_typ = print7;_}::[]),continuation) -> let is_mut = FStar_Util.for_some - (fun uu___39_4555 -> - match uu___39_4555 with + (fun uu___39_4553 -> + match uu___39_4553 with | FStar_Extraction_ML_Syntax.Mutable -> true - | uu____4556 -> false) flags1 in - let uu____4557 = + | uu____4554 -> false) flags1 in + let uu____4555 = if is_mut then - let uu____4566 = + let uu____4564 = match typ with | FStar_Extraction_ML_Syntax.MLTY_Named (t::[],p) when - let uu____4571 = + let uu____4569 = FStar_Extraction_ML_Syntax.string_of_mlpath p in - uu____4571 = "FStar.ST.stackref" -> t - | uu____4572 -> - let uu____4573 = - let uu____4574 = + uu____4569 = "FStar.ST.stackref" -> t + | uu____4570 -> + let uu____4571 = + let uu____4572 = FStar_Extraction_ML_Code.string_of_mlty ([], "") typ in FStar_Util.format1 "unexpected: bad desugaring of Mutable (typ is %s)" - uu____4574 in - failwith uu____4573 in - let uu____4577 = + uu____4572 in + failwith uu____4571 in + let uu____4575 = match body with | { FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_App - (uu____4578,body1::[]); - FStar_Extraction_ML_Syntax.mlty = uu____4580; - FStar_Extraction_ML_Syntax.loc = uu____4581;_} -> body1 - | uu____4584 -> + (uu____4576,body1::[]); + FStar_Extraction_ML_Syntax.mlty = uu____4578; + FStar_Extraction_ML_Syntax.loc = uu____4579;_} -> body1 + | uu____4582 -> failwith "unexpected: bad desugaring of Mutable" in - (uu____4566, uu____4577) + (uu____4564, uu____4575) else (typ, body) in - (match uu____4557 with + (match uu____4555 with | (typ1,body1) -> let binder = - let uu____4589 = translate_type env typ1 in - { name; typ = uu____4589; mut = is_mut } in + let uu____4587 = translate_type env typ1 in + { name; typ = uu____4587; mut = is_mut } in let body2 = translate_expr env body1 in let env1 = extend env name is_mut in let continuation1 = translate_expr env1 continuation in ELet (binder, body2, continuation1)) | FStar_Extraction_ML_Syntax.MLE_Match (expr,branches) -> - let uu____4615 = - let uu____4626 = translate_expr env expr in - let uu____4627 = translate_branches env branches in - (uu____4626, uu____4627) in - EMatch uu____4615 + let uu____4613 = + let uu____4624 = translate_expr env expr in + let uu____4625 = translate_branches env branches in + (uu____4624, uu____4625) in + EMatch uu____4613 | FStar_Extraction_ML_Syntax.MLE_App ({ FStar_Extraction_ML_Syntax.expr = @@ -1511,56 +1512,56 @@ and translate_expr: env -> FStar_Extraction_ML_Syntax.mlexpr -> expr = ({ FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Name p; - FStar_Extraction_ML_Syntax.mlty = uu____4641; - FStar_Extraction_ML_Syntax.loc = uu____4642;_},uu____4643); - FStar_Extraction_ML_Syntax.mlty = uu____4644; - FStar_Extraction_ML_Syntax.loc = uu____4645;_},uu____4646) + FStar_Extraction_ML_Syntax.mlty = uu____4639; + FStar_Extraction_ML_Syntax.loc = uu____4640;_},uu____4641); + FStar_Extraction_ML_Syntax.mlty = uu____4642; + FStar_Extraction_ML_Syntax.loc = uu____4643;_},uu____4644) when - let uu____4655 = FStar_Extraction_ML_Syntax.string_of_mlpath p in - uu____4655 = "Prims.admit" -> EAbort + let uu____4653 = FStar_Extraction_ML_Syntax.string_of_mlpath p in + uu____4653 = "Prims.admit" -> EAbort | FStar_Extraction_ML_Syntax.MLE_App ({ FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Name p; - FStar_Extraction_ML_Syntax.mlty = uu____4657; - FStar_Extraction_ML_Syntax.loc = uu____4658;_},{ + FStar_Extraction_ML_Syntax.mlty = uu____4655; + FStar_Extraction_ML_Syntax.loc = uu____4656;_},{ FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Var v1; FStar_Extraction_ML_Syntax.mlty - = uu____4660; + = uu____4658; FStar_Extraction_ML_Syntax.loc - = uu____4661;_}::[]) + = uu____4659;_}::[]) when - (let uu____4666 = FStar_Extraction_ML_Syntax.string_of_mlpath p in - uu____4666 = "FStar.HyperStack.ST.op_Bang") && (is_mutable env v1) - -> let uu____4667 = find env v1 in EBound uu____4667 + (let uu____4664 = FStar_Extraction_ML_Syntax.string_of_mlpath p in + uu____4664 = "FStar.HyperStack.ST.op_Bang") && (is_mutable env v1) + -> let uu____4665 = find env v1 in EBound uu____4665 | FStar_Extraction_ML_Syntax.MLE_App ({ FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Name p; - FStar_Extraction_ML_Syntax.mlty = uu____4669; - FStar_Extraction_ML_Syntax.loc = uu____4670;_},{ + FStar_Extraction_ML_Syntax.mlty = uu____4667; + FStar_Extraction_ML_Syntax.loc = uu____4668;_},{ FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Var v1; FStar_Extraction_ML_Syntax.mlty - = uu____4672; + = uu____4670; FStar_Extraction_ML_Syntax.loc - = uu____4673;_}::e1::[]) + = uu____4671;_}::e1::[]) when - (let uu____4679 = FStar_Extraction_ML_Syntax.string_of_mlpath p in - uu____4679 = "FStar.HyperStack.ST.op_Colon_Equals") && + (let uu____4677 = FStar_Extraction_ML_Syntax.string_of_mlpath p in + uu____4677 = "FStar.HyperStack.ST.op_Colon_Equals") && (is_mutable env v1) -> - let uu____4680 = - let uu____4685 = - let uu____4686 = find env v1 in EBound uu____4686 in - let uu____4687 = translate_expr env e1 in - (uu____4685, uu____4687) in - EAssign uu____4680 + let uu____4678 = + let uu____4683 = + let uu____4684 = find env v1 in EBound uu____4684 in + let uu____4685 = translate_expr env e1 in + (uu____4683, uu____4685) in + EAssign uu____4678 | FStar_Extraction_ML_Syntax.MLE_App ({ FStar_Extraction_ML_Syntax.expr = @@ -1568,21 +1569,21 @@ and translate_expr: env -> FStar_Extraction_ML_Syntax.mlexpr -> expr = ({ FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Name p; - FStar_Extraction_ML_Syntax.mlty = uu____4689; - FStar_Extraction_ML_Syntax.loc = uu____4690;_},uu____4691); - FStar_Extraction_ML_Syntax.mlty = uu____4692; - FStar_Extraction_ML_Syntax.loc = uu____4693;_},e1::e2::[]) + FStar_Extraction_ML_Syntax.mlty = uu____4687; + FStar_Extraction_ML_Syntax.loc = uu____4688;_},uu____4689); + FStar_Extraction_ML_Syntax.mlty = uu____4690; + FStar_Extraction_ML_Syntax.loc = uu____4691;_},e1::e2::[]) when - (let uu____4704 = FStar_Extraction_ML_Syntax.string_of_mlpath p in - uu____4704 = "FStar.Buffer.index") || - (let uu____4706 = FStar_Extraction_ML_Syntax.string_of_mlpath p in - uu____4706 = "FStar.Buffer.op_Array_Access") + (let uu____4702 = FStar_Extraction_ML_Syntax.string_of_mlpath p in + uu____4702 = "FStar.Buffer.index") || + (let uu____4704 = FStar_Extraction_ML_Syntax.string_of_mlpath p in + uu____4704 = "FStar.Buffer.op_Array_Access") -> - let uu____4707 = - let uu____4712 = translate_expr env e1 in - let uu____4713 = translate_expr env e2 in - (uu____4712, uu____4713) in - EBufRead uu____4707 + let uu____4705 = + let uu____4710 = translate_expr env e1 in + let uu____4711 = translate_expr env e2 in + (uu____4710, uu____4711) in + EBufRead uu____4705 | FStar_Extraction_ML_Syntax.MLE_App ({ FStar_Extraction_ML_Syntax.expr = @@ -1590,17 +1591,17 @@ and translate_expr: env -> FStar_Extraction_ML_Syntax.mlexpr -> expr = ({ FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Name p; - FStar_Extraction_ML_Syntax.mlty = uu____4715; - FStar_Extraction_ML_Syntax.loc = uu____4716;_},uu____4717); - FStar_Extraction_ML_Syntax.mlty = uu____4718; - FStar_Extraction_ML_Syntax.loc = uu____4719;_},e1::[]) + FStar_Extraction_ML_Syntax.mlty = uu____4713; + FStar_Extraction_ML_Syntax.loc = uu____4714;_},uu____4715); + FStar_Extraction_ML_Syntax.mlty = uu____4716; + FStar_Extraction_ML_Syntax.loc = uu____4717;_},e1::[]) when - let uu____4727 = FStar_Extraction_ML_Syntax.string_of_mlpath p in - uu____4727 = "FStar.HyperStack.ST.op_Bang" -> - let uu____4728 = - let uu____4733 = translate_expr env e1 in - (uu____4733, (EConstant (UInt32, "0"))) in - EBufRead uu____4728 + let uu____4725 = FStar_Extraction_ML_Syntax.string_of_mlpath p in + uu____4725 = "FStar.HyperStack.ST.op_Bang" -> + let uu____4726 = + let uu____4731 = translate_expr env e1 in + (uu____4731, (EConstant (UInt32, "0"))) in + EBufRead uu____4726 | FStar_Extraction_ML_Syntax.MLE_App ({ FStar_Extraction_ML_Syntax.expr = @@ -1608,18 +1609,18 @@ and translate_expr: env -> FStar_Extraction_ML_Syntax.mlexpr -> expr = ({ FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Name p; - FStar_Extraction_ML_Syntax.mlty = uu____4735; - FStar_Extraction_ML_Syntax.loc = uu____4736;_},uu____4737); - FStar_Extraction_ML_Syntax.mlty = uu____4738; - FStar_Extraction_ML_Syntax.loc = uu____4739;_},e1::e2::[]) + FStar_Extraction_ML_Syntax.mlty = uu____4733; + FStar_Extraction_ML_Syntax.loc = uu____4734;_},uu____4735); + FStar_Extraction_ML_Syntax.mlty = uu____4736; + FStar_Extraction_ML_Syntax.loc = uu____4737;_},e1::e2::[]) when - let uu____4748 = FStar_Extraction_ML_Syntax.string_of_mlpath p in - uu____4748 = "FStar.Buffer.create" -> - let uu____4749 = - let uu____4756 = translate_expr env e1 in - let uu____4757 = translate_expr env e2 in - (Stack, uu____4756, uu____4757) in - EBufCreate uu____4749 + let uu____4746 = FStar_Extraction_ML_Syntax.string_of_mlpath p in + uu____4746 = "FStar.Buffer.create" -> + let uu____4747 = + let uu____4754 = translate_expr env e1 in + let uu____4755 = translate_expr env e2 in + (Stack, uu____4754, uu____4755) in + EBufCreate uu____4747 | FStar_Extraction_ML_Syntax.MLE_App ({ FStar_Extraction_ML_Syntax.expr = @@ -1627,17 +1628,17 @@ and translate_expr: env -> FStar_Extraction_ML_Syntax.mlexpr -> expr = ({ FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Name p; - FStar_Extraction_ML_Syntax.mlty = uu____4759; - FStar_Extraction_ML_Syntax.loc = uu____4760;_},uu____4761); - FStar_Extraction_ML_Syntax.mlty = uu____4762; - FStar_Extraction_ML_Syntax.loc = uu____4763;_},_rid::init1::[]) + FStar_Extraction_ML_Syntax.mlty = uu____4757; + FStar_Extraction_ML_Syntax.loc = uu____4758;_},uu____4759); + FStar_Extraction_ML_Syntax.mlty = uu____4760; + FStar_Extraction_ML_Syntax.loc = uu____4761;_},_rid::init1::[]) when - let uu____4772 = FStar_Extraction_ML_Syntax.string_of_mlpath p in - uu____4772 = "FStar.HyperStack.ST.ralloc" -> - let uu____4773 = - let uu____4780 = translate_expr env init1 in - (Eternal, uu____4780, (EConstant (UInt32, "1"))) in - EBufCreate uu____4773 + let uu____4770 = FStar_Extraction_ML_Syntax.string_of_mlpath p in + uu____4770 = "FStar.HyperStack.ST.ralloc" -> + let uu____4771 = + let uu____4778 = translate_expr env init1 in + (Eternal, uu____4778, (EConstant (UInt32, "1"))) in + EBufCreate uu____4771 | FStar_Extraction_ML_Syntax.MLE_App ({ FStar_Extraction_ML_Syntax.expr = @@ -1645,18 +1646,18 @@ and translate_expr: env -> FStar_Extraction_ML_Syntax.mlexpr -> expr = ({ FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Name p; - FStar_Extraction_ML_Syntax.mlty = uu____4782; - FStar_Extraction_ML_Syntax.loc = uu____4783;_},uu____4784); - FStar_Extraction_ML_Syntax.mlty = uu____4785; - FStar_Extraction_ML_Syntax.loc = uu____4786;_},_e0::e1::e2::[]) + FStar_Extraction_ML_Syntax.mlty = uu____4780; + FStar_Extraction_ML_Syntax.loc = uu____4781;_},uu____4782); + FStar_Extraction_ML_Syntax.mlty = uu____4783; + FStar_Extraction_ML_Syntax.loc = uu____4784;_},_e0::e1::e2::[]) when - let uu____4796 = FStar_Extraction_ML_Syntax.string_of_mlpath p in - uu____4796 = "FStar.Buffer.rcreate" -> - let uu____4797 = - let uu____4804 = translate_expr env e1 in - let uu____4805 = translate_expr env e2 in - (Eternal, uu____4804, uu____4805) in - EBufCreate uu____4797 + let uu____4794 = FStar_Extraction_ML_Syntax.string_of_mlpath p in + uu____4794 = "FStar.Buffer.rcreate" -> + let uu____4795 = + let uu____4802 = translate_expr env e1 in + let uu____4803 = translate_expr env e2 in + (Eternal, uu____4802, uu____4803) in + EBufCreate uu____4795 | FStar_Extraction_ML_Syntax.MLE_App ({ FStar_Extraction_ML_Syntax.expr = @@ -1664,13 +1665,13 @@ and translate_expr: env -> FStar_Extraction_ML_Syntax.mlexpr -> expr = ({ FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Name p; - FStar_Extraction_ML_Syntax.mlty = uu____4807; - FStar_Extraction_ML_Syntax.loc = uu____4808;_},uu____4809); - FStar_Extraction_ML_Syntax.mlty = uu____4810; - FStar_Extraction_ML_Syntax.loc = uu____4811;_},e2::[]) + FStar_Extraction_ML_Syntax.mlty = uu____4805; + FStar_Extraction_ML_Syntax.loc = uu____4806;_},uu____4807); + FStar_Extraction_ML_Syntax.mlty = uu____4808; + FStar_Extraction_ML_Syntax.loc = uu____4809;_},e2::[]) when - let uu____4819 = FStar_Extraction_ML_Syntax.string_of_mlpath p in - uu____4819 = "FStar.Buffer.createL" -> + let uu____4817 = FStar_Extraction_ML_Syntax.string_of_mlpath p in + uu____4817 = "FStar.Buffer.createL" -> let rec list_elements acc e21 = match e21.FStar_Extraction_ML_Syntax.expr with | FStar_Extraction_ML_Syntax.MLE_CTor @@ -1678,16 +1679,16 @@ and translate_expr: env -> FStar_Extraction_ML_Syntax.mlexpr -> expr = list_elements (hd1 :: acc) tl1 | FStar_Extraction_ML_Syntax.MLE_CTor (("Prims"::[],"Nil"),[]) -> FStar_List.rev acc - | uu____4857 -> + | uu____4855 -> failwith "Argument of FStar.Buffer.createL is not a string literal!" in let list_elements1 = list_elements [] in - let uu____4865 = - let uu____4872 = - let uu____4875 = list_elements1 e2 in - FStar_List.map (translate_expr env) uu____4875 in - (Stack, uu____4872) in - EBufCreateL uu____4865 + let uu____4863 = + let uu____4870 = + let uu____4873 = list_elements1 e2 in + FStar_List.map (translate_expr env) uu____4873 in + (Stack, uu____4870) in + EBufCreateL uu____4863 | FStar_Extraction_ML_Syntax.MLE_App ({ FStar_Extraction_ML_Syntax.expr = @@ -1695,18 +1696,18 @@ and translate_expr: env -> FStar_Extraction_ML_Syntax.mlexpr -> expr = ({ FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Name p; - FStar_Extraction_ML_Syntax.mlty = uu____4881; - FStar_Extraction_ML_Syntax.loc = uu____4882;_},uu____4883); - FStar_Extraction_ML_Syntax.mlty = uu____4884; - FStar_Extraction_ML_Syntax.loc = uu____4885;_},e1::e2::_e3::[]) + FStar_Extraction_ML_Syntax.mlty = uu____4879; + FStar_Extraction_ML_Syntax.loc = uu____4880;_},uu____4881); + FStar_Extraction_ML_Syntax.mlty = uu____4882; + FStar_Extraction_ML_Syntax.loc = uu____4883;_},e1::e2::_e3::[]) when - let uu____4895 = FStar_Extraction_ML_Syntax.string_of_mlpath p in - uu____4895 = "FStar.Buffer.sub" -> - let uu____4896 = - let uu____4901 = translate_expr env e1 in - let uu____4902 = translate_expr env e2 in - (uu____4901, uu____4902) in - EBufSub uu____4896 + let uu____4893 = FStar_Extraction_ML_Syntax.string_of_mlpath p in + uu____4893 = "FStar.Buffer.sub" -> + let uu____4894 = + let uu____4899 = translate_expr env e1 in + let uu____4900 = translate_expr env e2 in + (uu____4899, uu____4900) in + EBufSub uu____4894 | FStar_Extraction_ML_Syntax.MLE_App ({ FStar_Extraction_ML_Syntax.expr = @@ -1714,13 +1715,13 @@ and translate_expr: env -> FStar_Extraction_ML_Syntax.mlexpr -> expr = ({ FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Name p; - FStar_Extraction_ML_Syntax.mlty = uu____4904; - FStar_Extraction_ML_Syntax.loc = uu____4905;_},uu____4906); - FStar_Extraction_ML_Syntax.mlty = uu____4907; - FStar_Extraction_ML_Syntax.loc = uu____4908;_},e1::e2::[]) + FStar_Extraction_ML_Syntax.mlty = uu____4902; + FStar_Extraction_ML_Syntax.loc = uu____4903;_},uu____4904); + FStar_Extraction_ML_Syntax.mlty = uu____4905; + FStar_Extraction_ML_Syntax.loc = uu____4906;_},e1::e2::[]) when - let uu____4917 = FStar_Extraction_ML_Syntax.string_of_mlpath p in - uu____4917 = "FStar.Buffer.join" -> translate_expr env e1 + let uu____4915 = FStar_Extraction_ML_Syntax.string_of_mlpath p in + uu____4915 = "FStar.Buffer.join" -> translate_expr env e1 | FStar_Extraction_ML_Syntax.MLE_App ({ FStar_Extraction_ML_Syntax.expr = @@ -1728,18 +1729,18 @@ and translate_expr: env -> FStar_Extraction_ML_Syntax.mlexpr -> expr = ({ FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Name p; - FStar_Extraction_ML_Syntax.mlty = uu____4919; - FStar_Extraction_ML_Syntax.loc = uu____4920;_},uu____4921); - FStar_Extraction_ML_Syntax.mlty = uu____4922; - FStar_Extraction_ML_Syntax.loc = uu____4923;_},e1::e2::[]) + FStar_Extraction_ML_Syntax.mlty = uu____4917; + FStar_Extraction_ML_Syntax.loc = uu____4918;_},uu____4919); + FStar_Extraction_ML_Syntax.mlty = uu____4920; + FStar_Extraction_ML_Syntax.loc = uu____4921;_},e1::e2::[]) when - let uu____4932 = FStar_Extraction_ML_Syntax.string_of_mlpath p in - uu____4932 = "FStar.Buffer.offset" -> - let uu____4933 = - let uu____4938 = translate_expr env e1 in - let uu____4939 = translate_expr env e2 in - (uu____4938, uu____4939) in - EBufSub uu____4933 + let uu____4930 = FStar_Extraction_ML_Syntax.string_of_mlpath p in + uu____4930 = "FStar.Buffer.offset" -> + let uu____4931 = + let uu____4936 = translate_expr env e1 in + let uu____4937 = translate_expr env e2 in + (uu____4936, uu____4937) in + EBufSub uu____4931 | FStar_Extraction_ML_Syntax.MLE_App ({ FStar_Extraction_ML_Syntax.expr = @@ -1747,22 +1748,22 @@ and translate_expr: env -> FStar_Extraction_ML_Syntax.mlexpr -> expr = ({ FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Name p; - FStar_Extraction_ML_Syntax.mlty = uu____4941; - FStar_Extraction_ML_Syntax.loc = uu____4942;_},uu____4943); - FStar_Extraction_ML_Syntax.mlty = uu____4944; - FStar_Extraction_ML_Syntax.loc = uu____4945;_},e1::e2::e3::[]) + FStar_Extraction_ML_Syntax.mlty = uu____4939; + FStar_Extraction_ML_Syntax.loc = uu____4940;_},uu____4941); + FStar_Extraction_ML_Syntax.mlty = uu____4942; + FStar_Extraction_ML_Syntax.loc = uu____4943;_},e1::e2::e3::[]) when - (let uu____4957 = FStar_Extraction_ML_Syntax.string_of_mlpath p in - uu____4957 = "FStar.Buffer.upd") || - (let uu____4959 = FStar_Extraction_ML_Syntax.string_of_mlpath p in - uu____4959 = "FStar.Buffer.op_Array_Assignment") + (let uu____4955 = FStar_Extraction_ML_Syntax.string_of_mlpath p in + uu____4955 = "FStar.Buffer.upd") || + (let uu____4957 = FStar_Extraction_ML_Syntax.string_of_mlpath p in + uu____4957 = "FStar.Buffer.op_Array_Assignment") -> - let uu____4960 = - let uu____4967 = translate_expr env e1 in - let uu____4968 = translate_expr env e2 in - let uu____4969 = translate_expr env e3 in - (uu____4967, uu____4968, uu____4969) in - EBufWrite uu____4960 + let uu____4958 = + let uu____4965 = translate_expr env e1 in + let uu____4966 = translate_expr env e2 in + let uu____4967 = translate_expr env e3 in + (uu____4965, uu____4966, uu____4967) in + EBufWrite uu____4958 | FStar_Extraction_ML_Syntax.MLE_App ({ FStar_Extraction_ML_Syntax.expr = @@ -1770,36 +1771,36 @@ and translate_expr: env -> FStar_Extraction_ML_Syntax.mlexpr -> expr = ({ FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Name p; - FStar_Extraction_ML_Syntax.mlty = uu____4971; - FStar_Extraction_ML_Syntax.loc = uu____4972;_},uu____4973); - FStar_Extraction_ML_Syntax.mlty = uu____4974; - FStar_Extraction_ML_Syntax.loc = uu____4975;_},e1::e2::[]) + FStar_Extraction_ML_Syntax.mlty = uu____4969; + FStar_Extraction_ML_Syntax.loc = uu____4970;_},uu____4971); + FStar_Extraction_ML_Syntax.mlty = uu____4972; + FStar_Extraction_ML_Syntax.loc = uu____4973;_},e1::e2::[]) when - let uu____4984 = FStar_Extraction_ML_Syntax.string_of_mlpath p in - uu____4984 = "FStar.HyperStack.ST.op_Colon_Equals" -> - let uu____4985 = - let uu____4992 = translate_expr env e1 in - let uu____4993 = translate_expr env e2 in - (uu____4992, (EConstant (UInt32, "0")), uu____4993) in - EBufWrite uu____4985 + let uu____4982 = FStar_Extraction_ML_Syntax.string_of_mlpath p in + uu____4982 = "FStar.HyperStack.ST.op_Colon_Equals" -> + let uu____4983 = + let uu____4990 = translate_expr env e1 in + let uu____4991 = translate_expr env e2 in + (uu____4990, (EConstant (UInt32, "0")), uu____4991) in + EBufWrite uu____4983 | FStar_Extraction_ML_Syntax.MLE_App ({ FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Name p; - FStar_Extraction_ML_Syntax.mlty = uu____4995; - FStar_Extraction_ML_Syntax.loc = uu____4996;_},uu____4997::[]) + FStar_Extraction_ML_Syntax.mlty = uu____4993; + FStar_Extraction_ML_Syntax.loc = uu____4994;_},uu____4995::[]) when - let uu____5000 = FStar_Extraction_ML_Syntax.string_of_mlpath p in - uu____5000 = "FStar.HyperStack.ST.push_frame" -> EPushFrame + let uu____4998 = FStar_Extraction_ML_Syntax.string_of_mlpath p in + uu____4998 = "FStar.HyperStack.ST.push_frame" -> EPushFrame | FStar_Extraction_ML_Syntax.MLE_App ({ FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Name p; - FStar_Extraction_ML_Syntax.mlty = uu____5002; - FStar_Extraction_ML_Syntax.loc = uu____5003;_},uu____5004::[]) + FStar_Extraction_ML_Syntax.mlty = uu____5000; + FStar_Extraction_ML_Syntax.loc = uu____5001;_},uu____5002::[]) when - let uu____5007 = FStar_Extraction_ML_Syntax.string_of_mlpath p in - uu____5007 = "FStar.HyperStack.ST.pop_frame" -> EPopFrame + let uu____5005 = FStar_Extraction_ML_Syntax.string_of_mlpath p in + uu____5005 = "FStar.HyperStack.ST.pop_frame" -> EPopFrame | FStar_Extraction_ML_Syntax.MLE_App ({ FStar_Extraction_ML_Syntax.expr = @@ -1807,21 +1808,21 @@ and translate_expr: env -> FStar_Extraction_ML_Syntax.mlexpr -> expr = ({ FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Name p; - FStar_Extraction_ML_Syntax.mlty = uu____5009; - FStar_Extraction_ML_Syntax.loc = uu____5010;_},uu____5011); - FStar_Extraction_ML_Syntax.mlty = uu____5012; - FStar_Extraction_ML_Syntax.loc = uu____5013;_},e1::e2::e3::e4::e5::[]) + FStar_Extraction_ML_Syntax.mlty = uu____5007; + FStar_Extraction_ML_Syntax.loc = uu____5008;_},uu____5009); + FStar_Extraction_ML_Syntax.mlty = uu____5010; + FStar_Extraction_ML_Syntax.loc = uu____5011;_},e1::e2::e3::e4::e5::[]) when - let uu____5025 = FStar_Extraction_ML_Syntax.string_of_mlpath p in - uu____5025 = "FStar.Buffer.blit" -> - let uu____5026 = - let uu____5037 = translate_expr env e1 in - let uu____5038 = translate_expr env e2 in - let uu____5039 = translate_expr env e3 in - let uu____5040 = translate_expr env e4 in - let uu____5041 = translate_expr env e5 in - (uu____5037, uu____5038, uu____5039, uu____5040, uu____5041) in - EBufBlit uu____5026 + let uu____5023 = FStar_Extraction_ML_Syntax.string_of_mlpath p in + uu____5023 = "FStar.Buffer.blit" -> + let uu____5024 = + let uu____5035 = translate_expr env e1 in + let uu____5036 = translate_expr env e2 in + let uu____5037 = translate_expr env e3 in + let uu____5038 = translate_expr env e4 in + let uu____5039 = translate_expr env e5 in + (uu____5035, uu____5036, uu____5037, uu____5038, uu____5039) in + EBufBlit uu____5024 | FStar_Extraction_ML_Syntax.MLE_App ({ FStar_Extraction_ML_Syntax.expr = @@ -1829,66 +1830,66 @@ and translate_expr: env -> FStar_Extraction_ML_Syntax.mlexpr -> expr = ({ FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Name p; - FStar_Extraction_ML_Syntax.mlty = uu____5043; - FStar_Extraction_ML_Syntax.loc = uu____5044;_},uu____5045); - FStar_Extraction_ML_Syntax.mlty = uu____5046; - FStar_Extraction_ML_Syntax.loc = uu____5047;_},e1::e2::e3::[]) + FStar_Extraction_ML_Syntax.mlty = uu____5041; + FStar_Extraction_ML_Syntax.loc = uu____5042;_},uu____5043); + FStar_Extraction_ML_Syntax.mlty = uu____5044; + FStar_Extraction_ML_Syntax.loc = uu____5045;_},e1::e2::e3::[]) when - let uu____5057 = FStar_Extraction_ML_Syntax.string_of_mlpath p in - uu____5057 = "FStar.Buffer.fill" -> - let uu____5058 = - let uu____5065 = translate_expr env e1 in - let uu____5066 = translate_expr env e2 in - let uu____5067 = translate_expr env e3 in - (uu____5065, uu____5066, uu____5067) in - EBufFill uu____5058 + let uu____5055 = FStar_Extraction_ML_Syntax.string_of_mlpath p in + uu____5055 = "FStar.Buffer.fill" -> + let uu____5056 = + let uu____5063 = translate_expr env e1 in + let uu____5064 = translate_expr env e2 in + let uu____5065 = translate_expr env e3 in + (uu____5063, uu____5064, uu____5065) in + EBufFill uu____5056 | FStar_Extraction_ML_Syntax.MLE_App ({ FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Name p; - FStar_Extraction_ML_Syntax.mlty = uu____5069; - FStar_Extraction_ML_Syntax.loc = uu____5070;_},uu____5071::[]) + FStar_Extraction_ML_Syntax.mlty = uu____5067; + FStar_Extraction_ML_Syntax.loc = uu____5068;_},uu____5069::[]) when - let uu____5074 = FStar_Extraction_ML_Syntax.string_of_mlpath p in - uu____5074 = "FStar.HyperStack.ST.get" -> EUnit + let uu____5072 = FStar_Extraction_ML_Syntax.string_of_mlpath p in + uu____5072 = "FStar.HyperStack.ST.get" -> EUnit | FStar_Extraction_ML_Syntax.MLE_App ({ FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Name p; - FStar_Extraction_ML_Syntax.mlty = uu____5076; - FStar_Extraction_ML_Syntax.loc = uu____5077;_},e1::[]) + FStar_Extraction_ML_Syntax.mlty = uu____5074; + FStar_Extraction_ML_Syntax.loc = uu____5075;_},e1::[]) when - let uu____5081 = FStar_Extraction_ML_Syntax.string_of_mlpath p in - uu____5081 = "Obj.repr" -> - let uu____5082 = - let uu____5087 = translate_expr env e1 in (uu____5087, TAny) in - ECast uu____5082 + let uu____5079 = FStar_Extraction_ML_Syntax.string_of_mlpath p in + uu____5079 = "Obj.repr" -> + let uu____5080 = + let uu____5085 = translate_expr env e1 in (uu____5085, TAny) in + ECast uu____5080 | FStar_Extraction_ML_Syntax.MLE_App ({ FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Name ("FStar"::m::[],op); - FStar_Extraction_ML_Syntax.mlty = uu____5090; - FStar_Extraction_ML_Syntax.loc = uu____5091;_},args) + FStar_Extraction_ML_Syntax.mlty = uu____5088; + FStar_Extraction_ML_Syntax.loc = uu____5089;_},args) when (is_machine_int m) && (is_op op) -> - let uu____5099 = FStar_Util.must (mk_width m) in - let uu____5100 = FStar_Util.must (mk_op op) in - mk_op_app env uu____5099 uu____5100 args + let uu____5097 = FStar_Util.must (mk_width m) in + let uu____5098 = FStar_Util.must (mk_op op) in + mk_op_app env uu____5097 uu____5098 args | FStar_Extraction_ML_Syntax.MLE_App ({ FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Name ("Prims"::[],op); - FStar_Extraction_ML_Syntax.mlty = uu____5102; - FStar_Extraction_ML_Syntax.loc = uu____5103;_},args) + FStar_Extraction_ML_Syntax.mlty = uu____5100; + FStar_Extraction_ML_Syntax.loc = uu____5101;_},args) when is_bool_op op -> - let uu____5111 = FStar_Util.must (mk_bool_op op) in - mk_op_app env Bool uu____5111 args + let uu____5109 = FStar_Util.must (mk_bool_op op) in + mk_op_app env Bool uu____5109 args | FStar_Extraction_ML_Syntax.MLE_App ({ FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Name ("FStar"::m::[],"int_to_t"); - FStar_Extraction_ML_Syntax.mlty = uu____5113; - FStar_Extraction_ML_Syntax.loc = uu____5114;_},{ + FStar_Extraction_ML_Syntax.mlty = uu____5111; + FStar_Extraction_ML_Syntax.loc = uu____5112;_},{ FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Const @@ -1896,20 +1897,20 @@ and translate_expr: env -> FStar_Extraction_ML_Syntax.mlexpr -> expr = (c,FStar_Pervasives_Native.None )); FStar_Extraction_ML_Syntax.mlty - = uu____5116; + = uu____5114; FStar_Extraction_ML_Syntax.loc - = uu____5117;_}::[]) + = uu____5115;_}::[]) when is_machine_int m -> - let uu____5132 = - let uu____5137 = FStar_Util.must (mk_width m) in (uu____5137, c) in - EConstant uu____5132 + let uu____5130 = + let uu____5135 = FStar_Util.must (mk_width m) in (uu____5135, c) in + EConstant uu____5130 | FStar_Extraction_ML_Syntax.MLE_App ({ FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Name ("FStar"::m::[],"uint_to_t"); - FStar_Extraction_ML_Syntax.mlty = uu____5139; - FStar_Extraction_ML_Syntax.loc = uu____5140;_},{ + FStar_Extraction_ML_Syntax.mlty = uu____5137; + FStar_Extraction_ML_Syntax.loc = uu____5138;_},{ FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Const @@ -1917,31 +1918,31 @@ and translate_expr: env -> FStar_Extraction_ML_Syntax.mlexpr -> expr = (c,FStar_Pervasives_Native.None )); FStar_Extraction_ML_Syntax.mlty - = uu____5142; + = uu____5140; FStar_Extraction_ML_Syntax.loc - = uu____5143;_}::[]) + = uu____5141;_}::[]) when is_machine_int m -> - let uu____5158 = - let uu____5163 = FStar_Util.must (mk_width m) in (uu____5163, c) in - EConstant uu____5158 + let uu____5156 = + let uu____5161 = FStar_Util.must (mk_width m) in (uu____5161, c) in + EConstant uu____5156 | FStar_Extraction_ML_Syntax.MLE_App ({ FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Name ("C"::[],"string_of_literal"); - FStar_Extraction_ML_Syntax.mlty = uu____5164; - FStar_Extraction_ML_Syntax.loc = uu____5165;_},{ + FStar_Extraction_ML_Syntax.mlty = uu____5162; + FStar_Extraction_ML_Syntax.loc = uu____5163;_},{ FStar_Extraction_ML_Syntax.expr = e1; FStar_Extraction_ML_Syntax.mlty - = uu____5167; + = uu____5165; FStar_Extraction_ML_Syntax.loc - = uu____5168;_}::[]) + = uu____5166;_}::[]) -> (match e1 with | FStar_Extraction_ML_Syntax.MLE_Const (FStar_Extraction_ML_Syntax.MLC_String s) -> EString s - | uu____5174 -> + | uu____5172 -> failwith "Cannot extract string_of_literal applied to a non-literal") | FStar_Extraction_ML_Syntax.MLE_App @@ -1949,19 +1950,19 @@ and translate_expr: env -> FStar_Extraction_ML_Syntax.mlexpr -> expr = FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Name ("C"::"String"::[],"of_literal"); - FStar_Extraction_ML_Syntax.mlty = uu____5175; - FStar_Extraction_ML_Syntax.loc = uu____5176;_},{ + FStar_Extraction_ML_Syntax.mlty = uu____5173; + FStar_Extraction_ML_Syntax.loc = uu____5174;_},{ FStar_Extraction_ML_Syntax.expr = e1; FStar_Extraction_ML_Syntax.mlty - = uu____5178; + = uu____5176; FStar_Extraction_ML_Syntax.loc - = uu____5179;_}::[]) + = uu____5177;_}::[]) -> (match e1 with | FStar_Extraction_ML_Syntax.MLE_Const (FStar_Extraction_ML_Syntax.MLC_String s) -> EString s - | uu____5185 -> + | uu____5183 -> failwith "Cannot extract string_of_literal applied to a non-literal") | FStar_Extraction_ML_Syntax.MLE_App @@ -1969,8 +1970,8 @@ and translate_expr: env -> FStar_Extraction_ML_Syntax.mlexpr -> expr = FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Name ("FStar"::"Int"::"Cast"::[],c); - FStar_Extraction_ML_Syntax.mlty = uu____5187; - FStar_Extraction_ML_Syntax.loc = uu____5188;_},arg::[]) + FStar_Extraction_ML_Syntax.mlty = uu____5185; + FStar_Extraction_ML_Syntax.loc = uu____5186;_},arg::[]) -> let is_known_type = (((((((FStar_Util.starts_with c "uint8") || @@ -1983,149 +1984,149 @@ and translate_expr: env -> FStar_Extraction_ML_Syntax.mlexpr -> expr = || (FStar_Util.starts_with c "int64") in if (FStar_Util.ends_with c "uint64") && is_known_type then - let uu____5195 = - let uu____5200 = translate_expr env arg in - (uu____5200, (TInt UInt64)) in - ECast uu____5195 + let uu____5193 = + let uu____5198 = translate_expr env arg in + (uu____5198, (TInt UInt64)) in + ECast uu____5193 else if (FStar_Util.ends_with c "uint32") && is_known_type then - (let uu____5202 = - let uu____5207 = translate_expr env arg in - (uu____5207, (TInt UInt32)) in - ECast uu____5202) + (let uu____5200 = + let uu____5205 = translate_expr env arg in + (uu____5205, (TInt UInt32)) in + ECast uu____5200) else if (FStar_Util.ends_with c "uint16") && is_known_type then - (let uu____5209 = - let uu____5214 = translate_expr env arg in - (uu____5214, (TInt UInt16)) in - ECast uu____5209) + (let uu____5207 = + let uu____5212 = translate_expr env arg in + (uu____5212, (TInt UInt16)) in + ECast uu____5207) else if (FStar_Util.ends_with c "uint8") && is_known_type then - (let uu____5216 = - let uu____5221 = translate_expr env arg in - (uu____5221, (TInt UInt8)) in - ECast uu____5216) + (let uu____5214 = + let uu____5219 = translate_expr env arg in + (uu____5219, (TInt UInt8)) in + ECast uu____5214) else if (FStar_Util.ends_with c "int64") && is_known_type then - (let uu____5223 = - let uu____5228 = translate_expr env arg in - (uu____5228, (TInt Int64)) in - ECast uu____5223) + (let uu____5221 = + let uu____5226 = translate_expr env arg in + (uu____5226, (TInt Int64)) in + ECast uu____5221) else if (FStar_Util.ends_with c "int32") && is_known_type then - (let uu____5230 = - let uu____5235 = translate_expr env arg in - (uu____5235, (TInt Int32)) in - ECast uu____5230) + (let uu____5228 = + let uu____5233 = translate_expr env arg in + (uu____5233, (TInt Int32)) in + ECast uu____5228) else if (FStar_Util.ends_with c "int16") && is_known_type then - (let uu____5237 = - let uu____5242 = translate_expr env arg in - (uu____5242, (TInt Int16)) in - ECast uu____5237) + (let uu____5235 = + let uu____5240 = translate_expr env arg in + (uu____5240, (TInt Int16)) in + ECast uu____5235) else if (FStar_Util.ends_with c "int8") && is_known_type then - (let uu____5244 = - let uu____5249 = translate_expr env arg in - (uu____5249, (TInt Int8)) in - ECast uu____5244) + (let uu____5242 = + let uu____5247 = translate_expr env arg in + (uu____5247, (TInt Int8)) in + ECast uu____5242) else - (let uu____5251 = - let uu____5258 = - let uu____5261 = translate_expr env arg in - [uu____5261] in + (let uu____5249 = + let uu____5256 = + let uu____5259 = translate_expr env arg in + [uu____5259] in ((EQualified (["FStar"; "Int"; "Cast"], c)), - uu____5258) in - EApp uu____5251) + uu____5256) in + EApp uu____5249) | FStar_Extraction_ML_Syntax.MLE_App (head1,args) -> - let uu____5272 = - let uu____5279 = translate_expr env head1 in - let uu____5280 = FStar_List.map (translate_expr env) args in - (uu____5279, uu____5280) in - EApp uu____5272 + let uu____5270 = + let uu____5277 = translate_expr env head1 in + let uu____5278 = FStar_List.map (translate_expr env) args in + (uu____5277, uu____5278) in + EApp uu____5270 | FStar_Extraction_ML_Syntax.MLE_TApp (head1,ty_args) -> - let uu____5291 = - let uu____5298 = translate_expr env head1 in - let uu____5299 = FStar_List.map (translate_type env) ty_args in - (uu____5298, uu____5299) in - ETypApp uu____5291 + let uu____5289 = + let uu____5296 = translate_expr env head1 in + let uu____5297 = FStar_List.map (translate_type env) ty_args in + (uu____5296, uu____5297) in + ETypApp uu____5289 | FStar_Extraction_ML_Syntax.MLE_Coerce (e1,t_from,t_to) -> - let uu____5307 = - let uu____5312 = translate_expr env e1 in - let uu____5313 = translate_type env t_to in - (uu____5312, uu____5313) in - ECast uu____5307 - | FStar_Extraction_ML_Syntax.MLE_Record (uu____5314,fields) -> - let uu____5332 = - let uu____5343 = assert_lid env e.FStar_Extraction_ML_Syntax.mlty in - let uu____5344 = + let uu____5305 = + let uu____5310 = translate_expr env e1 in + let uu____5311 = translate_type env t_to in + (uu____5310, uu____5311) in + ECast uu____5305 + | FStar_Extraction_ML_Syntax.MLE_Record (uu____5312,fields) -> + let uu____5330 = + let uu____5341 = assert_lid env e.FStar_Extraction_ML_Syntax.mlty in + let uu____5342 = FStar_List.map - (fun uu____5363 -> - match uu____5363 with + (fun uu____5361 -> + match uu____5361 with | (field,expr) -> - let uu____5374 = translate_expr env expr in - (field, uu____5374)) fields in - (uu____5343, uu____5344) in - EFlat uu____5332 + let uu____5372 = translate_expr env expr in + (field, uu____5372)) fields in + (uu____5341, uu____5342) in + EFlat uu____5330 | FStar_Extraction_ML_Syntax.MLE_Proj (e1,path) -> - let uu____5383 = - let uu____5390 = + let uu____5381 = + let uu____5388 = assert_lid env e1.FStar_Extraction_ML_Syntax.mlty in - let uu____5391 = translate_expr env e1 in - (uu____5390, uu____5391, (FStar_Pervasives_Native.snd path)) in - EField uu____5383 - | FStar_Extraction_ML_Syntax.MLE_Let uu____5394 -> + let uu____5389 = translate_expr env e1 in + (uu____5388, uu____5389, (FStar_Pervasives_Native.snd path)) in + EField uu____5381 + | FStar_Extraction_ML_Syntax.MLE_Let uu____5392 -> failwith "todo: translate_expr [MLE_Let]" - | FStar_Extraction_ML_Syntax.MLE_App (head1,uu____5408) -> - let uu____5413 = - let uu____5414 = + | FStar_Extraction_ML_Syntax.MLE_App (head1,uu____5404) -> + let uu____5409 = + let uu____5410 = FStar_Extraction_ML_Code.string_of_mlexpr ([], "") head1 in FStar_Util.format1 "todo: translate_expr [MLE_App] (head is: %s)" - uu____5414 in - failwith uu____5413 + uu____5410 in + failwith uu____5409 | FStar_Extraction_ML_Syntax.MLE_Seq seqs -> - let uu____5420 = FStar_List.map (translate_expr env) seqs in - ESequence uu____5420 + let uu____5416 = FStar_List.map (translate_expr env) seqs in + ESequence uu____5416 | FStar_Extraction_ML_Syntax.MLE_Tuple es -> - let uu____5426 = FStar_List.map (translate_expr env) es in - ETuple uu____5426 - | FStar_Extraction_ML_Syntax.MLE_CTor ((uu____5429,cons1),es) -> - let uu____5446 = - let uu____5455 = assert_lid env e.FStar_Extraction_ML_Syntax.mlty in - let uu____5456 = FStar_List.map (translate_expr env) es in - (uu____5455, cons1, uu____5456) in - ECons uu____5446 + let uu____5422 = FStar_List.map (translate_expr env) es in + ETuple uu____5422 + | FStar_Extraction_ML_Syntax.MLE_CTor ((uu____5425,cons1),es) -> + let uu____5442 = + let uu____5451 = assert_lid env e.FStar_Extraction_ML_Syntax.mlty in + let uu____5452 = FStar_List.map (translate_expr env) es in + (uu____5451, cons1, uu____5452) in + ECons uu____5442 | FStar_Extraction_ML_Syntax.MLE_Fun (args,body) -> let binders = translate_binders env args in let env1 = add_binders env args in - let uu____5479 = - let uu____5488 = translate_expr env1 body in - let uu____5489 = + let uu____5475 = + let uu____5484 = translate_expr env1 body in + let uu____5485 = translate_type env1 body.FStar_Extraction_ML_Syntax.mlty in - (binders, uu____5488, uu____5489) in - EFun uu____5479 + (binders, uu____5484, uu____5485) in + EFun uu____5475 | FStar_Extraction_ML_Syntax.MLE_If (e1,e2,e3) -> - let uu____5499 = - let uu____5506 = translate_expr env e1 in - let uu____5507 = translate_expr env e2 in - let uu____5508 = + let uu____5495 = + let uu____5502 = translate_expr env e1 in + let uu____5503 = translate_expr env e2 in + let uu____5504 = match e3 with | FStar_Pervasives_Native.None -> EUnit | FStar_Pervasives_Native.Some e31 -> translate_expr env e31 in - (uu____5506, uu____5507, uu____5508) in - EIfThenElse uu____5499 - | FStar_Extraction_ML_Syntax.MLE_Raise uu____5510 -> + (uu____5502, uu____5503, uu____5504) in + EIfThenElse uu____5495 + | FStar_Extraction_ML_Syntax.MLE_Raise uu____5506 -> failwith "todo: translate_expr [MLE_Raise]" - | FStar_Extraction_ML_Syntax.MLE_Try uu____5517 -> + | FStar_Extraction_ML_Syntax.MLE_Try uu____5513 -> failwith "todo: translate_expr [MLE_Try]" - | FStar_Extraction_ML_Syntax.MLE_Coerce uu____5532 -> + | FStar_Extraction_ML_Syntax.MLE_Coerce uu____5528 -> failwith "todo: translate_expr [MLE_Coerce]" and assert_lid: env -> FStar_Extraction_ML_Syntax.mlty -> typ = fun env -> @@ -2134,12 +2135,12 @@ and assert_lid: env -> FStar_Extraction_ML_Syntax.mlty -> typ = | FStar_Extraction_ML_Syntax.MLTY_Named (ts,lid) -> if (FStar_List.length ts) > (Prims.parse_int "0") then - let uu____5547 = - let uu____5560 = FStar_List.map (translate_type env) ts in - (lid, uu____5560) in - TApp uu____5547 + let uu____5543 = + let uu____5556 = FStar_List.map (translate_type env) ts in + (lid, uu____5556) in + TApp uu____5543 else TQualified lid - | uu____5566 -> failwith "invalid argument: assert_lid" + | uu____5562 -> failwith "invalid argument: assert_lid" and translate_branches: env -> (FStar_Extraction_ML_Syntax.mlpattern,FStar_Extraction_ML_Syntax.mlexpr @@ -2156,23 +2157,23 @@ and translate_branch: (pattern,expr) FStar_Pervasives_Native.tuple2 = fun env -> - fun uu____5592 -> - match uu____5592 with + fun uu____5588 -> + match uu____5588 with | (pat,guard,expr) -> if guard = FStar_Pervasives_Native.None then - let uu____5618 = translate_pat env pat in - (match uu____5618 with + let uu____5614 = translate_pat env pat in + (match uu____5614 with | (env1,pat1) -> - let uu____5629 = translate_expr env1 expr in - (pat1, uu____5629)) + let uu____5625 = translate_expr env1 expr in + (pat1, uu____5625)) else failwith "todo: translate_branch" and translate_width: (FStar_Const.signedness,FStar_Const.width) FStar_Pervasives_Native.tuple2 FStar_Pervasives_Native.option -> width = - fun uu___40_5635 -> - match uu___40_5635 with + fun uu___40_5631 -> + match uu___40_5631 with | FStar_Pervasives_Native.None -> CInt | FStar_Pervasives_Native.Some (FStar_Const.Signed ,FStar_Const.Int8 ) -> Int8 @@ -2204,57 +2205,57 @@ and translate_pat: (FStar_Extraction_ML_Syntax.MLC_Bool b) -> (env, (PBool b)) | FStar_Extraction_ML_Syntax.MLP_Const (FStar_Extraction_ML_Syntax.MLC_Int (s,sw)) -> - let uu____5699 = - let uu____5700 = - let uu____5705 = translate_width sw in (uu____5705, s) in - PConstant uu____5700 in - (env, uu____5699) + let uu____5695 = + let uu____5696 = + let uu____5701 = translate_width sw in (uu____5701, s) in + PConstant uu____5696 in + (env, uu____5695) | FStar_Extraction_ML_Syntax.MLP_Var name -> let env1 = extend env name false in (env1, (PVar { name; typ = TAny; mut = false })) | FStar_Extraction_ML_Syntax.MLP_Wild -> let env1 = extend env "_" false in (env1, (PVar { name = "_"; typ = TAny; mut = false })) - | FStar_Extraction_ML_Syntax.MLP_CTor ((uu____5709,cons1),ps) -> - let uu____5726 = + | FStar_Extraction_ML_Syntax.MLP_CTor ((uu____5705,cons1),ps) -> + let uu____5722 = FStar_List.fold_left - (fun uu____5746 -> + (fun uu____5742 -> fun p1 -> - match uu____5746 with + match uu____5742 with | (env1,acc) -> - let uu____5766 = translate_pat env1 p1 in - (match uu____5766 with + let uu____5762 = translate_pat env1 p1 in + (match uu____5762 with | (env2,p2) -> (env2, (p2 :: acc)))) (env, []) ps in - (match uu____5726 with + (match uu____5722 with | (env1,ps1) -> (env1, (PCons (cons1, (FStar_List.rev ps1))))) - | FStar_Extraction_ML_Syntax.MLP_Record (uu____5795,ps) -> - let uu____5813 = + | FStar_Extraction_ML_Syntax.MLP_Record (uu____5791,ps) -> + let uu____5809 = FStar_List.fold_left - (fun uu____5847 -> - fun uu____5848 -> - match (uu____5847, uu____5848) with + (fun uu____5843 -> + fun uu____5844 -> + match (uu____5843, uu____5844) with | ((env1,acc),(field,p1)) -> - let uu____5917 = translate_pat env1 p1 in - (match uu____5917 with + let uu____5913 = translate_pat env1 p1 in + (match uu____5913 with | (env2,p2) -> (env2, ((field, p2) :: acc)))) (env, []) ps in - (match uu____5813 with + (match uu____5809 with | (env1,ps1) -> (env1, (PRecord (FStar_List.rev ps1)))) | FStar_Extraction_ML_Syntax.MLP_Tuple ps -> - let uu____5979 = + let uu____5975 = FStar_List.fold_left - (fun uu____5999 -> + (fun uu____5995 -> fun p1 -> - match uu____5999 with + match uu____5995 with | (env1,acc) -> - let uu____6019 = translate_pat env1 p1 in - (match uu____6019 with + let uu____6015 = translate_pat env1 p1 in + (match uu____6015 with | (env2,p2) -> (env2, (p2 :: acc)))) (env, []) ps in - (match uu____5979 with + (match uu____5975 with | (env1,ps1) -> (env1, (PTuple (FStar_List.rev ps1)))) - | FStar_Extraction_ML_Syntax.MLP_Const uu____6046 -> + | FStar_Extraction_ML_Syntax.MLP_Const uu____6042 -> failwith "todo: translate_pat [MLP_Const]" - | FStar_Extraction_ML_Syntax.MLP_Branch uu____6051 -> + | FStar_Extraction_ML_Syntax.MLP_Branch uu____6047 -> failwith "todo: translate_pat [MLP_Branch]" and translate_constant: FStar_Extraction_ML_Syntax.mlconstant -> expr = fun c -> @@ -2262,30 +2263,30 @@ and translate_constant: FStar_Extraction_ML_Syntax.mlconstant -> expr = | FStar_Extraction_ML_Syntax.MLC_Unit -> EUnit | FStar_Extraction_ML_Syntax.MLC_Bool b -> EBool b | FStar_Extraction_ML_Syntax.MLC_String s -> - ((let uu____6062 = - let uu____6063 = FStar_String.list_of_string s in - FStar_All.pipe_right uu____6063 + ((let uu____6058 = + let uu____6059 = FStar_String.list_of_string s in + FStar_All.pipe_right uu____6059 (FStar_Util.for_some (fun c1 -> c1 = (FStar_Char.char_of_int (Prims.parse_int "0")))) in - if uu____6062 + if uu____6058 then - let uu____6075 = + let uu____6071 = FStar_Util.format1 "Refusing to translate a string literal that contains a null character: %s" s in - failwith uu____6075 + failwith uu____6071 else ()); EString s) | FStar_Extraction_ML_Syntax.MLC_Int - (s,FStar_Pervasives_Native.Some uu____6078) -> + (s,FStar_Pervasives_Native.Some uu____6074) -> failwith "impossible: machine integer not desugared to a function call" - | FStar_Extraction_ML_Syntax.MLC_Float uu____6093 -> + | FStar_Extraction_ML_Syntax.MLC_Float uu____6089 -> failwith "todo: translate_expr [MLC_Float]" - | FStar_Extraction_ML_Syntax.MLC_Char uu____6094 -> + | FStar_Extraction_ML_Syntax.MLC_Char uu____6090 -> failwith "todo: translate_expr [MLC_Char]" - | FStar_Extraction_ML_Syntax.MLC_Bytes uu____6095 -> + | FStar_Extraction_ML_Syntax.MLC_Bytes uu____6091 -> failwith "todo: translate_expr [MLC_Bytes]" | FStar_Extraction_ML_Syntax.MLC_Int (s,FStar_Pervasives_Native.None ) -> EConstant (CInt, s) @@ -2296,7 +2297,7 @@ and mk_op_app: fun w -> fun op -> fun args -> - let uu____6115 = - let uu____6122 = FStar_List.map (translate_expr env) args in - ((EOp (op, w)), uu____6122) in - EApp uu____6115 \ No newline at end of file + let uu____6111 = + let uu____6118 = FStar_List.map (translate_expr env) args in + ((EOp (op, w)), uu____6118) in + EApp uu____6111 \ No newline at end of file diff --git a/src/ocaml-output/FStar_Extraction_ML_Code.ml b/src/ocaml-output/FStar_Extraction_ML_Code.ml index 9d460b3b716..7ce8e4f327e 100644 --- a/src/ocaml-output/FStar_Extraction_ML_Code.ml +++ b/src/ocaml-output/FStar_Extraction_ML_Code.ml @@ -552,57 +552,57 @@ let rec doc_of_expr: FStar_Format.combine (FStar_Format.text ", ") docs in FStar_Format.parens uu____1481 in docs1 - | FStar_Extraction_ML_Syntax.MLE_Let ((rec_,uu____1483,lets),body) -> + | FStar_Extraction_ML_Syntax.MLE_Let ((rec_,lets),body) -> let pre = if e.FStar_Extraction_ML_Syntax.loc <> FStar_Extraction_ML_Syntax.dummy_loc then - let uu____1499 = - let uu____1502 = - let uu____1505 = + let uu____1496 = + let uu____1499 = + let uu____1502 = doc_of_loc e.FStar_Extraction_ML_Syntax.loc in - [uu____1505] in - FStar_Format.hardline :: uu____1502 in - FStar_Format.reduce uu____1499 + [uu____1502] in + FStar_Format.hardline :: uu____1499 in + FStar_Format.reduce uu____1496 else FStar_Format.empty in let doc1 = doc_of_lets currentModule (rec_, false, lets) in let body1 = doc_of_expr currentModule (min_op_prec, NonAssoc) body in - let uu____1515 = - let uu____1516 = - let uu____1519 = - let uu____1522 = - let uu____1525 = + let uu____1512 = + let uu____1513 = + let uu____1516 = + let uu____1519 = + let uu____1522 = FStar_Format.reduce1 [FStar_Format.text "in"; body1] in - [uu____1525] in - doc1 :: uu____1522 in - pre :: uu____1519 in - FStar_Format.combine FStar_Format.hardline uu____1516 in - FStar_Format.parens uu____1515 + [uu____1522] in + doc1 :: uu____1519 in + pre :: uu____1516 in + FStar_Format.combine FStar_Format.hardline uu____1513 in + FStar_Format.parens uu____1512 | FStar_Extraction_ML_Syntax.MLE_App (e1,args) -> (match ((e1.FStar_Extraction_ML_Syntax.expr), args) with | (FStar_Extraction_ML_Syntax.MLE_Name p,{ FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Fun - (uu____1535::[],scrutinee); - FStar_Extraction_ML_Syntax.mlty = uu____1537; - FStar_Extraction_ML_Syntax.loc = uu____1538;_}::{ + (uu____1532::[],scrutinee); + FStar_Extraction_ML_Syntax.mlty = uu____1534; + FStar_Extraction_ML_Syntax.loc = uu____1535;_}::{ FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Fun - ((arg,uu____1540)::[],possible_match); + ((arg,uu____1537)::[],possible_match); FStar_Extraction_ML_Syntax.mlty = - uu____1542; + uu____1539; FStar_Extraction_ML_Syntax.loc = - uu____1543;_}::[]) + uu____1540;_}::[]) when - let uu____1578 = + let uu____1575 = FStar_Extraction_ML_Syntax.string_of_mlpath p in - uu____1578 = "FStar.All.try_with" -> + uu____1575 = "FStar.All.try_with" -> let branches = match possible_match with | { @@ -611,10 +611,10 @@ let rec doc_of_expr: ({ FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Var arg'; - FStar_Extraction_ML_Syntax.mlty = uu____1601; - FStar_Extraction_ML_Syntax.loc = uu____1602;_},branches); - FStar_Extraction_ML_Syntax.mlty = uu____1604; - FStar_Extraction_ML_Syntax.loc = uu____1605;_} when + FStar_Extraction_ML_Syntax.mlty = uu____1598; + FStar_Extraction_ML_Syntax.loc = uu____1599;_},branches); + FStar_Extraction_ML_Syntax.mlty = uu____1601; + FStar_Extraction_ML_Syntax.loc = uu____1602;_} when arg = arg' -> branches | e2 -> [(FStar_Extraction_ML_Syntax.MLP_Wild, @@ -635,8 +635,8 @@ let rec doc_of_expr: ({ FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Name p; - FStar_Extraction_ML_Syntax.mlty = uu____1661; - FStar_Extraction_ML_Syntax.loc = uu____1662;_},unitVal::[]),e11::e2::[]) + FStar_Extraction_ML_Syntax.mlty = uu____1658; + FStar_Extraction_ML_Syntax.loc = uu____1659;_},unitVal::[]),e11::e2::[]) when (is_bin_op p) && (unitVal = FStar_Extraction_ML_Syntax.ml_unit) @@ -647,186 +647,186 @@ let rec doc_of_expr: ({ FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Name p; - FStar_Extraction_ML_Syntax.mlty = uu____1675; - FStar_Extraction_ML_Syntax.loc = uu____1676;_},unitVal::[]),e11::[]) + FStar_Extraction_ML_Syntax.mlty = uu____1672; + FStar_Extraction_ML_Syntax.loc = uu____1673;_},unitVal::[]),e11::[]) when (is_uni_op p) && (unitVal = FStar_Extraction_ML_Syntax.ml_unit) -> doc_of_uniop currentModule p e11 - | uu____1683 -> + | uu____1680 -> let e2 = doc_of_expr currentModule (e_app_prio, ILeft) e1 in let args1 = FStar_List.map (doc_of_expr currentModule (e_app_prio, IRight)) args in - let uu____1702 = FStar_Format.reduce1 (e2 :: args1) in - FStar_Format.parens uu____1702) + let uu____1699 = FStar_Format.reduce1 (e2 :: args1) in + FStar_Format.parens uu____1699) | FStar_Extraction_ML_Syntax.MLE_Proj (e1,f) -> let e2 = doc_of_expr currentModule (min_op_prec, NonAssoc) e1 in let doc1 = - let uu____1711 = FStar_Options.codegen_fsharp () in - if uu____1711 + let uu____1708 = FStar_Options.codegen_fsharp () in + if uu____1708 then FStar_Format.reduce [e2; FStar_Format.text "."; FStar_Format.text (FStar_Pervasives_Native.snd f)] else - (let uu____1715 = - let uu____1718 = - let uu____1721 = - let uu____1724 = - let uu____1725 = ptsym currentModule f in - FStar_Format.text uu____1725 in - [uu____1724] in - (FStar_Format.text ".") :: uu____1721 in - e2 :: uu____1718 in - FStar_Format.reduce uu____1715) in + (let uu____1712 = + let uu____1715 = + let uu____1718 = + let uu____1721 = + let uu____1722 = ptsym currentModule f in + FStar_Format.text uu____1722 in + [uu____1721] in + (FStar_Format.text ".") :: uu____1718 in + e2 :: uu____1715 in + FStar_Format.reduce uu____1712) in doc1 | FStar_Extraction_ML_Syntax.MLE_Fun (ids,body) -> let bvar_annot x xt = - let uu____1751 = FStar_Options.codegen_fsharp () in - if uu____1751 + let uu____1748 = FStar_Options.codegen_fsharp () in + if uu____1748 then - let uu____1752 = - let uu____1755 = - let uu____1758 = - let uu____1761 = + let uu____1749 = + let uu____1752 = + let uu____1755 = + let uu____1758 = match xt with | FStar_Pervasives_Native.Some xxt -> - let uu____1763 = - let uu____1766 = - let uu____1769 = + let uu____1760 = + let uu____1763 = + let uu____1766 = doc_of_mltype currentModule outer xxt in - [uu____1769] in - (FStar_Format.text " : ") :: uu____1766 in - FStar_Format.reduce1 uu____1763 - | uu____1770 -> FStar_Format.text "" in - [uu____1761; FStar_Format.text ")"] in - (FStar_Format.text x) :: uu____1758 in - (FStar_Format.text "(") :: uu____1755 in - FStar_Format.reduce1 uu____1752 + [uu____1766] in + (FStar_Format.text " : ") :: uu____1763 in + FStar_Format.reduce1 uu____1760 + | uu____1767 -> FStar_Format.text "" in + [uu____1758; FStar_Format.text ")"] in + (FStar_Format.text x) :: uu____1755 in + (FStar_Format.text "(") :: uu____1752 in + FStar_Format.reduce1 uu____1749 else FStar_Format.text x in let ids1 = FStar_List.map - (fun uu____1784 -> - match uu____1784 with + (fun uu____1781 -> + match uu____1781 with | (x,xt) -> bvar_annot x (FStar_Pervasives_Native.Some xt)) ids in let body1 = doc_of_expr currentModule (min_op_prec, NonAssoc) body in let doc1 = - let uu____1797 = - let uu____1800 = - let uu____1803 = FStar_Format.reduce1 ids1 in - [uu____1803; FStar_Format.text "->"; body1] in - (FStar_Format.text "fun") :: uu____1800 in - FStar_Format.reduce1 uu____1797 in + let uu____1794 = + let uu____1797 = + let uu____1800 = FStar_Format.reduce1 ids1 in + [uu____1800; FStar_Format.text "->"; body1] in + (FStar_Format.text "fun") :: uu____1797 in + FStar_Format.reduce1 uu____1794 in FStar_Format.parens doc1 | FStar_Extraction_ML_Syntax.MLE_If (cond,e1,FStar_Pervasives_Native.None ) -> let cond1 = doc_of_expr currentModule (min_op_prec, NonAssoc) cond in let doc1 = - let uu____1814 = - let uu____1817 = + let uu____1811 = + let uu____1814 = FStar_Format.reduce1 [FStar_Format.text "if"; cond1; FStar_Format.text "then"; FStar_Format.text "begin"] in - let uu____1818 = - let uu____1821 = + let uu____1815 = + let uu____1818 = doc_of_expr currentModule (min_op_prec, NonAssoc) e1 in - [uu____1821; FStar_Format.text "end"] in - uu____1817 :: uu____1818 in - FStar_Format.combine FStar_Format.hardline uu____1814 in + [uu____1818; FStar_Format.text "end"] in + uu____1814 :: uu____1815 in + FStar_Format.combine FStar_Format.hardline uu____1811 in maybe_paren outer e_bin_prio_if doc1 | FStar_Extraction_ML_Syntax.MLE_If (cond,e1,FStar_Pervasives_Native.Some e2) -> let cond1 = doc_of_expr currentModule (min_op_prec, NonAssoc) cond in let doc1 = - let uu____1837 = - let uu____1840 = + let uu____1834 = + let uu____1837 = FStar_Format.reduce1 [FStar_Format.text "if"; cond1; FStar_Format.text "then"; FStar_Format.text "begin"] in - let uu____1841 = - let uu____1844 = + let uu____1838 = + let uu____1841 = doc_of_expr currentModule (min_op_prec, NonAssoc) e1 in - let uu____1849 = - let uu____1852 = + let uu____1846 = + let uu____1849 = FStar_Format.reduce1 [FStar_Format.text "end"; FStar_Format.text "else"; FStar_Format.text "begin"] in - let uu____1853 = - let uu____1856 = + let uu____1850 = + let uu____1853 = doc_of_expr currentModule (min_op_prec, NonAssoc) e2 in - [uu____1856; FStar_Format.text "end"] in - uu____1852 :: uu____1853 in - uu____1844 :: uu____1849 in - uu____1840 :: uu____1841 in - FStar_Format.combine FStar_Format.hardline uu____1837 in + [uu____1853; FStar_Format.text "end"] in + uu____1849 :: uu____1850 in + uu____1841 :: uu____1846 in + uu____1837 :: uu____1838 in + FStar_Format.combine FStar_Format.hardline uu____1834 in maybe_paren outer e_bin_prio_if doc1 | FStar_Extraction_ML_Syntax.MLE_Match (cond,pats) -> let cond1 = doc_of_expr currentModule (min_op_prec, NonAssoc) cond in let pats1 = FStar_List.map (doc_of_branch currentModule) pats in let doc1 = - let uu____1894 = + let uu____1891 = FStar_Format.reduce1 [FStar_Format.text "match"; FStar_Format.parens cond1; FStar_Format.text "with"] in - uu____1894 :: pats1 in + uu____1891 :: pats1 in let doc2 = FStar_Format.combine FStar_Format.hardline doc1 in FStar_Format.parens doc2 | FStar_Extraction_ML_Syntax.MLE_Raise (exn,[]) -> - let uu____1899 = - let uu____1902 = - let uu____1905 = - let uu____1906 = ptctor currentModule exn in - FStar_Format.text uu____1906 in - [uu____1905] in - (FStar_Format.text "raise") :: uu____1902 in - FStar_Format.reduce1 uu____1899 + let uu____1896 = + let uu____1899 = + let uu____1902 = + let uu____1903 = ptctor currentModule exn in + FStar_Format.text uu____1903 in + [uu____1902] in + (FStar_Format.text "raise") :: uu____1899 in + FStar_Format.reduce1 uu____1896 | FStar_Extraction_ML_Syntax.MLE_Raise (exn,args) -> let args1 = FStar_List.map (doc_of_expr currentModule (min_op_prec, NonAssoc)) args in - let uu____1920 = - let uu____1923 = - let uu____1926 = - let uu____1927 = ptctor currentModule exn in - FStar_Format.text uu____1927 in - let uu____1928 = - let uu____1931 = - let uu____1932 = + let uu____1917 = + let uu____1920 = + let uu____1923 = + let uu____1924 = ptctor currentModule exn in + FStar_Format.text uu____1924 in + let uu____1925 = + let uu____1928 = + let uu____1929 = FStar_Format.combine (FStar_Format.text ", ") args1 in - FStar_Format.parens uu____1932 in - [uu____1931] in - uu____1926 :: uu____1928 in - (FStar_Format.text "raise") :: uu____1923 in - FStar_Format.reduce1 uu____1920 + FStar_Format.parens uu____1929 in + [uu____1928] in + uu____1923 :: uu____1925 in + (FStar_Format.text "raise") :: uu____1920 in + FStar_Format.reduce1 uu____1917 | FStar_Extraction_ML_Syntax.MLE_Try (e1,pats) -> - let uu____1955 = - let uu____1958 = - let uu____1961 = + let uu____1952 = + let uu____1955 = + let uu____1958 = doc_of_expr currentModule (min_op_prec, NonAssoc) e1 in - let uu____1966 = - let uu____1969 = - let uu____1972 = - let uu____1973 = + let uu____1963 = + let uu____1966 = + let uu____1969 = + let uu____1970 = FStar_List.map (doc_of_branch currentModule) pats in - FStar_Format.combine FStar_Format.hardline uu____1973 in - [uu____1972] in - (FStar_Format.text "with") :: uu____1969 in - uu____1961 :: uu____1966 in - (FStar_Format.text "try") :: uu____1958 in - FStar_Format.combine FStar_Format.hardline uu____1955 + FStar_Format.combine FStar_Format.hardline uu____1970 in + [uu____1969] in + (FStar_Format.text "with") :: uu____1966 in + uu____1958 :: uu____1963 in + (FStar_Format.text "try") :: uu____1955 in + FStar_Format.combine FStar_Format.hardline uu____1952 | FStar_Extraction_ML_Syntax.MLE_TApp (head1,ty_args) -> doc_of_expr currentModule outer head1 and doc_of_binop: @@ -839,10 +839,10 @@ and doc_of_binop: fun p -> fun e1 -> fun e2 -> - let uu____1986 = - let uu____1997 = as_bin_op p in FStar_Option.get uu____1997 in - match uu____1986 with - | (uu____2020,prio,txt) -> + let uu____1983 = + let uu____1994 = as_bin_op p in FStar_Option.get uu____1994 in + match uu____1983 with + | (uu____2017,prio,txt) -> let e11 = doc_of_expr currentModule (prio, Left) e1 in let e21 = doc_of_expr currentModule (prio, Right) e2 in let doc1 = @@ -856,10 +856,10 @@ and doc_of_uniop: fun currentModule -> fun p -> fun e1 -> - let uu____2045 = - let uu____2050 = as_uni_op p in FStar_Option.get uu____2050 in - match uu____2045 with - | (uu____2061,txt) -> + let uu____2042 = + let uu____2047 = as_uni_op p in FStar_Option.get uu____2047 in + match uu____2042 with + | (uu____2058,txt) -> let e11 = doc_of_expr currentModule (min_op_prec, NonAssoc) e1 in let doc1 = FStar_Format.reduce1 @@ -874,91 +874,91 @@ and doc_of_pattern: match pattern with | FStar_Extraction_ML_Syntax.MLP_Wild -> FStar_Format.text "_" | FStar_Extraction_ML_Syntax.MLP_Const c -> - let uu____2072 = string_of_mlconstant c in - FStar_Format.text uu____2072 + let uu____2069 = string_of_mlconstant c in + FStar_Format.text uu____2069 | FStar_Extraction_ML_Syntax.MLP_Var x -> FStar_Format.text x | FStar_Extraction_ML_Syntax.MLP_Record (path,fields) -> - let for1 uu____2099 = - match uu____2099 with + let for1 uu____2096 = + match uu____2096 with | (name,p) -> - let uu____2106 = - let uu____2109 = - let uu____2110 = ptsym currentModule (path, name) in - FStar_Format.text uu____2110 in - let uu____2113 = - let uu____2116 = - let uu____2119 = doc_of_pattern currentModule p in - [uu____2119] in - (FStar_Format.text "=") :: uu____2116 in - uu____2109 :: uu____2113 in - FStar_Format.reduce1 uu____2106 in - let uu____2120 = - let uu____2121 = FStar_List.map for1 fields in - FStar_Format.combine (FStar_Format.text "; ") uu____2121 in - FStar_Format.cbrackets uu____2120 + let uu____2103 = + let uu____2106 = + let uu____2107 = ptsym currentModule (path, name) in + FStar_Format.text uu____2107 in + let uu____2110 = + let uu____2113 = + let uu____2116 = doc_of_pattern currentModule p in + [uu____2116] in + (FStar_Format.text "=") :: uu____2113 in + uu____2106 :: uu____2110 in + FStar_Format.reduce1 uu____2103 in + let uu____2117 = + let uu____2118 = FStar_List.map for1 fields in + FStar_Format.combine (FStar_Format.text "; ") uu____2118 in + FStar_Format.cbrackets uu____2117 | FStar_Extraction_ML_Syntax.MLP_CTor (ctor,[]) -> let name = - let uu____2132 = is_standard_constructor ctor in - if uu____2132 + let uu____2129 = is_standard_constructor ctor in + if uu____2129 then - let uu____2133 = - let uu____2138 = as_standard_constructor ctor in - FStar_Option.get uu____2138 in - FStar_Pervasives_Native.snd uu____2133 + let uu____2130 = + let uu____2135 = as_standard_constructor ctor in + FStar_Option.get uu____2135 in + FStar_Pervasives_Native.snd uu____2130 else ptctor currentModule ctor in FStar_Format.text name | FStar_Extraction_ML_Syntax.MLP_CTor (ctor,pats) -> let name = - let uu____2157 = is_standard_constructor ctor in - if uu____2157 + let uu____2154 = is_standard_constructor ctor in + if uu____2154 then - let uu____2158 = - let uu____2163 = as_standard_constructor ctor in - FStar_Option.get uu____2163 in - FStar_Pervasives_Native.snd uu____2158 + let uu____2155 = + let uu____2160 = as_standard_constructor ctor in + FStar_Option.get uu____2160 in + FStar_Pervasives_Native.snd uu____2155 else ptctor currentModule ctor in let doc1 = match (name, pats) with | ("::",x::xs::[]) -> - let uu____2182 = - let uu____2185 = - let uu____2186 = doc_of_pattern currentModule x in - FStar_Format.parens uu____2186 in - let uu____2187 = - let uu____2190 = - let uu____2193 = doc_of_pattern currentModule xs in - [uu____2193] in - (FStar_Format.text "::") :: uu____2190 in - uu____2185 :: uu____2187 in - FStar_Format.reduce uu____2182 - | (uu____2194,(FStar_Extraction_ML_Syntax.MLP_Tuple - uu____2195)::[]) -> - let uu____2200 = - let uu____2203 = - let uu____2206 = - let uu____2207 = FStar_List.hd pats in - doc_of_pattern currentModule uu____2207 in - [uu____2206] in - (FStar_Format.text name) :: uu____2203 in - FStar_Format.reduce1 uu____2200 - | uu____2208 -> - let uu____2215 = - let uu____2218 = - let uu____2221 = - let uu____2222 = - let uu____2223 = + let uu____2179 = + let uu____2182 = + let uu____2183 = doc_of_pattern currentModule x in + FStar_Format.parens uu____2183 in + let uu____2184 = + let uu____2187 = + let uu____2190 = doc_of_pattern currentModule xs in + [uu____2190] in + (FStar_Format.text "::") :: uu____2187 in + uu____2182 :: uu____2184 in + FStar_Format.reduce uu____2179 + | (uu____2191,(FStar_Extraction_ML_Syntax.MLP_Tuple + uu____2192)::[]) -> + let uu____2197 = + let uu____2200 = + let uu____2203 = + let uu____2204 = FStar_List.hd pats in + doc_of_pattern currentModule uu____2204 in + [uu____2203] in + (FStar_Format.text name) :: uu____2200 in + FStar_Format.reduce1 uu____2197 + | uu____2205 -> + let uu____2212 = + let uu____2215 = + let uu____2218 = + let uu____2219 = + let uu____2220 = FStar_List.map (doc_of_pattern currentModule) pats in FStar_Format.combine (FStar_Format.text ", ") - uu____2223 in - FStar_Format.parens uu____2222 in - [uu____2221] in - (FStar_Format.text name) :: uu____2218 in - FStar_Format.reduce1 uu____2215 in + uu____2220 in + FStar_Format.parens uu____2219 in + [uu____2218] in + (FStar_Format.text name) :: uu____2215 in + FStar_Format.reduce1 uu____2212 in maybe_paren (min_op_prec, NonAssoc) e_app_prio doc1 | FStar_Extraction_ML_Syntax.MLP_Tuple ps -> let ps1 = FStar_List.map (doc_of_pattern currentModule) ps in - let uu____2236 = FStar_Format.combine (FStar_Format.text ", ") ps1 in - FStar_Format.parens uu____2236 + let uu____2233 = FStar_Format.combine (FStar_Format.text ", ") ps1 in + FStar_Format.parens uu____2233 | FStar_Extraction_ML_Syntax.MLP_Branch ps -> let ps1 = FStar_List.map (doc_of_pattern currentModule) ps in let ps2 = FStar_List.map FStar_Format.parens ps1 in @@ -968,36 +968,36 @@ and doc_of_branch: FStar_Extraction_ML_Syntax.mlbranch -> FStar_Format.doc = fun currentModule -> - fun uu____2247 -> - match uu____2247 with + fun uu____2244 -> + match uu____2244 with | (p,cond,e) -> let case = match cond with | FStar_Pervasives_Native.None -> - let uu____2256 = - let uu____2259 = - let uu____2262 = doc_of_pattern currentModule p in - [uu____2262] in - (FStar_Format.text "|") :: uu____2259 in - FStar_Format.reduce1 uu____2256 + let uu____2253 = + let uu____2256 = + let uu____2259 = doc_of_pattern currentModule p in + [uu____2259] in + (FStar_Format.text "|") :: uu____2256 in + FStar_Format.reduce1 uu____2253 | FStar_Pervasives_Native.Some c -> let c1 = doc_of_expr currentModule (min_op_prec, NonAssoc) c in - let uu____2269 = - let uu____2272 = - let uu____2275 = doc_of_pattern currentModule p in - [uu____2275; FStar_Format.text "when"; c1] in - (FStar_Format.text "|") :: uu____2272 in - FStar_Format.reduce1 uu____2269 in - let uu____2276 = - let uu____2279 = + let uu____2266 = + let uu____2269 = + let uu____2272 = doc_of_pattern currentModule p in + [uu____2272; FStar_Format.text "when"; c1] in + (FStar_Format.text "|") :: uu____2269 in + FStar_Format.reduce1 uu____2266 in + let uu____2273 = + let uu____2276 = FStar_Format.reduce1 [case; FStar_Format.text "->"; FStar_Format.text "begin"] in - let uu____2280 = - let uu____2283 = + let uu____2277 = + let uu____2280 = doc_of_expr currentModule (min_op_prec, NonAssoc) e in - [uu____2283; FStar_Format.text "end"] in - uu____2279 :: uu____2280 in - FStar_Format.combine FStar_Format.hardline uu____2276 + [uu____2280; FStar_Format.text "end"] in + uu____2276 :: uu____2277 in + FStar_Format.combine FStar_Format.hardline uu____2273 and doc_of_lets: FStar_Extraction_ML_Syntax.mlsymbol -> (FStar_Extraction_ML_Syntax.mlletflavor,Prims.bool,FStar_Extraction_ML_Syntax.mllb @@ -1005,15 +1005,16 @@ and doc_of_lets: FStar_Pervasives_Native.tuple3 -> FStar_Format.doc = fun currentModule -> - fun uu____2289 -> - match uu____2289 with + fun uu____2286 -> + match uu____2286 with | (rec_,top_level,lets) -> - let for1 uu____2308 = - match uu____2308 with + let for1 uu____2305 = + match uu____2305 with | { FStar_Extraction_ML_Syntax.mllb_name = name; FStar_Extraction_ML_Syntax.mllb_tysc = tys; - FStar_Extraction_ML_Syntax.mllb_add_unit = uu____2311; + FStar_Extraction_ML_Syntax.mllb_add_unit = uu____2308; FStar_Extraction_ML_Syntax.mllb_def = e; + FStar_Extraction_ML_Syntax.mllb_meta = uu____2310; FStar_Extraction_ML_Syntax.print_typ = pt;_} -> let e1 = doc_of_expr currentModule (min_op_prec, NonAssoc) e in let ids = [] in @@ -1021,15 +1022,15 @@ and doc_of_lets: if Prims.op_Negation pt then FStar_Format.text "" else - (let uu____2326 = + (let uu____2324 = (FStar_Options.codegen_fsharp ()) && ((rec_ = FStar_Extraction_ML_Syntax.Rec) || top_level) in - if uu____2326 + if uu____2324 then match tys with | FStar_Pervasives_Native.Some - (uu____2327::uu____2328,uu____2329) -> + (uu____2325::uu____2326,uu____2327) -> FStar_Format.text "" | FStar_Pervasives_Native.None -> FStar_Format.text "" @@ -1055,7 +1056,7 @@ and doc_of_lets: doc_of_mltype currentModule (min_op_prec, NonAssoc) ty in let vars = - let uu____2381 = + let uu____2379 = FStar_All.pipe_right vs (FStar_List.map (fun x -> @@ -1063,7 +1064,7 @@ and doc_of_lets: (min_op_prec, NonAssoc) (FStar_Extraction_ML_Syntax.MLTY_Var x))) in - FStar_All.pipe_right uu____2381 + FStar_All.pipe_right uu____2379 FStar_Format.reduce1 in FStar_Format.reduce1 [FStar_Format.text ":"; @@ -1071,12 +1072,12 @@ and doc_of_lets: FStar_Format.text "."; ty1]) else FStar_Format.text "") in - let uu____2395 = - let uu____2398 = - let uu____2401 = FStar_Format.reduce1 ids in - [uu____2401; ty_annot; FStar_Format.text "="; e1] in - (FStar_Format.text name) :: uu____2398 in - FStar_Format.reduce1 uu____2395 in + let uu____2393 = + let uu____2396 = + let uu____2399 = FStar_Format.reduce1 ids in + [uu____2399; ty_annot; FStar_Format.text "="; e1] in + (FStar_Format.text name) :: uu____2396 in + FStar_Format.reduce1 uu____2393 in let letdoc = if rec_ = FStar_Extraction_ML_Syntax.Rec then @@ -1095,13 +1096,13 @@ and doc_of_lets: doc1]) lets1 in FStar_Format.combine FStar_Format.hardline lets2 and doc_of_loc: FStar_Extraction_ML_Syntax.mlloc -> FStar_Format.doc = - fun uu____2415 -> - match uu____2415 with + fun uu____2413 -> + match uu____2413 with | (lineno,file) -> - let uu____2418 = + let uu____2416 = (FStar_Options.no_location_info ()) || (FStar_Options.codegen_fsharp ()) in - if uu____2418 + if uu____2416 then FStar_Format.empty else (let file1 = FStar_Util.basename file in @@ -1115,9 +1116,9 @@ let doc_of_mltydecl: = fun currentModule -> fun decls -> - let for1 uu____2448 = - match uu____2448 with - | (uu____2467,x,mangle_opt,tparams,uu____2471,body) -> + let for1 uu____2446 = + match uu____2446 with + | (uu____2465,x,mangle_opt,tparams,uu____2469,body) -> let x1 = match mangle_opt with | FStar_Pervasives_Native.None -> x @@ -1126,19 +1127,19 @@ let doc_of_mltydecl: match tparams with | [] -> FStar_Format.empty | x2::[] -> FStar_Format.text x2 - | uu____2489 -> + | uu____2487 -> let doc1 = FStar_List.map (fun x2 -> FStar_Format.text x2) tparams in - let uu____2497 = + let uu____2495 = FStar_Format.combine (FStar_Format.text ", ") doc1 in - FStar_Format.parens uu____2497 in + FStar_Format.parens uu____2495 in let forbody body1 = match body1 with | FStar_Extraction_ML_Syntax.MLTD_Abbrev ty -> doc_of_mltype currentModule (min_op_prec, NonAssoc) ty | FStar_Extraction_ML_Syntax.MLTD_Record fields -> - let forfield uu____2521 = - match uu____2521 with + let forfield uu____2519 = + match uu____2519 with | (name,ty) -> let name1 = FStar_Format.text name in let ty1 = @@ -1146,20 +1147,20 @@ let doc_of_mltydecl: ty in FStar_Format.reduce1 [name1; FStar_Format.text ":"; ty1] in - let uu____2534 = - let uu____2535 = FStar_List.map forfield fields in - FStar_Format.combine (FStar_Format.text "; ") uu____2535 in - FStar_Format.cbrackets uu____2534 + let uu____2532 = + let uu____2533 = FStar_List.map forfield fields in + FStar_Format.combine (FStar_Format.text "; ") uu____2533 in + FStar_Format.cbrackets uu____2532 | FStar_Extraction_ML_Syntax.MLTD_DType ctors -> - let forctor uu____2568 = - match uu____2568 with + let forctor uu____2566 = + match uu____2566 with | (name,tys) -> - let uu____2593 = FStar_List.split tys in - (match uu____2593 with + let uu____2591 = FStar_List.split tys in + (match uu____2591 with | (_names,tys1) -> (match tys1 with | [] -> FStar_Format.text name - | uu____2612 -> + | uu____2610 -> let tys2 = FStar_List.map (doc_of_mltype currentModule @@ -1179,34 +1180,34 @@ let doc_of_mltydecl: ctors1 in FStar_Format.combine FStar_Format.hardline ctors2 in let doc1 = - let uu____2642 = - let uu____2645 = - let uu____2648 = - let uu____2649 = ptsym currentModule ([], x1) in - FStar_Format.text uu____2649 in - [uu____2648] in - tparams1 :: uu____2645 in - FStar_Format.reduce1 uu____2642 in + let uu____2640 = + let uu____2643 = + let uu____2646 = + let uu____2647 = ptsym currentModule ([], x1) in + FStar_Format.text uu____2647 in + [uu____2646] in + tparams1 :: uu____2643 in + FStar_Format.reduce1 uu____2640 in (match body with | FStar_Pervasives_Native.None -> doc1 | FStar_Pervasives_Native.Some body1 -> let body2 = forbody body1 in - let uu____2654 = - let uu____2657 = + let uu____2652 = + let uu____2655 = FStar_Format.reduce1 [doc1; FStar_Format.text "="] in - [uu____2657; body2] in - FStar_Format.combine FStar_Format.hardline uu____2654) in + [uu____2655; body2] in + FStar_Format.combine FStar_Format.hardline uu____2652) in let doc1 = FStar_List.map for1 decls in let doc2 = if (FStar_List.length doc1) > (Prims.parse_int "0") then - let uu____2680 = - let uu____2683 = - let uu____2686 = + let uu____2678 = + let uu____2681 = + let uu____2684 = FStar_Format.combine (FStar_Format.text " \n and ") doc1 in - [uu____2686] in - (FStar_Format.text "type") :: uu____2683 in - FStar_Format.reduce1 uu____2680 + [uu____2684] in + (FStar_Format.text "type") :: uu____2681 in + FStar_Format.reduce1 uu____2678 else FStar_Format.text "" in doc2 let rec doc_of_sig1: @@ -1217,21 +1218,21 @@ let rec doc_of_sig1: fun s -> match s with | FStar_Extraction_ML_Syntax.MLS_Mod (x,subsig) -> - let uu____2704 = - let uu____2707 = + let uu____2702 = + let uu____2705 = FStar_Format.reduce1 [FStar_Format.text "module"; FStar_Format.text x; FStar_Format.text "="] in - let uu____2708 = - let uu____2711 = doc_of_sig currentModule subsig in - let uu____2712 = - let uu____2715 = + let uu____2706 = + let uu____2709 = doc_of_sig currentModule subsig in + let uu____2710 = + let uu____2713 = FStar_Format.reduce1 [FStar_Format.text "end"] in - [uu____2715] in - uu____2711 :: uu____2712 in - uu____2707 :: uu____2708 in - FStar_Format.combine FStar_Format.hardline uu____2704 + [uu____2713] in + uu____2709 :: uu____2710 in + uu____2705 :: uu____2706 in + FStar_Format.combine FStar_Format.hardline uu____2702 | FStar_Extraction_ML_Syntax.MLS_Exn (x,[]) -> FStar_Format.reduce1 [FStar_Format.text "exception"; FStar_Format.text x] @@ -1240,15 +1241,15 @@ let rec doc_of_sig1: FStar_List.map (doc_of_mltype currentModule (min_op_prec, NonAssoc)) args in let args2 = - let uu____2733 = + let uu____2731 = FStar_Format.combine (FStar_Format.text " * ") args1 in - FStar_Format.parens uu____2733 in + FStar_Format.parens uu____2731 in FStar_Format.reduce1 [FStar_Format.text "exception"; FStar_Format.text x; FStar_Format.text "of"; args2] - | FStar_Extraction_ML_Syntax.MLS_Val (x,(uu____2735,ty)) -> + | FStar_Extraction_ML_Syntax.MLS_Val (x,(uu____2733,ty)) -> let ty1 = doc_of_mltype currentModule (min_op_prec, NonAssoc) ty in FStar_Format.reduce1 [FStar_Format.text "val"; @@ -1286,9 +1287,9 @@ let doc_of_mod1: FStar_List.map (doc_of_mltype currentModule (min_op_prec, NonAssoc)) args1 in let args3 = - let uu____2803 = + let uu____2801 = FStar_Format.combine (FStar_Format.text " * ") args2 in - FStar_Format.parens uu____2803 in + FStar_Format.parens uu____2801 in FStar_Format.reduce1 [FStar_Format.text "exception"; FStar_Format.text x; @@ -1296,20 +1297,20 @@ let doc_of_mod1: args3] | FStar_Extraction_ML_Syntax.MLM_Ty decls -> doc_of_mltydecl currentModule decls - | FStar_Extraction_ML_Syntax.MLM_Let (rec_,uu____2806,lets) -> + | FStar_Extraction_ML_Syntax.MLM_Let (rec_,lets) -> doc_of_lets currentModule (rec_, true, lets) | FStar_Extraction_ML_Syntax.MLM_Top e -> - let uu____2815 = - let uu____2818 = - let uu____2821 = - let uu____2824 = - let uu____2827 = + let uu____2812 = + let uu____2815 = + let uu____2818 = + let uu____2821 = + let uu____2824 = doc_of_expr currentModule (min_op_prec, NonAssoc) e in - [uu____2827] in - (FStar_Format.text "=") :: uu____2824 in - (FStar_Format.text "_") :: uu____2821 in - (FStar_Format.text "let") :: uu____2818 in - FStar_Format.reduce1 uu____2815 + [uu____2824] in + (FStar_Format.text "=") :: uu____2821 in + (FStar_Format.text "_") :: uu____2818 in + (FStar_Format.text "let") :: uu____2815 in + FStar_Format.reduce1 uu____2812 | FStar_Extraction_ML_Syntax.MLM_Loc loc -> doc_of_loc loc let doc_of_mod: FStar_Extraction_ML_Syntax.mlsymbol -> @@ -1323,20 +1324,20 @@ let doc_of_mod: let doc1 = doc_of_mod1 currentModule x in [doc1; (match x with - | FStar_Extraction_ML_Syntax.MLM_Loc uu____2851 -> + | FStar_Extraction_ML_Syntax.MLM_Loc uu____2848 -> FStar_Format.empty - | uu____2852 -> FStar_Format.hardline); + | uu____2849 -> FStar_Format.hardline); FStar_Format.hardline]) m in FStar_Format.reduce (FStar_List.flatten docs) let rec doc_of_mllib_r: FStar_Extraction_ML_Syntax.mllib -> (Prims.string,FStar_Format.doc) FStar_Pervasives_Native.tuple2 Prims.list = - fun uu____2861 -> - match uu____2861 with + fun uu____2858 -> + match uu____2858 with | FStar_Extraction_ML_Syntax.MLLib mllib -> - let rec for1_sig uu____2927 = - match uu____2927 with + let rec for1_sig uu____2924 = + match uu____2924 with | (x,sigmod,FStar_Extraction_ML_Syntax.MLLib sub1) -> let x1 = FStar_Extraction_ML_Util.flatten_mlpath x in let head1 = @@ -1348,9 +1349,9 @@ let rec doc_of_mllib_r: let tail1 = FStar_Format.reduce1 [FStar_Format.text "end"] in let doc1 = FStar_Option.map - (fun uu____3000 -> - match uu____3000 with - | (s,uu____3006) -> doc_of_sig x1 s) sigmod in + (fun uu____2997 -> + match uu____2997 with + | (s,uu____3003) -> doc_of_sig x1 s) sigmod in let sub2 = FStar_List.map for1_sig sub1 in let sub3 = FStar_List.map @@ -1358,37 +1359,37 @@ let rec doc_of_mllib_r: FStar_Format.reduce [x2; FStar_Format.hardline; FStar_Format.hardline]) sub2 in - let uu____3033 = - let uu____3036 = - let uu____3039 = - let uu____3042 = FStar_Format.reduce sub3 in - [uu____3042; + let uu____3030 = + let uu____3033 = + let uu____3036 = + let uu____3039 = FStar_Format.reduce sub3 in + [uu____3039; FStar_Format.cat tail1 FStar_Format.hardline] in (match doc1 with | FStar_Pervasives_Native.None -> FStar_Format.empty | FStar_Pervasives_Native.Some s -> FStar_Format.cat s FStar_Format.hardline) - :: uu____3039 in - (FStar_Format.cat head1 FStar_Format.hardline) :: uu____3036 in - FStar_Format.reduce uu____3033 - and for1_mod istop uu____3045 = - match uu____3045 with + :: uu____3036 in + (FStar_Format.cat head1 FStar_Format.hardline) :: uu____3033 in + FStar_Format.reduce uu____3030 + and for1_mod istop uu____3042 = + match uu____3042 with | (mod_name1,sigmod,FStar_Extraction_ML_Syntax.MLLib sub1) -> let target_mod_name = FStar_Extraction_ML_Util.flatten_mlpath mod_name1 in let maybe_open_pervasives = match mod_name1 with | ("FStar"::[],"Pervasives") -> [] - | uu____3113 -> + | uu____3110 -> let pervasives1 = FStar_Extraction_ML_Util.flatten_mlpath (["FStar"], "Pervasives") in [FStar_Format.hardline; FStar_Format.text (Prims.strcat "open " pervasives1)] in let head1 = - let uu____3124 = - let uu____3127 = FStar_Options.codegen_fsharp () in - if uu____3127 + let uu____3121 = + let uu____3124 = FStar_Options.codegen_fsharp () in + if uu____3124 then [FStar_Format.text "module"; FStar_Format.text target_mod_name] @@ -1400,16 +1401,16 @@ let rec doc_of_mllib_r: FStar_Format.text "="; FStar_Format.text "struct"] else [] in - FStar_Format.reduce1 uu____3124 in + FStar_Format.reduce1 uu____3121 in let tail1 = if Prims.op_Negation istop then FStar_Format.reduce1 [FStar_Format.text "end"] else FStar_Format.reduce1 [] in let doc1 = FStar_Option.map - (fun uu____3146 -> - match uu____3146 with - | (uu____3151,m) -> doc_of_mod target_mod_name m) sigmod in + (fun uu____3143 -> + match uu____3143 with + | (uu____3148,m) -> doc_of_mod target_mod_name m) sigmod in let sub2 = FStar_List.map (for1_mod false) sub1 in let sub3 = FStar_List.map @@ -1418,43 +1419,43 @@ let rec doc_of_mllib_r: [x; FStar_Format.hardline; FStar_Format.hardline]) sub2 in let prefix1 = - let uu____3182 = FStar_Options.codegen_fsharp () in - if uu____3182 + let uu____3179 = FStar_Options.codegen_fsharp () in + if uu____3179 then [FStar_Format.cat (FStar_Format.text "#light \"off\"") FStar_Format.hardline] else [] in - let uu____3186 = - let uu____3189 = - let uu____3192 = - let uu____3195 = - let uu____3198 = - let uu____3201 = - let uu____3204 = FStar_Format.reduce sub3 in - [uu____3204; + let uu____3183 = + let uu____3186 = + let uu____3189 = + let uu____3192 = + let uu____3195 = + let uu____3198 = + let uu____3201 = FStar_Format.reduce sub3 in + [uu____3201; FStar_Format.cat tail1 FStar_Format.hardline] in (match doc1 with | FStar_Pervasives_Native.None -> FStar_Format.empty | FStar_Pervasives_Native.Some s -> FStar_Format.cat s FStar_Format.hardline) - :: uu____3201 in - FStar_Format.hardline :: uu____3198 in - FStar_List.append maybe_open_pervasives uu____3195 in + :: uu____3198 in + FStar_Format.hardline :: uu____3195 in + FStar_List.append maybe_open_pervasives uu____3192 in FStar_List.append [head1; FStar_Format.hardline; - FStar_Format.text "open Prims"] uu____3192 in - FStar_List.append prefix1 uu____3189 in - FStar_All.pipe_left FStar_Format.reduce uu____3186 in + FStar_Format.text "open Prims"] uu____3189 in + FStar_List.append prefix1 uu____3186 in + FStar_All.pipe_left FStar_Format.reduce uu____3183 in let docs = FStar_List.map - (fun uu____3243 -> - match uu____3243 with + (fun uu____3240 -> + match uu____3240 with | (x,s,m) -> - let uu____3293 = FStar_Extraction_ML_Util.flatten_mlpath x in - let uu____3294 = for1_mod true (x, s, m) in - (uu____3293, uu____3294)) mllib in + let uu____3290 = FStar_Extraction_ML_Util.flatten_mlpath x in + let uu____3291 = for1_mod true (x, s, m) in + (uu____3290, uu____3291)) mllib in docs let doc_of_mllib: FStar_Extraction_ML_Syntax.mllib -> @@ -1467,8 +1468,8 @@ let string_of_mlexpr: fun cmod -> fun e -> let doc1 = - let uu____3323 = FStar_Extraction_ML_Util.flatten_mlpath cmod in - doc_of_expr uu____3323 (min_op_prec, NonAssoc) e in + let uu____3320 = FStar_Extraction_ML_Util.flatten_mlpath cmod in + doc_of_expr uu____3320 (min_op_prec, NonAssoc) e in FStar_Format.pretty (Prims.parse_int "0") doc1 let string_of_mlty: FStar_Extraction_ML_Syntax.mlpath -> @@ -1477,6 +1478,6 @@ let string_of_mlty: fun cmod -> fun e -> let doc1 = - let uu____3335 = FStar_Extraction_ML_Util.flatten_mlpath cmod in - doc_of_mltype uu____3335 (min_op_prec, NonAssoc) e in + let uu____3332 = FStar_Extraction_ML_Util.flatten_mlpath cmod in + doc_of_mltype uu____3332 (min_op_prec, NonAssoc) e in FStar_Format.pretty (Prims.parse_int "0") doc1 \ No newline at end of file diff --git a/src/ocaml-output/FStar_Extraction_ML_Modul.ml b/src/ocaml-output/FStar_Extraction_ML_Modul.ml index a5e66567824..e4325cd8365 100644 --- a/src/ocaml-output/FStar_Extraction_ML_Modul.ml +++ b/src/ocaml-output/FStar_Extraction_ML_Modul.ml @@ -185,24 +185,15 @@ let rec extract_meta: | { FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_meta (x1,uu____251); FStar_Syntax_Syntax.pos = uu____252; FStar_Syntax_Syntax.vars = uu____253;_} -> extract_meta x1 - | a -> - ((let uu____262 = - let uu____267 = - let uu____268 = FStar_Syntax_Print.term_to_string a in - FStar_Util.format1 - "Unrecognized attribute (%s), valid attributes are `c_inline`, `substitute`, and `gc`.\n" - uu____268 in - (FStar_Errors.Warning_UnrecognizedAttribute, uu____267) in - FStar_Errors.log_issue a.FStar_Syntax_Syntax.pos uu____262); - FStar_Pervasives_Native.None) + | a -> FStar_Pervasives_Native.None let extract_metadata: FStar_Syntax_Syntax.term Prims.list -> FStar_Extraction_ML_Syntax.meta Prims.list = fun metas -> FStar_List.choose extract_meta metas let binders_as_mlty_binders: - 'Auu____281 . + 'Auu____273 . FStar_Extraction_ML_UEnv.env -> - (FStar_Syntax_Syntax.bv,'Auu____281) FStar_Pervasives_Native.tuple2 + (FStar_Syntax_Syntax.bv,'Auu____273) FStar_Pervasives_Native.tuple2 Prims.list -> (FStar_Extraction_ML_UEnv.env,Prims.string Prims.list) FStar_Pervasives_Native.tuple2 @@ -211,19 +202,19 @@ let binders_as_mlty_binders: fun bs -> FStar_Util.fold_map (fun env1 -> - fun uu____319 -> - match uu____319 with - | (bv,uu____329) -> - let uu____330 = - let uu____331 = - let uu____334 = - let uu____335 = + fun uu____311 -> + match uu____311 with + | (bv,uu____321) -> + let uu____322 = + let uu____323 = + let uu____326 = + let uu____327 = FStar_Extraction_ML_UEnv.bv_as_ml_tyvar bv in - FStar_Extraction_ML_Syntax.MLTY_Var uu____335 in - FStar_Pervasives_Native.Some uu____334 in - FStar_Extraction_ML_UEnv.extend_ty env1 bv uu____331 in - let uu____336 = FStar_Extraction_ML_UEnv.bv_as_ml_tyvar bv in - (uu____330, uu____336)) env bs + FStar_Extraction_ML_Syntax.MLTY_Var uu____327 in + FStar_Pervasives_Native.Some uu____326 in + FStar_Extraction_ML_UEnv.extend_ty env1 bv uu____323 in + let uu____328 = FStar_Extraction_ML_UEnv.bv_as_ml_tyvar bv in + (uu____322, uu____328)) env bs let extract_typ_abbrev: FStar_Extraction_ML_UEnv.env -> FStar_Syntax_Syntax.fv -> @@ -241,47 +232,47 @@ let extract_typ_abbrev: fun def -> let lid = (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in let def1 = - let uu____368 = - let uu____369 = FStar_Syntax_Subst.compress def in - FStar_All.pipe_right uu____369 FStar_Syntax_Util.unmeta in - FStar_All.pipe_right uu____368 FStar_Syntax_Util.un_uinst in + let uu____360 = + let uu____361 = FStar_Syntax_Subst.compress def in + FStar_All.pipe_right uu____361 FStar_Syntax_Util.unmeta in + FStar_All.pipe_right uu____360 FStar_Syntax_Util.un_uinst in let def2 = match def1.FStar_Syntax_Syntax.n with - | FStar_Syntax_Syntax.Tm_abs uu____371 -> + | FStar_Syntax_Syntax.Tm_abs uu____363 -> FStar_Extraction_ML_Term.normalize_abs def1 - | uu____388 -> def1 in - let uu____389 = + | uu____380 -> def1 in + let uu____381 = match def2.FStar_Syntax_Syntax.n with - | FStar_Syntax_Syntax.Tm_abs (bs,body,uu____400) -> + | FStar_Syntax_Syntax.Tm_abs (bs,body,uu____392) -> FStar_Syntax_Subst.open_term bs body - | uu____421 -> ([], def2) in - match uu____389 with + | uu____413 -> ([], def2) in + match uu____381 with | (bs,body) -> let assumed = FStar_Util.for_some - (fun uu___68_442 -> - match uu___68_442 with + (fun uu___68_434 -> + match uu___68_434 with | FStar_Syntax_Syntax.Assumption -> true - | uu____443 -> false) quals in - let uu____444 = binders_as_mlty_binders env bs in - (match uu____444 with + | uu____435 -> false) quals in + let uu____436 = binders_as_mlty_binders env bs in + (match uu____436 with | (env1,ml_bs) -> let body1 = - let uu____464 = + let uu____456 = FStar_Extraction_ML_Term.term_as_mlty env1 body in - FStar_All.pipe_right uu____464 + FStar_All.pipe_right uu____456 (FStar_Extraction_ML_Util.eraseTypeDeep (FStar_Extraction_ML_Util.udelta_unfold env1)) in let mangled_projector = - let uu____468 = + let uu____460 = FStar_All.pipe_right quals (FStar_Util.for_some - (fun uu___69_473 -> - match uu___69_473 with - | FStar_Syntax_Syntax.Projector uu____474 -> + (fun uu___69_465 -> + match uu___69_465 with + | FStar_Syntax_Syntax.Projector uu____466 -> true - | uu____479 -> false)) in - if uu____468 + | uu____471 -> false)) in + if uu____460 then let mname = mangle_projector_lid lid in FStar_Pervasives_Native.Some @@ -289,30 +280,30 @@ let extract_typ_abbrev: else FStar_Pervasives_Native.None in let metadata = extract_metadata attrs in let td = - let uu____510 = - let uu____531 = lident_as_mlsymbol lid in - (assumed, uu____531, mangled_projector, ml_bs, + let uu____502 = + let uu____523 = lident_as_mlsymbol lid in + (assumed, uu____523, mangled_projector, ml_bs, metadata, (FStar_Pervasives_Native.Some (FStar_Extraction_ML_Syntax.MLTD_Abbrev body1))) in - [uu____510] in + [uu____502] in let def3 = - let uu____583 = - let uu____584 = + let uu____575 = + let uu____576 = FStar_Extraction_ML_Util.mlloc_of_range (FStar_Ident.range_of_lid lid) in - FStar_Extraction_ML_Syntax.MLM_Loc uu____584 in - [uu____583; FStar_Extraction_ML_Syntax.MLM_Ty td] in + FStar_Extraction_ML_Syntax.MLM_Loc uu____576 in + [uu____575; FStar_Extraction_ML_Syntax.MLM_Ty td] in let env2 = - let uu____586 = + let uu____578 = FStar_All.pipe_right quals (FStar_Util.for_some - (fun uu___70_590 -> - match uu___70_590 with + (fun uu___70_582 -> + match uu___70_582 with | FStar_Syntax_Syntax.Assumption -> true | FStar_Syntax_Syntax.New -> true - | uu____591 -> false)) in - if uu____586 + | uu____583 -> false)) in + if uu____578 then FStar_Extraction_ML_UEnv.extend_type_name env1 fv else FStar_Extraction_ML_UEnv.extend_tydef env1 fv td in (env2, def3)) @@ -388,27 +379,27 @@ let __proj__Mkinductive_family__item__imetadata: __fname__imetadata let print_ifamily: inductive_family -> Prims.unit = fun i -> - let uu____730 = FStar_Syntax_Print.lid_to_string i.iname in - let uu____731 = FStar_Syntax_Print.binders_to_string " " i.iparams in - let uu____732 = FStar_Syntax_Print.term_to_string i.ityp in - let uu____733 = - let uu____734 = + let uu____722 = FStar_Syntax_Print.lid_to_string i.iname in + let uu____723 = FStar_Syntax_Print.binders_to_string " " i.iparams in + let uu____724 = FStar_Syntax_Print.term_to_string i.ityp in + let uu____725 = + let uu____726 = FStar_All.pipe_right i.idatas (FStar_List.map (fun d -> - let uu____745 = FStar_Syntax_Print.lid_to_string d.dname in - let uu____746 = - let uu____747 = FStar_Syntax_Print.term_to_string d.dtyp in - Prims.strcat " : " uu____747 in - Prims.strcat uu____745 uu____746)) in - FStar_All.pipe_right uu____734 (FStar_String.concat "\n\t\t") in - FStar_Util.print4 "\n\t%s %s : %s { %s }\n" uu____730 uu____731 uu____732 - uu____733 + let uu____737 = FStar_Syntax_Print.lid_to_string d.dname in + let uu____738 = + let uu____739 = FStar_Syntax_Print.term_to_string d.dtyp in + Prims.strcat " : " uu____739 in + Prims.strcat uu____737 uu____738)) in + FStar_All.pipe_right uu____726 (FStar_String.concat "\n\t\t") in + FStar_Util.print4 "\n\t%s %s : %s { %s }\n" uu____722 uu____723 uu____724 + uu____725 let bundle_as_inductive_families: - 'Auu____755 . + 'Auu____747 . FStar_Extraction_ML_UEnv.env -> FStar_Syntax_Syntax.sigelt Prims.list -> - 'Auu____755 -> + 'Auu____747 -> FStar_Syntax_Syntax.attribute Prims.list -> (FStar_Extraction_ML_UEnv.env,inductive_family Prims.list) FStar_Pervasives_Native.tuple2 @@ -417,15 +408,15 @@ let bundle_as_inductive_families: fun ses -> fun quals -> fun attrs -> - let uu____786 = + let uu____778 = FStar_Util.fold_map (fun env1 -> fun se -> match se.FStar_Syntax_Syntax.sigel with | FStar_Syntax_Syntax.Sig_inductive_typ (l,_us,bs,t,_mut_i,datas) -> - let uu____833 = FStar_Syntax_Subst.open_term bs t in - (match uu____833 with + let uu____825 = FStar_Syntax_Subst.open_term bs t in + (match uu____825 with | (bs1,t1) -> let datas1 = FStar_All.pipe_right ses @@ -434,64 +425,64 @@ let bundle_as_inductive_families: match se1.FStar_Syntax_Syntax.sigel with | FStar_Syntax_Syntax.Sig_datacon - (d,uu____872,t2,l',nparams,uu____876) + (d,uu____864,t2,l',nparams,uu____868) when FStar_Ident.lid_equals l l' -> - let uu____881 = + let uu____873 = FStar_Syntax_Util.arrow_formals t2 in - (match uu____881 with + (match uu____873 with | (bs',body) -> - let uu____914 = + let uu____906 = FStar_Util.first_N (FStar_List.length bs1) bs' in - (match uu____914 with + (match uu____906 with | (bs_params,rest) -> let subst1 = FStar_List.map2 - (fun uu____985 -> - fun uu____986 -> - match (uu____985, - uu____986) + (fun uu____977 -> + fun uu____978 -> + match (uu____977, + uu____978) with - | ((b',uu____1004), - (b,uu____1006)) + | ((b',uu____996), + (b,uu____998)) -> - let uu____1015 + let uu____1007 = - let uu____1022 + let uu____1014 = FStar_Syntax_Syntax.bv_to_name b in (b', - uu____1022) in + uu____1014) in FStar_Syntax_Syntax.NT - uu____1015) + uu____1007) bs_params bs1 in let t3 = - let uu____1024 = - let uu____1027 = + let uu____1016 = + let uu____1019 = FStar_Syntax_Syntax.mk_Total body in FStar_Syntax_Util.arrow - rest uu____1027 in + rest uu____1019 in FStar_All.pipe_right - uu____1024 + uu____1016 (FStar_Syntax_Subst.subst subst1) in [{ dname = d; dtyp = t3 }])) - | uu____1032 -> [])) in + | uu____1024 -> [])) in let metadata = extract_metadata (FStar_List.append se.FStar_Syntax_Syntax.sigattrs attrs) in let env2 = - let uu____1037 = + let uu____1029 = FStar_Syntax_Syntax.lid_as_fv l FStar_Syntax_Syntax.Delta_constant FStar_Pervasives_Native.None in FStar_Extraction_ML_UEnv.extend_type_name env1 - uu____1037 in + uu____1029 in (env2, [{ iname = l; @@ -501,8 +492,8 @@ let bundle_as_inductive_families: iquals = (se.FStar_Syntax_Syntax.sigquals); imetadata = metadata }])) - | uu____1040 -> (env1, [])) env ses in - match uu____786 with + | uu____1032 -> (env1, [])) env ses in + match uu____778 with | (env1,ifams) -> (env1, (FStar_List.flatten ifams)) type env_t = FStar_Extraction_ML_UEnv.env[@@deriving show] let extract_bundle: @@ -515,10 +506,10 @@ let extract_bundle: fun se -> let extract_ctor ml_tyvars env1 ctor = let mlt = - let uu____1116 = + let uu____1108 = FStar_Extraction_ML_Term.term_as_mlty env1 ctor.dtyp in FStar_Extraction_ML_Util.eraseTypeDeep - (FStar_Extraction_ML_Util.udelta_unfold env1) uu____1116 in + (FStar_Extraction_ML_Util.udelta_unfold env1) uu____1108 in let steps = [FStar_TypeChecker_Normalize.Inlining; FStar_TypeChecker_Normalize.UnfoldUntil @@ -526,120 +517,120 @@ let extract_bundle: FStar_TypeChecker_Normalize.EraseUniverses; FStar_TypeChecker_Normalize.AllowUnboundUniverses] in let names1 = - let uu____1123 = - let uu____1124 = - let uu____1127 = + let uu____1115 = + let uu____1116 = + let uu____1119 = FStar_TypeChecker_Normalize.normalize steps env1.FStar_Extraction_ML_UEnv.tcenv ctor.dtyp in - FStar_Syntax_Subst.compress uu____1127 in - uu____1124.FStar_Syntax_Syntax.n in - match uu____1123 with - | FStar_Syntax_Syntax.Tm_arrow (bs,uu____1131) -> + FStar_Syntax_Subst.compress uu____1119 in + uu____1116.FStar_Syntax_Syntax.n in + match uu____1115 with + | FStar_Syntax_Syntax.Tm_arrow (bs,uu____1123) -> FStar_List.map - (fun uu____1157 -> - match uu____1157 with + (fun uu____1149 -> + match uu____1149 with | ({ FStar_Syntax_Syntax.ppname = ppname; - FStar_Syntax_Syntax.index = uu____1163; - FStar_Syntax_Syntax.sort = uu____1164;_},uu____1165) + FStar_Syntax_Syntax.index = uu____1155; + FStar_Syntax_Syntax.sort = uu____1156;_},uu____1157) -> ppname.FStar_Ident.idText) bs - | uu____1168 -> [] in + | uu____1160 -> [] in let tys = (ml_tyvars, mlt) in let fvv = FStar_Extraction_ML_UEnv.mkFvvar ctor.dname ctor.dtyp in - let uu____1179 = - let uu____1180 = + let uu____1171 = + let uu____1172 = FStar_Extraction_ML_UEnv.extend_fv env1 fvv tys false false in - FStar_Pervasives_Native.fst uu____1180 in - let uu____1185 = - let uu____1196 = lident_as_mlsymbol ctor.dname in - let uu____1197 = - let uu____1204 = FStar_Extraction_ML_Util.argTypes mlt in - FStar_List.zip names1 uu____1204 in - (uu____1196, uu____1197) in - (uu____1179, uu____1185) in + FStar_Pervasives_Native.fst uu____1172 in + let uu____1177 = + let uu____1188 = lident_as_mlsymbol ctor.dname in + let uu____1189 = + let uu____1196 = FStar_Extraction_ML_Util.argTypes mlt in + FStar_List.zip names1 uu____1196 in + (uu____1188, uu____1189) in + (uu____1171, uu____1177) in let extract_one_family env1 ind = - let uu____1252 = binders_as_mlty_binders env1 ind.iparams in - match uu____1252 with + let uu____1244 = binders_as_mlty_binders env1 ind.iparams in + match uu____1244 with | (env2,vars) -> - let uu____1287 = + let uu____1279 = FStar_All.pipe_right ind.idatas (FStar_Util.fold_map (extract_ctor vars) env2) in - (match uu____1287 with + (match uu____1279 with | (env3,ctors) -> - let uu____1380 = FStar_Syntax_Util.arrow_formals ind.ityp in - (match uu____1380 with - | (indices,uu____1416) -> + let uu____1372 = FStar_Syntax_Util.arrow_formals ind.ityp in + (match uu____1372 with + | (indices,uu____1408) -> let ml_params = - let uu____1436 = + let uu____1428 = FStar_All.pipe_right indices (FStar_List.mapi (fun i -> - fun uu____1455 -> - let uu____1460 = + fun uu____1447 -> + let uu____1452 = FStar_Util.string_of_int i in - Prims.strcat "'dummyV" uu____1460)) in - FStar_List.append vars uu____1436 in + Prims.strcat "'dummyV" uu____1452)) in + FStar_List.append vars uu____1428 in let tbody = - let uu____1462 = + let uu____1454 = FStar_Util.find_opt - (fun uu___71_1467 -> - match uu___71_1467 with - | FStar_Syntax_Syntax.RecordType uu____1468 -> + (fun uu___71_1459 -> + match uu___71_1459 with + | FStar_Syntax_Syntax.RecordType uu____1460 -> true - | uu____1477 -> false) ind.iquals in - match uu____1462 with + | uu____1469 -> false) ind.iquals in + match uu____1454 with | FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.RecordType (ns,ids)) -> - let uu____1488 = FStar_List.hd ctors in - (match uu____1488 with - | (uu____1509,c_ty) -> + let uu____1480 = FStar_List.hd ctors in + (match uu____1480 with + | (uu____1501,c_ty) -> let fields = FStar_List.map2 (fun id1 -> - fun uu____1548 -> - match uu____1548 with - | (uu____1557,ty) -> + fun uu____1540 -> + match uu____1540 with + | (uu____1549,ty) -> let lid = FStar_Ident.lid_of_ids (FStar_List.append ns [id1]) in - let uu____1560 = + let uu____1552 = lident_as_mlsymbol lid in - (uu____1560, ty)) ids c_ty in + (uu____1552, ty)) ids c_ty in FStar_Extraction_ML_Syntax.MLTD_Record fields) - | uu____1561 -> + | uu____1553 -> FStar_Extraction_ML_Syntax.MLTD_DType ctors in - let uu____1564 = - let uu____1583 = lident_as_mlsymbol ind.iname in - (false, uu____1583, FStar_Pervasives_Native.None, + let uu____1556 = + let uu____1575 = lident_as_mlsymbol ind.iname in + (false, uu____1575, FStar_Pervasives_Native.None, ml_params, (ind.imetadata), (FStar_Pervasives_Native.Some tbody)) in - (env3, uu____1564))) in + (env3, uu____1556))) in match ((se.FStar_Syntax_Syntax.sigel), (se.FStar_Syntax_Syntax.sigquals)) with | (FStar_Syntax_Syntax.Sig_bundle ({ FStar_Syntax_Syntax.sigel = FStar_Syntax_Syntax.Sig_datacon - (l,uu____1617,t,uu____1619,uu____1620,uu____1621); - FStar_Syntax_Syntax.sigrng = uu____1622; - FStar_Syntax_Syntax.sigquals = uu____1623; - FStar_Syntax_Syntax.sigmeta = uu____1624; - FStar_Syntax_Syntax.sigattrs = uu____1625;_}::[],uu____1626),(FStar_Syntax_Syntax.ExceptionConstructor + (l,uu____1609,t,uu____1611,uu____1612,uu____1613); + FStar_Syntax_Syntax.sigrng = uu____1614; + FStar_Syntax_Syntax.sigquals = uu____1615; + FStar_Syntax_Syntax.sigmeta = uu____1616; + FStar_Syntax_Syntax.sigattrs = uu____1617;_}::[],uu____1618),(FStar_Syntax_Syntax.ExceptionConstructor )::[]) -> - let uu____1643 = extract_ctor [] env { dname = l; dtyp = t } in - (match uu____1643 with + let uu____1635 = extract_ctor [] env { dname = l; dtyp = t } in + (match uu____1635 with | (env1,ctor) -> (env1, [FStar_Extraction_ML_Syntax.MLM_Exn ctor])) - | (FStar_Syntax_Syntax.Sig_bundle (ses,uu____1689),quals) -> - let uu____1703 = + | (FStar_Syntax_Syntax.Sig_bundle (ses,uu____1681),quals) -> + let uu____1695 = bundle_as_inductive_families env ses quals se.FStar_Syntax_Syntax.sigattrs in - (match uu____1703 with + (match uu____1695 with | (env1,ifams) -> - let uu____1724 = + let uu____1716 = FStar_Util.fold_map extract_one_family env1 ifams in - (match uu____1724 with + (match uu____1716 with | (env2,td) -> (env2, [FStar_Extraction_ML_Syntax.MLM_Ty td]))) - | uu____1817 -> failwith "Unexpected signature element" + | uu____1809 -> failwith "Unexpected signature element" let rec extract_sig: env_t -> FStar_Syntax_Syntax.sigelt -> @@ -650,33 +641,33 @@ let rec extract_sig: fun se -> FStar_Extraction_ML_UEnv.debug g (fun u -> - let uu____1852 = FStar_Syntax_Print.sigelt_to_string se in - FStar_Util.print1 ">>>> extract_sig %s \n" uu____1852); + let uu____1844 = FStar_Syntax_Print.sigelt_to_string se in + FStar_Util.print1 ">>>> extract_sig %s \n" uu____1844); (match se.FStar_Syntax_Syntax.sigel with - | FStar_Syntax_Syntax.Sig_bundle uu____1859 -> extract_bundle g se - | FStar_Syntax_Syntax.Sig_inductive_typ uu____1868 -> + | FStar_Syntax_Syntax.Sig_bundle uu____1851 -> extract_bundle g se + | FStar_Syntax_Syntax.Sig_inductive_typ uu____1860 -> extract_bundle g se - | FStar_Syntax_Syntax.Sig_datacon uu____1885 -> extract_bundle g se + | FStar_Syntax_Syntax.Sig_datacon uu____1877 -> extract_bundle g se | FStar_Syntax_Syntax.Sig_new_effect ed when FStar_All.pipe_right se.FStar_Syntax_Syntax.sigquals (FStar_List.contains FStar_Syntax_Syntax.Reifiable) -> let extend_env g1 lid ml_name tm tysc = - let uu____1923 = - let uu____1928 = + let uu____1915 = + let uu____1920 = FStar_Syntax_Syntax.lid_as_fv lid FStar_Syntax_Syntax.Delta_equational FStar_Pervasives_Native.None in - FStar_Extraction_ML_UEnv.extend_fv' g1 uu____1928 ml_name tysc + FStar_Extraction_ML_UEnv.extend_fv' g1 uu____1920 ml_name tysc false false in - match uu____1923 with + match uu____1915 with | (g2,mangled_name) -> - ((let uu____1936 = + ((let uu____1928 = FStar_All.pipe_left (FStar_TypeChecker_Env.debug g2.FStar_Extraction_ML_UEnv.tcenv) (FStar_Options.Other "ExtractionReify") in - if uu____1936 + if uu____1928 then FStar_Util.print1 "Mangled name: %s\n" mangled_name else ()); (let lb = @@ -686,71 +677,72 @@ let rec extract_sig: FStar_Pervasives_Native.None; FStar_Extraction_ML_Syntax.mllb_add_unit = false; FStar_Extraction_ML_Syntax.mllb_def = tm; + FStar_Extraction_ML_Syntax.mllb_meta = []; FStar_Extraction_ML_Syntax.print_typ = false } in (g2, (FStar_Extraction_ML_Syntax.MLM_Let - (FStar_Extraction_ML_Syntax.NonRec, [], [lb]))))) in + (FStar_Extraction_ML_Syntax.NonRec, [lb]))))) in let rec extract_fv tm = - (let uu____1952 = + (let uu____1942 = FStar_All.pipe_left (FStar_TypeChecker_Env.debug g.FStar_Extraction_ML_UEnv.tcenv) (FStar_Options.Other "ExtractionReify") in - if uu____1952 + if uu____1942 then - let uu____1953 = FStar_Syntax_Print.term_to_string tm in - FStar_Util.print1 "extract_fv term: %s\n" uu____1953 + let uu____1943 = FStar_Syntax_Print.term_to_string tm in + FStar_Util.print1 "extract_fv term: %s\n" uu____1943 else ()); - (let uu____1955 = - let uu____1956 = FStar_Syntax_Subst.compress tm in - uu____1956.FStar_Syntax_Syntax.n in - match uu____1955 with - | FStar_Syntax_Syntax.Tm_uinst (tm1,uu____1964) -> + (let uu____1945 = + let uu____1946 = FStar_Syntax_Subst.compress tm in + uu____1946.FStar_Syntax_Syntax.n in + match uu____1945 with + | FStar_Syntax_Syntax.Tm_uinst (tm1,uu____1954) -> extract_fv tm1 | FStar_Syntax_Syntax.Tm_fvar fv -> let mlp = FStar_Extraction_ML_Syntax.mlpath_of_lident (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in - let uu____1971 = - let uu____1980 = FStar_Extraction_ML_UEnv.lookup_fv g fv in - FStar_All.pipe_left FStar_Util.right uu____1980 in - (match uu____1971 with - | (uu____2037,uu____2038,tysc,uu____2040) -> - let uu____2041 = + let uu____1961 = + let uu____1970 = FStar_Extraction_ML_UEnv.lookup_fv g fv in + FStar_All.pipe_left FStar_Util.right uu____1970 in + (match uu____1961 with + | (uu____2027,uu____2028,tysc,uu____2030) -> + let uu____2031 = FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty FStar_Extraction_ML_Syntax.MLTY_Top) (FStar_Extraction_ML_Syntax.MLE_Name mlp) in - (uu____2041, tysc)) - | uu____2042 -> failwith "Not an fv") in + (uu____2031, tysc)) + | uu____2032 -> failwith "Not an fv") in let extract_action g1 a = - (let uu____2068 = + (let uu____2058 = FStar_All.pipe_left (FStar_TypeChecker_Env.debug g1.FStar_Extraction_ML_UEnv.tcenv) (FStar_Options.Other "ExtractionReify") in - if uu____2068 + if uu____2058 then - let uu____2069 = + let uu____2059 = FStar_Syntax_Print.term_to_string a.FStar_Syntax_Syntax.action_typ in - let uu____2070 = + let uu____2060 = FStar_Syntax_Print.term_to_string a.FStar_Syntax_Syntax.action_defn in - FStar_Util.print2 "Action type %s and term %s\n" uu____2069 - uu____2070 + FStar_Util.print2 "Action type %s and term %s\n" uu____2059 + uu____2060 else ()); - (let uu____2072 = FStar_Extraction_ML_UEnv.action_name ed a in - match uu____2072 with + (let uu____2062 = FStar_Extraction_ML_UEnv.action_name ed a in + match uu____2062 with | (a_nm,a_lid) -> let lbname = - let uu____2088 = + let uu____2078 = FStar_Syntax_Syntax.new_bv (FStar_Pervasives_Native.Some ((a.FStar_Syntax_Syntax.action_defn).FStar_Syntax_Syntax.pos)) FStar_Syntax_Syntax.tun in - FStar_Util.Inl uu____2088 in + FStar_Util.Inl uu____2078 in let lb = FStar_Syntax_Syntax.mk_lb (lbname, (a.FStar_Syntax_Syntax.action_univs), @@ -764,28 +756,27 @@ let rec extract_sig: (lbs, FStar_Syntax_Util.exp_false_bool)) FStar_Pervasives_Native.None (a.FStar_Syntax_Syntax.action_defn).FStar_Syntax_Syntax.pos in - let uu____2114 = + let uu____2104 = FStar_Extraction_ML_Term.term_as_mlexpr g1 action_lb in - (match uu____2114 with - | (a_let,uu____2126,ty) -> - ((let uu____2129 = + (match uu____2104 with + | (a_let,uu____2116,ty) -> + ((let uu____2119 = FStar_All.pipe_left (FStar_TypeChecker_Env.debug g1.FStar_Extraction_ML_UEnv.tcenv) (FStar_Options.Other "ExtractionReify") in - if uu____2129 + if uu____2119 then - let uu____2130 = + let uu____2120 = FStar_Extraction_ML_Code.string_of_mlexpr a_nm a_let in FStar_Util.print1 "Extracted action term: %s\n" - uu____2130 + uu____2120 else ()); - (let uu____2132 = + (let uu____2122 = match a_let.FStar_Extraction_ML_Syntax.expr with | FStar_Extraction_ML_Syntax.MLE_Let - ((uu____2141,uu____2142,mllb::[]),uu____2144) - -> + ((uu____2131,mllb::[]),uu____2133) -> (match mllb.FStar_Extraction_ML_Syntax.mllb_tysc with | FStar_Pervasives_Native.Some tysc -> @@ -793,22 +784,22 @@ let rec extract_sig: tysc) | FStar_Pervasives_Native.None -> failwith "No type scheme") - | uu____2164 -> failwith "Impossible" in - match uu____2132 with + | uu____2151 -> failwith "Impossible" in + match uu____2122 with | (exp,tysc) -> - ((let uu____2176 = + ((let uu____2163 = FStar_All.pipe_left (FStar_TypeChecker_Env.debug g1.FStar_Extraction_ML_UEnv.tcenv) (FStar_Options.Other "ExtractionReify") in - if uu____2176 + if uu____2163 then - ((let uu____2178 = + ((let uu____2165 = FStar_Extraction_ML_Code.string_of_mlty a_nm (FStar_Pervasives_Native.snd tysc) in FStar_Util.print1 - "Extracted action type: %s\n" uu____2178); + "Extracted action type: %s\n" uu____2165); FStar_List.iter (fun x -> FStar_Util.print1 "and binders: %s\n" @@ -816,84 +807,84 @@ let rec extract_sig: (FStar_Pervasives_Native.fst tysc)) else ()); extend_env g1 a_lid a_nm exp tysc))))) in - let uu____2182 = - let uu____2187 = + let uu____2169 = + let uu____2174 = extract_fv (FStar_Pervasives_Native.snd ed.FStar_Syntax_Syntax.return_repr) in - match uu____2187 with + match uu____2174 with | (return_tm,ty_sc) -> - let uu____2200 = + let uu____2187 = FStar_Extraction_ML_UEnv.monad_op_name ed "return" in - (match uu____2200 with + (match uu____2187 with | (return_nm,return_lid) -> extend_env g return_lid return_nm return_tm ty_sc) in - (match uu____2182 with + (match uu____2169 with | (g1,return_decl) -> - let uu____2219 = - let uu____2224 = + let uu____2206 = + let uu____2211 = extract_fv (FStar_Pervasives_Native.snd ed.FStar_Syntax_Syntax.bind_repr) in - match uu____2224 with + match uu____2211 with | (bind_tm,ty_sc) -> - let uu____2237 = + let uu____2224 = FStar_Extraction_ML_UEnv.monad_op_name ed "bind" in - (match uu____2237 with + (match uu____2224 with | (bind_nm,bind_lid) -> extend_env g1 bind_lid bind_nm bind_tm ty_sc) in - (match uu____2219 with + (match uu____2206 with | (g2,bind_decl) -> - let uu____2256 = + let uu____2243 = FStar_Util.fold_map extract_action g2 ed.FStar_Syntax_Syntax.actions in - (match uu____2256 with + (match uu____2243 with | (g3,actions) -> (g3, (FStar_List.append [return_decl; bind_decl] actions))))) - | FStar_Syntax_Syntax.Sig_new_effect uu____2277 -> (g, []) - | FStar_Syntax_Syntax.Sig_declare_typ (lid,uu____2281,t) when + | FStar_Syntax_Syntax.Sig_new_effect uu____2264 -> (g, []) + | FStar_Syntax_Syntax.Sig_declare_typ (lid,uu____2268,t) when FStar_Extraction_ML_Term.is_arity g t -> let quals = se.FStar_Syntax_Syntax.sigquals in let attrs = se.FStar_Syntax_Syntax.sigattrs in - let uu____2289 = - let uu____2290 = + let uu____2276 = + let uu____2277 = FStar_All.pipe_right quals (FStar_Util.for_some - (fun uu___72_2294 -> - match uu___72_2294 with + (fun uu___72_2281 -> + match uu___72_2281 with | FStar_Syntax_Syntax.Assumption -> true - | uu____2295 -> false)) in - Prims.op_Negation uu____2290 in - if uu____2289 + | uu____2282 -> false)) in + Prims.op_Negation uu____2277 in + if uu____2276 then (g, []) else - (let uu____2305 = FStar_Syntax_Util.arrow_formals t in - match uu____2305 with - | (bs,uu____2325) -> + (let uu____2292 = FStar_Syntax_Util.arrow_formals t in + match uu____2292 with + | (bs,uu____2312) -> let fv = FStar_Syntax_Syntax.lid_as_fv lid FStar_Syntax_Syntax.Delta_constant FStar_Pervasives_Native.None in - let uu____2343 = + let uu____2330 = FStar_Syntax_Util.abs bs FStar_Syntax_Syntax.t_unit FStar_Pervasives_Native.None in - extract_typ_abbrev g fv quals attrs uu____2343) - | FStar_Syntax_Syntax.Sig_let ((false ,lb::[]),uu____2345) when + extract_typ_abbrev g fv quals attrs uu____2330) + | FStar_Syntax_Syntax.Sig_let ((false ,lb::[]),uu____2332) when FStar_Extraction_ML_Term.is_arity g lb.FStar_Syntax_Syntax.lbtyp -> let quals = se.FStar_Syntax_Syntax.sigquals in - let uu____2361 = - let uu____2370 = + let uu____2348 = + let uu____2357 = FStar_TypeChecker_Env.open_universes_in g.FStar_Extraction_ML_UEnv.tcenv lb.FStar_Syntax_Syntax.lbunivs [lb.FStar_Syntax_Syntax.lbdef; lb.FStar_Syntax_Syntax.lbtyp] in - match uu____2370 with - | (tcenv,uu____2394,def_typ) -> - let uu____2400 = as_pair def_typ in (tcenv, uu____2400) in - (match uu____2361 with + match uu____2357 with + | (tcenv,uu____2381,def_typ) -> + let uu____2387 = as_pair def_typ in (tcenv, uu____2387) in + (match uu____2348 with | (tcenv,(lbdef,lbtyp)) -> let lbtyp1 = FStar_TypeChecker_Normalize.normalize @@ -903,11 +894,11 @@ let rec extract_sig: let lbdef1 = FStar_TypeChecker_Normalize.eta_expand_with_type tcenv lbdef lbtyp1 in - let uu____2424 = + let uu____2411 = FStar_Util.right lb.FStar_Syntax_Syntax.lbname in - extract_typ_abbrev g uu____2424 quals + extract_typ_abbrev g uu____2411 quals se.FStar_Syntax_Syntax.sigattrs lbdef1) - | FStar_Syntax_Syntax.Sig_let (lbs,uu____2426) -> + | FStar_Syntax_Syntax.Sig_let (lbs,uu____2413) -> let attrs = se.FStar_Syntax_Syntax.sigattrs in let quals = se.FStar_Syntax_Syntax.sigquals in let elet = @@ -918,157 +909,230 @@ let rec extract_sig: let tactic_registration_decl = let mk_registration tac_lid assm_lid t bs = let h = - let uu____2473 = - let uu____2474 = - let uu____2475 = + let uu____2460 = + let uu____2461 = + let uu____2462 = FStar_Ident.lid_of_str "FStar_Tactics_Native.register_tactic" in - FStar_Extraction_ML_Syntax.mlpath_of_lident uu____2475 in - FStar_Extraction_ML_Syntax.MLE_Name uu____2474 in + FStar_Extraction_ML_Syntax.mlpath_of_lident uu____2462 in + FStar_Extraction_ML_Syntax.MLE_Name uu____2461 in FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty - FStar_Extraction_ML_Syntax.MLTY_Top) uu____2473 in + FStar_Extraction_ML_Syntax.MLTY_Top) uu____2460 in let lid_arg = - let uu____2477 = - let uu____2478 = FStar_Ident.string_of_lid assm_lid in - FStar_Extraction_ML_Syntax.MLC_String uu____2478 in - FStar_Extraction_ML_Syntax.MLE_Const uu____2477 in + let uu____2464 = + let uu____2465 = FStar_Ident.string_of_lid assm_lid in + FStar_Extraction_ML_Syntax.MLC_String uu____2465 in + FStar_Extraction_ML_Syntax.MLE_Const uu____2464 in let tac_arity = FStar_List.length bs in let arity = - let uu____2485 = - let uu____2486 = - let uu____2487 = + let uu____2472 = + let uu____2473 = + let uu____2474 = FStar_Util.string_of_int (tac_arity + (Prims.parse_int "1")) in - FStar_Ident.lid_of_str uu____2487 in - FStar_Extraction_ML_Syntax.mlpath_of_lident uu____2486 in - FStar_Extraction_ML_Syntax.MLE_Name uu____2485 in - let uu____2494 = + FStar_Ident.lid_of_str uu____2474 in + FStar_Extraction_ML_Syntax.mlpath_of_lident uu____2473 in + FStar_Extraction_ML_Syntax.MLE_Name uu____2472 in + let uu____2481 = FStar_Extraction_ML_Util.mk_interpretation_fun tac_lid lid_arg t bs in - match uu____2494 with + match uu____2481 with | FStar_Pervasives_Native.Some tac_interpretation -> let app = - let uu____2501 = - let uu____2502 = - let uu____2509 = + let uu____2488 = + let uu____2489 = + let uu____2496 = FStar_List.map (FStar_Extraction_ML_Syntax.with_ty FStar_Extraction_ML_Syntax.MLTY_Top) [lid_arg; arity; tac_interpretation] in - (h, uu____2509) in - FStar_Extraction_ML_Syntax.MLE_App uu____2502 in + (h, uu____2496) in + FStar_Extraction_ML_Syntax.MLE_App uu____2489 in FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty - FStar_Extraction_ML_Syntax.MLTY_Top) uu____2501 in + FStar_Extraction_ML_Syntax.MLTY_Top) uu____2488 in [FStar_Extraction_ML_Syntax.MLM_Top app] | FStar_Pervasives_Native.None -> [] in - let uu____2514 = - let uu____2515 = FStar_Options.codegen () in - uu____2515 = (FStar_Pervasives_Native.Some "tactics") in - if uu____2514 + let uu____2501 = + let uu____2502 = FStar_Options.codegen () in + uu____2502 = (FStar_Pervasives_Native.Some "tactics") in + if uu____2501 then match FStar_Pervasives_Native.snd lbs with | hd1::[] -> - let uu____2527 = + let uu____2514 = FStar_Syntax_Util.arrow_formals_comp hd1.FStar_Syntax_Syntax.lbtyp in - (match uu____2527 with + (match uu____2514 with | (bs,comp) -> let t = FStar_Syntax_Util.comp_result comp in - let uu____2557 = - let uu____2558 = FStar_Syntax_Subst.compress t in - uu____2558.FStar_Syntax_Syntax.n in - (match uu____2557 with + let uu____2544 = + let uu____2545 = FStar_Syntax_Subst.compress t in + uu____2545.FStar_Syntax_Syntax.n in + (match uu____2544 with | FStar_Syntax_Syntax.Tm_app (h,args) -> let tac_lid = - let uu____2586 = - let uu____2589 = + let uu____2573 = + let uu____2576 = FStar_Util.right hd1.FStar_Syntax_Syntax.lbname in - uu____2589.FStar_Syntax_Syntax.fv_name in - uu____2586.FStar_Syntax_Syntax.v in + uu____2576.FStar_Syntax_Syntax.fv_name in + uu____2573.FStar_Syntax_Syntax.v in let assm_lid = - let uu____2591 = + let uu____2578 = FStar_All.pipe_left FStar_Ident.id_of_text (Prims.strcat "__" (tac_lid.FStar_Ident.ident).FStar_Ident.idText) in FStar_Ident.lid_of_ns_and_id - tac_lid.FStar_Ident.ns uu____2591 in - let uu____2592 = - let uu____2593 = FStar_Syntax_Subst.compress h in - is_tactic_decl assm_lid uu____2593 + tac_lid.FStar_Ident.ns uu____2578 in + let uu____2579 = + let uu____2580 = FStar_Syntax_Subst.compress h in + is_tactic_decl assm_lid uu____2580 g.FStar_Extraction_ML_UEnv.currentModule in - if uu____2592 + if uu____2579 then - let uu____2596 = - let uu____2597 = FStar_List.hd args in - FStar_Pervasives_Native.fst uu____2597 in - mk_registration tac_lid assm_lid uu____2596 bs + let uu____2583 = + let uu____2584 = FStar_List.hd args in + FStar_Pervasives_Native.fst uu____2584 in + mk_registration tac_lid assm_lid uu____2583 bs else [] - | uu____2613 -> [])) - | uu____2614 -> [] + | uu____2600 -> [])) + | uu____2601 -> [] else [] in - let uu____2618 = FStar_Extraction_ML_Term.term_as_mlexpr g elet in - (match uu____2618 with - | (ml_let,uu____2632,uu____2633) -> + let uu____2605 = FStar_Extraction_ML_Term.term_as_mlexpr g elet in + (match uu____2605 with + | (ml_let,uu____2619,uu____2620) -> (match ml_let.FStar_Extraction_ML_Syntax.expr with | FStar_Extraction_ML_Syntax.MLE_Let - ((flavor,uu____2641,bindings),uu____2643) -> - let uu____2656 = + ((flavor,bindings),uu____2629) -> + let flags1 = + FStar_List.choose + (fun uu___73_2644 -> + match uu___73_2644 with + | FStar_Syntax_Syntax.Assumption -> + FStar_Pervasives_Native.Some + FStar_Extraction_ML_Syntax.Assumed + | FStar_Syntax_Syntax.Private -> + FStar_Pervasives_Native.Some + FStar_Extraction_ML_Syntax.Private + | FStar_Syntax_Syntax.NoExtract -> + FStar_Pervasives_Native.Some + FStar_Extraction_ML_Syntax.NoExtract + | uu____2647 -> FStar_Pervasives_Native.None) + quals in + let flags' = extract_metadata attrs in + let uu____2651 = FStar_List.fold_left2 - (fun uu____2683 -> + (fun uu____2681 -> fun ml_lb -> - fun uu____2685 -> - match (uu____2683, uu____2685) with + fun uu____2683 -> + match (uu____2681, uu____2683) with | ((env,ml_lbs),{ FStar_Syntax_Syntax.lbname = lbname; FStar_Syntax_Syntax.lbunivs - = uu____2707; + = uu____2705; FStar_Syntax_Syntax.lbtyp = t; FStar_Syntax_Syntax.lbeff = - uu____2709; + uu____2707; FStar_Syntax_Syntax.lbdef = - uu____2710;_}) + uu____2708;_}) -> let lb_lid = - let uu____2732 = - let uu____2735 = + let uu____2730 = + let uu____2733 = FStar_Util.right lbname in - uu____2735.FStar_Syntax_Syntax.fv_name in - uu____2732.FStar_Syntax_Syntax.v in - let uu____2736 = - let uu____2741 = + uu____2733.FStar_Syntax_Syntax.fv_name in + uu____2730.FStar_Syntax_Syntax.v in + let flags'' = + let uu____2737 = + let uu____2738 = + FStar_Syntax_Subst.compress t in + uu____2738.FStar_Syntax_Syntax.n in + match uu____2737 with + | FStar_Syntax_Syntax.Tm_arrow + (uu____2743,{ + FStar_Syntax_Syntax.n + = + FStar_Syntax_Syntax.Comp + { + FStar_Syntax_Syntax.comp_univs + = uu____2744; + FStar_Syntax_Syntax.effect_name + = e; + FStar_Syntax_Syntax.result_typ + = uu____2746; + FStar_Syntax_Syntax.effect_args + = uu____2747; + FStar_Syntax_Syntax.flags + = uu____2748;_}; + FStar_Syntax_Syntax.pos + = uu____2749; + FStar_Syntax_Syntax.vars + = uu____2750;_}) + when + let uu____2779 = + FStar_Ident.string_of_lid e in + uu____2779 = + "FStar.HyperStack.ST.StackInline" + -> + [FStar_Extraction_ML_Syntax.StackInline] + | uu____2780 -> [] in + let meta = + FStar_List.append flags1 + (FStar_List.append flags' flags'') in + let ml_lb1 = + let uu___77_2785 = ml_lb in + { + FStar_Extraction_ML_Syntax.mllb_name + = + (uu___77_2785.FStar_Extraction_ML_Syntax.mllb_name); + FStar_Extraction_ML_Syntax.mllb_tysc + = + (uu___77_2785.FStar_Extraction_ML_Syntax.mllb_tysc); + FStar_Extraction_ML_Syntax.mllb_add_unit + = + (uu___77_2785.FStar_Extraction_ML_Syntax.mllb_add_unit); + FStar_Extraction_ML_Syntax.mllb_def = + (uu___77_2785.FStar_Extraction_ML_Syntax.mllb_def); + FStar_Extraction_ML_Syntax.mllb_meta + = meta; + FStar_Extraction_ML_Syntax.print_typ + = + (uu___77_2785.FStar_Extraction_ML_Syntax.print_typ) + } in + let uu____2786 = + let uu____2791 = FStar_All.pipe_right quals (FStar_Util.for_some - (fun uu___73_2746 -> - match uu___73_2746 with + (fun uu___74_2796 -> + match uu___74_2796 with | FStar_Syntax_Syntax.Projector - uu____2747 -> true - | uu____2752 -> false)) in - if uu____2741 + uu____2797 -> true + | uu____2802 -> false)) in + if uu____2791 then let mname = - let uu____2758 = + let uu____2808 = mangle_projector_lid lb_lid in - FStar_All.pipe_right uu____2758 + FStar_All.pipe_right uu____2808 FStar_Extraction_ML_Syntax.mlpath_of_lident in - let uu____2759 = - let uu____2764 = + let uu____2809 = + let uu____2814 = FStar_Util.right lbname in - let uu____2765 = + let uu____2815 = FStar_Util.must - ml_lb.FStar_Extraction_ML_Syntax.mllb_tysc in + ml_lb1.FStar_Extraction_ML_Syntax.mllb_tysc in FStar_Extraction_ML_UEnv.extend_fv' - env uu____2764 mname uu____2765 - ml_lb.FStar_Extraction_ML_Syntax.mllb_add_unit + env uu____2814 mname uu____2815 + ml_lb1.FStar_Extraction_ML_Syntax.mllb_add_unit false in - match uu____2759 with - | (env1,uu____2771) -> + match uu____2809 with + | (env1,uu____2821) -> (env1, - (let uu___77_2773 = ml_lb in + (let uu___78_2823 = ml_lb1 in { FStar_Extraction_ML_Syntax.mllb_name = @@ -1076,190 +1140,176 @@ let rec extract_sig: mname); FStar_Extraction_ML_Syntax.mllb_tysc = - (uu___77_2773.FStar_Extraction_ML_Syntax.mllb_tysc); + (uu___78_2823.FStar_Extraction_ML_Syntax.mllb_tysc); FStar_Extraction_ML_Syntax.mllb_add_unit = - (uu___77_2773.FStar_Extraction_ML_Syntax.mllb_add_unit); + (uu___78_2823.FStar_Extraction_ML_Syntax.mllb_add_unit); FStar_Extraction_ML_Syntax.mllb_def = - (uu___77_2773.FStar_Extraction_ML_Syntax.mllb_def); + (uu___78_2823.FStar_Extraction_ML_Syntax.mllb_def); + FStar_Extraction_ML_Syntax.mllb_meta + = + (uu___78_2823.FStar_Extraction_ML_Syntax.mllb_meta); FStar_Extraction_ML_Syntax.print_typ = - (uu___77_2773.FStar_Extraction_ML_Syntax.print_typ) + (uu___78_2823.FStar_Extraction_ML_Syntax.print_typ) })) else - (let uu____2777 = - let uu____2778 = - let uu____2783 = + (let uu____2827 = + let uu____2828 = + let uu____2833 = FStar_Util.must - ml_lb.FStar_Extraction_ML_Syntax.mllb_tysc in + ml_lb1.FStar_Extraction_ML_Syntax.mllb_tysc in FStar_Extraction_ML_UEnv.extend_lb - env lbname t uu____2783 - ml_lb.FStar_Extraction_ML_Syntax.mllb_add_unit + env lbname t uu____2833 + ml_lb1.FStar_Extraction_ML_Syntax.mllb_add_unit false in FStar_All.pipe_left FStar_Pervasives_Native.fst - uu____2778 in - (uu____2777, ml_lb)) in - (match uu____2736 with - | (g1,ml_lb1) -> - (g1, (ml_lb1 :: ml_lbs)))) (g, []) + uu____2828 in + (uu____2827, ml_lb1)) in + (match uu____2786 with + | (g1,ml_lb2) -> + (g1, (ml_lb2 :: ml_lbs)))) (g, []) bindings (FStar_Pervasives_Native.snd lbs) in - (match uu____2656 with + (match uu____2651 with | (g1,ml_lbs') -> - let flags1 = - FStar_List.choose - (fun uu___74_2818 -> - match uu___74_2818 with - | FStar_Syntax_Syntax.Assumption -> - FStar_Pervasives_Native.Some - FStar_Extraction_ML_Syntax.Assumed - | FStar_Syntax_Syntax.Private -> - FStar_Pervasives_Native.Some - FStar_Extraction_ML_Syntax.Private - | FStar_Syntax_Syntax.NoExtract -> - FStar_Pervasives_Native.Some - FStar_Extraction_ML_Syntax.NoExtract - | uu____2821 -> FStar_Pervasives_Native.None) - quals in - let flags' = extract_metadata attrs in - let uu____2825 = - let uu____2828 = - let uu____2831 = - let uu____2832 = + let uu____2864 = + let uu____2867 = + let uu____2870 = + let uu____2871 = FStar_Extraction_ML_Util.mlloc_of_range se.FStar_Syntax_Syntax.sigrng in - FStar_Extraction_ML_Syntax.MLM_Loc uu____2832 in - [uu____2831; + FStar_Extraction_ML_Syntax.MLM_Loc uu____2871 in + [uu____2870; FStar_Extraction_ML_Syntax.MLM_Let - (flavor, (FStar_List.append flags1 flags'), - (FStar_List.rev ml_lbs'))] in - FStar_List.append uu____2828 + (flavor, (FStar_List.rev ml_lbs'))] in + FStar_List.append uu____2867 tactic_registration_decl in - (g1, uu____2825)) - | uu____2839 -> - let uu____2840 = - let uu____2841 = + (g1, uu____2864)) + | uu____2876 -> + let uu____2877 = + let uu____2878 = FStar_Extraction_ML_Code.string_of_mlexpr g.FStar_Extraction_ML_UEnv.currentModule ml_let in FStar_Util.format1 "Impossible: Translated a let to a non-let: %s" - uu____2841 in - failwith uu____2840)) - | FStar_Syntax_Syntax.Sig_declare_typ (lid,uu____2849,t) -> + uu____2878 in + failwith uu____2877)) + | FStar_Syntax_Syntax.Sig_declare_typ (lid,uu____2886,t) -> let quals = se.FStar_Syntax_Syntax.sigquals in - let uu____2854 = + let uu____2891 = FStar_All.pipe_right quals (FStar_List.contains FStar_Syntax_Syntax.Assumption) in - if uu____2854 + if uu____2891 then let always_fail = let imp = - let uu____2865 = FStar_Syntax_Util.arrow_formals t in - match uu____2865 with + let uu____2902 = FStar_Syntax_Util.arrow_formals t in + match uu____2902 with | ([],t1) -> let b = - let uu____2894 = + let uu____2931 = FStar_Syntax_Syntax.gen_bv "_" FStar_Pervasives_Native.None t1 in FStar_All.pipe_left FStar_Syntax_Syntax.mk_binder - uu____2894 in - let uu____2895 = fail_exp lid t1 in - FStar_Syntax_Util.abs [b] uu____2895 + uu____2931 in + let uu____2932 = fail_exp lid t1 in + FStar_Syntax_Util.abs [b] uu____2932 FStar_Pervasives_Native.None | (bs,t1) -> - let uu____2914 = fail_exp lid t1 in - FStar_Syntax_Util.abs bs uu____2914 + let uu____2951 = fail_exp lid t1 in + FStar_Syntax_Util.abs bs uu____2951 FStar_Pervasives_Native.None in - let uu___78_2915 = se in - let uu____2916 = - let uu____2917 = - let uu____2924 = - let uu____2931 = - let uu____2934 = - let uu____2935 = - let uu____2940 = + let uu___79_2952 = se in + let uu____2953 = + let uu____2954 = + let uu____2961 = + let uu____2968 = + let uu____2971 = + let uu____2972 = + let uu____2977 = FStar_Syntax_Syntax.lid_as_fv lid FStar_Syntax_Syntax.Delta_constant FStar_Pervasives_Native.None in - FStar_Util.Inr uu____2940 in + FStar_Util.Inr uu____2977 in { - FStar_Syntax_Syntax.lbname = uu____2935; + FStar_Syntax_Syntax.lbname = uu____2972; FStar_Syntax_Syntax.lbunivs = []; FStar_Syntax_Syntax.lbtyp = t; FStar_Syntax_Syntax.lbeff = FStar_Parser_Const.effect_ML_lid; FStar_Syntax_Syntax.lbdef = imp } in - [uu____2934] in - (false, uu____2931) in - (uu____2924, []) in - FStar_Syntax_Syntax.Sig_let uu____2917 in + [uu____2971] in + (false, uu____2968) in + (uu____2961, []) in + FStar_Syntax_Syntax.Sig_let uu____2954 in { - FStar_Syntax_Syntax.sigel = uu____2916; + FStar_Syntax_Syntax.sigel = uu____2953; FStar_Syntax_Syntax.sigrng = - (uu___78_2915.FStar_Syntax_Syntax.sigrng); + (uu___79_2952.FStar_Syntax_Syntax.sigrng); FStar_Syntax_Syntax.sigquals = - (uu___78_2915.FStar_Syntax_Syntax.sigquals); + (uu___79_2952.FStar_Syntax_Syntax.sigquals); FStar_Syntax_Syntax.sigmeta = - (uu___78_2915.FStar_Syntax_Syntax.sigmeta); + (uu___79_2952.FStar_Syntax_Syntax.sigmeta); FStar_Syntax_Syntax.sigattrs = - (uu___78_2915.FStar_Syntax_Syntax.sigattrs) + (uu___79_2952.FStar_Syntax_Syntax.sigattrs) } in - let uu____2951 = extract_sig g always_fail in - (match uu____2951 with + let uu____2988 = extract_sig g always_fail in + (match uu____2988 with | (g1,mlm) -> - let uu____2970 = + let uu____3007 = FStar_Util.find_map quals - (fun uu___75_2975 -> - match uu___75_2975 with + (fun uu___75_3012 -> + match uu___75_3012 with | FStar_Syntax_Syntax.Discriminator l -> FStar_Pervasives_Native.Some l - | uu____2979 -> FStar_Pervasives_Native.None) in - (match uu____2970 with + | uu____3016 -> FStar_Pervasives_Native.None) in + (match uu____3007 with | FStar_Pervasives_Native.Some l -> - let uu____2987 = - let uu____2990 = - let uu____2991 = + let uu____3024 = + let uu____3027 = + let uu____3028 = FStar_Extraction_ML_Util.mlloc_of_range se.FStar_Syntax_Syntax.sigrng in - FStar_Extraction_ML_Syntax.MLM_Loc uu____2991 in - let uu____2992 = - let uu____2995 = + FStar_Extraction_ML_Syntax.MLM_Loc uu____3028 in + let uu____3029 = + let uu____3032 = FStar_Extraction_ML_Term.ind_discriminator_body g1 lid l in - [uu____2995] in - uu____2990 :: uu____2992 in - (g1, uu____2987) - | uu____2998 -> - let uu____3001 = + [uu____3032] in + uu____3027 :: uu____3029 in + (g1, uu____3024) + | uu____3035 -> + let uu____3038 = FStar_Util.find_map quals - (fun uu___76_3007 -> - match uu___76_3007 with - | FStar_Syntax_Syntax.Projector (l,uu____3011) + (fun uu___76_3044 -> + match uu___76_3044 with + | FStar_Syntax_Syntax.Projector (l,uu____3048) -> FStar_Pervasives_Native.Some l - | uu____3012 -> FStar_Pervasives_Native.None) in - (match uu____3001 with - | FStar_Pervasives_Native.Some uu____3019 -> (g1, []) - | uu____3022 -> (g1, mlm)))) + | uu____3049 -> FStar_Pervasives_Native.None) in + (match uu____3038 with + | FStar_Pervasives_Native.Some uu____3056 -> (g1, []) + | uu____3059 -> (g1, mlm)))) else (g, []) | FStar_Syntax_Syntax.Sig_main e -> - let uu____3031 = FStar_Extraction_ML_Term.term_as_mlexpr g e in - (match uu____3031 with - | (ml_main,uu____3045,uu____3046) -> - let uu____3047 = - let uu____3050 = - let uu____3051 = + let uu____3068 = FStar_Extraction_ML_Term.term_as_mlexpr g e in + (match uu____3068 with + | (ml_main,uu____3082,uu____3083) -> + let uu____3084 = + let uu____3087 = + let uu____3088 = FStar_Extraction_ML_Util.mlloc_of_range se.FStar_Syntax_Syntax.sigrng in - FStar_Extraction_ML_Syntax.MLM_Loc uu____3051 in - [uu____3050; FStar_Extraction_ML_Syntax.MLM_Top ml_main] in - (g, uu____3047)) - | FStar_Syntax_Syntax.Sig_new_effect_for_free uu____3054 -> + FStar_Extraction_ML_Syntax.MLM_Loc uu____3088 in + [uu____3087; FStar_Extraction_ML_Syntax.MLM_Top ml_main] in + (g, uu____3084)) + | FStar_Syntax_Syntax.Sig_new_effect_for_free uu____3091 -> failwith "impossible -- removed by tc.fs" - | FStar_Syntax_Syntax.Sig_assume uu____3061 -> (g, []) - | FStar_Syntax_Syntax.Sig_sub_effect uu____3070 -> (g, []) - | FStar_Syntax_Syntax.Sig_effect_abbrev uu____3073 -> (g, []) + | FStar_Syntax_Syntax.Sig_assume uu____3098 -> (g, []) + | FStar_Syntax_Syntax.Sig_sub_effect uu____3107 -> (g, []) + | FStar_Syntax_Syntax.Sig_effect_abbrev uu____3110 -> (g, []) | FStar_Syntax_Syntax.Sig_pragma p -> (if p = FStar_Syntax_Syntax.LightOff then FStar_Options.set_ml_ish () @@ -1269,9 +1319,9 @@ let extract_iface: FStar_Extraction_ML_UEnv.env -> FStar_Syntax_Syntax.modul -> env_t = fun g -> fun m -> - let uu____3099 = + let uu____3136 = FStar_Util.fold_map extract_sig g m.FStar_Syntax_Syntax.declarations in - FStar_All.pipe_right uu____3099 FStar_Pervasives_Native.fst + FStar_All.pipe_right uu____3136 FStar_Pervasives_Native.fst let extract': FStar_Extraction_ML_UEnv.env -> FStar_Syntax_Syntax.modul -> @@ -1283,53 +1333,53 @@ let extract': fun m -> FStar_Syntax_Syntax.reset_gensym (); (let codegen_opt = FStar_Options.codegen () in - let uu____3144 = FStar_Options.restore_cmd_line_options true in + let uu____3181 = FStar_Options.restore_cmd_line_options true in (match codegen_opt with | FStar_Pervasives_Native.Some "tactics" -> FStar_Options.set_option "codegen" (FStar_Options.String "tactics") - | uu____3146 -> ()); + | uu____3183 -> ()); (let name = FStar_Extraction_ML_Syntax.mlpath_of_lident m.FStar_Syntax_Syntax.name in let g1 = - let uu___79_3151 = g in - let uu____3152 = + let uu___80_3188 = g in + let uu____3189 = FStar_TypeChecker_Env.set_current_module g.FStar_Extraction_ML_UEnv.tcenv m.FStar_Syntax_Syntax.name in { - FStar_Extraction_ML_UEnv.tcenv = uu____3152; + FStar_Extraction_ML_UEnv.tcenv = uu____3189; FStar_Extraction_ML_UEnv.gamma = - (uu___79_3151.FStar_Extraction_ML_UEnv.gamma); + (uu___80_3188.FStar_Extraction_ML_UEnv.gamma); FStar_Extraction_ML_UEnv.tydefs = - (uu___79_3151.FStar_Extraction_ML_UEnv.tydefs); + (uu___80_3188.FStar_Extraction_ML_UEnv.tydefs); FStar_Extraction_ML_UEnv.type_names = - (uu___79_3151.FStar_Extraction_ML_UEnv.type_names); + (uu___80_3188.FStar_Extraction_ML_UEnv.type_names); FStar_Extraction_ML_UEnv.currentModule = name } in - let uu____3153 = + let uu____3190 = FStar_Util.fold_map extract_sig g1 m.FStar_Syntax_Syntax.declarations in - match uu____3153 with + match uu____3190 with | (g2,sigs) -> let mlm = FStar_List.flatten sigs in let is_kremlin = - let uu____3182 = FStar_Options.codegen () in - match uu____3182 with + let uu____3219 = FStar_Options.codegen () in + match uu____3219 with | FStar_Pervasives_Native.Some "Kremlin" -> true - | uu____3185 -> false in - let uu____3188 = + | uu____3222 -> false in + let uu____3225 = (((m.FStar_Syntax_Syntax.name).FStar_Ident.str <> "Prims") && (is_kremlin || (Prims.op_Negation m.FStar_Syntax_Syntax.is_interface))) && (FStar_Options.should_extract (m.FStar_Syntax_Syntax.name).FStar_Ident.str) in - if uu____3188 + if uu____3225 then - ((let uu____3196 = + ((let uu____3233 = FStar_Syntax_Print.lid_to_string m.FStar_Syntax_Syntax.name in - FStar_Util.print1 "Extracted module %s\n" uu____3196); + FStar_Util.print1 "Extracted module %s\n" uu____3233); (g2, [FStar_Extraction_ML_Syntax.MLLib [(name, (FStar_Pervasives_Native.Some ([], mlm)), @@ -1344,13 +1394,13 @@ let extract: = fun g -> fun m -> - let uu____3270 = FStar_Options.debug_any () in - if uu____3270 + let uu____3307 = FStar_Options.debug_any () in + if uu____3307 then let msg = - let uu____3278 = + let uu____3315 = FStar_Syntax_Print.lid_to_string m.FStar_Syntax_Syntax.name in - FStar_Util.format1 "Extracting module %s\n" uu____3278 in + FStar_Util.format1 "Extracting module %s\n" uu____3315 in FStar_Util.measure_execution_time msg - (fun uu____3286 -> extract' g m) + (fun uu____3323 -> extract' g m) else extract' g m \ No newline at end of file diff --git a/src/ocaml-output/FStar_Extraction_ML_Syntax.ml b/src/ocaml-output/FStar_Extraction_ML_Syntax.ml index a2af8203592..47019f5b369 100644 --- a/src/ocaml-output/FStar_Extraction_ML_Syntax.ml +++ b/src/ocaml-output/FStar_Extraction_ML_Syntax.ml @@ -391,7 +391,8 @@ type meta = | GCType | PpxDerivingShow | PpxDerivingShowConstant of Prims.string - | Comment of Prims.string[@@deriving show] + | Comment of Prims.string + | StackInline[@@deriving show] let uu___is_Mutable: meta -> Prims.bool = fun projectee -> match projectee with | Mutable -> true | uu____958 -> false @@ -428,22 +429,25 @@ let uu___is_Comment: meta -> Prims.bool = match projectee with | Comment _0 -> true | uu____1003 -> false let __proj__Comment__item___0: meta -> Prims.string = fun projectee -> match projectee with | Comment _0 -> _0 +let uu___is_StackInline: meta -> Prims.bool = + fun projectee -> + match projectee with | StackInline -> true | uu____1014 -> false type metadata = meta Prims.list[@@deriving show] type mlletflavor = | Rec | NonRec[@@deriving show] let uu___is_Rec: mlletflavor -> Prims.bool = - fun projectee -> match projectee with | Rec -> true | uu____1016 -> false + fun projectee -> match projectee with | Rec -> true | uu____1020 -> false let uu___is_NonRec: mlletflavor -> Prims.bool = fun projectee -> - match projectee with | NonRec -> true | uu____1020 -> false + match projectee with | NonRec -> true | uu____1024 -> false type mlexpr' = | MLE_Const of mlconstant | MLE_Var of mlident | MLE_Name of mlpath | MLE_Let of - ((mlletflavor,metadata,mllb Prims.list) FStar_Pervasives_Native.tuple3, - mlexpr) FStar_Pervasives_Native.tuple2 + ((mlletflavor,mllb Prims.list) FStar_Pervasives_Native.tuple2,mlexpr) + FStar_Pervasives_Native.tuple2 | MLE_App of (mlexpr,mlexpr Prims.list) FStar_Pervasives_Native.tuple2 | MLE_TApp of (mlexpr,mlty Prims.list) FStar_Pervasives_Native.tuple2 | MLE_Fun of @@ -479,45 +483,46 @@ and mllb = mllb_tysc: mltyscheme FStar_Pervasives_Native.option; mllb_add_unit: Prims.bool; mllb_def: mlexpr; + mllb_meta: metadata; print_typ: Prims.bool;}[@@deriving show] let uu___is_MLE_Const: mlexpr' -> Prims.bool = fun projectee -> - match projectee with | MLE_Const _0 -> true | uu____1235 -> false + match projectee with | MLE_Const _0 -> true | uu____1241 -> false let __proj__MLE_Const__item___0: mlexpr' -> mlconstant = fun projectee -> match projectee with | MLE_Const _0 -> _0 let uu___is_MLE_Var: mlexpr' -> Prims.bool = fun projectee -> - match projectee with | MLE_Var _0 -> true | uu____1247 -> false + match projectee with | MLE_Var _0 -> true | uu____1253 -> false let __proj__MLE_Var__item___0: mlexpr' -> mlident = fun projectee -> match projectee with | MLE_Var _0 -> _0 let uu___is_MLE_Name: mlexpr' -> Prims.bool = fun projectee -> - match projectee with | MLE_Name _0 -> true | uu____1259 -> false + match projectee with | MLE_Name _0 -> true | uu____1265 -> false let __proj__MLE_Name__item___0: mlexpr' -> mlpath = fun projectee -> match projectee with | MLE_Name _0 -> _0 let uu___is_MLE_Let: mlexpr' -> Prims.bool = fun projectee -> - match projectee with | MLE_Let _0 -> true | uu____1283 -> false + match projectee with | MLE_Let _0 -> true | uu____1287 -> false let __proj__MLE_Let__item___0: mlexpr' -> - ((mlletflavor,metadata,mllb Prims.list) FStar_Pervasives_Native.tuple3, - mlexpr) FStar_Pervasives_Native.tuple2 + ((mlletflavor,mllb Prims.list) FStar_Pervasives_Native.tuple2,mlexpr) + FStar_Pervasives_Native.tuple2 = fun projectee -> match projectee with | MLE_Let _0 -> _0 let uu___is_MLE_App: mlexpr' -> Prims.bool = fun projectee -> - match projectee with | MLE_App _0 -> true | uu____1337 -> false + match projectee with | MLE_App _0 -> true | uu____1335 -> false let __proj__MLE_App__item___0: mlexpr' -> (mlexpr,mlexpr Prims.list) FStar_Pervasives_Native.tuple2 = fun projectee -> match projectee with | MLE_App _0 -> _0 let uu___is_MLE_TApp: mlexpr' -> Prims.bool = fun projectee -> - match projectee with | MLE_TApp _0 -> true | uu____1373 -> false + match projectee with | MLE_TApp _0 -> true | uu____1371 -> false let __proj__MLE_TApp__item___0: mlexpr' -> (mlexpr,mlty Prims.list) FStar_Pervasives_Native.tuple2 = fun projectee -> match projectee with | MLE_TApp _0 -> _0 let uu___is_MLE_Fun: mlexpr' -> Prims.bool = fun projectee -> - match projectee with | MLE_Fun _0 -> true | uu____1413 -> false + match projectee with | MLE_Fun _0 -> true | uu____1411 -> false let __proj__MLE_Fun__item___0: mlexpr' -> ((mlident,mlty) FStar_Pervasives_Native.tuple2 Prims.list,mlexpr) @@ -525,7 +530,7 @@ let __proj__MLE_Fun__item___0: = fun projectee -> match projectee with | MLE_Fun _0 -> _0 let uu___is_MLE_Match: mlexpr' -> Prims.bool = fun projectee -> - match projectee with | MLE_Match _0 -> true | uu____1469 -> false + match projectee with | MLE_Match _0 -> true | uu____1467 -> false let __proj__MLE_Match__item___0: mlexpr' -> (mlexpr,(mlpattern,mlexpr FStar_Pervasives_Native.option,mlexpr) @@ -534,29 +539,29 @@ let __proj__MLE_Match__item___0: = fun projectee -> match projectee with | MLE_Match _0 -> _0 let uu___is_MLE_Coerce: mlexpr' -> Prims.bool = fun projectee -> - match projectee with | MLE_Coerce _0 -> true | uu____1529 -> false + match projectee with | MLE_Coerce _0 -> true | uu____1527 -> false let __proj__MLE_Coerce__item___0: mlexpr' -> (mlexpr,mlty,mlty) FStar_Pervasives_Native.tuple3 = fun projectee -> match projectee with | MLE_Coerce _0 -> _0 let uu___is_MLE_CTor: mlexpr' -> Prims.bool = fun projectee -> - match projectee with | MLE_CTor _0 -> true | uu____1565 -> false + match projectee with | MLE_CTor _0 -> true | uu____1563 -> false let __proj__MLE_CTor__item___0: mlexpr' -> (mlpath,mlexpr Prims.list) FStar_Pervasives_Native.tuple2 = fun projectee -> match projectee with | MLE_CTor _0 -> _0 let uu___is_MLE_Seq: mlexpr' -> Prims.bool = fun projectee -> - match projectee with | MLE_Seq _0 -> true | uu____1597 -> false + match projectee with | MLE_Seq _0 -> true | uu____1595 -> false let __proj__MLE_Seq__item___0: mlexpr' -> mlexpr Prims.list = fun projectee -> match projectee with | MLE_Seq _0 -> _0 let uu___is_MLE_Tuple: mlexpr' -> Prims.bool = fun projectee -> - match projectee with | MLE_Tuple _0 -> true | uu____1617 -> false + match projectee with | MLE_Tuple _0 -> true | uu____1615 -> false let __proj__MLE_Tuple__item___0: mlexpr' -> mlexpr Prims.list = fun projectee -> match projectee with | MLE_Tuple _0 -> _0 let uu___is_MLE_Record: mlexpr' -> Prims.bool = fun projectee -> - match projectee with | MLE_Record _0 -> true | uu____1647 -> false + match projectee with | MLE_Record _0 -> true | uu____1645 -> false let __proj__MLE_Record__item___0: mlexpr' -> (mlsymbol Prims.list,(mlsymbol,mlexpr) FStar_Pervasives_Native.tuple2 @@ -565,13 +570,13 @@ let __proj__MLE_Record__item___0: = fun projectee -> match projectee with | MLE_Record _0 -> _0 let uu___is_MLE_Proj: mlexpr' -> Prims.bool = fun projectee -> - match projectee with | MLE_Proj _0 -> true | uu____1699 -> false + match projectee with | MLE_Proj _0 -> true | uu____1697 -> false let __proj__MLE_Proj__item___0: mlexpr' -> (mlexpr,mlpath) FStar_Pervasives_Native.tuple2 = fun projectee -> match projectee with | MLE_Proj _0 -> _0 let uu___is_MLE_If: mlexpr' -> Prims.bool = fun projectee -> - match projectee with | MLE_If _0 -> true | uu____1731 -> false + match projectee with | MLE_If _0 -> true | uu____1729 -> false let __proj__MLE_If__item___0: mlexpr' -> (mlexpr,mlexpr,mlexpr FStar_Pervasives_Native.option) @@ -579,13 +584,13 @@ let __proj__MLE_If__item___0: = fun projectee -> match projectee with | MLE_If _0 -> _0 let uu___is_MLE_Raise: mlexpr' -> Prims.bool = fun projectee -> - match projectee with | MLE_Raise _0 -> true | uu____1773 -> false + match projectee with | MLE_Raise _0 -> true | uu____1771 -> false let __proj__MLE_Raise__item___0: mlexpr' -> (mlpath,mlexpr Prims.list) FStar_Pervasives_Native.tuple2 = fun projectee -> match projectee with | MLE_Raise _0 -> _0 let uu___is_MLE_Try: mlexpr' -> Prims.bool = fun projectee -> - match projectee with | MLE_Try _0 -> true | uu____1817 -> false + match projectee with | MLE_Try _0 -> true | uu____1815 -> false let __proj__MLE_Try__item___0: mlexpr' -> (mlexpr,(mlpattern,mlexpr FStar_Pervasives_Native.option,mlexpr) @@ -612,38 +617,50 @@ let __proj__Mkmllb__item__mllb_name: mllb -> mlident = match projectee with | { mllb_name = __fname__mllb_name; mllb_tysc = __fname__mllb_tysc; mllb_add_unit = __fname__mllb_add_unit; mllb_def = __fname__mllb_def; - print_typ = __fname__print_typ;_} -> __fname__mllb_name + mllb_meta = __fname__mllb_meta; print_typ = __fname__print_typ;_} -> + __fname__mllb_name let __proj__Mkmllb__item__mllb_tysc: mllb -> mltyscheme FStar_Pervasives_Native.option = fun projectee -> match projectee with | { mllb_name = __fname__mllb_name; mllb_tysc = __fname__mllb_tysc; mllb_add_unit = __fname__mllb_add_unit; mllb_def = __fname__mllb_def; - print_typ = __fname__print_typ;_} -> __fname__mllb_tysc + mllb_meta = __fname__mllb_meta; print_typ = __fname__print_typ;_} -> + __fname__mllb_tysc let __proj__Mkmllb__item__mllb_add_unit: mllb -> Prims.bool = fun projectee -> match projectee with | { mllb_name = __fname__mllb_name; mllb_tysc = __fname__mllb_tysc; mllb_add_unit = __fname__mllb_add_unit; mllb_def = __fname__mllb_def; - print_typ = __fname__print_typ;_} -> __fname__mllb_add_unit + mllb_meta = __fname__mllb_meta; print_typ = __fname__print_typ;_} -> + __fname__mllb_add_unit let __proj__Mkmllb__item__mllb_def: mllb -> mlexpr = fun projectee -> match projectee with | { mllb_name = __fname__mllb_name; mllb_tysc = __fname__mllb_tysc; mllb_add_unit = __fname__mllb_add_unit; mllb_def = __fname__mllb_def; - print_typ = __fname__print_typ;_} -> __fname__mllb_def + mllb_meta = __fname__mllb_meta; print_typ = __fname__print_typ;_} -> + __fname__mllb_def +let __proj__Mkmllb__item__mllb_meta: mllb -> metadata = + fun projectee -> + match projectee with + | { mllb_name = __fname__mllb_name; mllb_tysc = __fname__mllb_tysc; + mllb_add_unit = __fname__mllb_add_unit; mllb_def = __fname__mllb_def; + mllb_meta = __fname__mllb_meta; print_typ = __fname__print_typ;_} -> + __fname__mllb_meta let __proj__Mkmllb__item__print_typ: mllb -> Prims.bool = fun projectee -> match projectee with | { mllb_name = __fname__mllb_name; mllb_tysc = __fname__mllb_tysc; mllb_add_unit = __fname__mllb_add_unit; mllb_def = __fname__mllb_def; - print_typ = __fname__print_typ;_} -> __fname__print_typ + mllb_meta = __fname__mllb_meta; print_typ = __fname__print_typ;_} -> + __fname__print_typ type mlbranch = (mlpattern,mlexpr FStar_Pervasives_Native.option,mlexpr) FStar_Pervasives_Native.tuple3[@@deriving show] type mlletbinding = - (mlletflavor,metadata,mllb Prims.list) FStar_Pervasives_Native.tuple3 -[@@deriving show] + (mlletflavor,mllb Prims.list) FStar_Pervasives_Native.tuple2[@@deriving + show] type mltybody = | MLTD_Abbrev of mlty | MLTD_Record of (mlsymbol,mlty) FStar_Pervasives_Native.tuple2 Prims.list @@ -652,18 +669,18 @@ type mltybody = FStar_Pervasives_Native.tuple2 Prims.list[@@deriving show] let uu___is_MLTD_Abbrev: mltybody -> Prims.bool = fun projectee -> - match projectee with | MLTD_Abbrev _0 -> true | uu____1989 -> false + match projectee with | MLTD_Abbrev _0 -> true | uu____2001 -> false let __proj__MLTD_Abbrev__item___0: mltybody -> mlty = fun projectee -> match projectee with | MLTD_Abbrev _0 -> _0 let uu___is_MLTD_Record: mltybody -> Prims.bool = fun projectee -> - match projectee with | MLTD_Record _0 -> true | uu____2007 -> false + match projectee with | MLTD_Record _0 -> true | uu____2019 -> false let __proj__MLTD_Record__item___0: mltybody -> (mlsymbol,mlty) FStar_Pervasives_Native.tuple2 Prims.list = fun projectee -> match projectee with | MLTD_Record _0 -> _0 let uu___is_MLTD_DType: mltybody -> Prims.bool = fun projectee -> - match projectee with | MLTD_DType _0 -> true | uu____2049 -> false + match projectee with | MLTD_DType _0 -> true | uu____2061 -> false let __proj__MLTD_DType__item___0: mltybody -> (mlsymbol,(mlsymbol,mlty) FStar_Pervasives_Native.tuple2 Prims.list) @@ -684,17 +701,17 @@ type mlmodule1 = | MLM_Loc of mlloc[@@deriving show] let uu___is_MLM_Ty: mlmodule1 -> Prims.bool = fun projectee -> - match projectee with | MLM_Ty _0 -> true | uu____2145 -> false + match projectee with | MLM_Ty _0 -> true | uu____2157 -> false let __proj__MLM_Ty__item___0: mlmodule1 -> mltydecl = fun projectee -> match projectee with | MLM_Ty _0 -> _0 let uu___is_MLM_Let: mlmodule1 -> Prims.bool = fun projectee -> - match projectee with | MLM_Let _0 -> true | uu____2157 -> false + match projectee with | MLM_Let _0 -> true | uu____2169 -> false let __proj__MLM_Let__item___0: mlmodule1 -> mlletbinding = fun projectee -> match projectee with | MLM_Let _0 -> _0 let uu___is_MLM_Exn: mlmodule1 -> Prims.bool = fun projectee -> - match projectee with | MLM_Exn _0 -> true | uu____2179 -> false + match projectee with | MLM_Exn _0 -> true | uu____2191 -> false let __proj__MLM_Exn__item___0: mlmodule1 -> (mlsymbol,(mlsymbol,mlty) FStar_Pervasives_Native.tuple2 Prims.list) @@ -702,12 +719,12 @@ let __proj__MLM_Exn__item___0: = fun projectee -> match projectee with | MLM_Exn _0 -> _0 let uu___is_MLM_Top: mlmodule1 -> Prims.bool = fun projectee -> - match projectee with | MLM_Top _0 -> true | uu____2221 -> false + match projectee with | MLM_Top _0 -> true | uu____2233 -> false let __proj__MLM_Top__item___0: mlmodule1 -> mlexpr = fun projectee -> match projectee with | MLM_Top _0 -> _0 let uu___is_MLM_Loc: mlmodule1 -> Prims.bool = fun projectee -> - match projectee with | MLM_Loc _0 -> true | uu____2233 -> false + match projectee with | MLM_Loc _0 -> true | uu____2245 -> false let __proj__MLM_Loc__item___0: mlmodule1 -> mlloc = fun projectee -> match projectee with | MLM_Loc _0 -> _0 type mlmodule = mlmodule1 Prims.list[@@deriving show] @@ -719,24 +736,24 @@ type mlsig1 = [@@deriving show] let uu___is_MLS_Mod: mlsig1 -> Prims.bool = fun projectee -> - match projectee with | MLS_Mod _0 -> true | uu____2285 -> false + match projectee with | MLS_Mod _0 -> true | uu____2297 -> false let __proj__MLS_Mod__item___0: mlsig1 -> (mlsymbol,mlsig1 Prims.list) FStar_Pervasives_Native.tuple2 = fun projectee -> match projectee with | MLS_Mod _0 -> _0 let uu___is_MLS_Ty: mlsig1 -> Prims.bool = fun projectee -> - match projectee with | MLS_Ty _0 -> true | uu____2315 -> false + match projectee with | MLS_Ty _0 -> true | uu____2327 -> false let __proj__MLS_Ty__item___0: mlsig1 -> mltydecl = fun projectee -> match projectee with | MLS_Ty _0 -> _0 let uu___is_MLS_Val: mlsig1 -> Prims.bool = fun projectee -> - match projectee with | MLS_Val _0 -> true | uu____2331 -> false + match projectee with | MLS_Val _0 -> true | uu____2343 -> false let __proj__MLS_Val__item___0: mlsig1 -> (mlsymbol,mltyscheme) FStar_Pervasives_Native.tuple2 = fun projectee -> match projectee with | MLS_Val _0 -> _0 let uu___is_MLS_Exn: mlsig1 -> Prims.bool = fun projectee -> - match projectee with | MLS_Exn _0 -> true | uu____2361 -> false + match projectee with | MLS_Exn _0 -> true | uu____2373 -> false let __proj__MLS_Exn__item___0: mlsig1 -> (mlsymbol,mlty Prims.list) FStar_Pervasives_Native.tuple2 = fun projectee -> match projectee with | MLS_Exn _0 -> _0 @@ -769,50 +786,50 @@ let apply_obj_repr: mlexpr -> mlty -> mlexpr = fun x -> fun t -> let obj_ns = - let uu____2526 = FStar_Options.codegen_fsharp () in - if uu____2526 then "FSharp.Compatibility.OCaml.Obj" else "Obj" in + let uu____2538 = FStar_Options.codegen_fsharp () in + if uu____2538 then "FSharp.Compatibility.OCaml.Obj" else "Obj" in let obj_repr = with_ty (MLTY_Fun (t, E_PURE, MLTY_Top)) (MLE_Name ([obj_ns], "repr")) in with_ty_loc MLTY_Top (MLE_App (obj_repr, [x])) x.loc let avoid_keyword: Prims.string -> Prims.string = fun s -> - let uu____2536 = is_reserved s in - if uu____2536 then Prims.strcat s "_" else s + let uu____2548 = is_reserved s in + if uu____2548 then Prims.strcat s "_" else s let bv_as_mlident: FStar_Syntax_Syntax.bv -> mlident = fun x -> - let uu____2541 = + let uu____2553 = ((FStar_Util.starts_with (x.FStar_Syntax_Syntax.ppname).FStar_Ident.idText FStar_Ident.reserved_prefix) || (FStar_Syntax_Syntax.is_null_bv x)) || (is_reserved (x.FStar_Syntax_Syntax.ppname).FStar_Ident.idText) in - if uu____2541 + if uu____2553 then - let uu____2542 = - let uu____2543 = - let uu____2544 = + let uu____2554 = + let uu____2555 = + let uu____2556 = FStar_Util.string_of_int x.FStar_Syntax_Syntax.index in - Prims.strcat "_" uu____2544 in + Prims.strcat "_" uu____2556 in Prims.strcat (x.FStar_Syntax_Syntax.ppname).FStar_Ident.idText - uu____2543 in - FStar_All.pipe_left avoid_keyword uu____2542 + uu____2555 in + FStar_All.pipe_left avoid_keyword uu____2554 else FStar_All.pipe_left avoid_keyword (x.FStar_Syntax_Syntax.ppname).FStar_Ident.idText let push_unit: mltyscheme -> mltyscheme = fun ts -> - let uu____2549 = ts in - match uu____2549 with + let uu____2561 = ts in + match uu____2561 with | (vs,ty) -> (vs, (MLTY_Fun (ml_unit_ty, E_PURE, ty))) let pop_unit: mltyscheme -> mltyscheme = fun ts -> - let uu____2555 = ts in - match uu____2555 with + let uu____2567 = ts in + match uu____2567 with | (vs,ty) -> (match ty with | MLTY_Fun (l,E_PURE ,t) -> if l = ml_unit_ty then (vs, t) else failwith "unexpected: pop_unit: domain was not unit" - | uu____2561 -> failwith "unexpected: pop_unit: not a function type") \ No newline at end of file + | uu____2573 -> failwith "unexpected: pop_unit: not a function type") \ No newline at end of file diff --git a/src/ocaml-output/FStar_Extraction_ML_Term.ml b/src/ocaml-output/FStar_Extraction_ML_Term.ml index 26ef959ef4f..57e0106b9c4 100644 --- a/src/ocaml-output/FStar_Extraction_ML_Term.ml +++ b/src/ocaml-output/FStar_Extraction_ML_Term.ml @@ -866,7 +866,7 @@ let mk_MLE_Let: fun lbs -> fun body -> match lbs with - | (FStar_Extraction_ML_Syntax.NonRec ,quals,lb::[]) when + | (FStar_Extraction_ML_Syntax.NonRec ,lb::[]) when Prims.op_Negation top_level -> (match lb.FStar_Extraction_ML_Syntax.mllb_tysc with | FStar_Pervasives_Native.Some ([],t) when @@ -881,16 +881,16 @@ let mk_MLE_Let: | FStar_Extraction_ML_Syntax.MLE_Var x when x = lb.FStar_Extraction_ML_Syntax.mllb_name -> (lb.FStar_Extraction_ML_Syntax.mllb_def).FStar_Extraction_ML_Syntax.expr - | uu____2794 when + | uu____2793 when (lb.FStar_Extraction_ML_Syntax.mllb_def).FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.ml_unit.FStar_Extraction_ML_Syntax.expr -> body.FStar_Extraction_ML_Syntax.expr - | uu____2795 -> + | uu____2794 -> mk_MLE_Seq lb.FStar_Extraction_ML_Syntax.mllb_def body) - | uu____2796 -> FStar_Extraction_ML_Syntax.MLE_Let (lbs, body)) - | uu____2799 -> FStar_Extraction_ML_Syntax.MLE_Let (lbs, body) + | uu____2795 -> FStar_Extraction_ML_Syntax.MLE_Let (lbs, body)) + | uu____2798 -> FStar_Extraction_ML_Syntax.MLE_Let (lbs, body) let resugar_pat: FStar_Syntax_Syntax.fv_qual FStar_Pervasives_Native.option -> FStar_Extraction_ML_Syntax.mlpattern -> @@ -900,11 +900,11 @@ let resugar_pat: fun p -> match p with | FStar_Extraction_ML_Syntax.MLP_CTor (d,pats) -> - let uu____2816 = FStar_Extraction_ML_Util.is_xtuple d in - (match uu____2816 with + let uu____2815 = FStar_Extraction_ML_Util.is_xtuple d in + (match uu____2815 with | FStar_Pervasives_Native.Some n1 -> FStar_Extraction_ML_Syntax.MLP_Tuple pats - | uu____2820 -> + | uu____2819 -> (match q with | FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Record_ctor (ty,fns)) -> @@ -912,8 +912,8 @@ let resugar_pat: FStar_List.map FStar_Ident.text_of_id ty.FStar_Ident.ns in let fs = record_fields fns pats in FStar_Extraction_ML_Syntax.MLP_Record (path, fs) - | uu____2847 -> p)) - | uu____2850 -> p + | uu____2846 -> p)) + | uu____2849 -> p let rec extract_one_pat: Prims.bool -> FStar_Extraction_ML_UEnv.env -> @@ -945,192 +945,192 @@ let rec extract_one_pat: (if Prims.op_Negation ok then FStar_Extraction_ML_UEnv.debug g - (fun uu____2930 -> - let uu____2931 = + (fun uu____2929 -> + let uu____2930 = FStar_Extraction_ML_Code.string_of_mlty g.FStar_Extraction_ML_UEnv.currentModule t' in - let uu____2932 = + let uu____2931 = FStar_Extraction_ML_Code.string_of_mlty g.FStar_Extraction_ML_UEnv.currentModule t in FStar_Util.print2 "Expected pattern type %s; got pattern type %s\n" - uu____2931 uu____2932) + uu____2930 uu____2931) else (); ok) in match p.FStar_Syntax_Syntax.v with | FStar_Syntax_Syntax.Pat_constant (FStar_Const.Const_int (c,swopt)) when - let uu____2962 = FStar_Options.codegen () in - uu____2962 <> (FStar_Pervasives_Native.Some "Kremlin") -> - let uu____2967 = + let uu____2961 = FStar_Options.codegen () in + uu____2961 <> (FStar_Pervasives_Native.Some "Kremlin") -> + let uu____2966 = match swopt with | FStar_Pervasives_Native.None -> - let uu____2980 = - let uu____2981 = - let uu____2982 = + let uu____2979 = + let uu____2980 = + let uu____2981 = FStar_Extraction_ML_Util.mlconst_of_const p.FStar_Syntax_Syntax.p (FStar_Const.Const_int (c, FStar_Pervasives_Native.None)) in - FStar_Extraction_ML_Syntax.MLE_Const uu____2982 in + FStar_Extraction_ML_Syntax.MLE_Const uu____2981 in FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty - FStar_Extraction_ML_Syntax.ml_int_ty) uu____2981 in - (uu____2980, FStar_Extraction_ML_Syntax.ml_int_ty) + FStar_Extraction_ML_Syntax.ml_int_ty) uu____2980 in + (uu____2979, FStar_Extraction_ML_Syntax.ml_int_ty) | FStar_Pervasives_Native.Some sw -> let source_term = FStar_ToSyntax_ToSyntax.desugar_machine_integer (g.FStar_Extraction_ML_UEnv.tcenv).FStar_TypeChecker_Env.dsenv c sw FStar_Range.dummyRange in - let uu____3003 = term_as_mlexpr g source_term in - (match uu____3003 with - | (mlterm,uu____3015,mlty) -> (mlterm, mlty)) in - (match uu____2967 with + let uu____3002 = term_as_mlexpr g source_term in + (match uu____3002 with + | (mlterm,uu____3014,mlty) -> (mlterm, mlty)) in + (match uu____2966 with | (mlc,ml_ty) -> let x = FStar_Extraction_ML_Syntax.gensym () in let when_clause = - let uu____3035 = - let uu____3036 = - let uu____3043 = - let uu____3046 = + let uu____3034 = + let uu____3035 = + let uu____3042 = + let uu____3045 = FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty ml_ty) (FStar_Extraction_ML_Syntax.MLE_Var x) in - [uu____3046; mlc] in + [uu____3045; mlc] in (FStar_Extraction_ML_Util.prims_op_equality, - uu____3043) in - FStar_Extraction_ML_Syntax.MLE_App uu____3036 in + uu____3042) in + FStar_Extraction_ML_Syntax.MLE_App uu____3035 in FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty - FStar_Extraction_ML_Syntax.ml_bool_ty) uu____3035 in - let uu____3049 = ok ml_ty in + FStar_Extraction_ML_Syntax.ml_bool_ty) uu____3034 in + let uu____3048 = ok ml_ty in (g, (FStar_Pervasives_Native.Some ((FStar_Extraction_ML_Syntax.MLP_Var x), - [when_clause])), uu____3049)) + [when_clause])), uu____3048)) | FStar_Syntax_Syntax.Pat_constant s -> let t = FStar_TypeChecker_TcTerm.tc_constant g.FStar_Extraction_ML_UEnv.tcenv FStar_Range.dummyRange s in let mlty = term_as_mlty g t in - let uu____3069 = - let uu____3078 = - let uu____3085 = - let uu____3086 = + let uu____3068 = + let uu____3077 = + let uu____3084 = + let uu____3085 = FStar_Extraction_ML_Util.mlconst_of_const p.FStar_Syntax_Syntax.p s in - FStar_Extraction_ML_Syntax.MLP_Const uu____3086 in - (uu____3085, []) in - FStar_Pervasives_Native.Some uu____3078 in - let uu____3095 = ok mlty in (g, uu____3069, uu____3095) + FStar_Extraction_ML_Syntax.MLP_Const uu____3085 in + (uu____3084, []) in + FStar_Pervasives_Native.Some uu____3077 in + let uu____3094 = ok mlty in (g, uu____3068, uu____3094) | FStar_Syntax_Syntax.Pat_var x -> let mlty = term_as_mlty g x.FStar_Syntax_Syntax.sort in - let uu____3106 = + let uu____3105 = FStar_Extraction_ML_UEnv.extend_bv g x ([], mlty) false false imp in - (match uu____3106 with + (match uu____3105 with | (g1,x1) -> - let uu____3129 = ok mlty in + let uu____3128 = ok mlty in (g1, (if imp then FStar_Pervasives_Native.None else FStar_Pervasives_Native.Some ((FStar_Extraction_ML_Syntax.MLP_Var x1), [])), - uu____3129)) + uu____3128)) | FStar_Syntax_Syntax.Pat_wild x -> let mlty = term_as_mlty g x.FStar_Syntax_Syntax.sort in - let uu____3163 = + let uu____3162 = FStar_Extraction_ML_UEnv.extend_bv g x ([], mlty) false false imp in - (match uu____3163 with + (match uu____3162 with | (g1,x1) -> - let uu____3186 = ok mlty in + let uu____3185 = ok mlty in (g1, (if imp then FStar_Pervasives_Native.None else FStar_Pervasives_Native.Some ((FStar_Extraction_ML_Syntax.MLP_Var x1), [])), - uu____3186)) - | FStar_Syntax_Syntax.Pat_dot_term uu____3218 -> + uu____3185)) + | FStar_Syntax_Syntax.Pat_dot_term uu____3217 -> (g, FStar_Pervasives_Native.None, true) | FStar_Syntax_Syntax.Pat_cons (f,pats) -> - let uu____3257 = - let uu____3262 = FStar_Extraction_ML_UEnv.lookup_fv g f in - match uu____3262 with + let uu____3256 = + let uu____3261 = FStar_Extraction_ML_UEnv.lookup_fv g f in + match uu____3261 with | FStar_Util.Inr - (uu____3267,{ + (uu____3266,{ FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Name n1; FStar_Extraction_ML_Syntax.mlty = - uu____3269; + uu____3268; FStar_Extraction_ML_Syntax.loc = - uu____3270;_},ttys,uu____3272) + uu____3269;_},ttys,uu____3271) -> (n1, ttys) - | uu____3285 -> failwith "Expected a constructor" in - (match uu____3257 with + | uu____3284 -> failwith "Expected a constructor" in + (match uu____3256 with | (d,tys) -> let nTyVars = FStar_List.length (FStar_Pervasives_Native.fst tys) in - let uu____3307 = FStar_Util.first_N nTyVars pats in - (match uu____3307 with + let uu____3306 = FStar_Util.first_N nTyVars pats in + (match uu____3306 with | (tysVarPats,restPats) -> let f_ty_opt = try let mlty_args = FStar_All.pipe_right tysVarPats (FStar_List.map - (fun uu____3440 -> - match uu____3440 with - | (p1,uu____3448) -> + (fun uu____3439 -> + match uu____3439 with + | (p1,uu____3447) -> (match p1.FStar_Syntax_Syntax.v with | FStar_Syntax_Syntax.Pat_dot_term - (uu____3453,t) -> + (uu____3452,t) -> term_as_mlty g t - | uu____3459 -> + | uu____3458 -> (FStar_Extraction_ML_UEnv.debug g - (fun uu____3463 -> - let uu____3464 = + (fun uu____3462 -> + let uu____3463 = FStar_Syntax_Print.pat_to_string p1 in FStar_Util.print1 "Pattern %s is not extractable" - uu____3464); + uu____3463); FStar_Exn.raise Un_extractable)))) in let f_ty = FStar_Extraction_ML_Util.subst tys mlty_args in - let uu____3466 = + let uu____3465 = FStar_Extraction_ML_Util.uncurry_mlty_fun f_ty in - FStar_Pervasives_Native.Some uu____3466 + FStar_Pervasives_Native.Some uu____3465 with | Un_extractable -> FStar_Pervasives_Native.None in - let uu____3495 = + let uu____3494 = FStar_Util.fold_map (fun g1 -> - fun uu____3531 -> - match uu____3531 with + fun uu____3530 -> + match uu____3530 with | (p1,imp1) -> - let uu____3550 = + let uu____3549 = extract_one_pat true g1 p1 FStar_Pervasives_Native.None term_as_mlexpr in - (match uu____3550 with - | (g2,p2,uu____3579) -> (g2, p2))) g + (match uu____3549 with + | (g2,p2,uu____3578) -> (g2, p2))) g tysVarPats in - (match uu____3495 with + (match uu____3494 with | (g1,tyMLPats) -> - let uu____3640 = + let uu____3639 = FStar_Util.fold_map - (fun uu____3704 -> - fun uu____3705 -> - match (uu____3704, uu____3705) with + (fun uu____3703 -> + fun uu____3704 -> + match (uu____3703, uu____3704) with | ((g2,f_ty_opt1),(p1,imp1)) -> - let uu____3798 = + let uu____3797 = match f_ty_opt1 with | FStar_Pervasives_Native.Some (hd1::rest,res) -> @@ -1138,56 +1138,56 @@ let rec extract_one_pat: (rest, res)), (FStar_Pervasives_Native.Some hd1)) - | uu____3858 -> + | uu____3857 -> (FStar_Pervasives_Native.None, FStar_Pervasives_Native.None) in - (match uu____3798 with + (match uu____3797 with | (f_ty_opt2,expected_ty) -> - let uu____3929 = + let uu____3928 = extract_one_pat false g2 p1 expected_ty term_as_mlexpr in - (match uu____3929 with - | (g3,p2,uu____3970) -> + (match uu____3928 with + | (g3,p2,uu____3969) -> ((g3, f_ty_opt2), p2)))) (g1, f_ty_opt) restPats in - (match uu____3640 with + (match uu____3639 with | ((g2,f_ty_opt1),restMLPats) -> - let uu____4088 = - let uu____4099 = + let uu____4087 = + let uu____4098 = FStar_All.pipe_right (FStar_List.append tyMLPats restMLPats) (FStar_List.collect - (fun uu___60_4150 -> - match uu___60_4150 with + (fun uu___60_4149 -> + match uu___60_4149 with | FStar_Pervasives_Native.Some x -> [x] - | uu____4192 -> [])) in - FStar_All.pipe_right uu____4099 + | uu____4191 -> [])) in + FStar_All.pipe_right uu____4098 FStar_List.split in - (match uu____4088 with + (match uu____4087 with | (mlPats,when_clauses) -> let pat_ty_compat = match f_ty_opt1 with | FStar_Pervasives_Native.Some ([],t) -> ok t - | uu____4265 -> false in - let uu____4274 = - let uu____4283 = - let uu____4290 = + | uu____4264 -> false in + let uu____4273 = + let uu____4282 = + let uu____4289 = resugar_pat f.FStar_Syntax_Syntax.fv_qual (FStar_Extraction_ML_Syntax.MLP_CTor (d, mlPats)) in - let uu____4293 = + let uu____4292 = FStar_All.pipe_right when_clauses FStar_List.flatten in - (uu____4290, uu____4293) in + (uu____4289, uu____4292) in FStar_Pervasives_Native.Some - uu____4283 in - (g2, uu____4274, pat_ty_compat)))))) + uu____4282 in + (g2, uu____4273, pat_ty_compat)))))) let extract_pat: FStar_Extraction_ML_UEnv.env -> FStar_Syntax_Syntax.pat -> @@ -1210,23 +1210,23 @@ let extract_pat: fun expected_t -> fun term_as_mlexpr -> let extract_one_pat1 g1 p1 expected_t1 = - let uu____4406 = + let uu____4405 = extract_one_pat false g1 p1 expected_t1 term_as_mlexpr in - match uu____4406 with + match uu____4405 with | (g2,FStar_Pervasives_Native.Some (x,v1),b) -> (g2, (x, v1), b) - | uu____4463 -> + | uu____4462 -> failwith "Impossible: Unable to translate pattern" in let mk_when_clause whens = match whens with | [] -> FStar_Pervasives_Native.None | hd1::tl1 -> - let uu____4506 = + let uu____4505 = FStar_List.fold_left FStar_Extraction_ML_Util.conjoin hd1 tl1 in - FStar_Pervasives_Native.Some uu____4506 in - let uu____4507 = + FStar_Pervasives_Native.Some uu____4505 in + let uu____4506 = extract_one_pat1 g p (FStar_Pervasives_Native.Some expected_t) in - match uu____4507 with + match uu____4506 with | (g1,(p1,whens),b) -> let when_clause = mk_when_clause whens in (g1, [(p1, when_clause)], b) @@ -1243,24 +1243,24 @@ let maybe_eta_data_and_project_record: fun mlAppExpr -> let rec eta_args more_args t = match t with - | FStar_Extraction_ML_Syntax.MLTY_Fun (t0,uu____4645,t1) -> + | FStar_Extraction_ML_Syntax.MLTY_Fun (t0,uu____4644,t1) -> let x = FStar_Extraction_ML_Syntax.gensym () in - let uu____4648 = - let uu____4659 = - let uu____4668 = + let uu____4647 = + let uu____4658 = + let uu____4667 = FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty t0) (FStar_Extraction_ML_Syntax.MLE_Var x) in - ((x, t0), uu____4668) in - uu____4659 :: more_args in - eta_args uu____4648 t1 - | FStar_Extraction_ML_Syntax.MLTY_Named (uu____4681,uu____4682) + ((x, t0), uu____4667) in + uu____4658 :: more_args in + eta_args uu____4647 t1 + | FStar_Extraction_ML_Syntax.MLTY_Named (uu____4680,uu____4681) -> ((FStar_List.rev more_args), t) - | uu____4705 -> failwith "Impossible: Head type is not an arrow" in + | uu____4704 -> failwith "Impossible: Head type is not an arrow" in let as_record qual1 e = match ((e.FStar_Extraction_ML_Syntax.expr), qual1) with | (FStar_Extraction_ML_Syntax.MLE_CTor - (uu____4733,args),FStar_Pervasives_Native.Some + (uu____4732,args),FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Record_ctor (tyname,fields))) -> let path = FStar_List.map FStar_Ident.text_of_id tyname.FStar_Ident.ns in @@ -1269,25 +1269,25 @@ let maybe_eta_data_and_project_record: (FStar_Extraction_ML_Syntax.with_ty e.FStar_Extraction_ML_Syntax.mlty) (FStar_Extraction_ML_Syntax.MLE_Record (path, fields1)) - | uu____4765 -> e in + | uu____4764 -> e in let resugar_and_maybe_eta qual1 e = - let uu____4783 = eta_args [] residualType in - match uu____4783 with + let uu____4782 = eta_args [] residualType in + match uu____4782 with | (eargs,tres) -> (match eargs with | [] -> - let uu____4836 = as_record qual1 e in - FStar_Extraction_ML_Util.resugar_exp uu____4836 - | uu____4837 -> - let uu____4848 = FStar_List.unzip eargs in - (match uu____4848 with + let uu____4835 = as_record qual1 e in + FStar_Extraction_ML_Util.resugar_exp uu____4835 + | uu____4836 -> + let uu____4847 = FStar_List.unzip eargs in + (match uu____4847 with | (binders,eargs1) -> (match e.FStar_Extraction_ML_Syntax.expr with | FStar_Extraction_ML_Syntax.MLE_CTor (head1,args) -> let body = - let uu____4890 = - let uu____4891 = + let uu____4889 = + let uu____4890 = FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty tres) @@ -1295,25 +1295,25 @@ let maybe_eta_data_and_project_record: (head1, (FStar_List.append args eargs1))) in FStar_All.pipe_left (as_record qual1) - uu____4891 in + uu____4890 in FStar_All.pipe_left FStar_Extraction_ML_Util.resugar_exp - uu____4890 in + uu____4889 in FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty e.FStar_Extraction_ML_Syntax.mlty) (FStar_Extraction_ML_Syntax.MLE_Fun (binders, body)) - | uu____4900 -> + | uu____4899 -> failwith "Impossible: Not a constructor"))) in match ((mlAppExpr.FStar_Extraction_ML_Syntax.expr), qual) with - | (uu____4903,FStar_Pervasives_Native.None ) -> mlAppExpr + | (uu____4902,FStar_Pervasives_Native.None ) -> mlAppExpr | (FStar_Extraction_ML_Syntax.MLE_App ({ FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Name mlp; - FStar_Extraction_ML_Syntax.mlty = uu____4907; - FStar_Extraction_ML_Syntax.loc = uu____4908;_},mle::args),FStar_Pervasives_Native.Some + FStar_Extraction_ML_Syntax.mlty = uu____4906; + FStar_Extraction_ML_Syntax.loc = uu____4907;_},mle::args),FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Record_projector (constrname,f))) -> let f1 = FStar_Ident.lid_of_ids @@ -1323,14 +1323,14 @@ let maybe_eta_data_and_project_record: let e = match args with | [] -> proj - | uu____4935 -> - let uu____4938 = - let uu____4945 = + | uu____4934 -> + let uu____4937 = + let uu____4944 = FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty FStar_Extraction_ML_Syntax.MLTY_Top) proj in - (uu____4945, args) in - FStar_Extraction_ML_Syntax.MLE_App uu____4938 in + (uu____4944, args) in + FStar_Extraction_ML_Syntax.MLE_App uu____4937 in FStar_Extraction_ML_Syntax.with_ty mlAppExpr.FStar_Extraction_ML_Syntax.mlty e | (FStar_Extraction_ML_Syntax.MLE_App @@ -1340,10 +1340,10 @@ let maybe_eta_data_and_project_record: ({ FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Name mlp; - FStar_Extraction_ML_Syntax.mlty = uu____4949; - FStar_Extraction_ML_Syntax.loc = uu____4950;_},uu____4951); - FStar_Extraction_ML_Syntax.mlty = uu____4952; - FStar_Extraction_ML_Syntax.loc = uu____4953;_},mle::args),FStar_Pervasives_Native.Some + FStar_Extraction_ML_Syntax.mlty = uu____4948; + FStar_Extraction_ML_Syntax.loc = uu____4949;_},uu____4950); + FStar_Extraction_ML_Syntax.mlty = uu____4951; + FStar_Extraction_ML_Syntax.loc = uu____4952;_},mle::args),FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Record_projector (constrname,f))) -> let f1 = FStar_Ident.lid_of_ids @@ -1353,42 +1353,42 @@ let maybe_eta_data_and_project_record: let e = match args with | [] -> proj - | uu____4984 -> - let uu____4987 = - let uu____4994 = + | uu____4983 -> + let uu____4986 = + let uu____4993 = FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty FStar_Extraction_ML_Syntax.MLTY_Top) proj in - (uu____4994, args) in - FStar_Extraction_ML_Syntax.MLE_App uu____4987 in + (uu____4993, args) in + FStar_Extraction_ML_Syntax.MLE_App uu____4986 in FStar_Extraction_ML_Syntax.with_ty mlAppExpr.FStar_Extraction_ML_Syntax.mlty e | (FStar_Extraction_ML_Syntax.MLE_App ({ FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Name mlp; - FStar_Extraction_ML_Syntax.mlty = uu____4998; - FStar_Extraction_ML_Syntax.loc = uu____4999;_},mlargs),FStar_Pervasives_Native.Some + FStar_Extraction_ML_Syntax.mlty = uu____4997; + FStar_Extraction_ML_Syntax.loc = uu____4998;_},mlargs),FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Data_ctor )) -> - let uu____5007 = + let uu____5006 = FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty mlAppExpr.FStar_Extraction_ML_Syntax.mlty) (FStar_Extraction_ML_Syntax.MLE_CTor (mlp, mlargs)) in - FStar_All.pipe_left (resugar_and_maybe_eta qual) uu____5007 + FStar_All.pipe_left (resugar_and_maybe_eta qual) uu____5006 | (FStar_Extraction_ML_Syntax.MLE_App ({ FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Name mlp; - FStar_Extraction_ML_Syntax.mlty = uu____5011; - FStar_Extraction_ML_Syntax.loc = uu____5012;_},mlargs),FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.Record_ctor uu____5014)) -> - let uu____5027 = + FStar_Extraction_ML_Syntax.mlty = uu____5010; + FStar_Extraction_ML_Syntax.loc = uu____5011;_},mlargs),FStar_Pervasives_Native.Some + (FStar_Syntax_Syntax.Record_ctor uu____5013)) -> + let uu____5026 = FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty mlAppExpr.FStar_Extraction_ML_Syntax.mlty) (FStar_Extraction_ML_Syntax.MLE_CTor (mlp, mlargs)) in - FStar_All.pipe_left (resugar_and_maybe_eta qual) uu____5027 + FStar_All.pipe_left (resugar_and_maybe_eta qual) uu____5026 | (FStar_Extraction_ML_Syntax.MLE_App ({ FStar_Extraction_ML_Syntax.expr = @@ -1396,17 +1396,17 @@ let maybe_eta_data_and_project_record: ({ FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Name mlp; - FStar_Extraction_ML_Syntax.mlty = uu____5031; - FStar_Extraction_ML_Syntax.loc = uu____5032;_},uu____5033); - FStar_Extraction_ML_Syntax.mlty = uu____5034; - FStar_Extraction_ML_Syntax.loc = uu____5035;_},mlargs),FStar_Pervasives_Native.Some + FStar_Extraction_ML_Syntax.mlty = uu____5030; + FStar_Extraction_ML_Syntax.loc = uu____5031;_},uu____5032); + FStar_Extraction_ML_Syntax.mlty = uu____5033; + FStar_Extraction_ML_Syntax.loc = uu____5034;_},mlargs),FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Data_ctor )) -> - let uu____5047 = + let uu____5046 = FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty mlAppExpr.FStar_Extraction_ML_Syntax.mlty) (FStar_Extraction_ML_Syntax.MLE_CTor (mlp, mlargs)) in - FStar_All.pipe_left (resugar_and_maybe_eta qual) uu____5047 + FStar_All.pipe_left (resugar_and_maybe_eta qual) uu____5046 | (FStar_Extraction_ML_Syntax.MLE_App ({ FStar_Extraction_ML_Syntax.expr = @@ -1414,62 +1414,62 @@ let maybe_eta_data_and_project_record: ({ FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Name mlp; - FStar_Extraction_ML_Syntax.mlty = uu____5051; - FStar_Extraction_ML_Syntax.loc = uu____5052;_},uu____5053); - FStar_Extraction_ML_Syntax.mlty = uu____5054; - FStar_Extraction_ML_Syntax.loc = uu____5055;_},mlargs),FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.Record_ctor uu____5057)) -> - let uu____5074 = + FStar_Extraction_ML_Syntax.mlty = uu____5050; + FStar_Extraction_ML_Syntax.loc = uu____5051;_},uu____5052); + FStar_Extraction_ML_Syntax.mlty = uu____5053; + FStar_Extraction_ML_Syntax.loc = uu____5054;_},mlargs),FStar_Pervasives_Native.Some + (FStar_Syntax_Syntax.Record_ctor uu____5056)) -> + let uu____5073 = FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty mlAppExpr.FStar_Extraction_ML_Syntax.mlty) (FStar_Extraction_ML_Syntax.MLE_CTor (mlp, mlargs)) in - FStar_All.pipe_left (resugar_and_maybe_eta qual) uu____5074 + FStar_All.pipe_left (resugar_and_maybe_eta qual) uu____5073 | (FStar_Extraction_ML_Syntax.MLE_Name mlp,FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Data_ctor )) -> - let uu____5080 = + let uu____5079 = FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty mlAppExpr.FStar_Extraction_ML_Syntax.mlty) (FStar_Extraction_ML_Syntax.MLE_CTor (mlp, [])) in - FStar_All.pipe_left (resugar_and_maybe_eta qual) uu____5080 + FStar_All.pipe_left (resugar_and_maybe_eta qual) uu____5079 | (FStar_Extraction_ML_Syntax.MLE_Name mlp,FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.Record_ctor uu____5084)) -> - let uu____5093 = + (FStar_Syntax_Syntax.Record_ctor uu____5083)) -> + let uu____5092 = FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty mlAppExpr.FStar_Extraction_ML_Syntax.mlty) (FStar_Extraction_ML_Syntax.MLE_CTor (mlp, [])) in - FStar_All.pipe_left (resugar_and_maybe_eta qual) uu____5093 + FStar_All.pipe_left (resugar_and_maybe_eta qual) uu____5092 | (FStar_Extraction_ML_Syntax.MLE_TApp ({ FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Name mlp; - FStar_Extraction_ML_Syntax.mlty = uu____5097; - FStar_Extraction_ML_Syntax.loc = uu____5098;_},uu____5099),FStar_Pervasives_Native.Some + FStar_Extraction_ML_Syntax.mlty = uu____5096; + FStar_Extraction_ML_Syntax.loc = uu____5097;_},uu____5098),FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Data_ctor )) -> - let uu____5106 = + let uu____5105 = FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty mlAppExpr.FStar_Extraction_ML_Syntax.mlty) (FStar_Extraction_ML_Syntax.MLE_CTor (mlp, [])) in - FStar_All.pipe_left (resugar_and_maybe_eta qual) uu____5106 + FStar_All.pipe_left (resugar_and_maybe_eta qual) uu____5105 | (FStar_Extraction_ML_Syntax.MLE_TApp ({ FStar_Extraction_ML_Syntax.expr = FStar_Extraction_ML_Syntax.MLE_Name mlp; - FStar_Extraction_ML_Syntax.mlty = uu____5110; - FStar_Extraction_ML_Syntax.loc = uu____5111;_},uu____5112),FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.Record_ctor uu____5113)) -> - let uu____5126 = + FStar_Extraction_ML_Syntax.mlty = uu____5109; + FStar_Extraction_ML_Syntax.loc = uu____5110;_},uu____5111),FStar_Pervasives_Native.Some + (FStar_Syntax_Syntax.Record_ctor uu____5112)) -> + let uu____5125 = FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty mlAppExpr.FStar_Extraction_ML_Syntax.mlty) (FStar_Extraction_ML_Syntax.MLE_CTor (mlp, [])) in - FStar_All.pipe_left (resugar_and_maybe_eta qual) uu____5126 - | uu____5129 -> mlAppExpr + FStar_All.pipe_left (resugar_and_maybe_eta qual) uu____5125 + | uu____5128 -> mlAppExpr let maybe_downgrade_eff: FStar_Extraction_ML_UEnv.env -> FStar_Extraction_ML_Syntax.e_tag -> @@ -1478,10 +1478,10 @@ let maybe_downgrade_eff: fun g -> fun f -> fun t -> - let uu____5145 = + let uu____5144 = (f = FStar_Extraction_ML_Syntax.E_GHOST) && (type_leq g t FStar_Extraction_ML_Syntax.ml_unit_ty) in - if uu____5145 then FStar_Extraction_ML_Syntax.E_PURE else f + if uu____5144 then FStar_Extraction_ML_Syntax.E_PURE else f let rec term_as_mlexpr: FStar_Extraction_ML_UEnv.env -> FStar_Syntax_Syntax.term -> @@ -1490,23 +1490,23 @@ let rec term_as_mlexpr: = fun g -> fun t -> - let uu____5199 = term_as_mlexpr' g t in - match uu____5199 with + let uu____5198 = term_as_mlexpr' g t in + match uu____5198 with | (e,tag,ty) -> let tag1 = maybe_downgrade_eff g tag ty in (FStar_Extraction_ML_UEnv.debug g (fun u -> - let uu____5220 = - let uu____5221 = FStar_Syntax_Print.tag_of_term t in - let uu____5222 = FStar_Syntax_Print.term_to_string t in - let uu____5223 = + let uu____5219 = + let uu____5220 = FStar_Syntax_Print.tag_of_term t in + let uu____5221 = FStar_Syntax_Print.term_to_string t in + let uu____5222 = FStar_Extraction_ML_Code.string_of_mlty g.FStar_Extraction_ML_UEnv.currentModule ty in FStar_Util.format4 "term_as_mlexpr (%s) : %s has ML type %s and effect %s\n" - uu____5221 uu____5222 uu____5223 + uu____5220 uu____5221 uu____5222 (FStar_Extraction_ML_Util.eff_to_string tag1) in - FStar_Util.print_string uu____5220); + FStar_Util.print_string uu____5219); erase g e ty tag1) and check_term_as_mlexpr: FStar_Extraction_ML_UEnv.env -> @@ -1520,11 +1520,11 @@ and check_term_as_mlexpr: fun t -> fun f -> fun ty -> - let uu____5232 = check_term_as_mlexpr' g t f ty in - match uu____5232 with + let uu____5231 = check_term_as_mlexpr' g t f ty in + match uu____5231 with | (e,t1) -> - let uu____5243 = erase g e t1 f in - (match uu____5243 with | (r,uu____5255,t2) -> (r, t2)) + let uu____5242 = erase g e t1 f in + (match uu____5242 with | (r,uu____5254,t2) -> (r, t2)) and check_term_as_mlexpr': FStar_Extraction_ML_UEnv.env -> FStar_Syntax_Syntax.term -> @@ -1537,12 +1537,12 @@ and check_term_as_mlexpr': fun e0 -> fun f -> fun ty -> - let uu____5265 = term_as_mlexpr g e0 in - match uu____5265 with + let uu____5264 = term_as_mlexpr g e0 in + match uu____5264 with | (e,tag,t) -> let tag1 = maybe_downgrade_eff g tag t in if FStar_Extraction_ML_Util.eff_leq tag1 f - then let uu____5284 = maybe_coerce g e t ty in (uu____5284, ty) + then let uu____5283 = maybe_coerce g e t ty in (uu____5283, ty) else err_unexpected_eff e0 f tag1 and term_as_mlexpr': FStar_Extraction_ML_UEnv.env -> @@ -1554,45 +1554,45 @@ and term_as_mlexpr': fun top -> FStar_Extraction_ML_UEnv.debug g (fun u -> - let uu____5302 = - let uu____5303 = + let uu____5301 = + let uu____5302 = FStar_Range.string_of_range top.FStar_Syntax_Syntax.pos in - let uu____5304 = FStar_Syntax_Print.tag_of_term top in - let uu____5305 = FStar_Syntax_Print.term_to_string top in + let uu____5303 = FStar_Syntax_Print.tag_of_term top in + let uu____5304 = FStar_Syntax_Print.term_to_string top in FStar_Util.format3 "%s: term_as_mlexpr' (%s) : %s \n" - uu____5303 uu____5304 uu____5305 in - FStar_Util.print_string uu____5302); + uu____5302 uu____5303 uu____5304 in + FStar_Util.print_string uu____5301); (let t = FStar_Syntax_Subst.compress top in match t.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Tm_unknown -> - let uu____5313 = - let uu____5314 = FStar_Syntax_Print.tag_of_term t in - FStar_Util.format1 "Impossible: Unexpected term: %s" uu____5314 in - failwith uu____5313 - | FStar_Syntax_Syntax.Tm_delayed uu____5321 -> - let uu____5346 = - let uu____5347 = FStar_Syntax_Print.tag_of_term t in - FStar_Util.format1 "Impossible: Unexpected term: %s" uu____5347 in - failwith uu____5346 - | FStar_Syntax_Syntax.Tm_uvar uu____5354 -> - let uu____5371 = - let uu____5372 = FStar_Syntax_Print.tag_of_term t in - FStar_Util.format1 "Impossible: Unexpected term: %s" uu____5372 in - failwith uu____5371 - | FStar_Syntax_Syntax.Tm_bvar uu____5379 -> - let uu____5380 = - let uu____5381 = FStar_Syntax_Print.tag_of_term t in - FStar_Util.format1 "Impossible: Unexpected term: %s" uu____5381 in - failwith uu____5380 - | FStar_Syntax_Syntax.Tm_type uu____5388 -> + let uu____5312 = + let uu____5313 = FStar_Syntax_Print.tag_of_term t in + FStar_Util.format1 "Impossible: Unexpected term: %s" uu____5313 in + failwith uu____5312 + | FStar_Syntax_Syntax.Tm_delayed uu____5320 -> + let uu____5345 = + let uu____5346 = FStar_Syntax_Print.tag_of_term t in + FStar_Util.format1 "Impossible: Unexpected term: %s" uu____5346 in + failwith uu____5345 + | FStar_Syntax_Syntax.Tm_uvar uu____5353 -> + let uu____5370 = + let uu____5371 = FStar_Syntax_Print.tag_of_term t in + FStar_Util.format1 "Impossible: Unexpected term: %s" uu____5371 in + failwith uu____5370 + | FStar_Syntax_Syntax.Tm_bvar uu____5378 -> + let uu____5379 = + let uu____5380 = FStar_Syntax_Print.tag_of_term t in + FStar_Util.format1 "Impossible: Unexpected term: %s" uu____5380 in + failwith uu____5379 + | FStar_Syntax_Syntax.Tm_type uu____5387 -> (FStar_Extraction_ML_Syntax.ml_unit, FStar_Extraction_ML_Syntax.E_PURE, FStar_Extraction_ML_Syntax.ml_unit_ty) - | FStar_Syntax_Syntax.Tm_refine uu____5389 -> + | FStar_Syntax_Syntax.Tm_refine uu____5388 -> (FStar_Extraction_ML_Syntax.ml_unit, FStar_Extraction_ML_Syntax.E_PURE, FStar_Extraction_ML_Syntax.ml_unit_ty) - | FStar_Syntax_Syntax.Tm_arrow uu____5396 -> + | FStar_Syntax_Syntax.Tm_arrow uu____5395 -> (FStar_Extraction_ML_Syntax.ml_unit, FStar_Extraction_ML_Syntax.E_PURE, FStar_Extraction_ML_Syntax.ml_unit_ty) @@ -1600,209 +1600,193 @@ and term_as_mlexpr': (t1,FStar_Syntax_Syntax.Meta_desugared (FStar_Syntax_Syntax.Mutable_alloc )) -> - let uu____5414 = term_as_mlexpr' g t1 in - (match uu____5414 with - | ({ - FStar_Extraction_ML_Syntax.expr = - FStar_Extraction_ML_Syntax.MLE_Let - ((FStar_Extraction_ML_Syntax.NonRec ,flags1,bodies),continuation); - FStar_Extraction_ML_Syntax.mlty = mlty; - FStar_Extraction_ML_Syntax.loc = loc;_},tag,typ) - -> - ({ - FStar_Extraction_ML_Syntax.expr = - (FStar_Extraction_ML_Syntax.MLE_Let - ((FStar_Extraction_ML_Syntax.NonRec, - (FStar_Extraction_ML_Syntax.Mutable :: flags1), - bodies), continuation)); - FStar_Extraction_ML_Syntax.mlty = mlty; - FStar_Extraction_ML_Syntax.loc = loc - }, tag, typ) - | uu____5460 -> failwith "impossible") + FStar_Errors.raise_err + (FStar_Errors.Error_NoLetMutable, + "let-mutable no longer supported") | FStar_Syntax_Syntax.Tm_meta - (t1,FStar_Syntax_Syntax.Meta_monadic (m,uu____5475)) -> + (t1,FStar_Syntax_Syntax.Meta_monadic (m,uu____5421)) -> let t2 = FStar_Syntax_Subst.compress t1 in (match t2.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Tm_let ((false ,lb::[]),body) when FStar_Util.is_left lb.FStar_Syntax_Syntax.lbname -> - let uu____5505 = - let uu____5512 = + let uu____5451 = + let uu____5458 = FStar_TypeChecker_Env.effect_decl_opt g.FStar_Extraction_ML_UEnv.tcenv m in - FStar_Util.must uu____5512 in - (match uu____5505 with + FStar_Util.must uu____5458 in + (match uu____5451 with | (ed,qualifiers) -> - let uu____5539 = - let uu____5540 = + let uu____5485 = + let uu____5486 = FStar_All.pipe_right qualifiers (FStar_List.contains FStar_Syntax_Syntax.Reifiable) in - FStar_All.pipe_right uu____5540 Prims.op_Negation in - if uu____5539 + FStar_All.pipe_right uu____5486 Prims.op_Negation in + if uu____5485 then term_as_mlexpr' g t2 else failwith "This should not happen (should have been handled at Tm_abs level)") - | uu____5556 -> term_as_mlexpr' g t2) - | FStar_Syntax_Syntax.Tm_meta (t1,uu____5558) -> term_as_mlexpr' g t1 - | FStar_Syntax_Syntax.Tm_uinst (t1,uu____5564) -> term_as_mlexpr' g t1 + | uu____5502 -> term_as_mlexpr' g t2) + | FStar_Syntax_Syntax.Tm_meta (t1,uu____5504) -> term_as_mlexpr' g t1 + | FStar_Syntax_Syntax.Tm_uinst (t1,uu____5510) -> term_as_mlexpr' g t1 | FStar_Syntax_Syntax.Tm_constant c -> - let uu____5570 = + let uu____5516 = FStar_TypeChecker_TcTerm.type_of_tot_term g.FStar_Extraction_ML_UEnv.tcenv t in - (match uu____5570 with - | (uu____5583,ty,uu____5585) -> + (match uu____5516 with + | (uu____5529,ty,uu____5531) -> let ml_ty = term_as_mlty g ty in - let uu____5587 = - let uu____5588 = + let uu____5533 = + let uu____5534 = FStar_Extraction_ML_Util.mlexpr_of_const t.FStar_Syntax_Syntax.pos c in - FStar_Extraction_ML_Syntax.with_ty ml_ty uu____5588 in - (uu____5587, FStar_Extraction_ML_Syntax.E_PURE, ml_ty)) - | FStar_Syntax_Syntax.Tm_name uu____5589 -> - let uu____5590 = is_type g t in - if uu____5590 + FStar_Extraction_ML_Syntax.with_ty ml_ty uu____5534 in + (uu____5533, FStar_Extraction_ML_Syntax.E_PURE, ml_ty)) + | FStar_Syntax_Syntax.Tm_name uu____5535 -> + let uu____5536 = is_type g t in + if uu____5536 then (FStar_Extraction_ML_Syntax.ml_unit, FStar_Extraction_ML_Syntax.E_PURE, FStar_Extraction_ML_Syntax.ml_unit_ty) else - (let uu____5598 = FStar_Extraction_ML_UEnv.lookup_term g t in - match uu____5598 with - | (FStar_Util.Inl uu____5611,uu____5612) -> + (let uu____5544 = FStar_Extraction_ML_UEnv.lookup_term g t in + match uu____5544 with + | (FStar_Util.Inl uu____5557,uu____5558) -> (FStar_Extraction_ML_Syntax.ml_unit, FStar_Extraction_ML_Syntax.E_PURE, FStar_Extraction_ML_Syntax.ml_unit_ty) - | (FStar_Util.Inr (uu____5649,x,mltys,uu____5652),qual) -> + | (FStar_Util.Inr (uu____5595,x,mltys,uu____5598),qual) -> (match mltys with | ([],t1) when t1 = FStar_Extraction_ML_Syntax.ml_unit_ty -> (FStar_Extraction_ML_Syntax.ml_unit, FStar_Extraction_ML_Syntax.E_PURE, t1) | ([],t1) -> - let uu____5698 = + let uu____5644 = maybe_eta_data_and_project_record g qual t1 x in - (uu____5698, FStar_Extraction_ML_Syntax.E_PURE, t1) - | uu____5699 -> err_uninst g t mltys t)) - | FStar_Syntax_Syntax.Tm_fvar uu____5706 -> - let uu____5707 = is_type g t in - if uu____5707 + (uu____5644, FStar_Extraction_ML_Syntax.E_PURE, t1) + | uu____5645 -> err_uninst g t mltys t)) + | FStar_Syntax_Syntax.Tm_fvar uu____5652 -> + let uu____5653 = is_type g t in + if uu____5653 then (FStar_Extraction_ML_Syntax.ml_unit, FStar_Extraction_ML_Syntax.E_PURE, FStar_Extraction_ML_Syntax.ml_unit_ty) else - (let uu____5715 = FStar_Extraction_ML_UEnv.lookup_term g t in - match uu____5715 with - | (FStar_Util.Inl uu____5728,uu____5729) -> + (let uu____5661 = FStar_Extraction_ML_UEnv.lookup_term g t in + match uu____5661 with + | (FStar_Util.Inl uu____5674,uu____5675) -> (FStar_Extraction_ML_Syntax.ml_unit, FStar_Extraction_ML_Syntax.E_PURE, FStar_Extraction_ML_Syntax.ml_unit_ty) - | (FStar_Util.Inr (uu____5766,x,mltys,uu____5769),qual) -> + | (FStar_Util.Inr (uu____5712,x,mltys,uu____5715),qual) -> (match mltys with | ([],t1) when t1 = FStar_Extraction_ML_Syntax.ml_unit_ty -> (FStar_Extraction_ML_Syntax.ml_unit, FStar_Extraction_ML_Syntax.E_PURE, t1) | ([],t1) -> - let uu____5815 = + let uu____5761 = maybe_eta_data_and_project_record g qual t1 x in - (uu____5815, FStar_Extraction_ML_Syntax.E_PURE, t1) - | uu____5816 -> err_uninst g t mltys t)) + (uu____5761, FStar_Extraction_ML_Syntax.E_PURE, t1) + | uu____5762 -> err_uninst g t mltys t)) | FStar_Syntax_Syntax.Tm_abs (bs,body,copt) -> - let uu____5846 = FStar_Syntax_Subst.open_term bs body in - (match uu____5846 with + let uu____5792 = FStar_Syntax_Subst.open_term bs body in + (match uu____5792 with | (bs1,body1) -> - let uu____5859 = binders_as_ml_binders g bs1 in - (match uu____5859 with + let uu____5805 = binders_as_ml_binders g bs1 in + (match uu____5805 with | (ml_bs,env) -> let body2 = match copt with | FStar_Pervasives_Native.Some c -> - let uu____5892 = + let uu____5838 = FStar_TypeChecker_Env.is_reifiable env.FStar_Extraction_ML_UEnv.tcenv c in - if uu____5892 + if uu____5838 then FStar_TypeChecker_Util.reify_body env.FStar_Extraction_ML_UEnv.tcenv body1 else body1 | FStar_Pervasives_Native.None -> (FStar_Extraction_ML_UEnv.debug g - (fun uu____5897 -> - let uu____5898 = + (fun uu____5843 -> + let uu____5844 = FStar_Syntax_Print.term_to_string body1 in FStar_Util.print1 - "No computation type for: %s\n" uu____5898); + "No computation type for: %s\n" uu____5844); body1) in - let uu____5899 = term_as_mlexpr env body2 in - (match uu____5899 with + let uu____5845 = term_as_mlexpr env body2 in + (match uu____5845 with | (ml_body,f,t1) -> - let uu____5915 = + let uu____5861 = FStar_List.fold_right - (fun uu____5934 -> - fun uu____5935 -> - match (uu____5934, uu____5935) with - | ((uu____5956,targ),(f1,t2)) -> + (fun uu____5880 -> + fun uu____5881 -> + match (uu____5880, uu____5881) with + | ((uu____5902,targ),(f1,t2)) -> (FStar_Extraction_ML_Syntax.E_PURE, (FStar_Extraction_ML_Syntax.MLTY_Fun (targ, f1, t2)))) ml_bs (f, t1) in - (match uu____5915 with + (match uu____5861 with | (f1,tfun) -> - let uu____5976 = + let uu____5922 = FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty tfun) (FStar_Extraction_ML_Syntax.MLE_Fun (ml_bs, ml_body)) in - (uu____5976, f1, tfun))))) + (uu____5922, f1, tfun))))) | FStar_Syntax_Syntax.Tm_app ({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_range_of ); - FStar_Syntax_Syntax.pos = uu____5983; - FStar_Syntax_Syntax.vars = uu____5984;_},(a1,uu____5986)::[]) + FStar_Syntax_Syntax.pos = uu____5929; + FStar_Syntax_Syntax.vars = uu____5930;_},(a1,uu____5932)::[]) -> let ty = - let uu____6016 = + let uu____5962 = FStar_Syntax_Syntax.tabbrev FStar_Parser_Const.range_lid in - term_as_mlty g uu____6016 in - let uu____6017 = - let uu____6018 = + term_as_mlty g uu____5962 in + let uu____5963 = + let uu____5964 = FStar_Extraction_ML_Util.mlexpr_of_range a1.FStar_Syntax_Syntax.pos in FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty ty) - uu____6018 in - (uu____6017, FStar_Extraction_ML_Syntax.E_PURE, ty) + uu____5964 in + (uu____5963, FStar_Extraction_ML_Syntax.E_PURE, ty) | FStar_Syntax_Syntax.Tm_app ({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_set_range_of ); - FStar_Syntax_Syntax.pos = uu____6019; - FStar_Syntax_Syntax.vars = uu____6020;_},(t1,uu____6022):: - (r,uu____6024)::[]) + FStar_Syntax_Syntax.pos = uu____5965; + FStar_Syntax_Syntax.vars = uu____5966;_},(t1,uu____5968):: + (r,uu____5970)::[]) -> term_as_mlexpr' g t1 | FStar_Syntax_Syntax.Tm_app ({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_constant - (FStar_Const.Const_reflect uu____6063); - FStar_Syntax_Syntax.pos = uu____6064; - FStar_Syntax_Syntax.vars = uu____6065;_},uu____6066) + (FStar_Const.Const_reflect uu____6009); + FStar_Syntax_Syntax.pos = uu____6010; + FStar_Syntax_Syntax.vars = uu____6011;_},uu____6012) -> failwith "Unreachable? Tm_app Const_reflect" - | FStar_Syntax_Syntax.Tm_app (head1,uu____6094::(v1,uu____6096)::[]) + | FStar_Syntax_Syntax.Tm_app (head1,uu____6040::(v1,uu____6042)::[]) when (FStar_Syntax_Util.is_fstar_tactics_embed head1) && false -> - let uu____6137 = - let uu____6140 = FStar_Syntax_Print.term_to_string v1 in + let uu____6083 = + let uu____6086 = FStar_Syntax_Print.term_to_string v1 in FStar_Util.format2 "Trying to extract a quotation of %s" - uu____6140 in + uu____6086 in let s = - let uu____6142 = - let uu____6143 = - let uu____6144 = - let uu____6147 = FStar_Util.marshal v1 in - FStar_Util.bytes_of_string uu____6147 in - FStar_Extraction_ML_Syntax.MLC_Bytes uu____6144 in - FStar_Extraction_ML_Syntax.MLE_Const uu____6143 in + let uu____6088 = + let uu____6089 = + let uu____6090 = + let uu____6093 = FStar_Util.marshal v1 in + FStar_Util.bytes_of_string uu____6093 in + FStar_Extraction_ML_Syntax.MLC_Bytes uu____6090 in + FStar_Extraction_ML_Syntax.MLE_Const uu____6089 in FStar_Extraction_ML_Syntax.with_ty - FStar_Extraction_ML_Syntax.ml_string_ty uu____6142 in + FStar_Extraction_ML_Syntax.ml_string_ty uu____6088 in let zero1 = FStar_Extraction_ML_Syntax.with_ty FStar_Extraction_ML_Syntax.ml_int_ty @@ -1810,12 +1794,12 @@ and term_as_mlexpr': (FStar_Extraction_ML_Syntax.MLC_Int ("0", FStar_Pervasives_Native.None))) in let term_ty = - let uu____6162 = + let uu____6108 = FStar_Syntax_Syntax.fvar FStar_Parser_Const.fstar_syntax_syntax_term FStar_Syntax_Syntax.Delta_constant FStar_Pervasives_Native.None in - term_as_mlty g uu____6162 in + term_as_mlty g uu____6108 in let marshal_from_string = let string_to_term_ty = FStar_Extraction_ML_Syntax.MLTY_Fun @@ -1824,11 +1808,11 @@ and term_as_mlexpr': FStar_Extraction_ML_Syntax.with_ty string_to_term_ty (FStar_Extraction_ML_Syntax.MLE_Name (["Marshal"], "from_string")) in - let uu____6167 = + let uu____6113 = FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty term_ty) (FStar_Extraction_ML_Syntax.MLE_App (marshal_from_string, [s; zero1])) in - (uu____6167, FStar_Extraction_ML_Syntax.E_PURE, term_ty) + (uu____6113, FStar_Extraction_ML_Syntax.E_PURE, term_ty) | FStar_Syntax_Syntax.Tm_app (head1,args) -> let is_total rc = (FStar_Ident.lid_equals rc.FStar_Syntax_Syntax.residual_effect @@ -1836,17 +1820,17 @@ and term_as_mlexpr': || (FStar_All.pipe_right rc.FStar_Syntax_Syntax.residual_flags (FStar_List.existsb - (fun uu___61_6199 -> - match uu___61_6199 with + (fun uu___61_6145 -> + match uu___61_6145 with | FStar_Syntax_Syntax.TOTAL -> true - | uu____6200 -> false))) in - let uu____6201 = - let uu____6206 = - let uu____6207 = FStar_Syntax_Subst.compress head1 in - uu____6207.FStar_Syntax_Syntax.n in - ((head1.FStar_Syntax_Syntax.n), uu____6206) in - (match uu____6201 with - | (FStar_Syntax_Syntax.Tm_uvar uu____6216,uu____6217) -> + | uu____6146 -> false))) in + let uu____6147 = + let uu____6152 = + let uu____6153 = FStar_Syntax_Subst.compress head1 in + uu____6153.FStar_Syntax_Syntax.n in + ((head1.FStar_Syntax_Syntax.n), uu____6152) in + (match uu____6147 with + | (FStar_Syntax_Syntax.Tm_uvar uu____6162,uu____6163) -> let t1 = FStar_TypeChecker_Normalize.normalize [FStar_TypeChecker_Normalize.Beta; @@ -1856,8 +1840,8 @@ and term_as_mlexpr': FStar_TypeChecker_Normalize.AllowUnboundUniverses] g.FStar_Extraction_ML_UEnv.tcenv t in term_as_mlexpr' g t1 - | (uu____6235,FStar_Syntax_Syntax.Tm_abs - (bs,uu____6237,FStar_Pervasives_Native.Some rc)) when + | (uu____6181,FStar_Syntax_Syntax.Tm_abs + (bs,uu____6183,FStar_Pervasives_Native.Some rc)) when is_total rc -> let t1 = FStar_TypeChecker_Normalize.normalize @@ -1868,26 +1852,26 @@ and term_as_mlexpr': FStar_TypeChecker_Normalize.AllowUnboundUniverses] g.FStar_Extraction_ML_UEnv.tcenv t in term_as_mlexpr' g t1 - | (uu____6258,FStar_Syntax_Syntax.Tm_constant + | (uu____6204,FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_reify )) -> let e = - let uu____6260 = FStar_List.hd args in + let uu____6206 = FStar_List.hd args in FStar_TypeChecker_Util.reify_body_with_arg - g.FStar_Extraction_ML_UEnv.tcenv head1 uu____6260 in + g.FStar_Extraction_ML_UEnv.tcenv head1 uu____6206 in let tm = - let uu____6270 = - let uu____6271 = FStar_TypeChecker_Util.remove_reify e in - let uu____6272 = FStar_List.tl args in - FStar_Syntax_Syntax.mk_Tm_app uu____6271 uu____6272 in - uu____6270 FStar_Pervasives_Native.None + let uu____6216 = + let uu____6217 = FStar_TypeChecker_Util.remove_reify e in + let uu____6218 = FStar_List.tl args in + FStar_Syntax_Syntax.mk_Tm_app uu____6217 uu____6218 in + uu____6216 FStar_Pervasives_Native.None t.FStar_Syntax_Syntax.pos in term_as_mlexpr' g tm - | uu____6281 -> - let rec extract_app is_data uu____6326 uu____6327 restArgs = - match (uu____6326, uu____6327) with + | uu____6227 -> + let rec extract_app is_data uu____6272 uu____6273 restArgs = + match (uu____6272, uu____6273) with | ((mlhead,mlargs_f),(f,t1)) -> (match (restArgs, t1) with - | ([],uu____6417) -> + | ([],uu____6363) -> let evaluation_order_guaranteed = (((FStar_List.length mlargs_f) = (Prims.parse_int "1")) @@ -1900,21 +1884,21 @@ and term_as_mlexpr': || (FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.op_Or) - | uu____6439 -> false) in - let uu____6440 = + | uu____6385 -> false) in + let uu____6386 = if evaluation_order_guaranteed then - let uu____6465 = + let uu____6411 = FStar_All.pipe_right (FStar_List.rev mlargs_f) (FStar_List.map FStar_Pervasives_Native.fst) in - ([], uu____6465) + ([], uu____6411) else FStar_List.fold_left - (fun uu____6519 -> - fun uu____6520 -> - match (uu____6519, uu____6520) with + (fun uu____6465 -> + fun uu____6466 -> + match (uu____6465, uu____6466) with | ((lbs,out_args),(arg,f1)) -> if (f1 = @@ -1927,39 +1911,38 @@ and term_as_mlexpr': (let x = FStar_Extraction_ML_Syntax.gensym () in - let uu____6623 = - let uu____6626 = + let uu____6569 = + let uu____6572 = FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty arg.FStar_Extraction_ML_Syntax.mlty) (FStar_Extraction_ML_Syntax.MLE_Var x) in - uu____6626 :: out_args in - (((x, arg) :: lbs), uu____6623))) + uu____6572 :: out_args in + (((x, arg) :: lbs), uu____6569))) ([], []) mlargs_f in - (match uu____6440 with + (match uu____6386 with | (lbs,mlargs) -> let app = - let uu____6676 = + let uu____6622 = FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty t1) (FStar_Extraction_ML_Syntax.MLE_App (mlhead, mlargs)) in FStar_All.pipe_left (maybe_eta_data_and_project_record g - is_data t1) uu____6676 in + is_data t1) uu____6622 in let l_app = FStar_List.fold_right - (fun uu____6688 -> + (fun uu____6634 -> fun out -> - match uu____6688 with + match uu____6634 with | (x,arg) -> FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty out.FStar_Extraction_ML_Syntax.mlty) (mk_MLE_Let false (FStar_Extraction_ML_Syntax.NonRec, - [], [{ FStar_Extraction_ML_Syntax.mllb_name = x; @@ -1972,78 +1955,80 @@ and term_as_mlexpr': = false; FStar_Extraction_ML_Syntax.mllb_def = arg; + FStar_Extraction_ML_Syntax.mllb_meta + = []; FStar_Extraction_ML_Syntax.print_typ = true }]) out)) lbs app in (l_app, f, t1)) - | ((arg,uu____6709)::rest,FStar_Extraction_ML_Syntax.MLTY_Fun + | ((arg,uu____6653)::rest,FStar_Extraction_ML_Syntax.MLTY_Fun (formal_t,f',t2)) when (is_type g arg) && (type_leq g formal_t FStar_Extraction_ML_Syntax.ml_unit_ty) -> - let uu____6740 = - let uu____6745 = + let uu____6684 = + let uu____6689 = FStar_Extraction_ML_Util.join arg.FStar_Syntax_Syntax.pos f f' in - (uu____6745, t2) in + (uu____6689, t2) in extract_app is_data (mlhead, ((FStar_Extraction_ML_Syntax.ml_unit, FStar_Extraction_ML_Syntax.E_PURE) :: - mlargs_f)) uu____6740 rest - | ((e0,uu____6757)::rest,FStar_Extraction_ML_Syntax.MLTY_Fun + mlargs_f)) uu____6684 rest + | ((e0,uu____6701)::rest,FStar_Extraction_ML_Syntax.MLTY_Fun (tExpected,f',t2)) -> let r = e0.FStar_Syntax_Syntax.pos in - let uu____6789 = term_as_mlexpr g e0 in - (match uu____6789 with + let uu____6733 = term_as_mlexpr g e0 in + (match uu____6733 with | (e01,f0,tInferred) -> let e02 = maybe_coerce g e01 tInferred tExpected in - let uu____6806 = - let uu____6811 = + let uu____6750 = + let uu____6755 = FStar_Extraction_ML_Util.join_l r [f; f'; f0] in - (uu____6811, t2) in + (uu____6755, t2) in extract_app is_data (mlhead, ((e02, f0) :: mlargs_f)) - uu____6806 rest) - | uu____6822 -> - let uu____6835 = + uu____6750 rest) + | uu____6766 -> + let uu____6779 = FStar_Extraction_ML_Util.udelta_unfold g t1 in - (match uu____6835 with + (match uu____6779 with | FStar_Pervasives_Native.Some t2 -> extract_app is_data (mlhead, mlargs_f) (f, t2) restArgs | FStar_Pervasives_Native.None -> err_ill_typed_application g top restArgs t1)) in - let extract_app_maybe_projector is_data mlhead uu____6892 + let extract_app_maybe_projector is_data mlhead uu____6836 args1 = - match uu____6892 with + match uu____6836 with | (f,t1) -> (match is_data with | FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.Record_projector uu____6924) + (FStar_Syntax_Syntax.Record_projector uu____6868) -> let rec remove_implicits args2 f1 t2 = match (args2, t2) with | ((a0,FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.Implicit uu____7002))::args3,FStar_Extraction_ML_Syntax.MLTY_Fun - (uu____7004,f',t3)) -> - let uu____7041 = + (FStar_Syntax_Syntax.Implicit uu____6946))::args3,FStar_Extraction_ML_Syntax.MLTY_Fun + (uu____6948,f',t3)) -> + let uu____6985 = FStar_Extraction_ML_Util.join a0.FStar_Syntax_Syntax.pos f1 f' in - remove_implicits args3 uu____7041 t3 - | uu____7042 -> (args2, f1, t2) in - let uu____7067 = remove_implicits args1 f t1 in - (match uu____7067 with + remove_implicits args3 uu____6985 t3 + | uu____6986 -> (args2, f1, t2) in + let uu____7011 = remove_implicits args1 f t1 in + (match uu____7011 with | (args2,f1,t2) -> extract_app is_data (mlhead, []) (f1, t2) args2) - | uu____7123 -> + | uu____7067 -> extract_app is_data (mlhead, []) (f, t1) args1) in - let uu____7136 = is_type g t in - if uu____7136 + let uu____7080 = is_type g t in + if uu____7080 then (FStar_Extraction_ML_Syntax.ml_unit, FStar_Extraction_ML_Syntax.E_PURE, @@ -2055,52 +2040,52 @@ and term_as_mlexpr': (FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.fstar_refl_embed_lid) && - (let uu____7153 = - let uu____7154 = + (let uu____7097 = + let uu____7098 = FStar_Extraction_ML_Syntax.string_of_mlpath g.FStar_Extraction_ML_UEnv.currentModule in - uu____7154 = "FStar.Tactics.Builtins" in - Prims.op_Negation uu____7153) + uu____7098 = "FStar.Tactics.Builtins" in + Prims.op_Negation uu____7097) -> (match args with | a::b::[] -> term_as_mlexpr g (FStar_Pervasives_Native.fst a) - | uu____7195 -> - let uu____7204 = + | uu____7139 -> + let uu____7148 = FStar_Syntax_Print.args_to_string args in - failwith uu____7204) - | FStar_Syntax_Syntax.Tm_name uu____7211 -> - let uu____7212 = - let uu____7225 = + failwith uu____7148) + | FStar_Syntax_Syntax.Tm_name uu____7155 -> + let uu____7156 = + let uu____7169 = FStar_Extraction_ML_UEnv.lookup_term g head2 in - match uu____7225 with - | (FStar_Util.Inr (uu____7244,x1,x2,x3),q) -> + match uu____7169 with + | (FStar_Util.Inr (uu____7188,x1,x2,x3),q) -> ((x1, x2, x3), q) - | uu____7289 -> failwith "FIXME Ty" in - (match uu____7212 with + | uu____7233 -> failwith "FIXME Ty" in + (match uu____7156 with | ((head_ml,(vars,t1),inst_ok),qual) -> let has_typ_apps = match args with - | (a,uu____7339)::uu____7340 -> is_type g a - | uu____7359 -> false in - let uu____7368 = + | (a,uu____7283)::uu____7284 -> is_type g a + | uu____7303 -> false in + let uu____7312 = match vars with - | uu____7397::uu____7398 when + | uu____7341::uu____7342 when (Prims.op_Negation has_typ_apps) && inst_ok -> (head_ml, t1, args) - | uu____7409 -> + | uu____7353 -> let n1 = FStar_List.length vars in if n1 <= (FStar_List.length args) then - let uu____7437 = + let uu____7381 = FStar_Util.first_N n1 args in - (match uu____7437 with + (match uu____7381 with | (prefix1,rest) -> let prefixAsMLTypes = FStar_List.map - (fun uu____7526 -> - match uu____7526 with - | (x,uu____7532) -> + (fun uu____7470 -> + match uu____7470 with + | (x,uu____7476) -> term_as_mlty g x) prefix1 in let t2 = instantiate (vars, t1) @@ -2108,8 +2093,8 @@ and term_as_mlexpr': let mk_tapp e ty_args = match ty_args with | [] -> e - | uu____7545 -> - let uu___65_7548 = e in + | uu____7489 -> + let uu___65_7492 = e in { FStar_Extraction_ML_Syntax.expr = @@ -2117,43 +2102,43 @@ and term_as_mlexpr': (e, ty_args)); FStar_Extraction_ML_Syntax.mlty = - (uu___65_7548.FStar_Extraction_ML_Syntax.mlty); + (uu___65_7492.FStar_Extraction_ML_Syntax.mlty); FStar_Extraction_ML_Syntax.loc = - (uu___65_7548.FStar_Extraction_ML_Syntax.loc) + (uu___65_7492.FStar_Extraction_ML_Syntax.loc) } in let head3 = match head_ml.FStar_Extraction_ML_Syntax.expr with | FStar_Extraction_ML_Syntax.MLE_Name - uu____7552 -> - let uu___66_7553 = + uu____7496 -> + let uu___66_7497 = mk_tapp head_ml prefixAsMLTypes in { FStar_Extraction_ML_Syntax.expr = - (uu___66_7553.FStar_Extraction_ML_Syntax.expr); + (uu___66_7497.FStar_Extraction_ML_Syntax.expr); FStar_Extraction_ML_Syntax.mlty = t2; FStar_Extraction_ML_Syntax.loc = - (uu___66_7553.FStar_Extraction_ML_Syntax.loc) + (uu___66_7497.FStar_Extraction_ML_Syntax.loc) } | FStar_Extraction_ML_Syntax.MLE_Var - uu____7554 -> - let uu___66_7555 = + uu____7498 -> + let uu___66_7499 = mk_tapp head_ml prefixAsMLTypes in { FStar_Extraction_ML_Syntax.expr = - (uu___66_7555.FStar_Extraction_ML_Syntax.expr); + (uu___66_7499.FStar_Extraction_ML_Syntax.expr); FStar_Extraction_ML_Syntax.mlty = t2; FStar_Extraction_ML_Syntax.loc = - (uu___66_7555.FStar_Extraction_ML_Syntax.loc) + (uu___66_7499.FStar_Extraction_ML_Syntax.loc) } | FStar_Extraction_ML_Syntax.MLE_App (head3,{ @@ -2163,19 +2148,19 @@ and term_as_mlexpr': (FStar_Extraction_ML_Syntax.MLC_Unit ); FStar_Extraction_ML_Syntax.mlty - = uu____7557; + = uu____7501; FStar_Extraction_ML_Syntax.loc - = uu____7558;_}::[]) + = uu____7502;_}::[]) -> FStar_All.pipe_right (FStar_Extraction_ML_Syntax.MLE_App - ((let uu___67_7564 = + ((let uu___67_7508 = mk_tapp head3 prefixAsMLTypes in { FStar_Extraction_ML_Syntax.expr = - (uu___67_7564.FStar_Extraction_ML_Syntax.expr); + (uu___67_7508.FStar_Extraction_ML_Syntax.expr); FStar_Extraction_ML_Syntax.mlty = (FStar_Extraction_ML_Syntax.MLTY_Fun @@ -2184,63 +2169,63 @@ and term_as_mlexpr': t2)); FStar_Extraction_ML_Syntax.loc = - (uu___67_7564.FStar_Extraction_ML_Syntax.loc) + (uu___67_7508.FStar_Extraction_ML_Syntax.loc) }), [FStar_Extraction_ML_Syntax.ml_unit])) (FStar_Extraction_ML_Syntax.with_ty t2) - | uu____7565 -> + | uu____7509 -> failwith "Impossible: Unexpected head term" in (head3, t2, rest)) else err_uninst g head2 (vars, t1) top in - (match uu____7368 with + (match uu____7312 with | (head_ml1,head_t,args1) -> (match args1 with | [] -> - let uu____7626 = + let uu____7570 = maybe_eta_data_and_project_record g qual head_t head_ml1 in - (uu____7626, + (uu____7570, FStar_Extraction_ML_Syntax.E_PURE, head_t) - | uu____7627 -> + | uu____7571 -> extract_app_maybe_projector qual head_ml1 (FStar_Extraction_ML_Syntax.E_PURE, head_t) args1))) - | FStar_Syntax_Syntax.Tm_fvar uu____7636 -> - let uu____7637 = - let uu____7650 = + | FStar_Syntax_Syntax.Tm_fvar uu____7580 -> + let uu____7581 = + let uu____7594 = FStar_Extraction_ML_UEnv.lookup_term g head2 in - match uu____7650 with - | (FStar_Util.Inr (uu____7669,x1,x2,x3),q) -> + match uu____7594 with + | (FStar_Util.Inr (uu____7613,x1,x2,x3),q) -> ((x1, x2, x3), q) - | uu____7714 -> failwith "FIXME Ty" in - (match uu____7637 with + | uu____7658 -> failwith "FIXME Ty" in + (match uu____7581 with | ((head_ml,(vars,t1),inst_ok),qual) -> let has_typ_apps = match args with - | (a,uu____7764)::uu____7765 -> is_type g a - | uu____7784 -> false in - let uu____7793 = + | (a,uu____7708)::uu____7709 -> is_type g a + | uu____7728 -> false in + let uu____7737 = match vars with - | uu____7822::uu____7823 when + | uu____7766::uu____7767 when (Prims.op_Negation has_typ_apps) && inst_ok -> (head_ml, t1, args) - | uu____7834 -> + | uu____7778 -> let n1 = FStar_List.length vars in if n1 <= (FStar_List.length args) then - let uu____7862 = + let uu____7806 = FStar_Util.first_N n1 args in - (match uu____7862 with + (match uu____7806 with | (prefix1,rest) -> let prefixAsMLTypes = FStar_List.map - (fun uu____7951 -> - match uu____7951 with - | (x,uu____7957) -> + (fun uu____7895 -> + match uu____7895 with + | (x,uu____7901) -> term_as_mlty g x) prefix1 in let t2 = instantiate (vars, t1) @@ -2248,8 +2233,8 @@ and term_as_mlexpr': let mk_tapp e ty_args = match ty_args with | [] -> e - | uu____7970 -> - let uu___65_7973 = e in + | uu____7914 -> + let uu___65_7917 = e in { FStar_Extraction_ML_Syntax.expr = @@ -2257,43 +2242,43 @@ and term_as_mlexpr': (e, ty_args)); FStar_Extraction_ML_Syntax.mlty = - (uu___65_7973.FStar_Extraction_ML_Syntax.mlty); + (uu___65_7917.FStar_Extraction_ML_Syntax.mlty); FStar_Extraction_ML_Syntax.loc = - (uu___65_7973.FStar_Extraction_ML_Syntax.loc) + (uu___65_7917.FStar_Extraction_ML_Syntax.loc) } in let head3 = match head_ml.FStar_Extraction_ML_Syntax.expr with | FStar_Extraction_ML_Syntax.MLE_Name - uu____7977 -> - let uu___66_7978 = + uu____7921 -> + let uu___66_7922 = mk_tapp head_ml prefixAsMLTypes in { FStar_Extraction_ML_Syntax.expr = - (uu___66_7978.FStar_Extraction_ML_Syntax.expr); + (uu___66_7922.FStar_Extraction_ML_Syntax.expr); FStar_Extraction_ML_Syntax.mlty = t2; FStar_Extraction_ML_Syntax.loc = - (uu___66_7978.FStar_Extraction_ML_Syntax.loc) + (uu___66_7922.FStar_Extraction_ML_Syntax.loc) } | FStar_Extraction_ML_Syntax.MLE_Var - uu____7979 -> - let uu___66_7980 = + uu____7923 -> + let uu___66_7924 = mk_tapp head_ml prefixAsMLTypes in { FStar_Extraction_ML_Syntax.expr = - (uu___66_7980.FStar_Extraction_ML_Syntax.expr); + (uu___66_7924.FStar_Extraction_ML_Syntax.expr); FStar_Extraction_ML_Syntax.mlty = t2; FStar_Extraction_ML_Syntax.loc = - (uu___66_7980.FStar_Extraction_ML_Syntax.loc) + (uu___66_7924.FStar_Extraction_ML_Syntax.loc) } | FStar_Extraction_ML_Syntax.MLE_App (head3,{ @@ -2303,19 +2288,19 @@ and term_as_mlexpr': (FStar_Extraction_ML_Syntax.MLC_Unit ); FStar_Extraction_ML_Syntax.mlty - = uu____7982; + = uu____7926; FStar_Extraction_ML_Syntax.loc - = uu____7983;_}::[]) + = uu____7927;_}::[]) -> FStar_All.pipe_right (FStar_Extraction_ML_Syntax.MLE_App - ((let uu___67_7989 = + ((let uu___67_7933 = mk_tapp head3 prefixAsMLTypes in { FStar_Extraction_ML_Syntax.expr = - (uu___67_7989.FStar_Extraction_ML_Syntax.expr); + (uu___67_7933.FStar_Extraction_ML_Syntax.expr); FStar_Extraction_ML_Syntax.mlty = (FStar_Extraction_ML_Syntax.MLTY_Fun @@ -2324,38 +2309,38 @@ and term_as_mlexpr': t2)); FStar_Extraction_ML_Syntax.loc = - (uu___67_7989.FStar_Extraction_ML_Syntax.loc) + (uu___67_7933.FStar_Extraction_ML_Syntax.loc) }), [FStar_Extraction_ML_Syntax.ml_unit])) (FStar_Extraction_ML_Syntax.with_ty t2) - | uu____7990 -> + | uu____7934 -> failwith "Impossible: Unexpected head term" in (head3, t2, rest)) else err_uninst g head2 (vars, t1) top in - (match uu____7793 with + (match uu____7737 with | (head_ml1,head_t,args1) -> (match args1 with | [] -> - let uu____8051 = + let uu____7995 = maybe_eta_data_and_project_record g qual head_t head_ml1 in - (uu____8051, + (uu____7995, FStar_Extraction_ML_Syntax.E_PURE, head_t) - | uu____8052 -> + | uu____7996 -> extract_app_maybe_projector qual head_ml1 (FStar_Extraction_ML_Syntax.E_PURE, head_t) args1))) - | uu____8061 -> - let uu____8062 = term_as_mlexpr g head2 in - (match uu____8062 with + | uu____8005 -> + let uu____8006 = term_as_mlexpr g head2 in + (match uu____8006 with | (head3,f,t1) -> extract_app_maybe_projector FStar_Pervasives_Native.None head3 (f, t1) args))) - | FStar_Syntax_Syntax.Tm_ascribed (e0,(tc,uu____8080),f) -> + | FStar_Syntax_Syntax.Tm_ascribed (e0,(tc,uu____8024),f) -> let t1 = match tc with | FStar_Util.Inl t1 -> term_as_mlty g t1 @@ -2366,41 +2351,41 @@ and term_as_mlexpr': | FStar_Pervasives_Native.None -> failwith "Ascription node with an empty effect label" | FStar_Pervasives_Native.Some l -> effect_as_etag g l in - let uu____8147 = check_term_as_mlexpr g e0 f1 t1 in - (match uu____8147 with | (e,t2) -> (e, f1, t2)) + let uu____8091 = check_term_as_mlexpr g e0 f1 t1 in + (match uu____8091 with | (e,t2) -> (e, f1, t2)) | FStar_Syntax_Syntax.Tm_let ((is_rec,lbs),e') -> let top_level = FStar_Syntax_Syntax.is_top_level lbs in - let uu____8178 = + let uu____8122 = if is_rec then FStar_Syntax_Subst.open_let_rec lbs e' else - (let uu____8192 = FStar_Syntax_Syntax.is_top_level lbs in - if uu____8192 + (let uu____8136 = FStar_Syntax_Syntax.is_top_level lbs in + if uu____8136 then (lbs, e') else (let lb = FStar_List.hd lbs in let x = - let uu____8206 = + let uu____8150 = FStar_Util.left lb.FStar_Syntax_Syntax.lbname in - FStar_Syntax_Syntax.freshen_bv uu____8206 in + FStar_Syntax_Syntax.freshen_bv uu____8150 in let lb1 = - let uu___68_8208 = lb in + let uu___68_8152 = lb in { FStar_Syntax_Syntax.lbname = (FStar_Util.Inl x); FStar_Syntax_Syntax.lbunivs = - (uu___68_8208.FStar_Syntax_Syntax.lbunivs); + (uu___68_8152.FStar_Syntax_Syntax.lbunivs); FStar_Syntax_Syntax.lbtyp = - (uu___68_8208.FStar_Syntax_Syntax.lbtyp); + (uu___68_8152.FStar_Syntax_Syntax.lbtyp); FStar_Syntax_Syntax.lbeff = - (uu___68_8208.FStar_Syntax_Syntax.lbeff); + (uu___68_8152.FStar_Syntax_Syntax.lbeff); FStar_Syntax_Syntax.lbdef = - (uu___68_8208.FStar_Syntax_Syntax.lbdef) + (uu___68_8152.FStar_Syntax_Syntax.lbdef) } in let e'1 = FStar_Syntax_Subst.subst [FStar_Syntax_Syntax.DB ((Prims.parse_int "0"), x)] e' in ([lb1], e'1))) in - (match uu____8178 with + (match uu____8122 with | (lbs1,e'1) -> let lbs2 = if top_level @@ -2409,7 +2394,7 @@ and term_as_mlexpr': (FStar_List.map (fun lb -> let tcenv = - let uu____8240 = + let uu____8184 = FStar_Ident.lid_of_path (FStar_List.append (FStar_Pervasives_Native.fst @@ -2418,16 +2403,16 @@ and term_as_mlexpr': g.FStar_Extraction_ML_UEnv.currentModule]) FStar_Range.dummyRange in FStar_TypeChecker_Env.set_current_module - g.FStar_Extraction_ML_UEnv.tcenv uu____8240 in + g.FStar_Extraction_ML_UEnv.tcenv uu____8184 in FStar_Extraction_ML_UEnv.debug g - (fun uu____8247 -> + (fun uu____8191 -> FStar_Options.set_option "debug_level" (FStar_Options.List [FStar_Options.String "Norm"; FStar_Options.String "Extraction"])); (let lbdef = - let uu____8251 = FStar_Options.ml_ish () in - if uu____8251 + let uu____8195 = FStar_Options.ml_ish () in + if uu____8195 then lb.FStar_Syntax_Syntax.lbdef else FStar_TypeChecker_Normalize.normalize @@ -2440,23 +2425,23 @@ and term_as_mlexpr': FStar_TypeChecker_Normalize.PureSubtermsWithinComputations; FStar_TypeChecker_Normalize.Primops] tcenv lb.FStar_Syntax_Syntax.lbdef in - let uu___69_8255 = lb in + let uu___69_8199 = lb in { FStar_Syntax_Syntax.lbname = - (uu___69_8255.FStar_Syntax_Syntax.lbname); + (uu___69_8199.FStar_Syntax_Syntax.lbname); FStar_Syntax_Syntax.lbunivs = - (uu___69_8255.FStar_Syntax_Syntax.lbunivs); + (uu___69_8199.FStar_Syntax_Syntax.lbunivs); FStar_Syntax_Syntax.lbtyp = - (uu___69_8255.FStar_Syntax_Syntax.lbtyp); + (uu___69_8199.FStar_Syntax_Syntax.lbtyp); FStar_Syntax_Syntax.lbeff = - (uu___69_8255.FStar_Syntax_Syntax.lbeff); + (uu___69_8199.FStar_Syntax_Syntax.lbeff); FStar_Syntax_Syntax.lbdef = lbdef }))) else lbs1 in - let maybe_generalize uu____8278 = - match uu____8278 with + let maybe_generalize uu____8222 = + match uu____8222 with | { FStar_Syntax_Syntax.lbname = lbname_; - FStar_Syntax_Syntax.lbunivs = uu____8298; + FStar_Syntax_Syntax.lbunivs = uu____8242; FStar_Syntax_Syntax.lbtyp = t1; FStar_Syntax_Syntax.lbeff = lbeff; FStar_Syntax_Syntax.lbdef = e;_} -> @@ -2464,89 +2449,89 @@ and term_as_mlexpr': let t2 = FStar_Syntax_Subst.compress t1 in (match t2.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Tm_arrow (bs,c) when - let uu____8368 = FStar_List.hd bs in - FStar_All.pipe_right uu____8368 (is_type_binder g) + let uu____8312 = FStar_List.hd bs in + FStar_All.pipe_right uu____8312 (is_type_binder g) -> - let uu____8381 = FStar_Syntax_Subst.open_comp bs c in - (match uu____8381 with + let uu____8325 = FStar_Syntax_Subst.open_comp bs c in + (match uu____8325 with | (bs1,c1) -> - let uu____8406 = - let uu____8413 = + let uu____8350 = + let uu____8357 = FStar_Util.prefix_until (fun x -> - let uu____8449 = is_type_binder g x in - Prims.op_Negation uu____8449) bs1 in - match uu____8413 with + let uu____8393 = is_type_binder g x in + Prims.op_Negation uu____8393) bs1 in + match uu____8357 with | FStar_Pervasives_Native.None -> (bs1, (FStar_Syntax_Util.comp_result c1)) | FStar_Pervasives_Native.Some (bs2,b,rest) -> - let uu____8537 = + let uu____8481 = FStar_Syntax_Util.arrow (b :: rest) c1 in - (bs2, uu____8537) in - (match uu____8406 with + (bs2, uu____8481) in + (match uu____8350 with | (tbinders,tbody) -> let n_tbinders = FStar_List.length tbinders in let e1 = - let uu____8582 = normalize_abs e in - FStar_All.pipe_right uu____8582 + let uu____8526 = normalize_abs e in + FStar_All.pipe_right uu____8526 FStar_Syntax_Util.unmeta in (match e1.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Tm_abs (bs2,body,copt) -> - let uu____8624 = + let uu____8568 = FStar_Syntax_Subst.open_term bs2 body in - (match uu____8624 with + (match uu____8568 with | (bs3,body1) -> if n_tbinders <= (FStar_List.length bs3) then - let uu____8677 = + let uu____8621 = FStar_Util.first_N n_tbinders bs3 in - (match uu____8677 with + (match uu____8621 with | (targs,rest_args) -> let expected_source_ty = let s = FStar_List.map2 - (fun uu____8765 + (fun uu____8709 -> - fun uu____8766 + fun uu____8710 -> match - (uu____8765, - uu____8766) + (uu____8709, + uu____8710) with - | ((x,uu____8784), - (y,uu____8786)) + | ((x,uu____8728), + (y,uu____8730)) -> - let uu____8795 + let uu____8739 = - let uu____8802 + let uu____8746 = FStar_Syntax_Syntax.bv_to_name y in (x, - uu____8802) in + uu____8746) in FStar_Syntax_Syntax.NT - uu____8795) + uu____8739) tbinders targs in FStar_Syntax_Subst.subst s tbody in let env = FStar_List.fold_left (fun env -> - fun uu____8813 + fun uu____8757 -> - match uu____8813 + match uu____8757 with - | (a,uu____8819) + | (a,uu____8763) -> FStar_Extraction_ML_UEnv.extend_ty env a @@ -2556,30 +2541,30 @@ and term_as_mlexpr': term_as_mlty env expected_source_ty in let polytype = - let uu____8828 = + let uu____8772 = FStar_All.pipe_right targs (FStar_List.map (fun - uu____8846 + uu____8790 -> - match uu____8846 + match uu____8790 with - | (x,uu____8852) + | (x,uu____8796) -> FStar_Extraction_ML_UEnv.bv_as_ml_tyvar x)) in - (uu____8828, + (uu____8772, expected_t) in let add_unit = match rest_args with | [] -> - let uu____8860 = + let uu____8804 = is_fstar_value body1 in Prims.op_Negation - uu____8860 - | uu____8861 -> false in + uu____8804 + | uu____8805 -> false in let rest_args1 = if add_unit then unit_binder :: @@ -2603,13 +2588,13 @@ and term_as_mlexpr': failwith "Not enough type binders") | FStar_Syntax_Syntax.Tm_uinst - uu____8930 -> + uu____8874 -> let env = FStar_List.fold_left (fun env -> - fun uu____8947 -> - match uu____8947 with - | (a,uu____8953) -> + fun uu____8891 -> + match uu____8891 with + | (a,uu____8897) -> FStar_Extraction_ML_UEnv.extend_ty env a FStar_Pervasives_Native.None) @@ -2617,26 +2602,26 @@ and term_as_mlexpr': let expected_t = term_as_mlty env tbody in let polytype = - let uu____8962 = + let uu____8906 = FStar_All.pipe_right tbinders (FStar_List.map - (fun uu____8974 -> - match uu____8974 with - | (x,uu____8980) -> + (fun uu____8918 -> + match uu____8918 with + | (x,uu____8924) -> FStar_Extraction_ML_UEnv.bv_as_ml_tyvar x)) in - (uu____8962, expected_t) in + (uu____8906, expected_t) in let args = FStar_All.pipe_right tbinders (FStar_List.map - (fun uu____8996 -> - match uu____8996 with - | (bv,uu____9002) -> - let uu____9003 = + (fun uu____8940 -> + match uu____8940 with + | (bv,uu____8946) -> + let uu____8947 = FStar_Syntax_Syntax.bv_to_name bv in FStar_All.pipe_right - uu____9003 + uu____8947 FStar_Syntax_Syntax.as_arg)) in let e2 = FStar_Syntax_Syntax.mk @@ -2648,13 +2633,13 @@ and term_as_mlexpr': (t2, (tbinders, polytype)), false, e2) | FStar_Syntax_Syntax.Tm_fvar - uu____9045 -> + uu____8989 -> let env = FStar_List.fold_left (fun env -> - fun uu____9056 -> - match uu____9056 with - | (a,uu____9062) -> + fun uu____9000 -> + match uu____9000 with + | (a,uu____9006) -> FStar_Extraction_ML_UEnv.extend_ty env a FStar_Pervasives_Native.None) @@ -2662,26 +2647,26 @@ and term_as_mlexpr': let expected_t = term_as_mlty env tbody in let polytype = - let uu____9071 = + let uu____9015 = FStar_All.pipe_right tbinders (FStar_List.map - (fun uu____9083 -> - match uu____9083 with - | (x,uu____9089) -> + (fun uu____9027 -> + match uu____9027 with + | (x,uu____9033) -> FStar_Extraction_ML_UEnv.bv_as_ml_tyvar x)) in - (uu____9071, expected_t) in + (uu____9015, expected_t) in let args = FStar_All.pipe_right tbinders (FStar_List.map - (fun uu____9105 -> - match uu____9105 with - | (bv,uu____9111) -> - let uu____9112 = + (fun uu____9049 -> + match uu____9049 with + | (bv,uu____9055) -> + let uu____9056 = FStar_Syntax_Syntax.bv_to_name bv in FStar_All.pipe_right - uu____9112 + uu____9056 FStar_Syntax_Syntax.as_arg)) in let e2 = FStar_Syntax_Syntax.mk @@ -2693,13 +2678,13 @@ and term_as_mlexpr': (t2, (tbinders, polytype)), false, e2) | FStar_Syntax_Syntax.Tm_name - uu____9154 -> + uu____9098 -> let env = FStar_List.fold_left (fun env -> - fun uu____9165 -> - match uu____9165 with - | (a,uu____9171) -> + fun uu____9109 -> + match uu____9109 with + | (a,uu____9115) -> FStar_Extraction_ML_UEnv.extend_ty env a FStar_Pervasives_Native.None) @@ -2707,26 +2692,26 @@ and term_as_mlexpr': let expected_t = term_as_mlty env tbody in let polytype = - let uu____9180 = + let uu____9124 = FStar_All.pipe_right tbinders (FStar_List.map - (fun uu____9192 -> - match uu____9192 with - | (x,uu____9198) -> + (fun uu____9136 -> + match uu____9136 with + | (x,uu____9142) -> FStar_Extraction_ML_UEnv.bv_as_ml_tyvar x)) in - (uu____9180, expected_t) in + (uu____9124, expected_t) in let args = FStar_All.pipe_right tbinders (FStar_List.map - (fun uu____9214 -> - match uu____9214 with - | (bv,uu____9220) -> - let uu____9221 = + (fun uu____9158 -> + match uu____9158 with + | (bv,uu____9164) -> + let uu____9165 = FStar_Syntax_Syntax.bv_to_name bv in FStar_All.pipe_right - uu____9221 + uu____9165 FStar_Syntax_Syntax.as_arg)) in let e2 = FStar_Syntax_Syntax.mk @@ -2737,28 +2722,28 @@ and term_as_mlexpr': (lbname_, f_e, (t2, (tbinders, polytype)), false, e2) - | uu____9263 -> + | uu____9207 -> err_value_restriction e1))) - | uu____9282 -> + | uu____9226 -> let expected_t = term_as_mlty g t2 in (lbname_, f_e, (t2, ([], ([], expected_t))), false, e)) in - let check_lb env uu____9386 = - match uu____9386 with + let check_lb env uu____9330 = + match uu____9330 with | (nm,(lbname,f,(t1,(targs,polytype)),add_unit,e)) -> let env1 = FStar_List.fold_left (fun env1 -> - fun uu____9521 -> - match uu____9521 with - | (a,uu____9527) -> + fun uu____9465 -> + match uu____9465 with + | (a,uu____9471) -> FStar_Extraction_ML_UEnv.extend_ty env1 a FStar_Pervasives_Native.None) env targs in let expected_t = FStar_Pervasives_Native.snd polytype in - let uu____9529 = + let uu____9473 = check_term_as_mlexpr env1 e f expected_t in - (match uu____9529 with - | (e1,uu____9539) -> + (match uu____9473 with + | (e1,uu____9483) -> let f1 = maybe_downgrade_eff env1 f expected_t in (f1, { @@ -2768,68 +2753,69 @@ and term_as_mlexpr': FStar_Extraction_ML_Syntax.mllb_add_unit = add_unit; FStar_Extraction_ML_Syntax.mllb_def = e1; + FStar_Extraction_ML_Syntax.mllb_meta = []; FStar_Extraction_ML_Syntax.print_typ = true })) in let lbs3 = FStar_All.pipe_right lbs2 (FStar_List.map maybe_generalize) in - let uu____9606 = + let uu____9550 = FStar_List.fold_right (fun lb -> - fun uu____9697 -> - match uu____9697 with + fun uu____9641 -> + match uu____9641 with | (env,lbs4) -> - let uu____9822 = lb in - (match uu____9822 with - | (lbname,uu____9870,(t1,(uu____9872,polytype)),add_unit,uu____9875) + let uu____9766 = lb in + (match uu____9766 with + | (lbname,uu____9814,(t1,(uu____9816,polytype)),add_unit,uu____9819) -> - let uu____9888 = + let uu____9832 = FStar_Extraction_ML_UEnv.extend_lb env lbname t1 polytype add_unit true in - (match uu____9888 with + (match uu____9832 with | (env1,nm) -> (env1, ((nm, lb) :: lbs4))))) lbs3 (g, []) in - (match uu____9606 with + (match uu____9550 with | (env_body,lbs4) -> let env_def = if is_rec then env_body else g in let lbs5 = FStar_All.pipe_right lbs4 (FStar_List.map (check_lb env_def)) in let e'_rng = e'1.FStar_Syntax_Syntax.pos in - let uu____10165 = term_as_mlexpr env_body e'1 in - (match uu____10165 with + let uu____10109 = term_as_mlexpr env_body e'1 in + (match uu____10109 with | (e'2,f',t') -> let f = - let uu____10182 = - let uu____10185 = + let uu____10126 = + let uu____10129 = FStar_List.map FStar_Pervasives_Native.fst lbs5 in - f' :: uu____10185 in + f' :: uu____10129 in FStar_Extraction_ML_Util.join_l e'_rng - uu____10182 in + uu____10126 in let is_rec1 = if is_rec = true then FStar_Extraction_ML_Syntax.Rec else FStar_Extraction_ML_Syntax.NonRec in - let uu____10194 = - let uu____10195 = - let uu____10196 = - let uu____10197 = + let uu____10138 = + let uu____10139 = + let uu____10140 = + let uu____10141 = FStar_List.map FStar_Pervasives_Native.snd lbs5 in - (is_rec1, [], uu____10197) in - mk_MLE_Let top_level uu____10196 e'2 in - let uu____10208 = + (is_rec1, uu____10141) in + mk_MLE_Let top_level uu____10140 e'2 in + let uu____10150 = FStar_Extraction_ML_Util.mlloc_of_range t.FStar_Syntax_Syntax.pos in FStar_Extraction_ML_Syntax.with_ty_loc t' - uu____10195 uu____10208 in - (uu____10194, f, t')))) + uu____10139 uu____10150 in + (uu____10138, f, t')))) | FStar_Syntax_Syntax.Tm_match (scrutinee,pats) -> - let uu____10247 = term_as_mlexpr g scrutinee in - (match uu____10247 with + let uu____10189 = term_as_mlexpr g scrutinee in + (match uu____10189 with | (e,f_e,t_e) -> - let uu____10263 = check_pats_for_ite pats in - (match uu____10263 with + let uu____10205 = check_pats_for_ite pats in + (match uu____10205 with | (b,then_e,else_e) -> let no_lift x t1 = x in if b @@ -2837,71 +2823,71 @@ and term_as_mlexpr': (match (then_e, else_e) with | (FStar_Pervasives_Native.Some then_e1,FStar_Pervasives_Native.Some else_e1) -> - let uu____10320 = term_as_mlexpr g then_e1 in - (match uu____10320 with + let uu____10262 = term_as_mlexpr g then_e1 in + (match uu____10262 with | (then_mle,f_then,t_then) -> - let uu____10336 = term_as_mlexpr g else_e1 in - (match uu____10336 with + let uu____10278 = term_as_mlexpr g else_e1 in + (match uu____10278 with | (else_mle,f_else,t_else) -> - let uu____10352 = - let uu____10361 = + let uu____10294 = + let uu____10303 = type_leq g t_then t_else in - if uu____10361 + if uu____10303 then (t_else, no_lift) else - (let uu____10375 = + (let uu____10317 = type_leq g t_else t_then in - if uu____10375 + if uu____10317 then (t_then, no_lift) else (FStar_Extraction_ML_Syntax.MLTY_Top, FStar_Extraction_ML_Syntax.apply_obj_repr)) in - (match uu____10352 with + (match uu____10294 with | (t_branch,maybe_lift1) -> - let uu____10409 = - let uu____10410 = - let uu____10411 = - let uu____10420 = + let uu____10351 = + let uu____10352 = + let uu____10353 = + let uu____10362 = maybe_lift1 then_mle t_then in - let uu____10421 = - let uu____10424 = + let uu____10363 = + let uu____10366 = maybe_lift1 else_mle t_else in FStar_Pervasives_Native.Some - uu____10424 in - (e, uu____10420, - uu____10421) in + uu____10366 in + (e, uu____10362, + uu____10363) in FStar_Extraction_ML_Syntax.MLE_If - uu____10411 in + uu____10353 in FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty - t_branch) uu____10410 in - let uu____10427 = + t_branch) uu____10352 in + let uu____10369 = FStar_Extraction_ML_Util.join then_e1.FStar_Syntax_Syntax.pos f_then f_else in - (uu____10409, uu____10427, + (uu____10351, uu____10369, t_branch)))) - | uu____10428 -> + | uu____10370 -> failwith "ITE pats matched but then and else expressions not found?") else - (let uu____10444 = + (let uu____10386 = FStar_All.pipe_right pats (FStar_Util.fold_map (fun compat -> fun br -> - let uu____10553 = + let uu____10495 = FStar_Syntax_Subst.open_branch br in - match uu____10553 with + match uu____10495 with | (pat,when_opt,branch1) -> - let uu____10597 = + let uu____10539 = extract_pat g pat t_e term_as_mlexpr in - (match uu____10597 with + (match uu____10539 with | (env,p,pat_t_compat) -> - let uu____10655 = + let uu____10597 = match when_opt with | FStar_Pervasives_Native.None -> @@ -2909,9 +2895,9 @@ and term_as_mlexpr': FStar_Extraction_ML_Syntax.E_PURE) | FStar_Pervasives_Native.Some w -> - let uu____10677 = + let uu____10619 = term_as_mlexpr env w in - (match uu____10677 with + (match uu____10619 with | (w1,f_w,t_w) -> let w2 = maybe_coerce env w1 @@ -2919,22 +2905,22 @@ and term_as_mlexpr': FStar_Extraction_ML_Syntax.ml_bool_ty in ((FStar_Pervasives_Native.Some w2), f_w)) in - (match uu____10655 with + (match uu____10597 with | (when_opt1,f_when) -> - let uu____10726 = + let uu____10668 = term_as_mlexpr env branch1 in - (match uu____10726 with + (match uu____10668 with | (mlbranch,f_branch,t_branch) -> - let uu____10760 = + let uu____10702 = FStar_All.pipe_right p (FStar_List.map (fun - uu____10837 + uu____10779 -> - match uu____10837 + match uu____10779 with | (p1,wopt) -> @@ -2951,9 +2937,9 @@ and term_as_mlexpr': t_branch)))) in ((compat && pat_t_compat), - uu____10760))))) + uu____10702))))) true) in - match uu____10444 with + match uu____10386 with | (pat_t_compat,mlbranches) -> let mlbranches1 = FStar_List.flatten mlbranches in let e1 = @@ -2961,18 +2947,18 @@ and term_as_mlexpr': then e else (FStar_Extraction_ML_UEnv.debug g - (fun uu____11002 -> - let uu____11003 = + (fun uu____10944 -> + let uu____10945 = FStar_Extraction_ML_Code.string_of_mlexpr g.FStar_Extraction_ML_UEnv.currentModule e in - let uu____11004 = + let uu____10946 = FStar_Extraction_ML_Code.string_of_mlty g.FStar_Extraction_ML_UEnv.currentModule t_e in FStar_Util.print2 "Coercing scrutinee %s from type %s because pattern type is incompatible\n" - uu____11003 uu____11004); + uu____10945 uu____10946); FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty t_e) (FStar_Extraction_ML_Syntax.MLE_Coerce @@ -2980,52 +2966,52 @@ and term_as_mlexpr': FStar_Extraction_ML_Syntax.MLTY_Top))) in (match mlbranches1 with | [] -> - let uu____11029 = - let uu____11038 = - let uu____11055 = + let uu____10971 = + let uu____10980 = + let uu____10997 = FStar_Syntax_Syntax.lid_as_fv FStar_Parser_Const.failwith_lid FStar_Syntax_Syntax.Delta_constant FStar_Pervasives_Native.None in FStar_Extraction_ML_UEnv.lookup_fv g - uu____11055 in + uu____10997 in FStar_All.pipe_left FStar_Util.right - uu____11038 in - (match uu____11029 with - | (uu____11098,fw,uu____11100,uu____11101) + uu____10980 in + (match uu____10971 with + | (uu____11040,fw,uu____11042,uu____11043) -> - let uu____11102 = - let uu____11103 = - let uu____11104 = - let uu____11111 = - let uu____11114 = + let uu____11044 = + let uu____11045 = + let uu____11046 = + let uu____11053 = + let uu____11056 = FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty FStar_Extraction_ML_Syntax.ml_string_ty) (FStar_Extraction_ML_Syntax.MLE_Const (FStar_Extraction_ML_Syntax.MLC_String "unreachable")) in - [uu____11114] in - (fw, uu____11111) in + [uu____11056] in + (fw, uu____11053) in FStar_Extraction_ML_Syntax.MLE_App - uu____11104 in + uu____11046 in FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty FStar_Extraction_ML_Syntax.ml_unit_ty) - uu____11103 in - (uu____11102, + uu____11045 in + (uu____11044, FStar_Extraction_ML_Syntax.E_PURE, FStar_Extraction_ML_Syntax.ml_unit_ty)) - | (uu____11117,uu____11118,(uu____11119,f_first,t_first))::rest + | (uu____11059,uu____11060,(uu____11061,f_first,t_first))::rest -> - let uu____11179 = + let uu____11121 = FStar_List.fold_left - (fun uu____11221 -> - fun uu____11222 -> - match (uu____11221, uu____11222) + (fun uu____11163 -> + fun uu____11164 -> + match (uu____11163, uu____11164) with - | ((topt,f),(uu____11279,uu____11280, - (uu____11281,f_branch,t_branch))) + | ((topt,f),(uu____11221,uu____11222, + (uu____11223,f_branch,t_branch))) -> let f1 = FStar_Extraction_ML_Util.join @@ -3038,17 +3024,17 @@ and term_as_mlexpr': FStar_Pervasives_Native.None | FStar_Pervasives_Native.Some t1 -> - let uu____11337 = + let uu____11279 = type_leq g t1 t_branch in - if uu____11337 + if uu____11279 then FStar_Pervasives_Native.Some t_branch else - (let uu____11341 = + (let uu____11283 = type_leq g t_branch t1 in - if uu____11341 + if uu____11283 then FStar_Pervasives_Native.Some t1 @@ -3057,15 +3043,15 @@ and term_as_mlexpr': (topt1, f1)) ((FStar_Pervasives_Native.Some t_first), f_first) rest in - (match uu____11179 with + (match uu____11121 with | (topt,f_match) -> let mlbranches2 = FStar_All.pipe_right mlbranches1 (FStar_List.map - (fun uu____11436 -> - match uu____11436 with - | (p,(wopt,uu____11465), - (b1,uu____11467,t1)) -> + (fun uu____11378 -> + match uu____11378 with + | (p,(wopt,uu____11407), + (b1,uu____11409,t1)) -> let b2 = match topt with | FStar_Pervasives_Native.None @@ -3073,7 +3059,7 @@ and term_as_mlexpr': FStar_Extraction_ML_Syntax.apply_obj_repr b1 t1 | FStar_Pervasives_Native.Some - uu____11486 -> b1 in + uu____11428 -> b1 in (p, wopt, b2))) in let t_match = match topt with @@ -3081,13 +3067,13 @@ and term_as_mlexpr': FStar_Extraction_ML_Syntax.MLTY_Top | FStar_Pervasives_Native.Some t1 -> t1 in - let uu____11491 = + let uu____11433 = FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty t_match) (FStar_Extraction_ML_Syntax.MLE_Match (e1, mlbranches2)) in - (uu____11491, f_match, t_match))))))) + (uu____11433, f_match, t_match))))))) let ind_discriminator_body: FStar_Extraction_ML_UEnv.env -> FStar_Ident.lident -> @@ -3096,68 +3082,68 @@ let ind_discriminator_body: fun env -> fun discName -> fun constrName -> - let uu____11511 = - let uu____11516 = + let uu____11453 = + let uu____11458 = FStar_TypeChecker_Env.lookup_lid env.FStar_Extraction_ML_UEnv.tcenv discName in - FStar_All.pipe_left FStar_Pervasives_Native.fst uu____11516 in - match uu____11511 with - | (uu____11541,fstar_disc_type) -> + FStar_All.pipe_left FStar_Pervasives_Native.fst uu____11458 in + match uu____11453 with + | (uu____11483,fstar_disc_type) -> let wildcards = - let uu____11550 = - let uu____11551 = FStar_Syntax_Subst.compress fstar_disc_type in - uu____11551.FStar_Syntax_Syntax.n in - match uu____11550 with - | FStar_Syntax_Syntax.Tm_arrow (binders,uu____11561) -> - let uu____11578 = + let uu____11492 = + let uu____11493 = FStar_Syntax_Subst.compress fstar_disc_type in + uu____11493.FStar_Syntax_Syntax.n in + match uu____11492 with + | FStar_Syntax_Syntax.Tm_arrow (binders,uu____11503) -> + let uu____11520 = FStar_All.pipe_right binders (FStar_List.filter - (fun uu___62_11610 -> - match uu___62_11610 with - | (uu____11617,FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.Implicit uu____11618)) -> + (fun uu___62_11552 -> + match uu___62_11552 with + | (uu____11559,FStar_Pervasives_Native.Some + (FStar_Syntax_Syntax.Implicit uu____11560)) -> true - | uu____11621 -> false)) in - FStar_All.pipe_right uu____11578 + | uu____11563 -> false)) in + FStar_All.pipe_right uu____11520 (FStar_List.map - (fun uu____11654 -> - let uu____11661 = fresh "_" in - (uu____11661, FStar_Extraction_ML_Syntax.MLTY_Top))) - | uu____11662 -> failwith "Discriminator must be a function" in + (fun uu____11596 -> + let uu____11603 = fresh "_" in + (uu____11603, FStar_Extraction_ML_Syntax.MLTY_Top))) + | uu____11604 -> failwith "Discriminator must be a function" in let mlid = fresh "_discr_" in let targ = FStar_Extraction_ML_Syntax.MLTY_Top in let disc_ty = FStar_Extraction_ML_Syntax.MLTY_Top in let discrBody = - let uu____11673 = - let uu____11674 = - let uu____11685 = - let uu____11686 = - let uu____11687 = - let uu____11702 = + let uu____11615 = + let uu____11616 = + let uu____11627 = + let uu____11628 = + let uu____11629 = + let uu____11644 = FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty targ) (FStar_Extraction_ML_Syntax.MLE_Name ([], mlid)) in - let uu____11705 = - let uu____11716 = - let uu____11725 = - let uu____11726 = - let uu____11733 = + let uu____11647 = + let uu____11658 = + let uu____11667 = + let uu____11668 = + let uu____11675 = FStar_Extraction_ML_Syntax.mlpath_of_lident constrName in - (uu____11733, + (uu____11675, [FStar_Extraction_ML_Syntax.MLP_Wild]) in - FStar_Extraction_ML_Syntax.MLP_CTor uu____11726 in - let uu____11736 = + FStar_Extraction_ML_Syntax.MLP_CTor uu____11668 in + let uu____11678 = FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty FStar_Extraction_ML_Syntax.ml_bool_ty) (FStar_Extraction_ML_Syntax.MLE_Const (FStar_Extraction_ML_Syntax.MLC_Bool true)) in - (uu____11725, FStar_Pervasives_Native.None, - uu____11736) in - let uu____11739 = - let uu____11750 = - let uu____11759 = + (uu____11667, FStar_Pervasives_Native.None, + uu____11678) in + let uu____11681 = + let uu____11692 = + let uu____11701 = FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty FStar_Extraction_ML_Syntax.ml_bool_ty) @@ -3165,32 +3151,33 @@ let ind_discriminator_body: (FStar_Extraction_ML_Syntax.MLC_Bool false)) in (FStar_Extraction_ML_Syntax.MLP_Wild, - FStar_Pervasives_Native.None, uu____11759) in - [uu____11750] in - uu____11716 :: uu____11739 in - (uu____11702, uu____11705) in - FStar_Extraction_ML_Syntax.MLE_Match uu____11687 in + FStar_Pervasives_Native.None, uu____11701) in + [uu____11692] in + uu____11658 :: uu____11681 in + (uu____11644, uu____11647) in + FStar_Extraction_ML_Syntax.MLE_Match uu____11629 in FStar_All.pipe_left (FStar_Extraction_ML_Syntax.with_ty - FStar_Extraction_ML_Syntax.ml_bool_ty) uu____11686 in - ((FStar_List.append wildcards [(mlid, targ)]), uu____11685) in - FStar_Extraction_ML_Syntax.MLE_Fun uu____11674 in + FStar_Extraction_ML_Syntax.ml_bool_ty) uu____11628 in + ((FStar_List.append wildcards [(mlid, targ)]), uu____11627) in + FStar_Extraction_ML_Syntax.MLE_Fun uu____11616 in FStar_All.pipe_left - (FStar_Extraction_ML_Syntax.with_ty disc_ty) uu____11673 in - let uu____11814 = - let uu____11815 = - let uu____11818 = - let uu____11819 = + (FStar_Extraction_ML_Syntax.with_ty disc_ty) uu____11615 in + let uu____11756 = + let uu____11757 = + let uu____11760 = + let uu____11761 = FStar_Extraction_ML_UEnv.convIdent discName.FStar_Ident.ident in { - FStar_Extraction_ML_Syntax.mllb_name = uu____11819; + FStar_Extraction_ML_Syntax.mllb_name = uu____11761; FStar_Extraction_ML_Syntax.mllb_tysc = FStar_Pervasives_Native.None; FStar_Extraction_ML_Syntax.mllb_add_unit = false; FStar_Extraction_ML_Syntax.mllb_def = discrBody; + FStar_Extraction_ML_Syntax.mllb_meta = []; FStar_Extraction_ML_Syntax.print_typ = false } in - [uu____11818] in - (FStar_Extraction_ML_Syntax.NonRec, [], uu____11815) in - FStar_Extraction_ML_Syntax.MLM_Let uu____11814 \ No newline at end of file + [uu____11760] in + (FStar_Extraction_ML_Syntax.NonRec, uu____11757) in + FStar_Extraction_ML_Syntax.MLM_Let uu____11756 \ No newline at end of file diff --git a/src/ocaml-output/FStar_Options.ml b/src/ocaml-output/FStar_Options.ml index cf6a7fda6ac..7fdb6abcaa9 100644 --- a/src/ocaml-output/FStar_Options.ml +++ b/src/ocaml-output/FStar_Options.ml @@ -79,24 +79,24 @@ let __set_unit_tests: Prims.unit -> Prims.unit = let __clear_unit_tests: Prims.unit -> Prims.unit = fun uu____268 -> FStar_ST.op_Colon_Equals __unit_tests__ false let as_bool: option_val -> Prims.bool = - fun uu___29_319 -> - match uu___29_319 with + fun uu___34_319 -> + match uu___34_319 with | Bool b -> b | uu____321 -> failwith "Impos: expected Bool" let as_int: option_val -> Prims.int = - fun uu___30_324 -> - match uu___30_324 with + fun uu___35_324 -> + match uu___35_324 with | Int b -> b | uu____326 -> failwith "Impos: expected Int" let as_string: option_val -> Prims.string = - fun uu___31_329 -> - match uu___31_329 with + fun uu___36_329 -> + match uu___36_329 with | String b -> b | Path b -> FStar_Common.try_convert_file_name_to_mixed b | uu____332 -> failwith "Impos: expected String" let as_list': option_val -> option_val Prims.list = - fun uu___32_337 -> - match uu___32_337 with + fun uu___37_337 -> + match uu___37_337 with | List ts -> ts | uu____343 -> failwith "Impos: expected List" let as_list: @@ -113,8 +113,8 @@ let as_option: option_val -> 'Auu____375 FStar_Pervasives_Native.option = fun as_t -> - fun uu___33_388 -> - match uu___33_388 with + fun uu___38_388 -> + match uu___38_388 with | Unset -> FStar_Pervasives_Native.None | v1 -> let uu____392 = as_t v1 in FStar_Pervasives_Native.Some uu____392 @@ -177,6 +177,7 @@ let defaults: ("dump_module", (List [])); ("eager_inference", (Bool false)); ("expose_interfaces", (Bool false)); + ("extract", Unset); ("extract_all", (Bool false)); ("extract_module", (List [])); ("extract_namespace", (List [])); @@ -225,7 +226,6 @@ let defaults: ("smtencoding.elim_box", (Bool false)); ("smtencoding.nl_arith_repr", (String "boxwrap")); ("smtencoding.l_arith_repr", (String "boxwrap")); - ("split_cases", (Int (Prims.parse_int "0"))); ("tactic_raw_binders", (Bool false)); ("tactic_trace", (Bool false)); ("tactic_trace_d", (Int (Prims.parse_int "0"))); @@ -239,6 +239,7 @@ let defaults: ("use_hints", (Bool false)); ("use_hint_hashes", (Bool false)); ("using_facts_from", Unset); + ("vcgen.optimize_bind_as_seq", Unset); ("verify_module", (List [])); ("warn_default_effects", (Bool false)); ("z3refresh", (Bool false)); @@ -251,12 +252,12 @@ let defaults: ("__ml_no_eta_expand_coertions", (Bool false)); ("warn_error", (String ""))] let init: Prims.unit -> Prims.unit = - fun uu____1353 -> + fun uu____1357 -> let o = peek () in FStar_Util.smap_clear o; FStar_All.pipe_right defaults (FStar_List.iter set_option') let clear: Prims.unit -> Prims.unit = - fun uu____1368 -> + fun uu____1372 -> let o = FStar_Util.smap_create (Prims.parse_int "50") in FStar_ST.op_Colon_Equals fstar_options [o]; FStar_ST.op_Colon_Equals light_off_files []; @@ -264,197 +265,202 @@ let clear: Prims.unit -> Prims.unit = let _run: Prims.unit = clear () let get_option: Prims.string -> option_val = fun s -> - let uu____1485 = - let uu____1488 = peek () in FStar_Util.smap_try_find uu____1488 s in - match uu____1485 with + let uu____1489 = + let uu____1492 = peek () in FStar_Util.smap_try_find uu____1492 s in + match uu____1489 with | FStar_Pervasives_Native.None -> failwith (Prims.strcat "Impossible: option " (Prims.strcat s " not found")) | FStar_Pervasives_Native.Some s1 -> s1 let lookup_opt: - 'Auu____1495 . Prims.string -> (option_val -> 'Auu____1495) -> 'Auu____1495 + 'Auu____1499 . Prims.string -> (option_val -> 'Auu____1499) -> 'Auu____1499 = fun s -> fun c -> c (get_option s) let get_admit_smt_queries: Prims.unit -> Prims.bool = - fun uu____1511 -> lookup_opt "admit_smt_queries" as_bool + fun uu____1515 -> lookup_opt "admit_smt_queries" as_bool let get_admit_except: Prims.unit -> Prims.string FStar_Pervasives_Native.option = - fun uu____1516 -> lookup_opt "admit_except" (as_option as_string) + fun uu____1520 -> lookup_opt "admit_except" (as_option as_string) let get_cache_checked_modules: Prims.unit -> Prims.bool = - fun uu____1521 -> lookup_opt "cache_checked_modules" as_bool + fun uu____1525 -> lookup_opt "cache_checked_modules" as_bool let get_codegen: Prims.unit -> Prims.string FStar_Pervasives_Native.option = - fun uu____1526 -> lookup_opt "codegen" (as_option as_string) + fun uu____1530 -> lookup_opt "codegen" (as_option as_string) let get_codegen_lib: Prims.unit -> Prims.string Prims.list = - fun uu____1533 -> lookup_opt "codegen-lib" (as_list as_string) + fun uu____1537 -> lookup_opt "codegen-lib" (as_list as_string) let get_debug: Prims.unit -> Prims.string Prims.list = - fun uu____1540 -> lookup_opt "debug" (as_list as_string) + fun uu____1544 -> lookup_opt "debug" (as_list as_string) let get_debug_level: Prims.unit -> Prims.string Prims.list = - fun uu____1547 -> lookup_opt "debug_level" (as_list as_string) + fun uu____1551 -> lookup_opt "debug_level" (as_list as_string) let get_dep: Prims.unit -> Prims.string FStar_Pervasives_Native.option = - fun uu____1554 -> lookup_opt "dep" (as_option as_string) + fun uu____1558 -> lookup_opt "dep" (as_option as_string) let get_detail_errors: Prims.unit -> Prims.bool = - fun uu____1559 -> lookup_opt "detail_errors" as_bool + fun uu____1563 -> lookup_opt "detail_errors" as_bool let get_detail_hint_replay: Prims.unit -> Prims.bool = - fun uu____1562 -> lookup_opt "detail_hint_replay" as_bool + fun uu____1566 -> lookup_opt "detail_hint_replay" as_bool let get_doc: Prims.unit -> Prims.bool = - fun uu____1565 -> lookup_opt "doc" as_bool + fun uu____1569 -> lookup_opt "doc" as_bool let get_dump_module: Prims.unit -> Prims.string Prims.list = - fun uu____1570 -> lookup_opt "dump_module" (as_list as_string) + fun uu____1574 -> lookup_opt "dump_module" (as_list as_string) let get_eager_inference: Prims.unit -> Prims.bool = - fun uu____1575 -> lookup_opt "eager_inference" as_bool + fun uu____1579 -> lookup_opt "eager_inference" as_bool let get_expose_interfaces: Prims.unit -> Prims.bool = - fun uu____1578 -> lookup_opt "expose_interfaces" as_bool + fun uu____1582 -> lookup_opt "expose_interfaces" as_bool +let get_extract: + Prims.unit -> Prims.string Prims.list FStar_Pervasives_Native.option = + fun uu____1589 -> lookup_opt "extract" (as_option (as_list as_string)) let get_extract_module: Prims.unit -> Prims.string Prims.list = - fun uu____1583 -> lookup_opt "extract_module" (as_list as_string) + fun uu____1600 -> lookup_opt "extract_module" (as_list as_string) let get_extract_namespace: Prims.unit -> Prims.string Prims.list = - fun uu____1590 -> lookup_opt "extract_namespace" (as_list as_string) + fun uu____1607 -> lookup_opt "extract_namespace" (as_list as_string) let get_fs_typ_app: Prims.unit -> Prims.bool = - fun uu____1595 -> lookup_opt "fs_typ_app" as_bool + fun uu____1612 -> lookup_opt "fs_typ_app" as_bool let get_fstar_home: Prims.unit -> Prims.string FStar_Pervasives_Native.option - = fun uu____1600 -> lookup_opt "fstar_home" (as_option as_string) + = fun uu____1617 -> lookup_opt "fstar_home" (as_option as_string) let get_gen_native_tactics: Prims.unit -> Prims.string FStar_Pervasives_Native.option = - fun uu____1607 -> lookup_opt "gen_native_tactics" (as_option as_string) + fun uu____1624 -> lookup_opt "gen_native_tactics" (as_option as_string) let get_hide_uvar_nums: Prims.unit -> Prims.bool = - fun uu____1612 -> lookup_opt "hide_uvar_nums" as_bool + fun uu____1629 -> lookup_opt "hide_uvar_nums" as_bool let get_hint_info: Prims.unit -> Prims.bool = - fun uu____1615 -> lookup_opt "hint_info" as_bool + fun uu____1632 -> lookup_opt "hint_info" as_bool let get_hint_file: Prims.unit -> Prims.string FStar_Pervasives_Native.option - = fun uu____1620 -> lookup_opt "hint_file" (as_option as_string) + = fun uu____1637 -> lookup_opt "hint_file" (as_option as_string) let get_in: Prims.unit -> Prims.bool = - fun uu____1625 -> lookup_opt "in" as_bool + fun uu____1642 -> lookup_opt "in" as_bool let get_ide: Prims.unit -> Prims.bool = - fun uu____1628 -> lookup_opt "ide" as_bool + fun uu____1645 -> lookup_opt "ide" as_bool let get_include: Prims.unit -> Prims.string Prims.list = - fun uu____1633 -> lookup_opt "include" (as_list as_string) + fun uu____1650 -> lookup_opt "include" (as_list as_string) let get_indent: Prims.unit -> Prims.bool = - fun uu____1638 -> lookup_opt "indent" as_bool + fun uu____1655 -> lookup_opt "indent" as_bool let get_initial_fuel: Prims.unit -> Prims.int = - fun uu____1641 -> lookup_opt "initial_fuel" as_int + fun uu____1658 -> lookup_opt "initial_fuel" as_int let get_initial_ifuel: Prims.unit -> Prims.int = - fun uu____1644 -> lookup_opt "initial_ifuel" as_int + fun uu____1661 -> lookup_opt "initial_ifuel" as_int let get_lax: Prims.unit -> Prims.bool = - fun uu____1647 -> lookup_opt "lax" as_bool + fun uu____1664 -> lookup_opt "lax" as_bool let get_load: Prims.unit -> Prims.string Prims.list = - fun uu____1652 -> lookup_opt "load" (as_list as_string) + fun uu____1669 -> lookup_opt "load" (as_list as_string) let get_log_queries: Prims.unit -> Prims.bool = - fun uu____1657 -> lookup_opt "log_queries" as_bool + fun uu____1674 -> lookup_opt "log_queries" as_bool let get_log_types: Prims.unit -> Prims.bool = - fun uu____1660 -> lookup_opt "log_types" as_bool + fun uu____1677 -> lookup_opt "log_types" as_bool let get_max_fuel: Prims.unit -> Prims.int = - fun uu____1663 -> lookup_opt "max_fuel" as_int + fun uu____1680 -> lookup_opt "max_fuel" as_int let get_max_ifuel: Prims.unit -> Prims.int = - fun uu____1666 -> lookup_opt "max_ifuel" as_int + fun uu____1683 -> lookup_opt "max_ifuel" as_int let get_min_fuel: Prims.unit -> Prims.int = - fun uu____1669 -> lookup_opt "min_fuel" as_int + fun uu____1686 -> lookup_opt "min_fuel" as_int let get_MLish: Prims.unit -> Prims.bool = - fun uu____1672 -> lookup_opt "MLish" as_bool + fun uu____1689 -> lookup_opt "MLish" as_bool let get_n_cores: Prims.unit -> Prims.int = - fun uu____1675 -> lookup_opt "n_cores" as_int + fun uu____1692 -> lookup_opt "n_cores" as_int let get_no_default_includes: Prims.unit -> Prims.bool = - fun uu____1678 -> lookup_opt "no_default_includes" as_bool + fun uu____1695 -> lookup_opt "no_default_includes" as_bool let get_no_extract: Prims.unit -> Prims.string Prims.list = - fun uu____1683 -> lookup_opt "no_extract" (as_list as_string) + fun uu____1700 -> lookup_opt "no_extract" (as_list as_string) let get_no_location_info: Prims.unit -> Prims.bool = - fun uu____1688 -> lookup_opt "no_location_info" as_bool + fun uu____1705 -> lookup_opt "no_location_info" as_bool let get_odir: Prims.unit -> Prims.string FStar_Pervasives_Native.option = - fun uu____1693 -> lookup_opt "odir" (as_option as_string) + fun uu____1710 -> lookup_opt "odir" (as_option as_string) let get_ugly: Prims.unit -> Prims.bool = - fun uu____1698 -> lookup_opt "ugly" as_bool + fun uu____1715 -> lookup_opt "ugly" as_bool let get_prims: Prims.unit -> Prims.string FStar_Pervasives_Native.option = - fun uu____1703 -> lookup_opt "prims" (as_option as_string) + fun uu____1720 -> lookup_opt "prims" (as_option as_string) let get_print_bound_var_types: Prims.unit -> Prims.bool = - fun uu____1708 -> lookup_opt "print_bound_var_types" as_bool + fun uu____1725 -> lookup_opt "print_bound_var_types" as_bool let get_print_effect_args: Prims.unit -> Prims.bool = - fun uu____1711 -> lookup_opt "print_effect_args" as_bool + fun uu____1728 -> lookup_opt "print_effect_args" as_bool let get_print_full_names: Prims.unit -> Prims.bool = - fun uu____1714 -> lookup_opt "print_full_names" as_bool + fun uu____1731 -> lookup_opt "print_full_names" as_bool let get_print_implicits: Prims.unit -> Prims.bool = - fun uu____1717 -> lookup_opt "print_implicits" as_bool + fun uu____1734 -> lookup_opt "print_implicits" as_bool let get_print_universes: Prims.unit -> Prims.bool = - fun uu____1720 -> lookup_opt "print_universes" as_bool + fun uu____1737 -> lookup_opt "print_universes" as_bool let get_print_z3_statistics: Prims.unit -> Prims.bool = - fun uu____1723 -> lookup_opt "print_z3_statistics" as_bool + fun uu____1740 -> lookup_opt "print_z3_statistics" as_bool let get_prn: Prims.unit -> Prims.bool = - fun uu____1726 -> lookup_opt "prn" as_bool + fun uu____1743 -> lookup_opt "prn" as_bool let get_query_stats: Prims.unit -> Prims.bool = - fun uu____1729 -> lookup_opt "query_stats" as_bool + fun uu____1746 -> lookup_opt "query_stats" as_bool let get_record_hints: Prims.unit -> Prims.bool = - fun uu____1732 -> lookup_opt "record_hints" as_bool + fun uu____1749 -> lookup_opt "record_hints" as_bool let get_reuse_hint_for: Prims.unit -> Prims.string FStar_Pervasives_Native.option = - fun uu____1737 -> lookup_opt "reuse_hint_for" (as_option as_string) + fun uu____1754 -> lookup_opt "reuse_hint_for" (as_option as_string) let get_silent: Prims.unit -> Prims.bool = - fun uu____1742 -> lookup_opt "silent" as_bool + fun uu____1759 -> lookup_opt "silent" as_bool let get_smt: Prims.unit -> Prims.string FStar_Pervasives_Native.option = - fun uu____1747 -> lookup_opt "smt" (as_option as_string) + fun uu____1764 -> lookup_opt "smt" (as_option as_string) let get_smtencoding_elim_box: Prims.unit -> Prims.bool = - fun uu____1752 -> lookup_opt "smtencoding.elim_box" as_bool + fun uu____1769 -> lookup_opt "smtencoding.elim_box" as_bool let get_smtencoding_nl_arith_repr: Prims.unit -> Prims.string = - fun uu____1755 -> lookup_opt "smtencoding.nl_arith_repr" as_string + fun uu____1772 -> lookup_opt "smtencoding.nl_arith_repr" as_string let get_smtencoding_l_arith_repr: Prims.unit -> Prims.string = - fun uu____1758 -> lookup_opt "smtencoding.l_arith_repr" as_string -let get_split_cases: Prims.unit -> Prims.int = - fun uu____1761 -> lookup_opt "split_cases" as_int + fun uu____1775 -> lookup_opt "smtencoding.l_arith_repr" as_string let get_tactic_raw_binders: Prims.unit -> Prims.bool = - fun uu____1764 -> lookup_opt "tactic_raw_binders" as_bool + fun uu____1778 -> lookup_opt "tactic_raw_binders" as_bool let get_tactic_trace: Prims.unit -> Prims.bool = - fun uu____1767 -> lookup_opt "tactic_trace" as_bool + fun uu____1781 -> lookup_opt "tactic_trace" as_bool let get_tactic_trace_d: Prims.unit -> Prims.int = - fun uu____1770 -> lookup_opt "tactic_trace_d" as_int + fun uu____1784 -> lookup_opt "tactic_trace_d" as_int let get_timing: Prims.unit -> Prims.bool = - fun uu____1773 -> lookup_opt "timing" as_bool + fun uu____1787 -> lookup_opt "timing" as_bool let get_trace_error: Prims.unit -> Prims.bool = - fun uu____1776 -> lookup_opt "trace_error" as_bool + fun uu____1790 -> lookup_opt "trace_error" as_bool let get_unthrottle_inductives: Prims.unit -> Prims.bool = - fun uu____1779 -> lookup_opt "unthrottle_inductives" as_bool + fun uu____1793 -> lookup_opt "unthrottle_inductives" as_bool let get_unsafe_tactic_exec: Prims.unit -> Prims.bool = - fun uu____1782 -> lookup_opt "unsafe_tactic_exec" as_bool + fun uu____1796 -> lookup_opt "unsafe_tactic_exec" as_bool let get_use_eq_at_higher_order: Prims.unit -> Prims.bool = - fun uu____1785 -> lookup_opt "use_eq_at_higher_order" as_bool + fun uu____1799 -> lookup_opt "use_eq_at_higher_order" as_bool let get_use_hints: Prims.unit -> Prims.bool = - fun uu____1788 -> lookup_opt "use_hints" as_bool + fun uu____1802 -> lookup_opt "use_hints" as_bool let get_use_hint_hashes: Prims.unit -> Prims.bool = - fun uu____1791 -> lookup_opt "use_hint_hashes" as_bool + fun uu____1805 -> lookup_opt "use_hint_hashes" as_bool let get_use_native_tactics: Prims.unit -> Prims.string FStar_Pervasives_Native.option = - fun uu____1796 -> lookup_opt "use_native_tactics" (as_option as_string) + fun uu____1810 -> lookup_opt "use_native_tactics" (as_option as_string) let get_use_tactics: Prims.unit -> Prims.bool = - fun uu____1801 -> - let uu____1802 = lookup_opt "no_tactics" as_bool in - Prims.op_Negation uu____1802 + fun uu____1815 -> + let uu____1816 = lookup_opt "no_tactics" as_bool in + Prims.op_Negation uu____1816 let get_using_facts_from: Prims.unit -> Prims.string Prims.list FStar_Pervasives_Native.option = - fun uu____1809 -> + fun uu____1823 -> lookup_opt "using_facts_from" (as_option (as_list as_string)) +let get_vcgen_optimize_bind_as_seq: + Prims.unit -> Prims.string FStar_Pervasives_Native.option = + fun uu____1834 -> + lookup_opt "vcgen.optimize_bind_as_seq" (as_option as_string) let get_verify_module: Prims.unit -> Prims.string Prims.list = - fun uu____1820 -> lookup_opt "verify_module" (as_list as_string) + fun uu____1841 -> lookup_opt "verify_module" (as_list as_string) let get___temp_no_proj: Prims.unit -> Prims.string Prims.list = - fun uu____1827 -> lookup_opt "__temp_no_proj" (as_list as_string) + fun uu____1848 -> lookup_opt "__temp_no_proj" (as_list as_string) let get_version: Prims.unit -> Prims.bool = - fun uu____1832 -> lookup_opt "version" as_bool + fun uu____1853 -> lookup_opt "version" as_bool let get_warn_default_effects: Prims.unit -> Prims.bool = - fun uu____1835 -> lookup_opt "warn_default_effects" as_bool + fun uu____1856 -> lookup_opt "warn_default_effects" as_bool let get_z3cliopt: Prims.unit -> Prims.string Prims.list = - fun uu____1840 -> lookup_opt "z3cliopt" (as_list as_string) + fun uu____1861 -> lookup_opt "z3cliopt" (as_list as_string) let get_z3refresh: Prims.unit -> Prims.bool = - fun uu____1845 -> lookup_opt "z3refresh" as_bool + fun uu____1866 -> lookup_opt "z3refresh" as_bool let get_z3rlimit: Prims.unit -> Prims.int = - fun uu____1848 -> lookup_opt "z3rlimit" as_int + fun uu____1869 -> lookup_opt "z3rlimit" as_int let get_z3rlimit_factor: Prims.unit -> Prims.int = - fun uu____1851 -> lookup_opt "z3rlimit_factor" as_int + fun uu____1872 -> lookup_opt "z3rlimit_factor" as_int let get_z3seed: Prims.unit -> Prims.int = - fun uu____1854 -> lookup_opt "z3seed" as_int + fun uu____1875 -> lookup_opt "z3seed" as_int let get_use_two_phase_tc: Prims.unit -> Prims.bool = - fun uu____1857 -> lookup_opt "use_two_phase_tc" as_bool + fun uu____1878 -> lookup_opt "use_two_phase_tc" as_bool let get_no_positivity: Prims.unit -> Prims.bool = - fun uu____1860 -> lookup_opt "__no_positivity" as_bool + fun uu____1881 -> lookup_opt "__no_positivity" as_bool let get_ml_no_eta_expand_coertions: Prims.unit -> Prims.bool = - fun uu____1863 -> lookup_opt "__ml_no_eta_expand_coertions" as_bool + fun uu____1884 -> lookup_opt "__ml_no_eta_expand_coertions" as_bool let get_warn_error: Prims.unit -> Prims.string = - fun uu____1866 -> lookup_opt "warn_error" as_string + fun uu____1887 -> lookup_opt "warn_error" as_string let dlevel: Prims.string -> debug_level_t = - fun uu___34_1869 -> - match uu___34_1869 with + fun uu___39_1890 -> + match uu___39_1890 with | "Low" -> Low | "Medium" -> Medium | "High" -> High @@ -464,7 +470,7 @@ let one_debug_level_geq: debug_level_t -> debug_level_t -> Prims.bool = fun l1 -> fun l2 -> match l1 with - | Other uu____1877 -> l1 = l2 + | Other uu____1898 -> l1 = l2 | Low -> l1 = l2 | Medium -> (l2 = Low) || (l2 = Medium) | High -> ((l2 = Low) || (l2 = Medium)) || (l2 = High) @@ -472,8 +478,8 @@ let one_debug_level_geq: debug_level_t -> debug_level_t -> Prims.bool = (((l2 = Low) || (l2 = Medium)) || (l2 = High)) || (l2 = Extreme) let debug_level_geq: debug_level_t -> Prims.bool = fun l2 -> - let uu____1881 = get_debug_level () in - FStar_All.pipe_right uu____1881 + let uu____1902 = get_debug_level () in + FStar_All.pipe_right uu____1902 (FStar_Util.for_some (fun l1 -> one_debug_level_geq (dlevel l1) l2)) let universe_include_path_base_dirs: Prims.string Prims.list = ["/ulib"; "/lib/fstar"] @@ -483,101 +489,101 @@ let _compiler: Prims.string FStar_ST.ref = FStar_Util.mk_ref "" let _date: Prims.string FStar_ST.ref = FStar_Util.mk_ref "" let _commit: Prims.string FStar_ST.ref = FStar_Util.mk_ref "" let display_version: Prims.unit -> Prims.unit = - fun uu____2012 -> - let uu____2013 = - let uu____2014 = FStar_ST.op_Bang _version in - let uu____2063 = FStar_ST.op_Bang _platform in - let uu____2112 = FStar_ST.op_Bang _compiler in - let uu____2161 = FStar_ST.op_Bang _date in - let uu____2210 = FStar_ST.op_Bang _commit in + fun uu____2033 -> + let uu____2034 = + let uu____2035 = FStar_ST.op_Bang _version in + let uu____2084 = FStar_ST.op_Bang _platform in + let uu____2133 = FStar_ST.op_Bang _compiler in + let uu____2182 = FStar_ST.op_Bang _date in + let uu____2231 = FStar_ST.op_Bang _commit in FStar_Util.format5 - "F* %s\nplatform=%s\ncompiler=%s\ndate=%s\ncommit=%s\n" uu____2014 - uu____2063 uu____2112 uu____2161 uu____2210 in - FStar_Util.print_string uu____2013 + "F* %s\nplatform=%s\ncompiler=%s\ndate=%s\ncommit=%s\n" uu____2035 + uu____2084 uu____2133 uu____2182 uu____2231 in + FStar_Util.print_string uu____2034 let display_usage_aux: - 'Auu____2262 'Auu____2263 . - ('Auu____2263,Prims.string,'Auu____2262 FStar_Getopt.opt_variant, + 'Auu____2283 'Auu____2284 . + ('Auu____2284,Prims.string,'Auu____2283 FStar_Getopt.opt_variant, Prims.string) FStar_Pervasives_Native.tuple4 Prims.list -> Prims.unit = fun specs -> FStar_Util.print_string "fstar.exe [options] file[s]\n"; FStar_List.iter - (fun uu____2310 -> - match uu____2310 with - | (uu____2321,flag,p,doc) -> + (fun uu____2331 -> + match uu____2331 with + | (uu____2342,flag,p,doc) -> (match p with | FStar_Getopt.ZeroArgs ig -> if doc = "" then - let uu____2332 = - let uu____2333 = FStar_Util.colorize_bold flag in - FStar_Util.format1 " --%s\n" uu____2333 in - FStar_Util.print_string uu____2332 + let uu____2353 = + let uu____2354 = FStar_Util.colorize_bold flag in + FStar_Util.format1 " --%s\n" uu____2354 in + FStar_Util.print_string uu____2353 else - (let uu____2335 = - let uu____2336 = FStar_Util.colorize_bold flag in - FStar_Util.format2 " --%s %s\n" uu____2336 doc in - FStar_Util.print_string uu____2335) - | FStar_Getopt.OneArg (uu____2337,argname) -> + (let uu____2356 = + let uu____2357 = FStar_Util.colorize_bold flag in + FStar_Util.format2 " --%s %s\n" uu____2357 doc in + FStar_Util.print_string uu____2356) + | FStar_Getopt.OneArg (uu____2358,argname) -> if doc = "" then - let uu____2343 = - let uu____2344 = FStar_Util.colorize_bold flag in - let uu____2345 = FStar_Util.colorize_bold argname in - FStar_Util.format2 " --%s %s\n" uu____2344 uu____2345 in - FStar_Util.print_string uu____2343 + let uu____2364 = + let uu____2365 = FStar_Util.colorize_bold flag in + let uu____2366 = FStar_Util.colorize_bold argname in + FStar_Util.format2 " --%s %s\n" uu____2365 uu____2366 in + FStar_Util.print_string uu____2364 else - (let uu____2347 = - let uu____2348 = FStar_Util.colorize_bold flag in - let uu____2349 = FStar_Util.colorize_bold argname in - FStar_Util.format3 " --%s %s %s\n" uu____2348 - uu____2349 doc in - FStar_Util.print_string uu____2347))) specs + (let uu____2368 = + let uu____2369 = FStar_Util.colorize_bold flag in + let uu____2370 = FStar_Util.colorize_bold argname in + FStar_Util.format3 " --%s %s %s\n" uu____2369 + uu____2370 doc in + FStar_Util.print_string uu____2368))) specs let mk_spec: (FStar_BaseTypes.char,Prims.string,option_val FStar_Getopt.opt_variant, Prims.string) FStar_Pervasives_Native.tuple4 -> FStar_Getopt.opt = fun o -> - let uu____2373 = o in - match uu____2373 with + let uu____2394 = o in + match uu____2394 with | (ns,name,arg,desc) -> let arg1 = match arg with | FStar_Getopt.ZeroArgs f -> - let g uu____2403 = - let uu____2404 = f () in set_option name uu____2404 in + let g uu____2424 = + let uu____2425 = f () in set_option name uu____2425 in FStar_Getopt.ZeroArgs g | FStar_Getopt.OneArg (f,d) -> - let g x = let uu____2415 = f x in set_option name uu____2415 in + let g x = let uu____2436 = f x in set_option name uu____2436 in FStar_Getopt.OneArg (g, d) in (ns, name, arg1, desc) let accumulated_option: Prims.string -> option_val -> option_val = fun name -> fun value -> let prev_values = - let uu____2429 = lookup_opt name (as_option as_list') in - FStar_Util.dflt [] uu____2429 in + let uu____2450 = lookup_opt name (as_option as_list') in + FStar_Util.dflt [] uu____2450 in mk_list (value :: prev_values) let reverse_accumulated_option: Prims.string -> option_val -> option_val = fun name -> fun value -> - let uu____2448 = - let uu____2451 = lookup_opt name as_list' in - FStar_List.append uu____2451 [value] in - mk_list uu____2448 + let uu____2469 = + let uu____2472 = lookup_opt name as_list' in + FStar_List.append uu____2472 [value] in + mk_list uu____2469 let accumulate_string: - 'Auu____2460 . + 'Auu____2481 . Prims.string -> - ('Auu____2460 -> Prims.string) -> 'Auu____2460 -> Prims.unit + ('Auu____2481 -> Prims.string) -> 'Auu____2481 -> Prims.unit = fun name -> fun post_processor -> fun value -> - let uu____2478 = - let uu____2479 = - let uu____2480 = post_processor value in mk_string uu____2480 in - accumulated_option name uu____2479 in - set_option name uu____2478 + let uu____2499 = + let uu____2500 = + let uu____2501 = post_processor value in mk_string uu____2501 in + accumulated_option name uu____2500 in + set_option name uu____2499 let add_extract_module: Prims.string -> Prims.unit = fun s -> accumulate_string "extract_module" FStar_String.lowercase s let add_extract_namespace: Prims.string -> Prims.unit = @@ -601,61 +607,61 @@ type opt_type = FStar_Pervasives_Native.tuple2[@@deriving show] let uu___is_Const: opt_type -> Prims.bool = fun projectee -> - match projectee with | Const _0 -> true | uu____2558 -> false + match projectee with | Const _0 -> true | uu____2579 -> false let __proj__Const__item___0: opt_type -> option_val = fun projectee -> match projectee with | Const _0 -> _0 let uu___is_IntStr: opt_type -> Prims.bool = fun projectee -> - match projectee with | IntStr _0 -> true | uu____2570 -> false + match projectee with | IntStr _0 -> true | uu____2591 -> false let __proj__IntStr__item___0: opt_type -> Prims.string = fun projectee -> match projectee with | IntStr _0 -> _0 let uu___is_BoolStr: opt_type -> Prims.bool = fun projectee -> - match projectee with | BoolStr -> true | uu____2581 -> false + match projectee with | BoolStr -> true | uu____2602 -> false let uu___is_PathStr: opt_type -> Prims.bool = fun projectee -> - match projectee with | PathStr _0 -> true | uu____2586 -> false + match projectee with | PathStr _0 -> true | uu____2607 -> false let __proj__PathStr__item___0: opt_type -> Prims.string = fun projectee -> match projectee with | PathStr _0 -> _0 let uu___is_SimpleStr: opt_type -> Prims.bool = fun projectee -> - match projectee with | SimpleStr _0 -> true | uu____2598 -> false + match projectee with | SimpleStr _0 -> true | uu____2619 -> false let __proj__SimpleStr__item___0: opt_type -> Prims.string = fun projectee -> match projectee with | SimpleStr _0 -> _0 let uu___is_EnumStr: opt_type -> Prims.bool = fun projectee -> - match projectee with | EnumStr _0 -> true | uu____2612 -> false + match projectee with | EnumStr _0 -> true | uu____2633 -> false let __proj__EnumStr__item___0: opt_type -> Prims.string Prims.list = fun projectee -> match projectee with | EnumStr _0 -> _0 let uu___is_OpenEnumStr: opt_type -> Prims.bool = fun projectee -> - match projectee with | OpenEnumStr _0 -> true | uu____2636 -> false + match projectee with | OpenEnumStr _0 -> true | uu____2657 -> false let __proj__OpenEnumStr__item___0: opt_type -> (Prims.string Prims.list,Prims.string) FStar_Pervasives_Native.tuple2 = fun projectee -> match projectee with | OpenEnumStr _0 -> _0 let uu___is_PostProcessed: opt_type -> Prims.bool = fun projectee -> - match projectee with | PostProcessed _0 -> true | uu____2672 -> false + match projectee with | PostProcessed _0 -> true | uu____2693 -> false let __proj__PostProcessed__item___0: opt_type -> (option_val -> option_val,opt_type) FStar_Pervasives_Native.tuple2 = fun projectee -> match projectee with | PostProcessed _0 -> _0 let uu___is_Accumulated: opt_type -> Prims.bool = fun projectee -> - match projectee with | Accumulated _0 -> true | uu____2702 -> false + match projectee with | Accumulated _0 -> true | uu____2723 -> false let __proj__Accumulated__item___0: opt_type -> opt_type = fun projectee -> match projectee with | Accumulated _0 -> _0 let uu___is_ReverseAccumulated: opt_type -> Prims.bool = fun projectee -> match projectee with | ReverseAccumulated _0 -> true - | uu____2714 -> false + | uu____2735 -> false let __proj__ReverseAccumulated__item___0: opt_type -> opt_type = fun projectee -> match projectee with | ReverseAccumulated _0 -> _0 let uu___is_WithSideEffect: opt_type -> Prims.bool = fun projectee -> - match projectee with | WithSideEffect _0 -> true | uu____2732 -> false + match projectee with | WithSideEffect _0 -> true | uu____2753 -> false let __proj__WithSideEffect__item___0: opt_type -> (Prims.unit -> Prims.unit,opt_type) FStar_Pervasives_Native.tuple2 @@ -664,11 +670,11 @@ exception InvalidArgument of Prims.string let uu___is_InvalidArgument: Prims.exn -> Prims.bool = fun projectee -> match projectee with - | InvalidArgument uu____2764 -> true - | uu____2765 -> false + | InvalidArgument uu____2785 -> true + | uu____2786 -> false let __proj__InvalidArgument__item__uu___: Prims.exn -> Prims.string = fun projectee -> - match projectee with | InvalidArgument uu____2772 -> uu____2772 + match projectee with | InvalidArgument uu____2793 -> uu____2793 let rec parse_opt_val: Prims.string -> opt_type -> Prims.string -> option_val = fun opt_name -> @@ -677,31 +683,31 @@ let rec parse_opt_val: Prims.string -> opt_type -> Prims.string -> option_val try match typ with | Const c -> c - | IntStr uu____2786 -> - let uu____2787 = FStar_Util.safe_int_of_string str_val in - (match uu____2787 with + | IntStr uu____2807 -> + let uu____2808 = FStar_Util.safe_int_of_string str_val in + (match uu____2808 with | FStar_Pervasives_Native.Some v1 -> mk_int v1 | FStar_Pervasives_Native.None -> FStar_Exn.raise (InvalidArgument opt_name)) | BoolStr -> - let uu____2791 = + let uu____2812 = if str_val = "true" then true else if str_val = "false" then false else FStar_Exn.raise (InvalidArgument opt_name) in - mk_bool uu____2791 - | PathStr uu____2794 -> mk_path str_val - | SimpleStr uu____2795 -> mk_string str_val + mk_bool uu____2812 + | PathStr uu____2815 -> mk_path str_val + | SimpleStr uu____2816 -> mk_string str_val | EnumStr strs -> if FStar_List.mem str_val strs then mk_string str_val else FStar_Exn.raise (InvalidArgument opt_name) - | OpenEnumStr uu____2800 -> mk_string str_val + | OpenEnumStr uu____2821 -> mk_string str_val | PostProcessed (pp,elem_spec) -> - let uu____2813 = parse_opt_val opt_name elem_spec str_val in - pp uu____2813 + let uu____2834 = parse_opt_val opt_name elem_spec str_val in + pp uu____2834 | Accumulated elem_spec -> let v1 = parse_opt_val opt_name elem_spec str_val in accumulated_option opt_name v1 @@ -712,9 +718,9 @@ let rec parse_opt_val: Prims.string -> opt_type -> Prims.string -> option_val (side_effect (); parse_opt_val opt_name elem_spec str_val) with | InvalidArgument opt_name1 -> - let uu____2830 = + let uu____2851 = FStar_Util.format1 "Invalid argument to --%s" opt_name1 in - failwith uu____2830 + failwith uu____2851 let rec desc_of_opt_type: opt_type -> Prims.string FStar_Pervasives_Native.option = fun typ -> @@ -729,780 +735,786 @@ let rec desc_of_opt_type: | SimpleStr desc -> FStar_Pervasives_Native.Some desc | EnumStr strs -> desc_of_enum strs | OpenEnumStr (strs,desc) -> desc_of_enum (FStar_List.append strs [desc]) - | PostProcessed (uu____2863,elem_spec) -> desc_of_opt_type elem_spec + | PostProcessed (uu____2884,elem_spec) -> desc_of_opt_type elem_spec | Accumulated elem_spec -> desc_of_opt_type elem_spec | ReverseAccumulated elem_spec -> desc_of_opt_type elem_spec - | WithSideEffect (uu____2871,elem_spec) -> desc_of_opt_type elem_spec + | WithSideEffect (uu____2892,elem_spec) -> desc_of_opt_type elem_spec let rec arg_spec_of_opt_type: Prims.string -> opt_type -> option_val FStar_Getopt.opt_variant = fun opt_name -> fun typ -> let parser = parse_opt_val opt_name typ in - let uu____2890 = desc_of_opt_type typ in - match uu____2890 with + let uu____2911 = desc_of_opt_type typ in + match uu____2911 with | FStar_Pervasives_Native.None -> - FStar_Getopt.ZeroArgs ((fun uu____2896 -> parser "")) + FStar_Getopt.ZeroArgs ((fun uu____2917 -> parser "")) | FStar_Pervasives_Native.Some desc -> FStar_Getopt.OneArg (parser, desc) let pp_validate_dir: option_val -> option_val = fun p -> let pp = as_string p in FStar_Util.mkdir false pp; p let pp_lowercase: option_val -> option_val = fun s -> - let uu____2908 = - let uu____2909 = as_string s in FStar_String.lowercase uu____2909 in - mk_string uu____2908 + let uu____2929 = + let uu____2930 = as_string s in FStar_String.lowercase uu____2930 in + mk_string uu____2929 let rec specs_with_types: Prims.unit -> (FStar_BaseTypes.char,Prims.string,opt_type,Prims.string) FStar_Pervasives_Native.tuple4 Prims.list = - fun uu____2926 -> - let uu____2937 = - let uu____2948 = - let uu____2959 = - let uu____2968 = let uu____2969 = mk_bool true in Const uu____2969 in - (FStar_Getopt.noshort, "cache_checked_modules", uu____2968, + fun uu____2947 -> + let uu____2958 = + let uu____2969 = + let uu____2980 = + let uu____2989 = let uu____2990 = mk_bool true in Const uu____2990 in + (FStar_Getopt.noshort, "cache_checked_modules", uu____2989, "Write a '.checked' file for each module after verification and read from it if present, instead of re-verifying") in - let uu____2970 = - let uu____2981 = - let uu____2992 = - let uu____3003 = - let uu____3014 = - let uu____3025 = - let uu____3036 = - let uu____3045 = - let uu____3046 = mk_bool true in Const uu____3046 in - (FStar_Getopt.noshort, "detail_errors", uu____3045, + let uu____2991 = + let uu____3002 = + let uu____3013 = + let uu____3024 = + let uu____3035 = + let uu____3046 = + let uu____3057 = + let uu____3066 = + let uu____3067 = mk_bool true in Const uu____3067 in + (FStar_Getopt.noshort, "detail_errors", uu____3066, "Emit a detailed error report by asking the SMT solver many queries; will take longer;\n implies n_cores=1") in - let uu____3047 = - let uu____3058 = - let uu____3067 = - let uu____3068 = mk_bool true in Const uu____3068 in + let uu____3068 = + let uu____3079 = + let uu____3088 = + let uu____3089 = mk_bool true in Const uu____3089 in (FStar_Getopt.noshort, "detail_hint_replay", - uu____3067, + uu____3088, "Emit a detailed report for proof whose unsat core fails to replay;\n implies n_cores=1") in - let uu____3069 = - let uu____3080 = - let uu____3089 = - let uu____3090 = mk_bool true in Const uu____3090 in - (FStar_Getopt.noshort, "doc", uu____3089, + let uu____3090 = + let uu____3101 = + let uu____3110 = + let uu____3111 = mk_bool true in Const uu____3111 in + (FStar_Getopt.noshort, "doc", uu____3110, "Extract Markdown documentation files for the input modules, as well as an index. Output is written to --odir directory.") in - let uu____3091 = - let uu____3102 = - let uu____3113 = - let uu____3122 = - let uu____3123 = mk_bool true in - Const uu____3123 in + let uu____3112 = + let uu____3123 = + let uu____3134 = + let uu____3143 = + let uu____3144 = mk_bool true in + Const uu____3144 in (FStar_Getopt.noshort, "eager_inference", - uu____3122, + uu____3143, "Solve all type-inference constraints eagerly; more efficient but at the cost of generality") in - let uu____3124 = - let uu____3135 = - let uu____3146 = - let uu____3157 = - let uu____3166 = - let uu____3167 = mk_bool true in - Const uu____3167 in - (FStar_Getopt.noshort, - "expose_interfaces", uu____3166, - "Explicitly break the abstraction imposed by the interface of any implementation file that appears on the command line (use with care!)") in - let uu____3168 = - let uu____3179 = - let uu____3190 = - let uu____3201 = - let uu____3210 = - let uu____3211 = mk_bool true in - Const uu____3211 in - (FStar_Getopt.noshort, - "hide_uvar_nums", uu____3210, - "Don't print unification variable numbers") in - let uu____3212 = - let uu____3223 = - let uu____3234 = - let uu____3243 = - let uu____3244 = mk_bool true in - Const uu____3244 in - (FStar_Getopt.noshort, - "hint_info", uu____3243, - "Print information regarding hints (deprecated; use --query_stats instead)") in - let uu____3245 = - let uu____3256 = - let uu____3265 = - let uu____3266 = + let uu____3145 = + let uu____3156 = + let uu____3167 = + let uu____3178 = + let uu____3189 = + let uu____3198 = + let uu____3199 = mk_bool true in + Const uu____3199 in + (FStar_Getopt.noshort, + "expose_interfaces", uu____3198, + "Explicitly break the abstraction imposed by the interface of any implementation file that appears on the command line (use with care!)") in + let uu____3200 = + let uu____3211 = + let uu____3222 = + let uu____3233 = + let uu____3242 = + let uu____3243 = mk_bool true in + Const uu____3243 in + (FStar_Getopt.noshort, + "hide_uvar_nums", uu____3242, + "Don't print unification variable numbers") in + let uu____3244 = + let uu____3255 = + let uu____3266 = + let uu____3275 = + let uu____3276 = mk_bool true in - Const uu____3266 in - (FStar_Getopt.noshort, "in", - uu____3265, - "Legacy interactive mode; reads input from stdin") in - let uu____3267 = - let uu____3278 = - let uu____3287 = - let uu____3288 = + Const uu____3276 in + (FStar_Getopt.noshort, + "hint_info", uu____3275, + "Print information regarding hints (deprecated; use --query_stats instead)") in + let uu____3277 = + let uu____3288 = + let uu____3297 = + let uu____3298 = mk_bool true in - Const uu____3288 in + Const uu____3298 in (FStar_Getopt.noshort, - "ide", uu____3287, - "JSON-based interactive mode for IDEs") in - let uu____3289 = - let uu____3300 = - let uu____3311 = + "in", uu____3297, + "Legacy interactive mode; reads input from stdin") in + let uu____3299 = + let uu____3310 = + let uu____3319 = let uu____3320 = - let uu____3321 = - mk_bool true in - Const uu____3321 in - (FStar_Getopt.noshort, - "indent", uu____3320, - "Parses and outputs the files on the command line") in - let uu____3322 = - let uu____3333 = - let uu____3344 = - let uu____3355 = - let uu____3364 = - let uu____3365 - = - mk_bool true in - Const - uu____3365 in - (FStar_Getopt.noshort, - "lax", - uu____3364, - "Run the lax-type checker only (admit all verification conditions)") in - let uu____3366 = - let uu____3377 = - let uu____3388 + mk_bool true in + Const uu____3320 in + (FStar_Getopt.noshort, + "ide", uu____3319, + "JSON-based interactive mode for IDEs") in + let uu____3321 = + let uu____3332 = + let uu____3343 = + let uu____3352 = + let uu____3353 = + mk_bool true in + Const uu____3353 in + (FStar_Getopt.noshort, + "indent", + uu____3352, + "Parses and outputs the files on the command line") in + let uu____3354 = + let uu____3365 = + let uu____3376 = + let uu____3387 = + let uu____3396 = let uu____3397 = - let uu____3398 - = - mk_bool + mk_bool true in - Const - uu____3398 in - (FStar_Getopt.noshort, - "log_types", - uu____3397, - "Print types computed for data/val/let-bindings") in - let uu____3399 + Const + uu____3397 in + (FStar_Getopt.noshort, + "lax", + uu____3396, + "Run the lax-type checker only (admit all verification conditions)") in + let uu____3398 = + let uu____3409 = - let uu____3410 + let uu____3420 = - let uu____3419 + let uu____3429 = - let uu____3420 + let uu____3430 = mk_bool true in Const - uu____3420 in + uu____3430 in (FStar_Getopt.noshort, - "log_queries", - uu____3419, - "Log the Z3 queries in several queries-*.smt2 files, as we go") in - let uu____3421 + "log_types", + uu____3429, + "Print types computed for data/val/let-bindings") in + let uu____3431 = - let uu____3432 + let uu____3442 = - let uu____3443 + let uu____3451 = - let uu____3454 + let uu____3452 = - let uu____3465 + mk_bool + true in + Const + uu____3452 in + (FStar_Getopt.noshort, + "log_queries", + uu____3451, + "Log the Z3 queries in several queries-*.smt2 files, as we go") in + let uu____3453 = - let uu____3474 + let uu____3464 = let uu____3475 = + let uu____3486 + = + let uu____3497 + = + let uu____3506 + = + let uu____3507 + = mk_bool true in Const - uu____3475 in + uu____3507 in (FStar_Getopt.noshort, "MLish", - uu____3474, + uu____3506, "Trigger various specializations for compiling the F* compiler itself (not meant for user code)") in - let uu____3476 + let uu____3508 = - let uu____3487 + let uu____3519 = - let uu____3498 + let uu____3530 = - let uu____3507 + let uu____3539 = - let uu____3508 + let uu____3540 = mk_bool true in Const - uu____3508 in + uu____3540 in (FStar_Getopt.noshort, "no_default_includes", - uu____3507, + uu____3539, "Ignore the default module search paths") in - let uu____3509 + let uu____3541 = - let uu____3520 + let uu____3552 = - let uu____3531 + let uu____3563 = - let uu____3540 + let uu____3572 = - let uu____3541 + let uu____3573 = mk_bool true in Const - uu____3541 in + uu____3573 in (FStar_Getopt.noshort, "no_location_info", - uu____3540, + uu____3572, "Suppress location information in the generated OCaml output (only relevant with --codegen OCaml)") in - let uu____3542 + let uu____3574 = - let uu____3553 + let uu____3585 = - let uu____3564 + let uu____3596 = - let uu____3575 + let uu____3607 = - let uu____3584 + let uu____3616 = - let uu____3585 + let uu____3617 = mk_bool true in Const - uu____3585 in + uu____3617 in (FStar_Getopt.noshort, "print_bound_var_types", - uu____3584, + uu____3616, "Print the types of bound variables") in - let uu____3586 + let uu____3618 = - let uu____3597 + let uu____3629 = - let uu____3606 + let uu____3638 = - let uu____3607 + let uu____3639 = mk_bool true in Const - uu____3607 in + uu____3639 in (FStar_Getopt.noshort, "print_effect_args", - uu____3606, + uu____3638, "Print inferred predicate transformers for all computation types") in - let uu____3608 + let uu____3640 = - let uu____3619 + let uu____3651 = - let uu____3628 + let uu____3660 = - let uu____3629 + let uu____3661 = mk_bool true in Const - uu____3629 in + uu____3661 in (FStar_Getopt.noshort, "print_full_names", - uu____3628, + uu____3660, "Print full names of variables") in - let uu____3630 + let uu____3662 = - let uu____3641 + let uu____3673 = - let uu____3650 + let uu____3682 = - let uu____3651 + let uu____3683 = mk_bool true in Const - uu____3651 in + uu____3683 in (FStar_Getopt.noshort, "print_implicits", - uu____3650, + uu____3682, "Print implicit arguments") in - let uu____3652 + let uu____3684 = - let uu____3663 + let uu____3695 = - let uu____3672 + let uu____3704 = - let uu____3673 + let uu____3705 = mk_bool true in Const - uu____3673 in + uu____3705 in (FStar_Getopt.noshort, "print_universes", - uu____3672, + uu____3704, "Print universes") in - let uu____3674 + let uu____3706 = - let uu____3685 + let uu____3717 = - let uu____3694 + let uu____3726 = - let uu____3695 + let uu____3727 = mk_bool true in Const - uu____3695 in + uu____3727 in (FStar_Getopt.noshort, "print_z3_statistics", - uu____3694, + uu____3726, "Print Z3 statistics for each SMT query (deprecated; use --query_stats instead)") in - let uu____3696 + let uu____3728 = - let uu____3707 + let uu____3739 = - let uu____3716 + let uu____3748 = - let uu____3717 + let uu____3749 = mk_bool true in Const - uu____3717 in + uu____3749 in (FStar_Getopt.noshort, "prn", - uu____3716, + uu____3748, "Print full names (deprecated; use --print_full_names instead)") in - let uu____3718 + let uu____3750 = - let uu____3729 + let uu____3761 = - let uu____3738 + let uu____3770 = - let uu____3739 + let uu____3771 = mk_bool true in Const - uu____3739 in + uu____3771 in (FStar_Getopt.noshort, "query_stats", - uu____3738, + uu____3770, "Print SMT query statistics") in - let uu____3740 + let uu____3772 = - let uu____3751 + let uu____3783 = - let uu____3760 + let uu____3792 = - let uu____3761 + let uu____3793 = mk_bool true in Const - uu____3761 in + uu____3793 in (FStar_Getopt.noshort, "record_hints", - uu____3760, + uu____3792, "Record a database of hints for efficient proof replay") in - let uu____3762 + let uu____3794 = - let uu____3773 + let uu____3805 = - let uu____3784 + let uu____3816 = - let uu____3793 + let uu____3825 = - let uu____3794 + let uu____3826 = mk_bool true in Const - uu____3794 in + uu____3826 in (FStar_Getopt.noshort, "silent", - uu____3793, + uu____3825, " ") in - let uu____3795 + let uu____3827 = - let uu____3806 + let uu____3838 = - let uu____3817 + let uu____3849 = - let uu____3828 + let uu____3860 = - let uu____3839 - = - let uu____3850 + let uu____3871 = - let uu____3861 + let uu____3882 = - let uu____3870 + let uu____3891 = - let uu____3871 + let uu____3892 = mk_bool true in Const - uu____3871 in + uu____3892 in (FStar_Getopt.noshort, "tactic_raw_binders", - uu____3870, + uu____3891, "Do not use the lexical scope of tactics to improve binder names") in - let uu____3872 + let uu____3893 = - let uu____3883 + let uu____3904 = - let uu____3892 + let uu____3913 = - let uu____3893 + let uu____3914 = mk_bool true in Const - uu____3893 in + uu____3914 in (FStar_Getopt.noshort, "tactic_trace", - uu____3892, + uu____3913, "Print a depth-indexed trace of tactic execution (Warning: very verbose)") in - let uu____3894 + let uu____3915 = - let uu____3905 + let uu____3926 = - let uu____3916 + let uu____3937 = - let uu____3925 + let uu____3946 = - let uu____3926 + let uu____3947 = mk_bool true in Const - uu____3926 in + uu____3947 in (FStar_Getopt.noshort, "timing", - uu____3925, + uu____3946, "Print the time it takes to verify each top-level definition") in - let uu____3927 + let uu____3948 = - let uu____3938 + let uu____3959 = - let uu____3947 + let uu____3968 = - let uu____3948 + let uu____3969 = mk_bool true in Const - uu____3948 in + uu____3969 in (FStar_Getopt.noshort, "trace_error", - uu____3947, + uu____3968, "Don't print an error message; show an exception trace instead") in - let uu____3949 + let uu____3970 = - let uu____3960 + let uu____3981 = - let uu____3969 + let uu____3990 = - let uu____3970 + let uu____3991 = mk_bool true in Const - uu____3970 in + uu____3991 in (FStar_Getopt.noshort, "ugly", - uu____3969, + uu____3990, "Emit output formatted for debugging") in - let uu____3971 + let uu____3992 = - let uu____3982 + let uu____4003 = - let uu____3991 + let uu____4012 = - let uu____3992 + let uu____4013 = mk_bool true in Const - uu____3992 in + uu____4013 in (FStar_Getopt.noshort, "unthrottle_inductives", - uu____3991, + uu____4012, "Let the SMT solver unfold inductive types to arbitrary depths (may affect verifier performance)") in - let uu____3993 + let uu____4014 = - let uu____4004 + let uu____4025 = - let uu____4013 + let uu____4034 = - let uu____4014 + let uu____4035 = mk_bool true in Const - uu____4014 in + uu____4035 in (FStar_Getopt.noshort, "unsafe_tactic_exec", - uu____4013, + uu____4034, "Allow tactics to run external processes. WARNING: checking an untrusted F* file while using this option can have disastrous effects.") in - let uu____4015 + let uu____4036 = - let uu____4026 + let uu____4047 = - let uu____4035 + let uu____4056 = - let uu____4036 + let uu____4057 = mk_bool true in Const - uu____4036 in + uu____4057 in (FStar_Getopt.noshort, "use_eq_at_higher_order", - uu____4035, + uu____4056, "Use equality constraints when comparing higher-order types (Temporary)") in - let uu____4037 + let uu____4058 = - let uu____4048 + let uu____4069 = - let uu____4057 + let uu____4078 = - let uu____4058 + let uu____4079 = mk_bool true in Const - uu____4058 in + uu____4079 in (FStar_Getopt.noshort, "use_hints", - uu____4057, + uu____4078, "Use a previously recorded hints database for proof replay") in - let uu____4059 + let uu____4080 = - let uu____4070 + let uu____4091 = - let uu____4079 + let uu____4100 = - let uu____4080 + let uu____4101 = mk_bool true in Const - uu____4080 in + uu____4101 in (FStar_Getopt.noshort, "use_hint_hashes", - uu____4079, + uu____4100, "Admit queries if their hash matches the hash recorded in the hints database") in - let uu____4081 + let uu____4102 = - let uu____4092 + let uu____4113 = - let uu____4103 + let uu____4124 = - let uu____4112 + let uu____4133 = - let uu____4113 + let uu____4134 = mk_bool true in Const - uu____4113 in + uu____4134 in (FStar_Getopt.noshort, "no_tactics", - uu____4112, + uu____4133, "Do not run the tactic engine before discharging a VC") in - let uu____4114 + let uu____4135 + = + let uu____4146 = - let uu____4125 + let uu____4157 = - let uu____4136 + let uu____4168 = - let uu____4147 + let uu____4179 = - let uu____4157 + let uu____4189 = - let uu____4158 + let uu____4190 = - let uu____4165 + let uu____4197 = - let uu____4166 + let uu____4198 = mk_bool true in Const - uu____4166 in + uu____4198 in ((fun - uu____4171 + uu____4203 -> display_version (); FStar_All.exit (Prims.parse_int "0")), - uu____4165) in + uu____4197) in WithSideEffect - uu____4158 in + uu____4190 in (118, "version", - uu____4157, + uu____4189, "Display version number") in - let uu____4175 + let uu____4207 = - let uu____4187 + let uu____4219 = - let uu____4196 + let uu____4228 = - let uu____4197 + let uu____4229 = mk_bool true in Const - uu____4197 in + uu____4229 in (FStar_Getopt.noshort, "warn_default_effects", - uu____4196, + uu____4228, "Warn when (a -> b) is desugared to (a -> Tot b)") in - let uu____4198 + let uu____4230 = - let uu____4209 + let uu____4241 = - let uu____4220 + let uu____4252 = - let uu____4229 + let uu____4261 = - let uu____4230 + let uu____4262 = mk_bool true in Const - uu____4230 in + uu____4262 in (FStar_Getopt.noshort, "z3refresh", - uu____4229, + uu____4261, "Restart Z3 after each query; useful for ensuring proof robustness") in - let uu____4231 + let uu____4263 = - let uu____4242 + let uu____4274 = - let uu____4253 + let uu____4285 = - let uu____4264 + let uu____4296 = - let uu____4275 + let uu____4307 = - let uu____4286 + let uu____4318 = - let uu____4295 + let uu____4327 = - let uu____4296 + let uu____4328 = mk_bool true in Const - uu____4296 in + uu____4328 in (FStar_Getopt.noshort, "__no_positivity", - uu____4295, + uu____4327, "Don't check positivity of inductive types") in - let uu____4297 + let uu____4329 = - let uu____4308 + let uu____4340 = - let uu____4317 + let uu____4349 = - let uu____4318 + let uu____4350 = mk_bool true in Const - uu____4318 in + uu____4350 in (FStar_Getopt.noshort, "__ml_no_eta_expand_coertions", - uu____4317, + uu____4349, "Do not eta-expand coertions in generated OCaml") in - let uu____4319 + let uu____4351 = - let uu____4330 + let uu____4362 = - let uu____4341 + let uu____4373 = - let uu____4351 + let uu____4383 = - let uu____4352 + let uu____4384 = - let uu____4359 + let uu____4391 = - let uu____4360 + let uu____4392 = mk_bool true in Const - uu____4360 in + uu____4392 in ((fun - uu____4365 + uu____4397 -> ( - let uu____4367 + let uu____4399 = specs () in display_usage_aux - uu____4367); + uu____4399); FStar_All.exit (Prims.parse_int "0")), - uu____4359) in + uu____4391) in WithSideEffect - uu____4352 in + uu____4384 in (104, "help", - uu____4351, + uu____4383, "Display this information") in - [uu____4341] in + [uu____4373] in (FStar_Getopt.noshort, "warn_error", (SimpleStr ""), "The [-warn_error] option follows the OCaml syntax, namely:\n\t\t- [r] is a range of warnings (either a number [n], or a range [n..n])\n\t\t- [-r] silences range [r]\n\t\t- [+r] enables range [r]\n\t\t- [@r] makes range [r] fatal.") :: - uu____4330 in - uu____4308 + uu____4362 in + uu____4340 :: - uu____4319 in - uu____4286 + uu____4351 in + uu____4318 :: - uu____4297 in + uu____4329 in (FStar_Getopt.noshort, "use_two_phase_tc", BoolStr, "Use the two phase typechecker (default 'false')") :: - uu____4275 in + uu____4307 in (FStar_Getopt.noshort, "z3seed", (IntStr "positive_integer"), "Set the Z3 random seed (default 0)") :: - uu____4264 in + uu____4296 in (FStar_Getopt.noshort, "z3rlimit_factor", (IntStr "positive_integer"), "Set the Z3 per-query resource limit multiplier. This is useful when, say, regenerating hints and you want to be more lax. (default 1)") :: - uu____4253 in + uu____4285 in (FStar_Getopt.noshort, "z3rlimit", (IntStr "positive_integer"), "Set the Z3 per-query resource limit (default 5 units, taking roughtly 5s)") :: - uu____4242 in - uu____4220 + uu____4274 in + uu____4252 :: - uu____4231 in + uu____4263 in (FStar_Getopt.noshort, "z3cliopt", (ReverseAccumulated @@ -1510,13 +1522,13 @@ let rec specs_with_types: "option")), "Z3 command line options") :: - uu____4209 in - uu____4187 + uu____4241 in + uu____4219 :: - uu____4198 in - uu____4147 + uu____4230 in + uu____4179 :: - uu____4175 in + uu____4207 in (FStar_Getopt.noshort, "__temp_no_proj", (Accumulated @@ -1524,7 +1536,16 @@ let rec specs_with_types: "module_name")), "Don't generate projectors for this module") :: - uu____4136 in + uu____4168 in + (FStar_Getopt.noshort, + "vcgen.optimize_bind_as_seq", + (EnumStr + ["off"; + "without_type"; + "with_type"]), + "\n\t\tOptimize the generation of verification conditions, \n\t\t\tspecifically the construction of monadic `bind`,\n\t\t\tgenerating `seq` instead of `bind` when the first computation as a trivial post-condition.\n\t\t\tBy default, this optimization does not apply.\n\t\t\tWhen the `without_type` option is chosen, this imposes a cost on the SMT solver\n\t\t\tto reconstruct type information.\n\t\t\tWhen `with_type` is chosen, type information is provided to the SMT solver,\n\t\t\tbut at the cost of VC bloat, which may often be redundant.") + :: + uu____4157 in (FStar_Getopt.noshort, "using_facts_from", (Accumulated @@ -1532,61 +1553,54 @@ let rec specs_with_types: "One or more space-separated occurrences of '[+|-]( * | namespace | fact id)'")), "\n\t\tPrunes the context to include only the facts from the given namespace or fact id. \n\t\t\tFacts can be include or excluded using the [+|-] qualifier. \n\t\t\tFor example --using_facts_from '* -FStar.Reflection +FStar.List -FStar.List.Tot' will \n\t\t\t\tremove all facts from FStar.List.Tot.*, \n\t\t\t\tretain all remaining facts from FStar.List.*, \n\t\t\t\tremove all facts from FStar.Reflection.*, \n\t\t\t\tand retain all the rest.\n\t\tNote, the '+' is optional: --using_facts_from 'FStar.List' is equivalent to --using_facts_from '+FStar.List'. \n\t\tMultiple uses of this option accumulate, e.g., --using_facts_from A --using_facts_from B is interpreted as --using_facts_from A^B.") :: - uu____4125 in - uu____4103 + uu____4146 in + uu____4124 :: - uu____4114 in + uu____4135 in (FStar_Getopt.noshort, "use_native_tactics", (PathStr "path"), "Use compiled tactics from ") :: - uu____4092 in - uu____4070 + uu____4113 in + uu____4091 :: - uu____4081 in - uu____4048 + uu____4102 in + uu____4069 :: - uu____4059 in - uu____4026 + uu____4080 in + uu____4047 :: - uu____4037 in - uu____4004 + uu____4058 in + uu____4025 :: - uu____4015 in - uu____3982 + uu____4036 in + uu____4003 :: - uu____3993 in - uu____3960 + uu____4014 in + uu____3981 :: - uu____3971 in - uu____3938 + uu____3992 in + uu____3959 :: - uu____3949 in - uu____3916 + uu____3970 in + uu____3937 :: - uu____3927 in + uu____3948 in (FStar_Getopt.noshort, "tactic_trace_d", (IntStr "positive_integer"), "Trace tactics up to a certain binding depth") :: - uu____3905 in - uu____3883 - :: - uu____3894 in - uu____3861 + uu____3926 in + uu____3904 :: - uu____3872 in - (FStar_Getopt.noshort, - "split_cases", - (IntStr - "positive_integer"), - "Partition VC of a match into groups of cases") + uu____3915 in + uu____3882 :: - uu____3850 in + uu____3893 in (FStar_Getopt.noshort, "smtencoding.l_arith_repr", (EnumStr @@ -1594,7 +1608,7 @@ let rec specs_with_types: "boxwrap"]), "Toggle the representation of linear arithmetic functions in the SMT encoding:\n\t\ti.e., if 'boxwrap', use 'Prims.op_Addition, Prims.op_Subtraction, Prims.op_Minus'; \n\t\tif 'native', use '+, -, -'; \n\t\t(default 'boxwrap')") :: - uu____3839 in + uu____3871 in (FStar_Getopt.noshort, "smtencoding.nl_arith_repr", (EnumStr @@ -1603,63 +1617,63 @@ let rec specs_with_types: "boxwrap"]), "Control the representation of non-linear arithmetic functions in the SMT encoding:\n\t\ti.e., if 'boxwrap' use 'Prims.op_Multiply, Prims.op_Division, Prims.op_Modulus'; \n\t\tif 'native' use '*, div, mod';\n\t\tif 'wrapped' use '_mul, _div, _mod : Int*Int -> Int'; \n\t\t(default 'boxwrap')") :: - uu____3828 in + uu____3860 in (FStar_Getopt.noshort, "smtencoding.elim_box", BoolStr, "Toggle a peephole optimization that eliminates redundant uses of boxing/unboxing in the SMT encoding (default 'false')") :: - uu____3817 in + uu____3849 in (FStar_Getopt.noshort, "smt", (PathStr "path"), "Path to the Z3 SMT solver (we could eventually support other solvers)") :: - uu____3806 in - uu____3784 + uu____3838 in + uu____3816 :: - uu____3795 in + uu____3827 in (FStar_Getopt.noshort, "reuse_hint_for", (SimpleStr "toplevel_name"), "Optimistically, attempt using the recorded hint for (a top-level name in the current module) when trying to verify some other term 'g'") :: - uu____3773 in - uu____3751 + uu____3805 in + uu____3783 :: - uu____3762 in - uu____3729 + uu____3794 in + uu____3761 :: - uu____3740 in - uu____3707 + uu____3772 in + uu____3739 :: - uu____3718 in - uu____3685 + uu____3750 in + uu____3717 :: - uu____3696 in - uu____3663 + uu____3728 in + uu____3695 :: - uu____3674 in - uu____3641 + uu____3706 in + uu____3673 :: - uu____3652 in - uu____3619 + uu____3684 in + uu____3651 :: - uu____3630 in - uu____3597 + uu____3662 in + uu____3629 :: - uu____3608 in - uu____3575 + uu____3640 in + uu____3607 :: - uu____3586 in + uu____3618 in (FStar_Getopt.noshort, "prims", (PathStr "file"), "") :: - uu____3564 in + uu____3596 in (FStar_Getopt.noshort, "odir", (PostProcessed @@ -1668,165 +1682,172 @@ let rec specs_with_types: "dir"))), "Place output in directory ") :: - uu____3553 in - uu____3531 + uu____3585 in + uu____3563 :: - uu____3542 in + uu____3574 in (FStar_Getopt.noshort, "no_extract", (Accumulated (PathStr "module name")), - "Do not extract code from this module") + "Deprecated: use --extract instead; Do not extract code from this module") :: - uu____3520 in - uu____3498 + uu____3552 in + uu____3530 :: - uu____3509 in + uu____3541 in (FStar_Getopt.noshort, "n_cores", (IntStr "positive_integer"), "Maximum number of cores to use for the solver (implies detail_errors = false) (default 1)") :: - uu____3487 in - uu____3465 + uu____3519 in + uu____3497 :: - uu____3476 in + uu____3508 in (FStar_Getopt.noshort, "min_fuel", (IntStr "non-negative integer"), "Minimum number of unrolling of recursive functions to try (default 1)") :: - uu____3454 in + uu____3486 in (FStar_Getopt.noshort, "max_ifuel", (IntStr "non-negative integer"), "Number of unrolling of inductive datatypes to try at most (default 2)") :: - uu____3443 in - (FStar_Getopt.noshort, + uu____3475 in + (FStar_Getopt.noshort, "max_fuel", - ( - IntStr + (IntStr "non-negative integer"), "Number of unrolling of recursive functions to try at most (default 8)") :: - uu____3432 in - uu____3410 :: - uu____3421 in - uu____3388 :: - uu____3399 in - (FStar_Getopt.noshort, - "load", - (ReverseAccumulated - (PathStr + uu____3464 in + uu____3442 + :: + uu____3453 in + uu____3420 :: + uu____3431 in + (FStar_Getopt.noshort, + "load", + (ReverseAccumulated + (PathStr "module")), - "Load compiled module") - :: uu____3377 in - uu____3355 :: - uu____3366 in + "Load compiled module") + :: uu____3409 in + uu____3387 :: + uu____3398 in + (FStar_Getopt.noshort, + "initial_ifuel", + (IntStr + "non-negative integer"), + "Number of unrolling of inductive datatypes to try at first (default 1)") + :: uu____3376 in (FStar_Getopt.noshort, - "initial_ifuel", + "initial_fuel", (IntStr "non-negative integer"), - "Number of unrolling of inductive datatypes to try at first (default 1)") - :: uu____3344 in - (FStar_Getopt.noshort, - "initial_fuel", - (IntStr - "non-negative integer"), - "Number of unrolling of recursive functions to try initially (default 2)") - :: uu____3333 in - uu____3311 :: uu____3322 in - (FStar_Getopt.noshort, - "include", - (ReverseAccumulated - (PathStr "path")), - "A directory in which to search for files included on the command line") - :: uu____3300 in - uu____3278 :: uu____3289 in - uu____3256 :: uu____3267 in - uu____3234 :: uu____3245 in - (FStar_Getopt.noshort, "hint_file", - (PathStr "path"), - "Read/write hints to (instead of module-specific hints files)") - :: uu____3223 in - uu____3201 :: uu____3212 in - (FStar_Getopt.noshort, - "gen_native_tactics", - (PathStr "[path]"), - "Compile all user tactics used in the module in ") - :: uu____3190 in - (FStar_Getopt.noshort, "fstar_home", - (PathStr "dir"), - "Set the FSTAR_HOME variable to ") - :: uu____3179 in - uu____3157 :: uu____3168 in - (FStar_Getopt.noshort, "extract_namespace", + "Number of unrolling of recursive functions to try initially (default 2)") + :: uu____3365 in + uu____3343 :: + uu____3354 in + (FStar_Getopt.noshort, + "include", + (ReverseAccumulated + (PathStr "path")), + "A directory in which to search for files included on the command line") + :: uu____3332 in + uu____3310 :: uu____3321 in + uu____3288 :: uu____3299 in + uu____3266 :: uu____3277 in + (FStar_Getopt.noshort, + "hint_file", (PathStr "path"), + "Read/write hints to (instead of module-specific hints files)") + :: uu____3255 in + uu____3233 :: uu____3244 in + (FStar_Getopt.noshort, + "gen_native_tactics", + (PathStr "[path]"), + "Compile all user tactics used in the module in ") + :: uu____3222 in + (FStar_Getopt.noshort, "fstar_home", + (PathStr "dir"), + "Set the FSTAR_HOME variable to ") + :: uu____3211 in + uu____3189 :: uu____3200 in + (FStar_Getopt.noshort, "extract_namespace", + (Accumulated + (PostProcessed + (pp_lowercase, + (SimpleStr "namespace name")))), + "Deprecated: use --extract instead; Only extract modules in the specified namespace") + :: uu____3178 in + (FStar_Getopt.noshort, "extract_module", (Accumulated (PostProcessed (pp_lowercase, - (SimpleStr "namespace name")))), - "Only extract modules in the specified namespace") - :: uu____3146 in - (FStar_Getopt.noshort, "extract_module", + (SimpleStr "module_name")))), + "Deprecated: use --extract instead; Only extract the specified modules (instead of the possibly-partial dependency graph)") + :: uu____3167 in + (FStar_Getopt.noshort, "extract", (Accumulated - (PostProcessed - (pp_lowercase, - (SimpleStr "module_name")))), - "Only extract the specified modules (instead of the possibly-partial dependency graph)") - :: uu____3135 in - uu____3113 :: uu____3124 in + (SimpleStr + "One or more space-separated occurrences of '[+|-]( * | namespace | module)'")), + "\n\t\tExtract only those modules whose names or namespaces match the provided options.\n\t\t\tModules can be extracted or not using the [+|-] qualifier. \n\t\t\tFor example --extract '* -FStar.Reflection +FStar.List -FStar.List.Tot' will \n\t\t\t\tnot extract FStar.List.Tot.*, \n\t\t\t\textract remaining modules from FStar.List.*, \n\t\t\t\tnot extract FStar.Reflection.*, \n\t\t\t\tand extract all the rest.\n\t\tNote, the '+' is optional: --extract '+A' and --extract 'A' mean the same thing.\n\t\tMultiple uses of this option accumulate, e.g., --extract A --extract B is interpreted as --extract 'A B'.") + :: uu____3156 in + uu____3134 :: uu____3145 in (FStar_Getopt.noshort, "dump_module", (Accumulated (SimpleStr "module_name")), "") :: - uu____3102 in - uu____3080 :: uu____3091 in - uu____3058 :: uu____3069 in - uu____3036 :: uu____3047 in + uu____3123 in + uu____3101 :: uu____3112 in + uu____3079 :: uu____3090 in + uu____3057 :: uu____3068 in (FStar_Getopt.noshort, "dep", (EnumStr ["make"; "graph"; "full"]), "Output the transitive closure of the full dependency graph in three formats:\n\t 'graph': a format suitable the 'dot' tool from 'GraphViz'\n\t 'full': a format suitable for 'make', including dependences for producing .ml and .krml files\n\t 'make': (deprecated) a format suitable for 'make', including only dependences among source files") - :: uu____3025 in + :: uu____3046 in (FStar_Getopt.noshort, "debug_level", (Accumulated (OpenEnumStr (["Low"; "Medium"; "High"; "Extreme"], "..."))), - "Control the verbosity of debugging info") :: uu____3014 in + "Control the verbosity of debugging info") :: uu____3035 in (FStar_Getopt.noshort, "debug", (Accumulated (SimpleStr "module_name")), "Print lots of debugging information while checking module") - :: uu____3003 in + :: uu____3024 in (FStar_Getopt.noshort, "codegen-lib", (Accumulated (SimpleStr "namespace")), "External runtime library (i.e. M.N.x extracts to M.N.X instead of M_N.x)") - :: uu____2992 in + :: uu____3013 in (FStar_Getopt.noshort, "codegen", (EnumStr ["OCaml"; "FSharp"; "Kremlin"; "tactics"]), - "Generate code for execution") :: uu____2981 in - uu____2959 :: uu____2970 in + "Generate code for execution") :: uu____3002 in + uu____2980 :: uu____2991 in (FStar_Getopt.noshort, "admit_except", (SimpleStr "[symbol|(symbol, id)]"), "Admit all queries, except those with label (, )) (e.g. --admit_except '(FStar.Fin.pigeonhole, 1)' or --admit_except FStar.Fin.pigeonhole)") - :: uu____2948 in + :: uu____2969 in (FStar_Getopt.noshort, "admit_smt_queries", BoolStr, - "Admit SMT queries, unsafe! (default 'false')") :: uu____2937 + "Admit SMT queries, unsafe! (default 'false')") :: uu____2958 and specs: Prims.unit -> FStar_Getopt.opt Prims.list = - fun uu____5073 -> - let uu____5076 = specs_with_types () in + fun uu____5113 -> + let uu____5116 = specs_with_types () in FStar_List.map - (fun uu____5101 -> - match uu____5101 with + (fun uu____5141 -> + match uu____5141 with | (short,long,typ,doc) -> - let uu____5114 = - let uu____5125 = arg_spec_of_opt_type long typ in - (short, long, uu____5125, doc) in - mk_spec uu____5114) uu____5076 + let uu____5154 = + let uu____5165 = arg_spec_of_opt_type long typ in + (short, long, uu____5165, doc) in + mk_spec uu____5154) uu____5116 let settable: Prims.string -> Prims.bool = - fun uu___35_5132 -> - match uu___35_5132 with + fun uu___40_5172 -> + match uu___40_5172 with | "admit_smt_queries" -> true | "admit_except" -> true | "debug" -> true @@ -1859,7 +1880,6 @@ let settable: Prims.string -> Prims.bool = | "smtencoding.elim_box" -> true | "smtencoding.nl_arith_repr" -> true | "smtencoding.l_arith_repr" -> true - | "split_cases" -> true | "timing" -> true | "trace_error" -> true | "unthrottle_inductives" -> true @@ -1875,7 +1895,8 @@ let settable: Prims.string -> Prims.bool = | "z3rlimit" -> true | "z3refresh" -> true | "use_two_phase_tc" -> true - | uu____5133 -> false + | "vcgen.optimize_bind_as_seq" -> true + | uu____5173 -> false let resettable: Prims.string -> Prims.bool = fun s -> (((settable s) || (s = "z3seed")) || (s = "z3cliopt")) || @@ -1891,42 +1912,42 @@ let settable_specs: = FStar_All.pipe_right all_specs (FStar_List.filter - (fun uu____5190 -> - match uu____5190 with - | (uu____5201,x,uu____5203,uu____5204) -> settable x)) + (fun uu____5230 -> + match uu____5230 with + | (uu____5241,x,uu____5243,uu____5244) -> settable x)) let resettable_specs: (FStar_BaseTypes.char,Prims.string,Prims.unit FStar_Getopt.opt_variant, Prims.string) FStar_Pervasives_Native.tuple4 Prims.list = FStar_All.pipe_right all_specs (FStar_List.filter - (fun uu____5250 -> - match uu____5250 with - | (uu____5261,x,uu____5263,uu____5264) -> resettable x)) + (fun uu____5290 -> + match uu____5290 with + | (uu____5301,x,uu____5303,uu____5304) -> resettable x)) let display_usage: Prims.unit -> Prims.unit = - fun uu____5271 -> - let uu____5272 = specs () in display_usage_aux uu____5272 + fun uu____5311 -> + let uu____5312 = specs () in display_usage_aux uu____5312 let fstar_home: Prims.unit -> Prims.string = - fun uu____5287 -> - let uu____5288 = get_fstar_home () in - match uu____5288 with + fun uu____5327 -> + let uu____5328 = get_fstar_home () in + match uu____5328 with | FStar_Pervasives_Native.None -> let x = FStar_Util.get_exec_dir () in let x1 = Prims.strcat x "/.." in - ((let uu____5294 = - let uu____5299 = mk_string x1 in ("fstar_home", uu____5299) in - set_option' uu____5294); + ((let uu____5334 = + let uu____5339 = mk_string x1 in ("fstar_home", uu____5339) in + set_option' uu____5334); x1) | FStar_Pervasives_Native.Some x -> x exception File_argument of Prims.string let uu___is_File_argument: Prims.exn -> Prims.bool = fun projectee -> match projectee with - | File_argument uu____5307 -> true - | uu____5308 -> false + | File_argument uu____5347 -> true + | uu____5348 -> false let __proj__File_argument__item__uu___: Prims.exn -> Prims.string = fun projectee -> - match projectee with | File_argument uu____5315 -> uu____5315 + match projectee with | File_argument uu____5355 -> uu____5355 let set_options: options -> Prims.string -> FStar_Getopt.parse_cmdline_res = fun o -> fun s -> @@ -1943,407 +1964,455 @@ let set_options: options -> Prims.string -> FStar_Getopt.parse_cmdline_res = (fun s1 -> FStar_Exn.raise (File_argument s1)) s with | File_argument s1 -> - let uu____5359 = + let uu____5399 = FStar_Util.format1 "File %s is not a valid option" s1 in - FStar_Getopt.Error uu____5359 + FStar_Getopt.Error uu____5399 let file_list_: Prims.string Prims.list FStar_ST.ref = FStar_Util.mk_ref [] let parse_cmd_line: Prims.unit -> (FStar_Getopt.parse_cmdline_res,Prims.string Prims.list) FStar_Pervasives_Native.tuple2 = - fun uu____5385 -> + fun uu____5425 -> let res = FStar_Getopt.parse_cmdline all_specs (fun i -> - let uu____5390 = - let uu____5393 = FStar_ST.op_Bang file_list_ in - FStar_List.append uu____5393 [i] in - FStar_ST.op_Colon_Equals file_list_ uu____5390) in - let uu____5500 = - let uu____5503 = FStar_ST.op_Bang file_list_ in - FStar_List.map FStar_Common.try_convert_file_name_to_mixed uu____5503 in - (res, uu____5500) + let uu____5430 = + let uu____5433 = FStar_ST.op_Bang file_list_ in + FStar_List.append uu____5433 [i] in + FStar_ST.op_Colon_Equals file_list_ uu____5430) in + let uu____5540 = + let uu____5543 = FStar_ST.op_Bang file_list_ in + FStar_List.map FStar_Common.try_convert_file_name_to_mixed uu____5543 in + (res, uu____5540) let file_list: Prims.unit -> Prims.string Prims.list = - fun uu____5564 -> FStar_ST.op_Bang file_list_ + fun uu____5604 -> FStar_ST.op_Bang file_list_ let restore_cmd_line_options: Prims.bool -> FStar_Getopt.parse_cmdline_res = fun should_clear -> let old_verify_module = get_verify_module () in if should_clear then clear () else init (); (let r = - let uu____5626 = specs () in - FStar_Getopt.parse_cmdline uu____5626 (fun x -> ()) in - (let uu____5632 = - let uu____5637 = - let uu____5638 = FStar_List.map mk_string old_verify_module in - List uu____5638 in - ("verify_module", uu____5637) in - set_option' uu____5632); + let uu____5666 = specs () in + FStar_Getopt.parse_cmdline uu____5666 (fun x -> ()) in + (let uu____5672 = + let uu____5677 = + let uu____5678 = FStar_List.map mk_string old_verify_module in + List uu____5678 in + ("verify_module", uu____5677) in + set_option' uu____5672); r) let module_name_of_file_name: Prims.string -> Prims.string = fun f -> let f1 = FStar_Util.basename f in let f2 = - let uu____5646 = - let uu____5647 = - let uu____5648 = - let uu____5649 = FStar_Util.get_file_extension f1 in - FStar_String.length uu____5649 in - (FStar_String.length f1) - uu____5648 in - uu____5647 - (Prims.parse_int "1") in - FStar_String.substring f1 (Prims.parse_int "0") uu____5646 in + let uu____5686 = + let uu____5687 = + let uu____5688 = + let uu____5689 = FStar_Util.get_file_extension f1 in + FStar_String.length uu____5689 in + (FStar_String.length f1) - uu____5688 in + uu____5687 - (Prims.parse_int "1") in + FStar_String.substring f1 (Prims.parse_int "0") uu____5686 in FStar_String.lowercase f2 let should_verify: Prims.string -> Prims.bool = fun m -> - let uu____5653 = get_lax () in - if uu____5653 + let uu____5693 = get_lax () in + if uu____5693 then false else (let l = get_verify_module () in FStar_List.contains (FStar_String.lowercase m) l) let should_verify_file: Prims.string -> Prims.bool = fun fn -> - let uu____5661 = module_name_of_file_name fn in should_verify uu____5661 + let uu____5701 = module_name_of_file_name fn in should_verify uu____5701 let dont_gen_projectors: Prims.string -> Prims.bool = fun m -> - let uu____5665 = get___temp_no_proj () in - FStar_List.contains m uu____5665 + let uu____5705 = get___temp_no_proj () in + FStar_List.contains m uu____5705 let should_print_message: Prims.string -> Prims.bool = fun m -> - let uu____5671 = should_verify m in - if uu____5671 then m <> "Prims" else false + let uu____5711 = should_verify m in + if uu____5711 then m <> "Prims" else false let include_path: Prims.unit -> Prims.string Prims.list = - fun uu____5677 -> - let uu____5678 = get_no_default_includes () in - if uu____5678 + fun uu____5717 -> + let uu____5718 = get_no_default_includes () in + if uu____5718 then get_include () else (let h = fstar_home () in let defs = universe_include_path_base_dirs in - let uu____5686 = - let uu____5689 = + let uu____5726 = + let uu____5729 = FStar_All.pipe_right defs (FStar_List.map (fun x -> Prims.strcat h x)) in - FStar_All.pipe_right uu____5689 + FStar_All.pipe_right uu____5729 (FStar_List.filter FStar_Util.file_exists) in - let uu____5702 = - let uu____5705 = get_include () in - FStar_List.append uu____5705 ["."] in - FStar_List.append uu____5686 uu____5702) + let uu____5742 = + let uu____5745 = get_include () in + FStar_List.append uu____5745 ["."] in + FStar_List.append uu____5726 uu____5742) let find_file: Prims.string -> Prims.string FStar_Pervasives_Native.option = fun filename -> - let uu____5713 = FStar_Util.is_path_absolute filename in - if uu____5713 + let uu____5753 = FStar_Util.is_path_absolute filename in + if uu____5753 then (if FStar_Util.file_exists filename then FStar_Pervasives_Native.Some filename else FStar_Pervasives_Native.None) else - (let uu____5720 = - let uu____5723 = include_path () in FStar_List.rev uu____5723 in - FStar_Util.find_map uu____5720 + (let uu____5760 = + let uu____5763 = include_path () in FStar_List.rev uu____5763 in + FStar_Util.find_map uu____5760 (fun p -> let path = FStar_Util.join_paths p filename in if FStar_Util.file_exists path then FStar_Pervasives_Native.Some path else FStar_Pervasives_Native.None)) let prims: Prims.unit -> Prims.string = - fun uu____5735 -> - let uu____5736 = get_prims () in - match uu____5736 with + fun uu____5775 -> + let uu____5776 = get_prims () in + match uu____5776 with | FStar_Pervasives_Native.None -> let filename = "prims.fst" in - let uu____5740 = find_file filename in - (match uu____5740 with + let uu____5780 = find_file filename in + (match uu____5780 with | FStar_Pervasives_Native.Some result -> result | FStar_Pervasives_Native.None -> - let uu____5744 = + let uu____5784 = FStar_Util.format1 "unable to find required file \"%s\" in the module search path.\n" filename in - failwith uu____5744) + failwith uu____5784) | FStar_Pervasives_Native.Some x -> x let prims_basename: Prims.unit -> Prims.string = - fun uu____5748 -> - let uu____5749 = prims () in FStar_Util.basename uu____5749 + fun uu____5788 -> + let uu____5789 = prims () in FStar_Util.basename uu____5789 let pervasives: Prims.unit -> Prims.string = - fun uu____5752 -> + fun uu____5792 -> let filename = "FStar.Pervasives.fst" in - let uu____5754 = find_file filename in - match uu____5754 with + let uu____5794 = find_file filename in + match uu____5794 with | FStar_Pervasives_Native.Some result -> result | FStar_Pervasives_Native.None -> - let uu____5758 = + let uu____5798 = FStar_Util.format1 "unable to find required file \"%s\" in the module search path.\n" filename in - failwith uu____5758 + failwith uu____5798 let pervasives_basename: Prims.unit -> Prims.string = - fun uu____5761 -> - let uu____5762 = pervasives () in FStar_Util.basename uu____5762 + fun uu____5801 -> + let uu____5802 = pervasives () in FStar_Util.basename uu____5802 let pervasives_native_basename: Prims.unit -> Prims.string = - fun uu____5765 -> + fun uu____5805 -> let filename = "FStar.Pervasives.Native.fst" in - let uu____5767 = find_file filename in - match uu____5767 with + let uu____5807 = find_file filename in + match uu____5807 with | FStar_Pervasives_Native.Some result -> FStar_Util.basename result | FStar_Pervasives_Native.None -> - let uu____5771 = + let uu____5811 = FStar_Util.format1 "unable to find required file \"%s\" in the module search path.\n" filename in - failwith uu____5771 + failwith uu____5811 let prepend_output_dir: Prims.string -> Prims.string = fun fname -> - let uu____5775 = get_odir () in - match uu____5775 with + let uu____5815 = get_odir () in + match uu____5815 with | FStar_Pervasives_Native.None -> fname | FStar_Pervasives_Native.Some x -> Prims.strcat x (Prims.strcat "/" fname) +let parse_settings: + Prims.string Prims.list -> + (Prims.string Prims.list,Prims.bool) FStar_Pervasives_Native.tuple2 + Prims.list + = + fun ns -> + let parse_one_setting s = + if s = "*" + then ([], true) + else + if FStar_Util.starts_with s "-" + then + (let path = + let uu____5870 = + FStar_Util.substring_from s (Prims.parse_int "1") in + FStar_Ident.path_of_text uu____5870 in + (path, false)) + else + (let s1 = + if FStar_Util.starts_with s "+" + then FStar_Util.substring_from s (Prims.parse_int "1") + else s in + ((FStar_Ident.path_of_text s1), true)) in + let uu____5878 = + FStar_All.pipe_right ns + (FStar_List.collect + (fun s -> + FStar_All.pipe_right (FStar_Util.split s " ") + (FStar_List.map parse_one_setting))) in + FStar_All.pipe_right uu____5878 FStar_List.rev let __temp_no_proj: Prims.string -> Prims.bool = fun s -> - let uu____5782 = get___temp_no_proj () in - FStar_All.pipe_right uu____5782 (FStar_List.contains s) + let uu____5946 = get___temp_no_proj () in + FStar_All.pipe_right uu____5946 (FStar_List.contains s) let admit_smt_queries: Prims.unit -> Prims.bool = - fun uu____5789 -> get_admit_smt_queries () + fun uu____5953 -> get_admit_smt_queries () let admit_except: Prims.unit -> Prims.string FStar_Pervasives_Native.option = - fun uu____5794 -> get_admit_except () + fun uu____5958 -> get_admit_except () let cache_checked_modules: Prims.unit -> Prims.bool = - fun uu____5797 -> get_cache_checked_modules () + fun uu____5961 -> get_cache_checked_modules () let codegen: Prims.unit -> Prims.string FStar_Pervasives_Native.option = - fun uu____5802 -> get_codegen () + fun uu____5966 -> get_codegen () let codegen_libs: Prims.unit -> Prims.string Prims.list Prims.list = - fun uu____5809 -> - let uu____5810 = get_codegen_lib () in - FStar_All.pipe_right uu____5810 + fun uu____5973 -> + let uu____5974 = get_codegen_lib () in + FStar_All.pipe_right uu____5974 (FStar_List.map (fun x -> FStar_Util.split x ".")) let debug_any: Prims.unit -> Prims.bool = - fun uu____5825 -> let uu____5826 = get_debug () in uu____5826 <> [] + fun uu____5989 -> let uu____5990 = get_debug () in uu____5990 <> [] let debug_at_level: Prims.string -> debug_level_t -> Prims.bool = fun modul -> fun level -> - (let uu____5839 = get_debug () in - FStar_All.pipe_right uu____5839 (FStar_List.contains modul)) && + (let uu____6003 = get_debug () in + FStar_All.pipe_right uu____6003 (FStar_List.contains modul)) && (debug_level_geq level) let dep: Prims.unit -> Prims.string FStar_Pervasives_Native.option = - fun uu____5848 -> get_dep () + fun uu____6012 -> get_dep () let detail_errors: Prims.unit -> Prims.bool = - fun uu____5851 -> get_detail_errors () + fun uu____6015 -> get_detail_errors () let detail_hint_replay: Prims.unit -> Prims.bool = - fun uu____5854 -> get_detail_hint_replay () -let doc: Prims.unit -> Prims.bool = fun uu____5857 -> get_doc () + fun uu____6018 -> get_detail_hint_replay () +let doc: Prims.unit -> Prims.bool = fun uu____6021 -> get_doc () let dump_module: Prims.string -> Prims.bool = fun s -> - let uu____5861 = get_dump_module () in - FStar_All.pipe_right uu____5861 (FStar_List.contains s) + let uu____6025 = get_dump_module () in + FStar_All.pipe_right uu____6025 (FStar_List.contains s) let eager_inference: Prims.unit -> Prims.bool = - fun uu____5868 -> get_eager_inference () + fun uu____6032 -> get_eager_inference () let expose_interfaces: Prims.unit -> Prims.bool = - fun uu____5871 -> get_expose_interfaces () + fun uu____6035 -> get_expose_interfaces () let fs_typ_app: Prims.string -> Prims.bool = fun filename -> - let uu____5875 = FStar_ST.op_Bang light_off_files in - FStar_List.contains filename uu____5875 + let uu____6039 = FStar_ST.op_Bang light_off_files in + FStar_List.contains filename uu____6039 let gen_native_tactics: Prims.unit -> Prims.string FStar_Pervasives_Native.option = - fun uu____5934 -> get_gen_native_tactics () + fun uu____6098 -> get_gen_native_tactics () let full_context_dependency: Prims.unit -> Prims.bool = - fun uu____5937 -> true + fun uu____6101 -> true let hide_uvar_nums: Prims.unit -> Prims.bool = - fun uu____5940 -> get_hide_uvar_nums () + fun uu____6104 -> get_hide_uvar_nums () let hint_info: Prims.unit -> Prims.bool = - fun uu____5943 -> (get_hint_info ()) || (get_query_stats ()) + fun uu____6107 -> (get_hint_info ()) || (get_query_stats ()) let hint_file: Prims.unit -> Prims.string FStar_Pervasives_Native.option = - fun uu____5948 -> get_hint_file () -let ide: Prims.unit -> Prims.bool = fun uu____5951 -> get_ide () -let indent: Prims.unit -> Prims.bool = fun uu____5954 -> get_indent () + fun uu____6112 -> get_hint_file () +let ide: Prims.unit -> Prims.bool = fun uu____6115 -> get_ide () +let indent: Prims.unit -> Prims.bool = fun uu____6118 -> get_indent () let initial_fuel: Prims.unit -> Prims.int = - fun uu____5957 -> - let uu____5958 = get_initial_fuel () in - let uu____5959 = get_max_fuel () in Prims.min uu____5958 uu____5959 + fun uu____6121 -> + let uu____6122 = get_initial_fuel () in + let uu____6123 = get_max_fuel () in Prims.min uu____6122 uu____6123 let initial_ifuel: Prims.unit -> Prims.int = - fun uu____5962 -> - let uu____5963 = get_initial_ifuel () in - let uu____5964 = get_max_ifuel () in Prims.min uu____5963 uu____5964 + fun uu____6126 -> + let uu____6127 = get_initial_ifuel () in + let uu____6128 = get_max_ifuel () in Prims.min uu____6127 uu____6128 let interactive: Prims.unit -> Prims.bool = - fun uu____5967 -> (get_in ()) || (get_ide ()) -let lax: Prims.unit -> Prims.bool = fun uu____5970 -> get_lax () + fun uu____6131 -> (get_in ()) || (get_ide ()) +let lax: Prims.unit -> Prims.bool = fun uu____6134 -> get_lax () let load: Prims.unit -> Prims.string Prims.list = - fun uu____5975 -> get_load () + fun uu____6139 -> get_load () let legacy_interactive: Prims.unit -> Prims.bool = - fun uu____5978 -> get_in () + fun uu____6142 -> get_in () let log_queries: Prims.unit -> Prims.bool = - fun uu____5981 -> get_log_queries () -let log_types: Prims.unit -> Prims.bool = fun uu____5984 -> get_log_types () -let max_fuel: Prims.unit -> Prims.int = fun uu____5987 -> get_max_fuel () -let max_ifuel: Prims.unit -> Prims.int = fun uu____5990 -> get_max_ifuel () -let min_fuel: Prims.unit -> Prims.int = fun uu____5993 -> get_min_fuel () -let ml_ish: Prims.unit -> Prims.bool = fun uu____5996 -> get_MLish () + fun uu____6145 -> get_log_queries () +let log_types: Prims.unit -> Prims.bool = fun uu____6148 -> get_log_types () +let max_fuel: Prims.unit -> Prims.int = fun uu____6151 -> get_max_fuel () +let max_ifuel: Prims.unit -> Prims.int = fun uu____6154 -> get_max_ifuel () +let min_fuel: Prims.unit -> Prims.int = fun uu____6157 -> get_min_fuel () +let ml_ish: Prims.unit -> Prims.bool = fun uu____6160 -> get_MLish () let set_ml_ish: Prims.unit -> Prims.unit = - fun uu____5999 -> set_option "MLish" (Bool true) -let n_cores: Prims.unit -> Prims.int = fun uu____6002 -> get_n_cores () + fun uu____6163 -> set_option "MLish" (Bool true) +let n_cores: Prims.unit -> Prims.int = fun uu____6166 -> get_n_cores () let no_default_includes: Prims.unit -> Prims.bool = - fun uu____6005 -> get_no_default_includes () + fun uu____6169 -> get_no_default_includes () let no_extract: Prims.string -> Prims.bool = fun s -> let s1 = FStar_String.lowercase s in - let uu____6010 = get_no_extract () in - FStar_All.pipe_right uu____6010 + let uu____6174 = get_no_extract () in + FStar_All.pipe_right uu____6174 (FStar_Util.for_some (fun f -> (FStar_String.lowercase f) = s1)) let no_location_info: Prims.unit -> Prims.bool = - fun uu____6019 -> get_no_location_info () + fun uu____6183 -> get_no_location_info () let output_dir: Prims.unit -> Prims.string FStar_Pervasives_Native.option = - fun uu____6024 -> get_odir () -let ugly: Prims.unit -> Prims.bool = fun uu____6027 -> get_ugly () + fun uu____6188 -> get_odir () +let ugly: Prims.unit -> Prims.bool = fun uu____6191 -> get_ugly () let print_bound_var_types: Prims.unit -> Prims.bool = - fun uu____6030 -> get_print_bound_var_types () + fun uu____6194 -> get_print_bound_var_types () let print_effect_args: Prims.unit -> Prims.bool = - fun uu____6033 -> get_print_effect_args () + fun uu____6197 -> get_print_effect_args () let print_implicits: Prims.unit -> Prims.bool = - fun uu____6036 -> get_print_implicits () + fun uu____6200 -> get_print_implicits () let print_real_names: Prims.unit -> Prims.bool = - fun uu____6039 -> (get_prn ()) || (get_print_full_names ()) + fun uu____6203 -> (get_prn ()) || (get_print_full_names ()) let print_universes: Prims.unit -> Prims.bool = - fun uu____6042 -> get_print_universes () + fun uu____6206 -> get_print_universes () let print_z3_statistics: Prims.unit -> Prims.bool = - fun uu____6045 -> (get_print_z3_statistics ()) || (get_query_stats ()) + fun uu____6209 -> (get_print_z3_statistics ()) || (get_query_stats ()) let query_stats: Prims.unit -> Prims.bool = - fun uu____6048 -> get_query_stats () + fun uu____6212 -> get_query_stats () let record_hints: Prims.unit -> Prims.bool = - fun uu____6051 -> get_record_hints () + fun uu____6215 -> get_record_hints () let reuse_hint_for: Prims.unit -> Prims.string FStar_Pervasives_Native.option - = fun uu____6056 -> get_reuse_hint_for () -let silent: Prims.unit -> Prims.bool = fun uu____6059 -> get_silent () + = fun uu____6220 -> get_reuse_hint_for () +let silent: Prims.unit -> Prims.bool = fun uu____6223 -> get_silent () let smtencoding_elim_box: Prims.unit -> Prims.bool = - fun uu____6062 -> get_smtencoding_elim_box () + fun uu____6226 -> get_smtencoding_elim_box () let smtencoding_nl_arith_native: Prims.unit -> Prims.bool = - fun uu____6065 -> - let uu____6066 = get_smtencoding_nl_arith_repr () in - uu____6066 = "native" + fun uu____6229 -> + let uu____6230 = get_smtencoding_nl_arith_repr () in + uu____6230 = "native" let smtencoding_nl_arith_wrapped: Prims.unit -> Prims.bool = - fun uu____6069 -> - let uu____6070 = get_smtencoding_nl_arith_repr () in - uu____6070 = "wrapped" + fun uu____6233 -> + let uu____6234 = get_smtencoding_nl_arith_repr () in + uu____6234 = "wrapped" let smtencoding_nl_arith_default: Prims.unit -> Prims.bool = - fun uu____6073 -> - let uu____6074 = get_smtencoding_nl_arith_repr () in - uu____6074 = "boxwrap" + fun uu____6237 -> + let uu____6238 = get_smtencoding_nl_arith_repr () in + uu____6238 = "boxwrap" let smtencoding_l_arith_native: Prims.unit -> Prims.bool = - fun uu____6077 -> - let uu____6078 = get_smtencoding_l_arith_repr () in uu____6078 = "native" + fun uu____6241 -> + let uu____6242 = get_smtencoding_l_arith_repr () in uu____6242 = "native" let smtencoding_l_arith_default: Prims.unit -> Prims.bool = - fun uu____6081 -> - let uu____6082 = get_smtencoding_l_arith_repr () in - uu____6082 = "boxwrap" -let split_cases: Prims.unit -> Prims.int = - fun uu____6085 -> get_split_cases () + fun uu____6245 -> + let uu____6246 = get_smtencoding_l_arith_repr () in + uu____6246 = "boxwrap" let tactic_raw_binders: Prims.unit -> Prims.bool = - fun uu____6088 -> get_tactic_raw_binders () + fun uu____6249 -> get_tactic_raw_binders () let tactic_trace: Prims.unit -> Prims.bool = - fun uu____6091 -> get_tactic_trace () + fun uu____6252 -> get_tactic_trace () let tactic_trace_d: Prims.unit -> Prims.int = - fun uu____6094 -> get_tactic_trace_d () -let timing: Prims.unit -> Prims.bool = fun uu____6097 -> get_timing () + fun uu____6255 -> get_tactic_trace_d () +let timing: Prims.unit -> Prims.bool = fun uu____6258 -> get_timing () let trace_error: Prims.unit -> Prims.bool = - fun uu____6100 -> get_trace_error () + fun uu____6261 -> get_trace_error () let unthrottle_inductives: Prims.unit -> Prims.bool = - fun uu____6103 -> get_unthrottle_inductives () + fun uu____6264 -> get_unthrottle_inductives () let unsafe_tactic_exec: Prims.unit -> Prims.bool = - fun uu____6106 -> get_unsafe_tactic_exec () + fun uu____6267 -> get_unsafe_tactic_exec () let use_eq_at_higher_order: Prims.unit -> Prims.bool = - fun uu____6109 -> get_use_eq_at_higher_order () -let use_hints: Prims.unit -> Prims.bool = fun uu____6112 -> get_use_hints () + fun uu____6270 -> get_use_eq_at_higher_order () +let use_hints: Prims.unit -> Prims.bool = fun uu____6273 -> get_use_hints () let use_hint_hashes: Prims.unit -> Prims.bool = - fun uu____6115 -> get_use_hint_hashes () + fun uu____6276 -> get_use_hint_hashes () let use_native_tactics: Prims.unit -> Prims.string FStar_Pervasives_Native.option = - fun uu____6120 -> get_use_native_tactics () + fun uu____6281 -> get_use_native_tactics () let use_tactics: Prims.unit -> Prims.bool = - fun uu____6123 -> get_use_tactics () + fun uu____6284 -> get_use_tactics () let using_facts_from: Prims.unit -> (FStar_Ident.path,Prims.bool) FStar_Pervasives_Native.tuple2 Prims.list = - fun uu____6132 -> - let parse_one_setting s = - if s = "*" - then ([], true) - else - if FStar_Util.starts_with s "-" - then - (let path = - let uu____6161 = - FStar_Util.substring_from s (Prims.parse_int "1") in - FStar_Ident.path_of_text uu____6161 in - (path, false)) - else - (let s1 = - if FStar_Util.starts_with s "+" - then FStar_Util.substring_from s (Prims.parse_int "1") - else s in - ((FStar_Ident.path_of_text s1), true)) in - let parse_setting s = - FStar_All.pipe_right (FStar_Util.split s " ") - (FStar_List.map parse_one_setting) in - let uu____6197 = get_using_facts_from () in - match uu____6197 with + fun uu____6293 -> + let uu____6294 = get_using_facts_from () in + match uu____6294 with | FStar_Pervasives_Native.None -> [([], true)] - | FStar_Pervasives_Native.Some ns -> - let uu____6229 = FStar_List.collect parse_setting ns in - FStar_All.pipe_right uu____6229 FStar_List.rev + | FStar_Pervasives_Native.Some ns -> parse_settings ns +let vcgen_optimize_bind_as_seq: Prims.unit -> Prims.bool = + fun uu____6328 -> + let uu____6329 = get_vcgen_optimize_bind_as_seq () in + FStar_Option.isSome uu____6329 +let vcgen_decorate_with_type: Prims.unit -> Prims.bool = + fun uu____6334 -> + let uu____6335 = get_vcgen_optimize_bind_as_seq () in + match uu____6335 with + | FStar_Pervasives_Native.Some "with_type" -> true + | uu____6338 -> false let warn_default_effects: Prims.unit -> Prims.bool = - fun uu____6268 -> get_warn_default_effects () + fun uu____6343 -> get_warn_default_effects () let z3_exe: Prims.unit -> Prims.string = - fun uu____6271 -> - let uu____6272 = get_smt () in - match uu____6272 with + fun uu____6346 -> + let uu____6347 = get_smt () in + match uu____6347 with | FStar_Pervasives_Native.None -> FStar_Platform.exe "z3" | FStar_Pervasives_Native.Some s -> s let z3_cliopt: Prims.unit -> Prims.string Prims.list = - fun uu____6280 -> get_z3cliopt () + fun uu____6355 -> get_z3cliopt () let z3_refresh: Prims.unit -> Prims.bool = - fun uu____6283 -> get_z3refresh () -let z3_rlimit: Prims.unit -> Prims.int = fun uu____6286 -> get_z3rlimit () + fun uu____6358 -> get_z3refresh () +let z3_rlimit: Prims.unit -> Prims.int = fun uu____6361 -> get_z3rlimit () let z3_rlimit_factor: Prims.unit -> Prims.int = - fun uu____6289 -> get_z3rlimit_factor () -let z3_seed: Prims.unit -> Prims.int = fun uu____6292 -> get_z3seed () + fun uu____6364 -> get_z3rlimit_factor () +let z3_seed: Prims.unit -> Prims.int = fun uu____6367 -> get_z3seed () let use_two_phase_tc: Prims.unit -> Prims.bool = - fun uu____6295 -> get_use_two_phase_tc () + fun uu____6370 -> get_use_two_phase_tc () let no_positivity: Prims.unit -> Prims.bool = - fun uu____6298 -> get_no_positivity () + fun uu____6373 -> get_no_positivity () let ml_no_eta_expand_coertions: Prims.unit -> Prims.bool = - fun uu____6301 -> get_ml_no_eta_expand_coertions () + fun uu____6376 -> get_ml_no_eta_expand_coertions () let warn_error: Prims.unit -> Prims.string = - fun uu____6304 -> get_warn_error () -let should_extract_namespace: Prims.string -> Prims.bool = - fun m -> - let uu____6308 = get_extract_namespace () in - match uu____6308 with - | [] -> false - | ns -> - FStar_All.pipe_right ns - (FStar_Util.for_some - (fun n1 -> FStar_Util.starts_with m (FStar_String.lowercase n1))) -let should_extract_module: Prims.string -> Prims.bool = - fun m -> - let uu____6321 = get_extract_module () in - match uu____6321 with - | [] -> false - | l -> - FStar_All.pipe_right l - (FStar_Util.for_some (fun n1 -> (FStar_String.lowercase n1) = m)) + fun uu____6379 -> get_warn_error () let should_extract: Prims.string -> Prims.bool = fun m -> let m1 = FStar_String.lowercase m in - (let uu____6337 = no_extract m1 in Prims.op_Negation uu____6337) && - (let uu____6339 = - let uu____6348 = get_extract_namespace () in - let uu____6351 = get_extract_module () in (uu____6348, uu____6351) in - match uu____6339 with - | ([],[]) -> true - | uu____6362 -> - (should_extract_namespace m1) || (should_extract_module m1)) + let uu____6384 = get_extract () in + match uu____6384 with + | FStar_Pervasives_Native.Some extract_setting -> + ((let uu____6395 = + let uu____6408 = get_no_extract () in + let uu____6411 = get_extract_namespace () in + let uu____6414 = get_extract_module () in + (uu____6408, uu____6411, uu____6414) in + match uu____6395 with + | ([],[],[]) -> () + | uu____6429 -> + failwith + "Incompatible options: --extract cannot be used with --no_extract, --extract_namespace or --extract_module"); + (let setting = parse_settings extract_setting in + let m_components = FStar_Ident.path_of_text m1 in + let rec matches_path m_components1 path = + match (m_components1, path) with + | (uu____6473,[]) -> true + | (m2::ms,p::ps) -> + (m2 = (FStar_String.lowercase p)) && (matches_path ms ps) + | uu____6492 -> false in + let uu____6501 = + FStar_All.pipe_right setting + (FStar_Util.try_find + (fun uu____6535 -> + match uu____6535 with + | (path,uu____6543) -> matches_path m_components path)) in + match uu____6501 with + | FStar_Pervasives_Native.None -> false + | FStar_Pervasives_Native.Some (uu____6554,flag) -> flag)) + | FStar_Pervasives_Native.None -> + let should_extract_namespace m2 = + let uu____6572 = get_extract_namespace () in + match uu____6572 with + | [] -> false + | ns -> + FStar_All.pipe_right ns + (FStar_Util.for_some + (fun n1 -> + FStar_Util.starts_with m2 (FStar_String.lowercase n1))) in + let should_extract_module m2 = + let uu____6586 = get_extract_module () in + match uu____6586 with + | [] -> false + | l -> + FStar_All.pipe_right l + (FStar_Util.for_some + (fun n1 -> (FStar_String.lowercase n1) = m2)) in + (let uu____6598 = no_extract m1 in Prims.op_Negation uu____6598) && + (let uu____6600 = + let uu____6609 = get_extract_namespace () in + let uu____6612 = get_extract_module () in + (uu____6609, uu____6612) in + (match uu____6600 with + | ([],[]) -> true + | uu____6623 -> + (should_extract_namespace m1) || (should_extract_module m1))) let codegen_fsharp: Prims.unit -> Prims.bool = - fun uu____6373 -> - let uu____6374 = codegen () in - uu____6374 = (FStar_Pervasives_Native.Some "FSharp") \ No newline at end of file + fun uu____6634 -> + let uu____6635 = codegen () in + uu____6635 = (FStar_Pervasives_Native.Some "FSharp") \ No newline at end of file diff --git a/src/ocaml-output/FStar_Parser_Const.ml b/src/ocaml-output/FStar_Parser_Const.ml index b037608e2eb..e429ba29500 100644 --- a/src/ocaml-output/FStar_Parser_Const.ml +++ b/src/ocaml-output/FStar_Parser_Const.ml @@ -159,6 +159,7 @@ let range_0: FStar_Ident.lident = pconst "range_0" let guard_free: FStar_Ident.lident = pconst "guard_free" let inversion_lid: FStar_Ident.lident = p2l ["FStar"; "Pervasives"; "inversion"] +let with_type_lid: FStar_Ident.lident = pconst "with_type" let normalize: FStar_Ident.lident = pconst "normalize" let normalize_term: FStar_Ident.lident = pconst "normalize_term" let norm: FStar_Ident.lident = pconst "norm" diff --git a/src/ocaml-output/FStar_SMTEncoding_Encode.ml b/src/ocaml-output/FStar_SMTEncoding_Encode.ml index 45d1d8c0184..f1b95c6862f 100644 --- a/src/ocaml-output/FStar_SMTEncoding_Encode.ml +++ b/src/ocaml-output/FStar_SMTEncoding_Encode.ml @@ -24,27 +24,6 @@ let vargs: match uu___77_107 with | (FStar_Util.Inl uu____116,uu____117) -> false | uu____122 -> true) args -let subst_lcomp_opt: - 'Auu____134 . - FStar_Syntax_Syntax.subst_elt Prims.list -> - (FStar_Syntax_Syntax.lcomp,'Auu____134) FStar_Util.either - FStar_Pervasives_Native.option -> - (FStar_Syntax_Syntax.lcomp,'Auu____134) FStar_Util.either - FStar_Pervasives_Native.option - = - fun s -> - fun l -> - match l with - | FStar_Pervasives_Native.Some (FStar_Util.Inl l1) -> - let uu____170 = - let uu____175 = - let uu____176 = - let uu____179 = l1.FStar_Syntax_Syntax.comp () in - FStar_Syntax_Subst.subst_comp s uu____179 in - FStar_All.pipe_left FStar_Syntax_Util.lcomp_of_comp uu____176 in - FStar_Util.Inl uu____175 in - FStar_Pervasives_Native.Some uu____170 - | uu____186 -> l let escape: Prims.string -> Prims.string = fun s -> FStar_Util.replace_char s 39 95 let mk_term_projector_name: @@ -52,19 +31,19 @@ let mk_term_projector_name: fun lid -> fun a -> let a1 = - let uu___100_205 = a in - let uu____206 = + let uu___100_143 = a in + let uu____144 = FStar_Syntax_Util.unmangle_field_name a.FStar_Syntax_Syntax.ppname in { - FStar_Syntax_Syntax.ppname = uu____206; + FStar_Syntax_Syntax.ppname = uu____144; FStar_Syntax_Syntax.index = - (uu___100_205.FStar_Syntax_Syntax.index); - FStar_Syntax_Syntax.sort = (uu___100_205.FStar_Syntax_Syntax.sort) + (uu___100_143.FStar_Syntax_Syntax.index); + FStar_Syntax_Syntax.sort = (uu___100_143.FStar_Syntax_Syntax.sort) } in - let uu____207 = + let uu____145 = FStar_Util.format2 "%s_%s" lid.FStar_Ident.str (a1.FStar_Syntax_Syntax.ppname).FStar_Ident.idText in - FStar_All.pipe_left escape uu____207 + FStar_All.pipe_left escape uu____145 let primitive_projector_by_pos: FStar_TypeChecker_Env.env -> FStar_Ident.lident -> Prims.int -> Prims.string @@ -72,23 +51,23 @@ let primitive_projector_by_pos: fun env -> fun lid -> fun i -> - let fail uu____220 = - let uu____221 = + let fail uu____158 = + let uu____159 = FStar_Util.format2 "Projector %s on data constructor %s not found" (Prims.string_of_int i) lid.FStar_Ident.str in - failwith uu____221 in - let uu____222 = FStar_TypeChecker_Env.lookup_datacon env lid in - match uu____222 with - | (uu____227,t) -> - let uu____229 = - let uu____230 = FStar_Syntax_Subst.compress t in - uu____230.FStar_Syntax_Syntax.n in - (match uu____229 with + failwith uu____159 in + let uu____160 = FStar_TypeChecker_Env.lookup_datacon env lid in + match uu____160 with + | (uu____165,t) -> + let uu____167 = + let uu____168 = FStar_Syntax_Subst.compress t in + uu____168.FStar_Syntax_Syntax.n in + (match uu____167 with | FStar_Syntax_Syntax.Tm_arrow (bs,c) -> - let uu____251 = FStar_Syntax_Subst.open_comp bs c in - (match uu____251 with - | (binders,uu____257) -> + let uu____189 = FStar_Syntax_Subst.open_comp bs c in + (match uu____189 with + | (binders,uu____195) -> if (i < (Prims.parse_int "0")) || (i >= (FStar_List.length binders)) @@ -97,41 +76,41 @@ let primitive_projector_by_pos: (let b = FStar_List.nth binders i in mk_term_projector_name lid (FStar_Pervasives_Native.fst b))) - | uu____272 -> fail ()) + | uu____210 -> fail ()) let mk_term_projector_name_by_pos: FStar_Ident.lident -> Prims.int -> Prims.string = fun lid -> fun i -> - let uu____279 = + let uu____217 = FStar_Util.format2 "%s_%s" lid.FStar_Ident.str (Prims.string_of_int i) in - FStar_All.pipe_left escape uu____279 + FStar_All.pipe_left escape uu____217 let mk_term_projector: FStar_Ident.lident -> FStar_Syntax_Syntax.bv -> FStar_SMTEncoding_Term.term = fun lid -> fun a -> - let uu____286 = - let uu____291 = mk_term_projector_name lid a in - (uu____291, + let uu____224 = + let uu____229 = mk_term_projector_name lid a in + (uu____229, (FStar_SMTEncoding_Term.Arrow (FStar_SMTEncoding_Term.Term_sort, FStar_SMTEncoding_Term.Term_sort))) in - FStar_SMTEncoding_Util.mkFreeV uu____286 + FStar_SMTEncoding_Util.mkFreeV uu____224 let mk_term_projector_by_pos: FStar_Ident.lident -> Prims.int -> FStar_SMTEncoding_Term.term = fun lid -> fun i -> - let uu____298 = - let uu____303 = mk_term_projector_name_by_pos lid i in - (uu____303, + let uu____236 = + let uu____241 = mk_term_projector_name_by_pos lid i in + (uu____241, (FStar_SMTEncoding_Term.Arrow (FStar_SMTEncoding_Term.Term_sort, FStar_SMTEncoding_Term.Term_sort))) in - FStar_SMTEncoding_Util.mkFreeV uu____298 + FStar_SMTEncoding_Util.mkFreeV uu____236 let mk_data_tester: - 'Auu____308 . - 'Auu____308 -> + 'Auu____246 . + 'Auu____246 -> FStar_Ident.lident -> FStar_SMTEncoding_Term.term -> FStar_SMTEncoding_Term.term = @@ -212,77 +191,77 @@ let __proj__Mkvarops_t__item__mk_unique: let varops: varops_t = let initial_ctr = Prims.parse_int "100" in let ctr = FStar_Util.mk_ref initial_ctr in - let new_scope uu____672 = - let uu____673 = FStar_Util.smap_create (Prims.parse_int "100") in - let uu____676 = FStar_Util.smap_create (Prims.parse_int "100") in - (uu____673, uu____676) in + let new_scope uu____610 = + let uu____611 = FStar_Util.smap_create (Prims.parse_int "100") in + let uu____614 = FStar_Util.smap_create (Prims.parse_int "100") in + (uu____611, uu____614) in let scopes = - let uu____696 = let uu____707 = new_scope () in [uu____707] in - FStar_Util.mk_ref uu____696 in + let uu____634 = let uu____645 = new_scope () in [uu____645] in + FStar_Util.mk_ref uu____634 in let mk_unique y = let y1 = escape y in let y2 = - let uu____748 = - let uu____751 = FStar_ST.op_Bang scopes in - FStar_Util.find_map uu____751 - (fun uu____863 -> - match uu____863 with - | (names1,uu____875) -> FStar_Util.smap_try_find names1 y1) in - match uu____748 with + let uu____686 = + let uu____689 = FStar_ST.op_Bang scopes in + FStar_Util.find_map uu____689 + (fun uu____801 -> + match uu____801 with + | (names1,uu____813) -> FStar_Util.smap_try_find names1 y1) in + match uu____686 with | FStar_Pervasives_Native.None -> y1 - | FStar_Pervasives_Native.Some uu____884 -> + | FStar_Pervasives_Native.Some uu____822 -> (FStar_Util.incr ctr; - (let uu____919 = - let uu____920 = - let uu____921 = FStar_ST.op_Bang ctr in - Prims.string_of_int uu____921 in - Prims.strcat "__" uu____920 in - Prims.strcat y1 uu____919)) in + (let uu____857 = + let uu____858 = + let uu____859 = FStar_ST.op_Bang ctr in + Prims.string_of_int uu____859 in + Prims.strcat "__" uu____858 in + Prims.strcat y1 uu____857)) in let top_scope = - let uu____995 = - let uu____1004 = FStar_ST.op_Bang scopes in FStar_List.hd uu____1004 in - FStar_All.pipe_left FStar_Pervasives_Native.fst uu____995 in + let uu____933 = + let uu____942 = FStar_ST.op_Bang scopes in FStar_List.hd uu____942 in + FStar_All.pipe_left FStar_Pervasives_Native.fst uu____933 in FStar_Util.smap_add top_scope y2 true; y2 in let new_var pp rn = FStar_All.pipe_left mk_unique (Prims.strcat pp.FStar_Ident.idText (Prims.strcat "__" (Prims.string_of_int rn))) in let new_fvar lid = mk_unique lid.FStar_Ident.str in - let next_id1 uu____1142 = FStar_Util.incr ctr; FStar_ST.op_Bang ctr in + let next_id1 uu____1080 = FStar_Util.incr ctr; FStar_ST.op_Bang ctr in let fresh1 pfx = - let uu____1251 = - let uu____1252 = next_id1 () in - FStar_All.pipe_left Prims.string_of_int uu____1252 in - FStar_Util.format2 "%s_%s" pfx uu____1251 in + let uu____1189 = + let uu____1190 = next_id1 () in + FStar_All.pipe_left Prims.string_of_int uu____1190 in + FStar_Util.format2 "%s_%s" pfx uu____1189 in let string_const s = - let uu____1257 = - let uu____1260 = FStar_ST.op_Bang scopes in - FStar_Util.find_map uu____1260 - (fun uu____1372 -> - match uu____1372 with - | (uu____1383,strings) -> FStar_Util.smap_try_find strings s) in - match uu____1257 with + let uu____1195 = + let uu____1198 = FStar_ST.op_Bang scopes in + FStar_Util.find_map uu____1198 + (fun uu____1310 -> + match uu____1310 with + | (uu____1321,strings) -> FStar_Util.smap_try_find strings s) in + match uu____1195 with | FStar_Pervasives_Native.Some f -> f | FStar_Pervasives_Native.None -> let id1 = next_id1 () in let f = - let uu____1396 = FStar_SMTEncoding_Util.mk_String_const id1 in - FStar_All.pipe_left FStar_SMTEncoding_Term.boxString uu____1396 in + let uu____1334 = FStar_SMTEncoding_Util.mk_String_const id1 in + FStar_All.pipe_left FStar_SMTEncoding_Term.boxString uu____1334 in let top_scope = - let uu____1400 = - let uu____1409 = FStar_ST.op_Bang scopes in - FStar_List.hd uu____1409 in - FStar_All.pipe_left FStar_Pervasives_Native.snd uu____1400 in + let uu____1338 = + let uu____1347 = FStar_ST.op_Bang scopes in + FStar_List.hd uu____1347 in + FStar_All.pipe_left FStar_Pervasives_Native.snd uu____1338 in (FStar_Util.smap_add top_scope s f; f) in - let push1 uu____1536 = - let uu____1537 = - let uu____1548 = new_scope () in - let uu____1557 = FStar_ST.op_Bang scopes in uu____1548 :: uu____1557 in - FStar_ST.op_Colon_Equals scopes uu____1537 in - let pop1 uu____1759 = - let uu____1760 = - let uu____1771 = FStar_ST.op_Bang scopes in FStar_List.tl uu____1771 in - FStar_ST.op_Colon_Equals scopes uu____1760 in + let push1 uu____1474 = + let uu____1475 = + let uu____1486 = new_scope () in + let uu____1495 = FStar_ST.op_Bang scopes in uu____1486 :: uu____1495 in + FStar_ST.op_Colon_Equals scopes uu____1475 in + let pop1 uu____1697 = + let uu____1698 = + let uu____1709 = FStar_ST.op_Bang scopes in FStar_List.tl uu____1709 in + FStar_ST.op_Colon_Equals scopes uu____1698 in { push = push1; pop = pop1; @@ -295,13 +274,13 @@ let varops: varops_t = } let unmangle: FStar_Syntax_Syntax.bv -> FStar_Syntax_Syntax.bv = fun x -> - let uu___101_1973 = x in - let uu____1974 = + let uu___101_1911 = x in + let uu____1912 = FStar_Syntax_Util.unmangle_field_name x.FStar_Syntax_Syntax.ppname in { - FStar_Syntax_Syntax.ppname = uu____1974; - FStar_Syntax_Syntax.index = (uu___101_1973.FStar_Syntax_Syntax.index); - FStar_Syntax_Syntax.sort = (uu___101_1973.FStar_Syntax_Syntax.sort) + FStar_Syntax_Syntax.ppname = uu____1912; + FStar_Syntax_Syntax.index = (uu___101_1911.FStar_Syntax_Syntax.index); + FStar_Syntax_Syntax.sort = (uu___101_1911.FStar_Syntax_Syntax.sort) } type binding = | Binding_var of (FStar_Syntax_Syntax.bv,FStar_SMTEncoding_Term.term) @@ -313,7 +292,7 @@ type binding = FStar_Pervasives_Native.tuple4[@@deriving show] let uu___is_Binding_var: binding -> Prims.bool = fun projectee -> - match projectee with | Binding_var _0 -> true | uu____2007 -> false + match projectee with | Binding_var _0 -> true | uu____1945 -> false let __proj__Binding_var__item___0: binding -> (FStar_Syntax_Syntax.bv,FStar_SMTEncoding_Term.term) @@ -321,7 +300,7 @@ let __proj__Binding_var__item___0: = fun projectee -> match projectee with | Binding_var _0 -> _0 let uu___is_Binding_fvar: binding -> Prims.bool = fun projectee -> - match projectee with | Binding_fvar _0 -> true | uu____2043 -> false + match projectee with | Binding_fvar _0 -> true | uu____1981 -> false let __proj__Binding_fvar__item___0: binding -> (FStar_Ident.lident,Prims.string,FStar_SMTEncoding_Term.term @@ -330,9 +309,9 @@ let __proj__Binding_fvar__item___0: FStar_Pervasives_Native.tuple4 = fun projectee -> match projectee with | Binding_fvar _0 -> _0 let binder_of_eithervar: - 'Auu____2090 'Auu____2091 . - 'Auu____2091 -> - ('Auu____2091,'Auu____2090 FStar_Pervasives_Native.option) + 'Auu____2028 'Auu____2029 . + 'Auu____2029 -> + ('Auu____2029,'Auu____2028 FStar_Pervasives_Native.option) FStar_Pervasives_Native.tuple2 = fun v1 -> (v1, FStar_Pervasives_Native.None) type cache_entry = @@ -493,8 +472,8 @@ let __proj__Mkenv_t__item__current_module_name: env_t -> Prims.string = current_module_name = __fname__current_module_name;_} -> __fname__current_module_name let mk_cache_entry: - 'Auu____2387 . - 'Auu____2387 -> + 'Auu____2325 . + 'Auu____2325 -> Prims.string -> FStar_SMTEncoding_Term.sort Prims.list -> FStar_SMTEncoding_Term.decl Prims.list -> cache_entry @@ -506,11 +485,11 @@ let mk_cache_entry: let names1 = FStar_All.pipe_right t_decls (FStar_List.collect - (fun uu___78_2421 -> - match uu___78_2421 with + (fun uu___78_2359 -> + match uu___78_2359 with | FStar_SMTEncoding_Term.Assume a -> [a.FStar_SMTEncoding_Term.assumption_name] - | uu____2425 -> [])) in + | uu____2363 -> [])) in { cache_symbol_name = tsym; cache_symbol_arg_sorts = cvar_sorts; @@ -523,21 +502,21 @@ let use_cache_entry: cache_entry -> FStar_SMTEncoding_Term.decl Prims.list = (ce.cache_symbol_assumption_names)] let print_env: env_t -> Prims.string = fun e -> - let uu____2434 = + let uu____2372 = FStar_All.pipe_right e.bindings (FStar_List.map - (fun uu___79_2444 -> - match uu___79_2444 with - | Binding_var (x,uu____2446) -> + (fun uu___79_2382 -> + match uu___79_2382 with + | Binding_var (x,uu____2384) -> FStar_Syntax_Print.bv_to_string x - | Binding_fvar (l,uu____2448,uu____2449,uu____2450) -> + | Binding_fvar (l,uu____2386,uu____2387,uu____2388) -> FStar_Syntax_Print.lid_to_string l)) in - FStar_All.pipe_right uu____2434 (FStar_String.concat ", ") + FStar_All.pipe_right uu____2372 (FStar_String.concat ", ") let lookup_binding: - 'Auu____2464 . + 'Auu____2402 . env_t -> - (binding -> 'Auu____2464 FStar_Pervasives_Native.option) -> - 'Auu____2464 FStar_Pervasives_Native.option + (binding -> 'Auu____2402 FStar_Pervasives_Native.option) -> + 'Auu____2402 FStar_Pervasives_Native.option = fun env -> fun f -> FStar_Util.find_map env.bindings f let caption_t: env_t -> @@ -545,12 +524,12 @@ let caption_t: = fun env -> fun t -> - let uu____2492 = + let uu____2430 = FStar_TypeChecker_Env.debug env.tcenv FStar_Options.Low in - if uu____2492 + if uu____2430 then - let uu____2495 = FStar_Syntax_Print.term_to_string t in - FStar_Pervasives_Native.Some uu____2495 + let uu____2433 = FStar_Syntax_Print.term_to_string t in + FStar_Pervasives_Native.Some uu____2433 else FStar_Pervasives_Native.None let fresh_fvar: Prims.string -> @@ -561,8 +540,8 @@ let fresh_fvar: fun x -> fun s -> let xsym = varops.fresh x in - let uu____2508 = FStar_SMTEncoding_Util.mkFreeV (xsym, s) in - (xsym, uu____2508) + let uu____2446 = FStar_SMTEncoding_Util.mkFreeV (xsym, s) in + (xsym, uu____2446) let gen_term_var: env_t -> FStar_Syntax_Syntax.bv -> @@ -576,18 +555,18 @@ let gen_term_var: FStar_SMTEncoding_Util.mkFreeV (ysym, FStar_SMTEncoding_Term.Term_sort) in (ysym, y, - (let uu___102_2524 = env in + (let uu___102_2462 = env in { bindings = ((Binding_var (x, y)) :: (env.bindings)); depth = (env.depth + (Prims.parse_int "1")); - tcenv = (uu___102_2524.tcenv); - warn = (uu___102_2524.warn); - cache = (uu___102_2524.cache); - nolabels = (uu___102_2524.nolabels); - use_zfuel_name = (uu___102_2524.use_zfuel_name); + tcenv = (uu___102_2462.tcenv); + warn = (uu___102_2462.warn); + cache = (uu___102_2462.cache); + nolabels = (uu___102_2462.nolabels); + use_zfuel_name = (uu___102_2462.use_zfuel_name); encode_non_total_function_typ = - (uu___102_2524.encode_non_total_function_typ); - current_module_name = (uu___102_2524.current_module_name) + (uu___102_2462.encode_non_total_function_typ); + current_module_name = (uu___102_2462.current_module_name) })) let new_term_constant: env_t -> @@ -602,18 +581,18 @@ let new_term_constant: x.FStar_Syntax_Syntax.index in let y = FStar_SMTEncoding_Util.mkApp (ysym, []) in (ysym, y, - (let uu___103_2542 = env in + (let uu___103_2480 = env in { bindings = ((Binding_var (x, y)) :: (env.bindings)); - depth = (uu___103_2542.depth); - tcenv = (uu___103_2542.tcenv); - warn = (uu___103_2542.warn); - cache = (uu___103_2542.cache); - nolabels = (uu___103_2542.nolabels); - use_zfuel_name = (uu___103_2542.use_zfuel_name); + depth = (uu___103_2480.depth); + tcenv = (uu___103_2480.tcenv); + warn = (uu___103_2480.warn); + cache = (uu___103_2480.cache); + nolabels = (uu___103_2480.nolabels); + use_zfuel_name = (uu___103_2480.use_zfuel_name); encode_non_total_function_typ = - (uu___103_2542.encode_non_total_function_typ); - current_module_name = (uu___103_2542.current_module_name) + (uu___103_2480.encode_non_total_function_typ); + current_module_name = (uu___103_2480.current_module_name) })) let new_term_constant_from_string: env_t -> @@ -628,36 +607,36 @@ let new_term_constant_from_string: let ysym = varops.mk_unique str in let y = FStar_SMTEncoding_Util.mkApp (ysym, []) in (ysym, y, - (let uu___104_2563 = env in + (let uu___104_2501 = env in { bindings = ((Binding_var (x, y)) :: (env.bindings)); - depth = (uu___104_2563.depth); - tcenv = (uu___104_2563.tcenv); - warn = (uu___104_2563.warn); - cache = (uu___104_2563.cache); - nolabels = (uu___104_2563.nolabels); - use_zfuel_name = (uu___104_2563.use_zfuel_name); + depth = (uu___104_2501.depth); + tcenv = (uu___104_2501.tcenv); + warn = (uu___104_2501.warn); + cache = (uu___104_2501.cache); + nolabels = (uu___104_2501.nolabels); + use_zfuel_name = (uu___104_2501.use_zfuel_name); encode_non_total_function_typ = - (uu___104_2563.encode_non_total_function_typ); - current_module_name = (uu___104_2563.current_module_name) + (uu___104_2501.encode_non_total_function_typ); + current_module_name = (uu___104_2501.current_module_name) })) let push_term_var: env_t -> FStar_Syntax_Syntax.bv -> FStar_SMTEncoding_Term.term -> env_t = fun env -> fun x -> fun t -> - let uu___105_2573 = env in + let uu___105_2511 = env in { bindings = ((Binding_var (x, t)) :: (env.bindings)); - depth = (uu___105_2573.depth); - tcenv = (uu___105_2573.tcenv); - warn = (uu___105_2573.warn); - cache = (uu___105_2573.cache); - nolabels = (uu___105_2573.nolabels); - use_zfuel_name = (uu___105_2573.use_zfuel_name); + depth = (uu___105_2511.depth); + tcenv = (uu___105_2511.tcenv); + warn = (uu___105_2511.warn); + cache = (uu___105_2511.cache); + nolabels = (uu___105_2511.nolabels); + use_zfuel_name = (uu___105_2511.use_zfuel_name); encode_non_total_function_typ = - (uu___105_2573.encode_non_total_function_typ); - current_module_name = (uu___105_2573.current_module_name) + (uu___105_2511.encode_non_total_function_typ); + current_module_name = (uu___105_2511.current_module_name) } let lookup_term_var: env_t -> FStar_Syntax_Syntax.bv -> FStar_SMTEncoding_Term.term = @@ -665,25 +644,25 @@ let lookup_term_var: fun a -> let aux a' = lookup_binding env - (fun uu___80_2597 -> - match uu___80_2597 with + (fun uu___80_2535 -> + match uu___80_2535 with | Binding_var (b,t) when FStar_Syntax_Syntax.bv_eq b a' -> FStar_Pervasives_Native.Some (b, t) - | uu____2610 -> FStar_Pervasives_Native.None) in - let uu____2615 = aux a in - match uu____2615 with + | uu____2548 -> FStar_Pervasives_Native.None) in + let uu____2553 = aux a in + match uu____2553 with | FStar_Pervasives_Native.None -> let a2 = unmangle a in - let uu____2627 = aux a2 in - (match uu____2627 with + let uu____2565 = aux a2 in + (match uu____2565 with | FStar_Pervasives_Native.None -> - let uu____2638 = - let uu____2639 = FStar_Syntax_Print.bv_to_string a2 in - let uu____2640 = print_env env in + let uu____2576 = + let uu____2577 = FStar_Syntax_Print.bv_to_string a2 in + let uu____2578 = print_env env in FStar_Util.format2 "Bound term variable not found (after unmangling): %s in environment: %s" - uu____2639 uu____2640 in - failwith uu____2638 + uu____2577 uu____2578 in + failwith uu____2576 | FStar_Pervasives_Native.Some (b,t) -> t) | FStar_Pervasives_Native.Some (b,t) -> t let new_term_constant_and_tok_from_lid: @@ -695,32 +674,32 @@ let new_term_constant_and_tok_from_lid: fun x -> let fname = varops.new_fvar x in let ftok = Prims.strcat fname "@tok" in - let uu____2667 = - let uu___106_2668 = env in - let uu____2669 = - let uu____2672 = - let uu____2673 = - let uu____2686 = - let uu____2689 = FStar_SMTEncoding_Util.mkApp (ftok, []) in + let uu____2605 = + let uu___106_2606 = env in + let uu____2607 = + let uu____2610 = + let uu____2611 = + let uu____2624 = + let uu____2627 = FStar_SMTEncoding_Util.mkApp (ftok, []) in FStar_All.pipe_left (fun _0_40 -> FStar_Pervasives_Native.Some _0_40) - uu____2689 in - (x, fname, uu____2686, FStar_Pervasives_Native.None) in - Binding_fvar uu____2673 in - uu____2672 :: (env.bindings) in + uu____2627 in + (x, fname, uu____2624, FStar_Pervasives_Native.None) in + Binding_fvar uu____2611 in + uu____2610 :: (env.bindings) in { - bindings = uu____2669; - depth = (uu___106_2668.depth); - tcenv = (uu___106_2668.tcenv); - warn = (uu___106_2668.warn); - cache = (uu___106_2668.cache); - nolabels = (uu___106_2668.nolabels); - use_zfuel_name = (uu___106_2668.use_zfuel_name); + bindings = uu____2607; + depth = (uu___106_2606.depth); + tcenv = (uu___106_2606.tcenv); + warn = (uu___106_2606.warn); + cache = (uu___106_2606.cache); + nolabels = (uu___106_2606.nolabels); + use_zfuel_name = (uu___106_2606.use_zfuel_name); encode_non_total_function_typ = - (uu___106_2668.encode_non_total_function_typ); - current_module_name = (uu___106_2668.current_module_name) + (uu___106_2606.encode_non_total_function_typ); + current_module_name = (uu___106_2606.current_module_name) } in - (fname, ftok, uu____2667) + (fname, ftok, uu____2605) let try_lookup_lid: env_t -> FStar_Ident.lident -> @@ -732,22 +711,22 @@ let try_lookup_lid: fun env -> fun a -> lookup_binding env - (fun uu___81_2731 -> - match uu___81_2731 with + (fun uu___81_2669 -> + match uu___81_2669 with | Binding_fvar (b,t1,t2,t3) when FStar_Ident.lid_equals b a -> FStar_Pervasives_Native.Some (t1, t2, t3) - | uu____2770 -> FStar_Pervasives_Native.None) + | uu____2708 -> FStar_Pervasives_Native.None) let contains_name: env_t -> Prims.string -> Prims.bool = fun env -> fun s -> - let uu____2787 = + let uu____2725 = lookup_binding env - (fun uu___82_2795 -> - match uu___82_2795 with + (fun uu___82_2733 -> + match uu___82_2733 with | Binding_fvar (b,t1,t2,t3) when b.FStar_Ident.str = s -> FStar_Pervasives_Native.Some () - | uu____2810 -> FStar_Pervasives_Native.None) in - FStar_All.pipe_right uu____2787 FStar_Option.isSome + | uu____2748 -> FStar_Pervasives_Native.None) in + FStar_All.pipe_right uu____2725 FStar_Option.isSome let lookup_lid: env_t -> FStar_Ident.lident -> @@ -758,13 +737,13 @@ let lookup_lid: = fun env -> fun a -> - let uu____2829 = try_lookup_lid env a in - match uu____2829 with + let uu____2767 = try_lookup_lid env a in + match uu____2767 with | FStar_Pervasives_Native.None -> - let uu____2862 = - let uu____2863 = FStar_Syntax_Print.lid_to_string a in - FStar_Util.format1 "Name not found: %s" uu____2863 in - failwith uu____2862 + let uu____2800 = + let uu____2801 = FStar_Syntax_Print.lid_to_string a in + FStar_Util.format1 "Name not found: %s" uu____2801 in + failwith uu____2800 | FStar_Pervasives_Native.Some s -> s let push_free_var: env_t -> @@ -776,49 +755,49 @@ let push_free_var: fun x -> fun fname -> fun ftok -> - let uu___107_2911 = env in + let uu___107_2849 = env in { bindings = ((Binding_fvar (x, fname, ftok, FStar_Pervasives_Native.None)) :: (env.bindings)); - depth = (uu___107_2911.depth); - tcenv = (uu___107_2911.tcenv); - warn = (uu___107_2911.warn); - cache = (uu___107_2911.cache); - nolabels = (uu___107_2911.nolabels); - use_zfuel_name = (uu___107_2911.use_zfuel_name); + depth = (uu___107_2849.depth); + tcenv = (uu___107_2849.tcenv); + warn = (uu___107_2849.warn); + cache = (uu___107_2849.cache); + nolabels = (uu___107_2849.nolabels); + use_zfuel_name = (uu___107_2849.use_zfuel_name); encode_non_total_function_typ = - (uu___107_2911.encode_non_total_function_typ); - current_module_name = (uu___107_2911.current_module_name) + (uu___107_2849.encode_non_total_function_typ); + current_module_name = (uu___107_2849.current_module_name) } let push_zfuel_name: env_t -> FStar_Ident.lident -> Prims.string -> env_t = fun env -> fun x -> fun f -> - let uu____2925 = lookup_lid env x in - match uu____2925 with - | (t1,t2,uu____2938) -> + let uu____2863 = lookup_lid env x in + match uu____2863 with + | (t1,t2,uu____2876) -> let t3 = - let uu____2948 = - let uu____2955 = - let uu____2958 = FStar_SMTEncoding_Util.mkApp ("ZFuel", []) in - [uu____2958] in - (f, uu____2955) in - FStar_SMTEncoding_Util.mkApp uu____2948 in - let uu___108_2963 = env in + let uu____2886 = + let uu____2893 = + let uu____2896 = FStar_SMTEncoding_Util.mkApp ("ZFuel", []) in + [uu____2896] in + (f, uu____2893) in + FStar_SMTEncoding_Util.mkApp uu____2886 in + let uu___108_2901 = env in { bindings = ((Binding_fvar (x, t1, t2, (FStar_Pervasives_Native.Some t3))) :: (env.bindings)); - depth = (uu___108_2963.depth); - tcenv = (uu___108_2963.tcenv); - warn = (uu___108_2963.warn); - cache = (uu___108_2963.cache); - nolabels = (uu___108_2963.nolabels); - use_zfuel_name = (uu___108_2963.use_zfuel_name); + depth = (uu___108_2901.depth); + tcenv = (uu___108_2901.tcenv); + warn = (uu___108_2901.warn); + cache = (uu___108_2901.cache); + nolabels = (uu___108_2901.nolabels); + use_zfuel_name = (uu___108_2901.use_zfuel_name); encode_non_total_function_typ = - (uu___108_2963.encode_non_total_function_typ); - current_module_name = (uu___108_2963.current_module_name) + (uu___108_2901.encode_non_total_function_typ); + current_module_name = (uu___108_2901.current_module_name) } let try_lookup_free_var: env_t -> @@ -827,40 +806,40 @@ let try_lookup_free_var: = fun env -> fun l -> - let uu____2976 = try_lookup_lid env l in - match uu____2976 with + let uu____2914 = try_lookup_lid env l in + match uu____2914 with | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None | FStar_Pervasives_Native.Some (name,sym,zf_opt) -> (match zf_opt with | FStar_Pervasives_Native.Some f when env.use_zfuel_name -> FStar_Pervasives_Native.Some f - | uu____3025 -> + | uu____2963 -> (match sym with | FStar_Pervasives_Native.Some t -> (match t.FStar_SMTEncoding_Term.tm with - | FStar_SMTEncoding_Term.App (uu____3033,fuel::[]) -> - let uu____3037 = - let uu____3038 = - let uu____3039 = + | FStar_SMTEncoding_Term.App (uu____2971,fuel::[]) -> + let uu____2975 = + let uu____2976 = + let uu____2977 = FStar_SMTEncoding_Term.fv_of_term fuel in - FStar_All.pipe_right uu____3039 + FStar_All.pipe_right uu____2977 FStar_Pervasives_Native.fst in - FStar_Util.starts_with uu____3038 "fuel" in - if uu____3037 + FStar_Util.starts_with uu____2976 "fuel" in + if uu____2975 then - let uu____3042 = - let uu____3043 = + let uu____2980 = + let uu____2981 = FStar_SMTEncoding_Util.mkFreeV (name, FStar_SMTEncoding_Term.Term_sort) in - FStar_SMTEncoding_Term.mk_ApplyTF uu____3043 + FStar_SMTEncoding_Term.mk_ApplyTF uu____2981 fuel in FStar_All.pipe_left (fun _0_41 -> FStar_Pervasives_Native.Some _0_41) - uu____3042 + uu____2980 else FStar_Pervasives_Native.Some t - | uu____3047 -> FStar_Pervasives_Native.Some t) - | uu____3048 -> FStar_Pervasives_Native.None)) + | uu____2985 -> FStar_Pervasives_Native.Some t) + | uu____2986 -> FStar_Pervasives_Native.None)) let lookup_free_var: env_t -> FStar_Ident.lident FStar_Syntax_Syntax.withinfo_t -> @@ -868,22 +847,22 @@ let lookup_free_var: = fun env -> fun a -> - let uu____3061 = try_lookup_free_var env a.FStar_Syntax_Syntax.v in - match uu____3061 with + let uu____2999 = try_lookup_free_var env a.FStar_Syntax_Syntax.v in + match uu____2999 with | FStar_Pervasives_Native.Some t -> t | FStar_Pervasives_Native.None -> - let uu____3065 = - let uu____3066 = + let uu____3003 = + let uu____3004 = FStar_Syntax_Print.lid_to_string a.FStar_Syntax_Syntax.v in - FStar_Util.format1 "Name not found: %s" uu____3066 in - failwith uu____3065 + FStar_Util.format1 "Name not found: %s" uu____3004 in + failwith uu____3003 let lookup_free_var_name: env_t -> FStar_Ident.lident FStar_Syntax_Syntax.withinfo_t -> Prims.string = fun env -> fun a -> - let uu____3077 = lookup_lid env a.FStar_Syntax_Syntax.v in - match uu____3077 with | (x,uu____3089,uu____3090) -> x + let uu____3015 = lookup_lid env a.FStar_Syntax_Syntax.v in + match uu____3015 with | (x,uu____3027,uu____3028) -> x let lookup_free_var_sym: env_t -> FStar_Ident.lident FStar_Syntax_Syntax.withinfo_t -> @@ -892,25 +871,25 @@ let lookup_free_var_sym: = fun env -> fun a -> - let uu____3115 = lookup_lid env a.FStar_Syntax_Syntax.v in - match uu____3115 with + let uu____3053 = lookup_lid env a.FStar_Syntax_Syntax.v in + match uu____3053 with | (name,sym,zf_opt) -> (match zf_opt with | FStar_Pervasives_Native.Some { FStar_SMTEncoding_Term.tm = FStar_SMTEncoding_Term.App (g,zf); - FStar_SMTEncoding_Term.freevars = uu____3151; - FStar_SMTEncoding_Term.rng = uu____3152;_} + FStar_SMTEncoding_Term.freevars = uu____3089; + FStar_SMTEncoding_Term.rng = uu____3090;_} when env.use_zfuel_name -> (g, zf) - | uu____3167 -> + | uu____3105 -> (match sym with | FStar_Pervasives_Native.None -> ((FStar_SMTEncoding_Term.Var name), []) | FStar_Pervasives_Native.Some sym1 -> (match sym1.FStar_SMTEncoding_Term.tm with | FStar_SMTEncoding_Term.App (g,fuel::[]) -> (g, [fuel]) - | uu____3191 -> ((FStar_SMTEncoding_Term.Var name), [])))) + | uu____3129 -> ((FStar_SMTEncoding_Term.Var name), [])))) let tok_of_name: env_t -> Prims.string -> @@ -919,30 +898,30 @@ let tok_of_name: fun env -> fun nm -> FStar_Util.find_map env.bindings - (fun uu___83_3207 -> - match uu___83_3207 with - | Binding_fvar (uu____3210,nm',tok,uu____3213) when nm = nm' -> + (fun uu___83_3145 -> + match uu___83_3145 with + | Binding_fvar (uu____3148,nm',tok,uu____3151) when nm = nm' -> tok - | uu____3222 -> FStar_Pervasives_Native.None) + | uu____3160 -> FStar_Pervasives_Native.None) let mkForall_fuel': - 'Auu____3226 . - 'Auu____3226 -> + 'Auu____3164 . + 'Auu____3164 -> (FStar_SMTEncoding_Term.pat Prims.list Prims.list,FStar_SMTEncoding_Term.fvs, FStar_SMTEncoding_Term.term) FStar_Pervasives_Native.tuple3 -> FStar_SMTEncoding_Term.term = fun n1 -> - fun uu____3244 -> - match uu____3244 with + fun uu____3182 -> + match uu____3182 with | (pats,vars,body) -> - let fallback uu____3269 = + let fallback uu____3207 = FStar_SMTEncoding_Util.mkForall (pats, vars, body) in - let uu____3274 = FStar_Options.unthrottle_inductives () in - if uu____3274 + let uu____3212 = FStar_Options.unthrottle_inductives () in + if uu____3212 then fallback () else - (let uu____3276 = fresh_fvar "f" FStar_SMTEncoding_Term.Fuel_sort in - match uu____3276 with + (let uu____3214 = fresh_fvar "f" FStar_SMTEncoding_Term.Fuel_sort in + match uu____3214 with | (fsym,fterm) -> let add_fuel1 tms = FStar_All.pipe_right tms @@ -953,7 +932,7 @@ let mkForall_fuel': (FStar_SMTEncoding_Term.Var "HasType",args) -> FStar_SMTEncoding_Util.mkApp ("HasTypeFuel", (fterm :: args)) - | uu____3307 -> p)) in + | uu____3245 -> p)) in let pats1 = FStar_List.map add_fuel1 pats in let body1 = match body.FStar_SMTEncoding_Term.tm with @@ -963,13 +942,13 @@ let mkForall_fuel': match guard.FStar_SMTEncoding_Term.tm with | FStar_SMTEncoding_Term.App (FStar_SMTEncoding_Term.And ,guards) -> - let uu____3328 = add_fuel1 guards in - FStar_SMTEncoding_Util.mk_and_l uu____3328 - | uu____3331 -> - let uu____3332 = add_fuel1 [guard] in - FStar_All.pipe_right uu____3332 FStar_List.hd in + let uu____3266 = add_fuel1 guards in + FStar_SMTEncoding_Util.mk_and_l uu____3266 + | uu____3269 -> + let uu____3270 = add_fuel1 [guard] in + FStar_All.pipe_right uu____3270 FStar_List.hd in FStar_SMTEncoding_Util.mkImp (guard1, body') - | uu____3337 -> body in + | uu____3275 -> body in let vars1 = (fsym, FStar_SMTEncoding_Term.Fuel_sort) :: vars in FStar_SMTEncoding_Util.mkForall (pats1, vars1, body1)) let mkForall_fuel: @@ -982,38 +961,38 @@ let head_normal: env_t -> FStar_Syntax_Syntax.term -> Prims.bool = fun t -> let t1 = FStar_Syntax_Util.unmeta t in match t1.FStar_Syntax_Syntax.n with - | FStar_Syntax_Syntax.Tm_arrow uu____3378 -> true - | FStar_Syntax_Syntax.Tm_refine uu____3391 -> true - | FStar_Syntax_Syntax.Tm_bvar uu____3398 -> true - | FStar_Syntax_Syntax.Tm_uvar uu____3399 -> true - | FStar_Syntax_Syntax.Tm_abs uu____3416 -> true - | FStar_Syntax_Syntax.Tm_constant uu____3433 -> true + | FStar_Syntax_Syntax.Tm_arrow uu____3316 -> true + | FStar_Syntax_Syntax.Tm_refine uu____3329 -> true + | FStar_Syntax_Syntax.Tm_bvar uu____3336 -> true + | FStar_Syntax_Syntax.Tm_uvar uu____3337 -> true + | FStar_Syntax_Syntax.Tm_abs uu____3354 -> true + | FStar_Syntax_Syntax.Tm_constant uu____3371 -> true | FStar_Syntax_Syntax.Tm_fvar fv -> - let uu____3435 = + let uu____3373 = FStar_TypeChecker_Env.lookup_definition [FStar_TypeChecker_Env.Eager_unfolding_only] env.tcenv (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in - FStar_All.pipe_right uu____3435 FStar_Option.isNone + FStar_All.pipe_right uu____3373 FStar_Option.isNone | FStar_Syntax_Syntax.Tm_app ({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_fvar fv; - FStar_Syntax_Syntax.pos = uu____3453; - FStar_Syntax_Syntax.vars = uu____3454;_},uu____3455) + FStar_Syntax_Syntax.pos = uu____3391; + FStar_Syntax_Syntax.vars = uu____3392;_},uu____3393) -> - let uu____3476 = + let uu____3414 = FStar_TypeChecker_Env.lookup_definition [FStar_TypeChecker_Env.Eager_unfolding_only] env.tcenv (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in - FStar_All.pipe_right uu____3476 FStar_Option.isNone - | uu____3493 -> false + FStar_All.pipe_right uu____3414 FStar_Option.isNone + | uu____3431 -> false let head_redex: env_t -> FStar_Syntax_Syntax.term -> Prims.bool = fun env -> fun t -> - let uu____3500 = - let uu____3501 = FStar_Syntax_Util.un_uinst t in - uu____3501.FStar_Syntax_Syntax.n in - match uu____3500 with + let uu____3438 = + let uu____3439 = FStar_Syntax_Util.un_uinst t in + uu____3439.FStar_Syntax_Syntax.n in + match uu____3438 with | FStar_Syntax_Syntax.Tm_abs - (uu____3504,uu____3505,FStar_Pervasives_Native.Some rc) -> + (uu____3442,uu____3443,FStar_Pervasives_Native.Some rc) -> ((FStar_Ident.lid_equals rc.FStar_Syntax_Syntax.residual_effect FStar_Parser_Const.effect_Tot_lid) || @@ -1021,23 +1000,23 @@ let head_redex: env_t -> FStar_Syntax_Syntax.term -> Prims.bool = FStar_Parser_Const.effect_GTot_lid)) || (FStar_List.existsb - (fun uu___84_3526 -> - match uu___84_3526 with + (fun uu___84_3464 -> + match uu___84_3464 with | FStar_Syntax_Syntax.TOTAL -> true - | uu____3527 -> false) + | uu____3465 -> false) rc.FStar_Syntax_Syntax.residual_flags) | FStar_Syntax_Syntax.Tm_fvar fv -> - let uu____3529 = + let uu____3467 = FStar_TypeChecker_Env.lookup_definition [FStar_TypeChecker_Env.Eager_unfolding_only] env.tcenv (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in - FStar_All.pipe_right uu____3529 FStar_Option.isSome - | uu____3546 -> false + FStar_All.pipe_right uu____3467 FStar_Option.isSome + | uu____3484 -> false let whnf: env_t -> FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term = fun env -> fun t -> - let uu____3553 = head_normal env t in - if uu____3553 + let uu____3491 = head_normal env t in + if uu____3491 then t else FStar_TypeChecker_Normalize.normalize @@ -1058,12 +1037,12 @@ let norm: env_t -> FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term = FStar_TypeChecker_Normalize.EraseUniverses] env.tcenv t let trivial_post: FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term = fun t -> - let uu____3564 = - let uu____3565 = FStar_Syntax_Syntax.null_binder t in [uu____3565] in - let uu____3566 = + let uu____3502 = + let uu____3503 = FStar_Syntax_Syntax.null_binder t in [uu____3503] in + let uu____3504 = FStar_Syntax_Syntax.fvar FStar_Parser_Const.true_lid FStar_Syntax_Syntax.Delta_constant FStar_Pervasives_Native.None in - FStar_Syntax_Util.abs uu____3564 uu____3566 FStar_Pervasives_Native.None + FStar_Syntax_Util.abs uu____3502 uu____3504 FStar_Pervasives_Native.None let mk_Apply: FStar_SMTEncoding_Term.term -> (Prims.string,FStar_SMTEncoding_Term.sort) FStar_Pervasives_Native.tuple2 @@ -1077,11 +1056,11 @@ let mk_Apply: fun var -> match FStar_Pervasives_Native.snd var with | FStar_SMTEncoding_Term.Fuel_sort -> - let uu____3604 = FStar_SMTEncoding_Util.mkFreeV var in - FStar_SMTEncoding_Term.mk_ApplyTF out uu____3604 + let uu____3542 = FStar_SMTEncoding_Util.mkFreeV var in + FStar_SMTEncoding_Term.mk_ApplyTF out uu____3542 | s -> - let uu____3609 = FStar_SMTEncoding_Util.mkFreeV var in - FStar_SMTEncoding_Util.mk_ApplyTT out uu____3609) e) + let uu____3547 = FStar_SMTEncoding_Util.mkFreeV var in + FStar_SMTEncoding_Util.mk_ApplyTT out uu____3547) e) let mk_Apply_args: FStar_SMTEncoding_Term.term -> FStar_SMTEncoding_Term.term Prims.list -> FStar_SMTEncoding_Term.term @@ -1091,11 +1070,11 @@ let mk_Apply_args: FStar_All.pipe_right args (FStar_List.fold_left FStar_SMTEncoding_Util.mk_ApplyTT e) let is_app: FStar_SMTEncoding_Term.op -> Prims.bool = - fun uu___85_3624 -> - match uu___85_3624 with + fun uu___85_3562 -> + match uu___85_3562 with | FStar_SMTEncoding_Term.Var "ApplyTT" -> true | FStar_SMTEncoding_Term.Var "ApplyTF" -> true - | uu____3625 -> false + | uu____3563 -> false let is_an_eta_expansion: env_t -> FStar_SMTEncoding_Term.fv Prims.list -> @@ -1111,13 +1090,13 @@ let is_an_eta_expansion: (app,f::{ FStar_SMTEncoding_Term.tm = FStar_SMTEncoding_Term.FreeV y; - FStar_SMTEncoding_Term.freevars = uu____3661; - FStar_SMTEncoding_Term.rng = uu____3662;_}::[]),x::xs1) + FStar_SMTEncoding_Term.freevars = uu____3599; + FStar_SMTEncoding_Term.rng = uu____3600;_}::[]),x::xs1) when (is_app app) && (FStar_SMTEncoding_Term.fv_eq x y) -> check_partial_applications f xs1 | (FStar_SMTEncoding_Term.App - (FStar_SMTEncoding_Term.Var f,args),uu____3685) -> - let uu____3694 = + (FStar_SMTEncoding_Term.Var f,args),uu____3623) -> + let uu____3632 = ((FStar_List.length args) = (FStar_List.length xs)) && (FStar_List.forall2 (fun a -> @@ -1125,24 +1104,24 @@ let is_an_eta_expansion: match a.FStar_SMTEncoding_Term.tm with | FStar_SMTEncoding_Term.FreeV fv -> FStar_SMTEncoding_Term.fv_eq fv v1 - | uu____3705 -> false) args (FStar_List.rev xs)) in - if uu____3694 + | uu____3643 -> false) args (FStar_List.rev xs)) in + if uu____3632 then tok_of_name env f else FStar_Pervasives_Native.None - | (uu____3709,[]) -> + | (uu____3647,[]) -> let fvs = FStar_SMTEncoding_Term.free_variables t in - let uu____3713 = + let uu____3651 = FStar_All.pipe_right fvs (FStar_List.for_all (fun fv -> - let uu____3717 = + let uu____3655 = FStar_Util.for_some (FStar_SMTEncoding_Term.fv_eq fv) vars in - Prims.op_Negation uu____3717)) in - if uu____3713 + Prims.op_Negation uu____3655)) in + if uu____3651 then FStar_Pervasives_Native.Some t else FStar_Pervasives_Native.None - | uu____3721 -> FStar_Pervasives_Native.None in + | uu____3659 -> FStar_Pervasives_Native.None in check_partial_applications body (FStar_List.rev vars) type label = (FStar_SMTEncoding_Term.fv,Prims.string,FStar_Range.range) @@ -1206,11 +1185,11 @@ let uu___is_Let_rec_unencodeable: Prims.exn -> Prims.bool = fun projectee -> match projectee with | Let_rec_unencodeable -> true - | uu____3943 -> false + | uu____3881 -> false exception Inner_let_rec let uu___is_Inner_let_rec: Prims.exn -> Prims.bool = fun projectee -> - match projectee with | Inner_let_rec -> true | uu____3947 -> false + match projectee with | Inner_let_rec -> true | uu____3885 -> false let as_function_typ: env_t -> FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax -> @@ -1221,21 +1200,21 @@ let as_function_typ: let rec aux norm1 t = let t1 = FStar_Syntax_Subst.compress t in match t1.FStar_Syntax_Syntax.n with - | FStar_Syntax_Syntax.Tm_arrow uu____3966 -> t1 - | FStar_Syntax_Syntax.Tm_refine uu____3979 -> - let uu____3986 = FStar_Syntax_Util.unrefine t1 in - aux true uu____3986 - | uu____3987 -> + | FStar_Syntax_Syntax.Tm_arrow uu____3904 -> t1 + | FStar_Syntax_Syntax.Tm_refine uu____3917 -> + let uu____3924 = FStar_Syntax_Util.unrefine t1 in + aux true uu____3924 + | uu____3925 -> if norm1 - then let uu____3988 = whnf env t1 in aux false uu____3988 + then let uu____3926 = whnf env t1 in aux false uu____3926 else - (let uu____3990 = - let uu____3991 = + (let uu____3928 = + let uu____3929 = FStar_Range.string_of_range t0.FStar_Syntax_Syntax.pos in - let uu____3992 = FStar_Syntax_Print.term_to_string t0 in + let uu____3930 = FStar_Syntax_Print.term_to_string t0 in FStar_Util.format2 "(%s) Expected a function typ; got %s" - uu____3991 uu____3992 in - failwith uu____3990) in + uu____3929 uu____3930 in + failwith uu____3928) in aux true t0 let rec curried_arrow_formals_comp: FStar_Syntax_Syntax.term -> @@ -1247,19 +1226,19 @@ let rec curried_arrow_formals_comp: match k1.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Tm_arrow (bs,c) -> FStar_Syntax_Subst.open_comp bs c - | FStar_Syntax_Syntax.Tm_refine (bv,uu____4024) -> + | FStar_Syntax_Syntax.Tm_refine (bv,uu____3962) -> curried_arrow_formals_comp bv.FStar_Syntax_Syntax.sort - | uu____4029 -> - let uu____4030 = FStar_Syntax_Syntax.mk_Total k1 in ([], uu____4030) + | uu____3967 -> + let uu____3968 = FStar_Syntax_Syntax.mk_Total k1 in ([], uu____3968) let is_arithmetic_primitive: - 'Auu____4044 . + 'Auu____3982 . FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax -> - 'Auu____4044 Prims.list -> Prims.bool + 'Auu____3982 Prims.list -> Prims.bool = fun head1 -> fun args -> match ((head1.FStar_Syntax_Syntax.n), args) with - | (FStar_Syntax_Syntax.Tm_fvar fv,uu____4064::uu____4065::[]) -> + | (FStar_Syntax_Syntax.Tm_fvar fv,uu____4002::uu____4003::[]) -> ((((FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.op_Addition) || (FStar_Syntax_Syntax.fv_eq_lid fv @@ -1271,32 +1250,32 @@ let is_arithmetic_primitive: (FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.op_Division)) || (FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.op_Modulus) - | (FStar_Syntax_Syntax.Tm_fvar fv,uu____4069::[]) -> + | (FStar_Syntax_Syntax.Tm_fvar fv,uu____4007::[]) -> FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.op_Minus - | uu____4072 -> false + | uu____4010 -> false let isInteger: FStar_Syntax_Syntax.term' -> Prims.bool = fun tm -> match tm with | FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_int (n1,FStar_Pervasives_Native.None )) -> true - | uu____4093 -> false + | uu____4031 -> false let getInteger: FStar_Syntax_Syntax.term' -> Prims.int = fun tm -> match tm with | FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_int (n1,FStar_Pervasives_Native.None )) -> FStar_Util.int_of_string n1 - | uu____4108 -> failwith "Expected an Integer term" + | uu____4046 -> failwith "Expected an Integer term" let is_BitVector_primitive: - 'Auu____4112 . + 'Auu____4050 . FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax -> - (FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax,'Auu____4112) + (FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax,'Auu____4050) FStar_Pervasives_Native.tuple2 Prims.list -> Prims.bool = fun head1 -> fun args -> match ((head1.FStar_Syntax_Syntax.n), args) with | (FStar_Syntax_Syntax.Tm_fvar - fv,(sz_arg,uu____4151)::uu____4152::uu____4153::[]) -> + fv,(sz_arg,uu____4089)::uu____4090::uu____4091::[]) -> (((((((((((FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.bv_and_lid) || @@ -1329,14 +1308,14 @@ let is_BitVector_primitive: || (FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.bv_mul_lid)) && (isInteger sz_arg.FStar_Syntax_Syntax.n) - | (FStar_Syntax_Syntax.Tm_fvar fv,(sz_arg,uu____4204)::uu____4205::[]) + | (FStar_Syntax_Syntax.Tm_fvar fv,(sz_arg,uu____4142)::uu____4143::[]) -> ((FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.nat_to_bv_lid) || (FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.bv_to_nat_lid)) && (isInteger sz_arg.FStar_Syntax_Syntax.n) - | uu____4242 -> false + | uu____4180 -> false let rec encode_const: FStar_Const.sconst -> env_t -> @@ -1348,49 +1327,49 @@ let rec encode_const: match c with | FStar_Const.Const_unit -> (FStar_SMTEncoding_Term.mk_Term_unit, []) | FStar_Const.Const_bool (true ) -> - let uu____4461 = + let uu____4399 = FStar_SMTEncoding_Term.boxBool FStar_SMTEncoding_Util.mkTrue in - (uu____4461, []) + (uu____4399, []) | FStar_Const.Const_bool (false ) -> - let uu____4464 = + let uu____4402 = FStar_SMTEncoding_Term.boxBool FStar_SMTEncoding_Util.mkFalse in - (uu____4464, []) + (uu____4402, []) | FStar_Const.Const_char c1 -> - let uu____4468 = - let uu____4469 = - let uu____4476 = - let uu____4479 = - let uu____4480 = + let uu____4406 = + let uu____4407 = + let uu____4414 = + let uu____4417 = + let uu____4418 = FStar_SMTEncoding_Util.mkInteger' (FStar_Util.int_of_char c1) in - FStar_SMTEncoding_Term.boxInt uu____4480 in - [uu____4479] in - ("FStar.Char.__char_of_int", uu____4476) in - FStar_SMTEncoding_Util.mkApp uu____4469 in - (uu____4468, []) + FStar_SMTEncoding_Term.boxInt uu____4418 in + [uu____4417] in + ("FStar.Char.__char_of_int", uu____4414) in + FStar_SMTEncoding_Util.mkApp uu____4407 in + (uu____4406, []) | FStar_Const.Const_int (i,FStar_Pervasives_Native.None ) -> - let uu____4496 = - let uu____4497 = FStar_SMTEncoding_Util.mkInteger i in - FStar_SMTEncoding_Term.boxInt uu____4497 in - (uu____4496, []) + let uu____4434 = + let uu____4435 = FStar_SMTEncoding_Util.mkInteger i in + FStar_SMTEncoding_Term.boxInt uu____4435 in + (uu____4434, []) | FStar_Const.Const_int (repr,FStar_Pervasives_Native.Some sw) -> let syntax_term = FStar_ToSyntax_ToSyntax.desugar_machine_integer (env.tcenv).FStar_TypeChecker_Env.dsenv repr sw FStar_Range.dummyRange in encode_term syntax_term env - | FStar_Const.Const_string (s,uu____4518) -> - let uu____4519 = varops.string_const s in (uu____4519, []) - | FStar_Const.Const_range uu____4522 -> - let uu____4523 = FStar_SMTEncoding_Term.mk_Range_const () in - (uu____4523, []) + | FStar_Const.Const_string (s,uu____4456) -> + let uu____4457 = varops.string_const s in (uu____4457, []) + | FStar_Const.Const_range uu____4460 -> + let uu____4461 = FStar_SMTEncoding_Term.mk_Range_const () in + (uu____4461, []) | FStar_Const.Const_effect -> (FStar_SMTEncoding_Term.mk_Term_type, []) | c1 -> - let uu____4529 = - let uu____4530 = FStar_Syntax_Print.const_to_string c1 in - FStar_Util.format1 "Unhandled constant: %s" uu____4530 in - failwith uu____4529 + let uu____4467 = + let uu____4468 = FStar_Syntax_Print.const_to_string c1 in + FStar_Util.format1 "Unhandled constant: %s" uu____4468 in + failwith uu____4467 and encode_binders: FStar_SMTEncoding_Term.term FStar_Pervasives_Native.option -> FStar_Syntax_Syntax.binders -> @@ -1402,40 +1381,40 @@ and encode_binders: fun fuel_opt -> fun bs -> fun env -> - (let uu____4559 = + (let uu____4497 = FStar_TypeChecker_Env.debug env.tcenv FStar_Options.Low in - if uu____4559 + if uu____4497 then - let uu____4560 = FStar_Syntax_Print.binders_to_string ", " bs in - FStar_Util.print1 "Encoding binders %s\n" uu____4560 + let uu____4498 = FStar_Syntax_Print.binders_to_string ", " bs in + FStar_Util.print1 "Encoding binders %s\n" uu____4498 else ()); - (let uu____4562 = + (let uu____4500 = FStar_All.pipe_right bs (FStar_List.fold_left - (fun uu____4646 -> + (fun uu____4584 -> fun b -> - match uu____4646 with + match uu____4584 with | (vars,guards,env1,decls,names1) -> - let uu____4725 = + let uu____4663 = let x = unmangle (FStar_Pervasives_Native.fst b) in - let uu____4741 = gen_term_var env1 x in - match uu____4741 with + let uu____4679 = gen_term_var env1 x in + match uu____4679 with | (xxsym,xx,env') -> - let uu____4765 = - let uu____4770 = + let uu____4703 = + let uu____4708 = norm env1 x.FStar_Syntax_Syntax.sort in - encode_term_pred fuel_opt uu____4770 env1 xx in - (match uu____4765 with + encode_term_pred fuel_opt uu____4708 env1 xx in + (match uu____4703 with | (guard_x_t,decls') -> ((xxsym, FStar_SMTEncoding_Term.Term_sort), guard_x_t, env', decls', x)) in - (match uu____4725 with + (match uu____4663 with | (v1,g,env2,decls',n1) -> ((v1 :: vars), (g :: guards), env2, (FStar_List.append decls decls'), (n1 :: names1)))) ([], [], env, [], [])) in - match uu____4562 with + match uu____4500 with | (vars,guards,env1,decls,names1) -> ((FStar_List.rev vars), (FStar_List.rev guards), env1, decls, (FStar_List.rev names1))) @@ -1451,12 +1430,12 @@ and encode_term_pred: fun t -> fun env -> fun e -> - let uu____4929 = encode_term t env in - match uu____4929 with + let uu____4867 = encode_term t env in + match uu____4867 with | (t1,decls) -> - let uu____4940 = + let uu____4878 = FStar_SMTEncoding_Term.mk_HasTypeWithFuel fuel_opt e t1 in - (uu____4940, decls) + (uu____4878, decls) and encode_term_pred': FStar_SMTEncoding_Term.term FStar_Pervasives_Native.option -> FStar_Syntax_Syntax.typ -> @@ -1469,17 +1448,17 @@ and encode_term_pred': fun t -> fun env -> fun e -> - let uu____4951 = encode_term t env in - match uu____4951 with + let uu____4889 = encode_term t env in + match uu____4889 with | (t1,decls) -> (match fuel_opt with | FStar_Pervasives_Native.None -> - let uu____4966 = FStar_SMTEncoding_Term.mk_HasTypeZ e t1 in - (uu____4966, decls) + let uu____4904 = FStar_SMTEncoding_Term.mk_HasTypeZ e t1 in + (uu____4904, decls) | FStar_Pervasives_Native.Some f -> - let uu____4968 = + let uu____4906 = FStar_SMTEncoding_Term.mk_HasTypeFuel f e t1 in - (uu____4968, decls)) + (uu____4906, decls)) and encode_arith_term: env_t -> FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax -> @@ -1490,58 +1469,58 @@ and encode_arith_term: fun env -> fun head1 -> fun args_e -> - let uu____4974 = encode_args args_e env in - match uu____4974 with + let uu____4912 = encode_args args_e env in + match uu____4912 with | (arg_tms,decls) -> let head_fv = match head1.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Tm_fvar fv -> fv - | uu____4993 -> failwith "Impossible" in + | uu____4931 -> failwith "Impossible" in let unary arg_tms1 = - let uu____5002 = FStar_List.hd arg_tms1 in - FStar_SMTEncoding_Term.unboxInt uu____5002 in + let uu____4940 = FStar_List.hd arg_tms1 in + FStar_SMTEncoding_Term.unboxInt uu____4940 in let binary arg_tms1 = - let uu____5015 = - let uu____5016 = FStar_List.hd arg_tms1 in - FStar_SMTEncoding_Term.unboxInt uu____5016 in - let uu____5017 = - let uu____5018 = - let uu____5019 = FStar_List.tl arg_tms1 in - FStar_List.hd uu____5019 in - FStar_SMTEncoding_Term.unboxInt uu____5018 in - (uu____5015, uu____5017) in - let mk_default uu____5025 = - let uu____5026 = + let uu____4953 = + let uu____4954 = FStar_List.hd arg_tms1 in + FStar_SMTEncoding_Term.unboxInt uu____4954 in + let uu____4955 = + let uu____4956 = + let uu____4957 = FStar_List.tl arg_tms1 in + FStar_List.hd uu____4957 in + FStar_SMTEncoding_Term.unboxInt uu____4956 in + (uu____4953, uu____4955) in + let mk_default uu____4963 = + let uu____4964 = lookup_free_var_sym env head_fv.FStar_Syntax_Syntax.fv_name in - match uu____5026 with + match uu____4964 with | (fname,fuel_args) -> FStar_SMTEncoding_Util.mkApp' (fname, (FStar_List.append fuel_args arg_tms)) in let mk_l op mk_args ts = - let uu____5077 = FStar_Options.smtencoding_l_arith_native () in - if uu____5077 + let uu____5015 = FStar_Options.smtencoding_l_arith_native () in + if uu____5015 then - let uu____5078 = let uu____5079 = mk_args ts in op uu____5079 in - FStar_All.pipe_right uu____5078 FStar_SMTEncoding_Term.boxInt + let uu____5016 = let uu____5017 = mk_args ts in op uu____5017 in + FStar_All.pipe_right uu____5016 FStar_SMTEncoding_Term.boxInt else mk_default () in let mk_nl nm op ts = - let uu____5108 = FStar_Options.smtencoding_nl_arith_wrapped () in - if uu____5108 + let uu____5046 = FStar_Options.smtencoding_nl_arith_wrapped () in + if uu____5046 then - let uu____5109 = binary ts in - match uu____5109 with + let uu____5047 = binary ts in + match uu____5047 with | (t1,t2) -> - let uu____5116 = + let uu____5054 = FStar_SMTEncoding_Util.mkApp (nm, [t1; t2]) in - FStar_All.pipe_right uu____5116 + FStar_All.pipe_right uu____5054 FStar_SMTEncoding_Term.boxInt else - (let uu____5120 = + (let uu____5058 = FStar_Options.smtencoding_nl_arith_native () in - if uu____5120 + if uu____5058 then - let uu____5121 = op (binary ts) in - FStar_All.pipe_right uu____5121 + let uu____5059 = op (binary ts) in + FStar_All.pipe_right uu____5059 FStar_SMTEncoding_Term.boxInt else mk_default ()) in let add1 = mk_l FStar_SMTEncoding_Util.mkAdd binary in @@ -1557,17 +1536,17 @@ and encode_arith_term: (FStar_Parser_Const.op_Division, div1); (FStar_Parser_Const.op_Modulus, modulus); (FStar_Parser_Const.op_Minus, minus)] in - let uu____5252 = - let uu____5261 = + let uu____5190 = + let uu____5199 = FStar_List.tryFind - (fun uu____5283 -> - match uu____5283 with - | (l,uu____5293) -> + (fun uu____5221 -> + match uu____5221 with + | (l,uu____5231) -> FStar_Syntax_Syntax.fv_eq_lid head_fv l) ops in - FStar_All.pipe_right uu____5261 FStar_Util.must in - (match uu____5252 with - | (uu____5332,op) -> - let uu____5342 = op arg_tms in (uu____5342, decls)) + FStar_All.pipe_right uu____5199 FStar_Util.must in + (match uu____5190 with + | (uu____5270,op) -> + let uu____5280 = op arg_tms in (uu____5280, decls)) and encode_BitVector_term: env_t -> FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax -> @@ -1578,88 +1557,88 @@ and encode_BitVector_term: fun env -> fun head1 -> fun args_e -> - let uu____5350 = FStar_List.hd args_e in - match uu____5350 with - | (tm_sz,uu____5358) -> + let uu____5288 = FStar_List.hd args_e in + match uu____5288 with + | (tm_sz,uu____5296) -> let sz = getInteger tm_sz.FStar_Syntax_Syntax.n in let sz_key = FStar_Util.format1 "BitVector_%s" (Prims.string_of_int sz) in let sz_decls = - let uu____5368 = FStar_Util.smap_try_find env.cache sz_key in - match uu____5368 with + let uu____5306 = FStar_Util.smap_try_find env.cache sz_key in + match uu____5306 with | FStar_Pervasives_Native.Some cache_entry -> [] | FStar_Pervasives_Native.None -> let t_decls = FStar_SMTEncoding_Term.mkBvConstructor sz in - ((let uu____5376 = mk_cache_entry env "" [] [] in - FStar_Util.smap_add env.cache sz_key uu____5376); + ((let uu____5314 = mk_cache_entry env "" [] [] in + FStar_Util.smap_add env.cache sz_key uu____5314); t_decls) in - let uu____5377 = + let uu____5315 = match ((head1.FStar_Syntax_Syntax.n), args_e) with | (FStar_Syntax_Syntax.Tm_fvar - fv,uu____5397::(sz_arg,uu____5399)::uu____5400::[]) when + fv,uu____5335::(sz_arg,uu____5337)::uu____5338::[]) when (FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.bv_uext_lid) && (isInteger sz_arg.FStar_Syntax_Syntax.n) -> - let uu____5449 = - let uu____5452 = FStar_List.tail args_e in - FStar_List.tail uu____5452 in - let uu____5455 = - let uu____5458 = getInteger sz_arg.FStar_Syntax_Syntax.n in - FStar_Pervasives_Native.Some uu____5458 in - (uu____5449, uu____5455) + let uu____5387 = + let uu____5390 = FStar_List.tail args_e in + FStar_List.tail uu____5390 in + let uu____5393 = + let uu____5396 = getInteger sz_arg.FStar_Syntax_Syntax.n in + FStar_Pervasives_Native.Some uu____5396 in + (uu____5387, uu____5393) | (FStar_Syntax_Syntax.Tm_fvar - fv,uu____5464::(sz_arg,uu____5466)::uu____5467::[]) when + fv,uu____5402::(sz_arg,uu____5404)::uu____5405::[]) when FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.bv_uext_lid -> - let uu____5516 = - let uu____5517 = FStar_Syntax_Print.term_to_string sz_arg in + let uu____5454 = + let uu____5455 = FStar_Syntax_Print.term_to_string sz_arg in FStar_Util.format1 - "Not a constant bitvector extend size: %s" uu____5517 in - failwith uu____5516 - | uu____5526 -> - let uu____5533 = FStar_List.tail args_e in - (uu____5533, FStar_Pervasives_Native.None) in - (match uu____5377 with + "Not a constant bitvector extend size: %s" uu____5455 in + failwith uu____5454 + | uu____5464 -> + let uu____5471 = FStar_List.tail args_e in + (uu____5471, FStar_Pervasives_Native.None) in + (match uu____5315 with | (arg_tms,ext_sz) -> - let uu____5556 = encode_args arg_tms env in - (match uu____5556 with + let uu____5494 = encode_args arg_tms env in + (match uu____5494 with | (arg_tms1,decls) -> let head_fv = match head1.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Tm_fvar fv -> fv - | uu____5577 -> failwith "Impossible" in + | uu____5515 -> failwith "Impossible" in let unary arg_tms2 = - let uu____5586 = FStar_List.hd arg_tms2 in - FStar_SMTEncoding_Term.unboxBitVec sz uu____5586 in + let uu____5524 = FStar_List.hd arg_tms2 in + FStar_SMTEncoding_Term.unboxBitVec sz uu____5524 in let unary_arith arg_tms2 = - let uu____5595 = FStar_List.hd arg_tms2 in - FStar_SMTEncoding_Term.unboxInt uu____5595 in + let uu____5533 = FStar_List.hd arg_tms2 in + FStar_SMTEncoding_Term.unboxInt uu____5533 in let binary arg_tms2 = - let uu____5608 = - let uu____5609 = FStar_List.hd arg_tms2 in - FStar_SMTEncoding_Term.unboxBitVec sz uu____5609 in - let uu____5610 = - let uu____5611 = - let uu____5612 = FStar_List.tl arg_tms2 in - FStar_List.hd uu____5612 in - FStar_SMTEncoding_Term.unboxBitVec sz uu____5611 in - (uu____5608, uu____5610) in + let uu____5546 = + let uu____5547 = FStar_List.hd arg_tms2 in + FStar_SMTEncoding_Term.unboxBitVec sz uu____5547 in + let uu____5548 = + let uu____5549 = + let uu____5550 = FStar_List.tl arg_tms2 in + FStar_List.hd uu____5550 in + FStar_SMTEncoding_Term.unboxBitVec sz uu____5549 in + (uu____5546, uu____5548) in let binary_arith arg_tms2 = - let uu____5627 = - let uu____5628 = FStar_List.hd arg_tms2 in - FStar_SMTEncoding_Term.unboxBitVec sz uu____5628 in - let uu____5629 = - let uu____5630 = - let uu____5631 = FStar_List.tl arg_tms2 in - FStar_List.hd uu____5631 in - FStar_SMTEncoding_Term.unboxInt uu____5630 in - (uu____5627, uu____5629) in + let uu____5565 = + let uu____5566 = FStar_List.hd arg_tms2 in + FStar_SMTEncoding_Term.unboxBitVec sz uu____5566 in + let uu____5567 = + let uu____5568 = + let uu____5569 = FStar_List.tl arg_tms2 in + FStar_List.hd uu____5569 in + FStar_SMTEncoding_Term.unboxInt uu____5568 in + (uu____5565, uu____5567) in let mk_bv op mk_args resBox ts = - let uu____5680 = - let uu____5681 = mk_args ts in op uu____5681 in - FStar_All.pipe_right uu____5680 resBox in + let uu____5618 = + let uu____5619 = mk_args ts in op uu____5619 in + FStar_All.pipe_right uu____5618 resBox in let bv_and = mk_bv FStar_SMTEncoding_Util.mkBvAnd binary (FStar_SMTEncoding_Term.boxBitVec sz) in @@ -1694,23 +1673,23 @@ and encode_BitVector_term: mk_bv FStar_SMTEncoding_Util.mkBvUlt binary FStar_SMTEncoding_Term.boxBool in let bv_uext arg_tms2 = - let uu____5789 = - let uu____5792 = + let uu____5727 = + let uu____5730 = match ext_sz with | FStar_Pervasives_Native.Some x -> x | FStar_Pervasives_Native.None -> failwith "impossible" in - FStar_SMTEncoding_Util.mkBvUext uu____5792 in - let uu____5794 = - let uu____5797 = - let uu____5798 = + FStar_SMTEncoding_Util.mkBvUext uu____5730 in + let uu____5732 = + let uu____5735 = + let uu____5736 = match ext_sz with | FStar_Pervasives_Native.Some x -> x | FStar_Pervasives_Native.None -> failwith "impossible" in - sz + uu____5798 in - FStar_SMTEncoding_Term.boxBitVec uu____5797 in - mk_bv uu____5789 unary uu____5794 arg_tms2 in + sz + uu____5736 in + FStar_SMTEncoding_Term.boxBitVec uu____5735 in + mk_bv uu____5727 unary uu____5732 arg_tms2 in let to_int1 = mk_bv FStar_SMTEncoding_Util.mkBvToNat unary FStar_SMTEncoding_Term.boxInt in @@ -1732,19 +1711,19 @@ and encode_BitVector_term: (FStar_Parser_Const.bv_uext_lid, bv_uext); (FStar_Parser_Const.bv_to_nat_lid, to_int1); (FStar_Parser_Const.nat_to_bv_lid, bv_to)] in - let uu____5997 = - let uu____6006 = + let uu____5935 = + let uu____5944 = FStar_List.tryFind - (fun uu____6028 -> - match uu____6028 with - | (l,uu____6038) -> + (fun uu____5966 -> + match uu____5966 with + | (l,uu____5976) -> FStar_Syntax_Syntax.fv_eq_lid head_fv l) ops in - FStar_All.pipe_right uu____6006 FStar_Util.must in - (match uu____5997 with - | (uu____6079,op) -> - let uu____6089 = op arg_tms1 in - (uu____6089, (FStar_List.append sz_decls decls))))) + FStar_All.pipe_right uu____5944 FStar_Util.must in + (match uu____5935 with + | (uu____6017,op) -> + let uu____6027 = op arg_tms1 in + (uu____6027, (FStar_List.append sz_decls decls))))) and encode_term: FStar_Syntax_Syntax.typ -> env_t -> @@ -1754,212 +1733,212 @@ and encode_term: fun t -> fun env -> let t0 = FStar_Syntax_Subst.compress t in - (let uu____6100 = + (let uu____6038 = FStar_All.pipe_left (FStar_TypeChecker_Env.debug env.tcenv) (FStar_Options.Other "SMTEncoding") in - if uu____6100 + if uu____6038 then - let uu____6101 = FStar_Syntax_Print.tag_of_term t in - let uu____6102 = FStar_Syntax_Print.tag_of_term t0 in - let uu____6103 = FStar_Syntax_Print.term_to_string t0 in - FStar_Util.print3 "(%s) (%s) %s\n" uu____6101 uu____6102 - uu____6103 + let uu____6039 = FStar_Syntax_Print.tag_of_term t in + let uu____6040 = FStar_Syntax_Print.tag_of_term t0 in + let uu____6041 = FStar_Syntax_Print.term_to_string t0 in + FStar_Util.print3 "(%s) (%s) %s\n" uu____6039 uu____6040 + uu____6041 else ()); (match t0.FStar_Syntax_Syntax.n with - | FStar_Syntax_Syntax.Tm_delayed uu____6109 -> - let uu____6134 = - let uu____6135 = + | FStar_Syntax_Syntax.Tm_delayed uu____6047 -> + let uu____6072 = + let uu____6073 = FStar_All.pipe_left FStar_Range.string_of_range t.FStar_Syntax_Syntax.pos in - let uu____6136 = FStar_Syntax_Print.tag_of_term t0 in - let uu____6137 = FStar_Syntax_Print.term_to_string t0 in - let uu____6138 = FStar_Syntax_Print.term_to_string t in - FStar_Util.format4 "(%s) Impossible: %s\n%s\n%s\n" uu____6135 - uu____6136 uu____6137 uu____6138 in - failwith uu____6134 + let uu____6074 = FStar_Syntax_Print.tag_of_term t0 in + let uu____6075 = FStar_Syntax_Print.term_to_string t0 in + let uu____6076 = FStar_Syntax_Print.term_to_string t in + FStar_Util.format4 "(%s) Impossible: %s\n%s\n%s\n" uu____6073 + uu____6074 uu____6075 uu____6076 in + failwith uu____6072 | FStar_Syntax_Syntax.Tm_unknown -> - let uu____6143 = - let uu____6144 = + let uu____6081 = + let uu____6082 = FStar_All.pipe_left FStar_Range.string_of_range t.FStar_Syntax_Syntax.pos in - let uu____6145 = FStar_Syntax_Print.tag_of_term t0 in - let uu____6146 = FStar_Syntax_Print.term_to_string t0 in - let uu____6147 = FStar_Syntax_Print.term_to_string t in - FStar_Util.format4 "(%s) Impossible: %s\n%s\n%s\n" uu____6144 - uu____6145 uu____6146 uu____6147 in - failwith uu____6143 + let uu____6083 = FStar_Syntax_Print.tag_of_term t0 in + let uu____6084 = FStar_Syntax_Print.term_to_string t0 in + let uu____6085 = FStar_Syntax_Print.term_to_string t in + FStar_Util.format4 "(%s) Impossible: %s\n%s\n%s\n" uu____6082 + uu____6083 uu____6084 uu____6085 in + failwith uu____6081 | FStar_Syntax_Syntax.Tm_bvar x -> - let uu____6153 = - let uu____6154 = FStar_Syntax_Print.bv_to_string x in + let uu____6091 = + let uu____6092 = FStar_Syntax_Print.bv_to_string x in FStar_Util.format1 "Impossible: locally nameless; got %s" - uu____6154 in - failwith uu____6153 - | FStar_Syntax_Syntax.Tm_ascribed (t1,k,uu____6161) -> + uu____6092 in + failwith uu____6091 + | FStar_Syntax_Syntax.Tm_ascribed (t1,k,uu____6099) -> encode_term t1 env | FStar_Syntax_Syntax.Tm_meta ({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_unknown ; - FStar_Syntax_Syntax.pos = uu____6202; - FStar_Syntax_Syntax.vars = uu____6203;_},FStar_Syntax_Syntax.Meta_alien + FStar_Syntax_Syntax.pos = uu____6140; + FStar_Syntax_Syntax.vars = uu____6141;_},FStar_Syntax_Syntax.Meta_alien (obj,desc,ty)) -> let tsym = - let uu____6220 = varops.fresh "t" in - (uu____6220, FStar_SMTEncoding_Term.Term_sort) in + let uu____6158 = varops.fresh "t" in + (uu____6158, FStar_SMTEncoding_Term.Term_sort) in let t1 = FStar_SMTEncoding_Util.mkFreeV tsym in let decl = - let uu____6223 = - let uu____6234 = - let uu____6237 = FStar_Util.format1 "alien term (%s)" desc in - FStar_Pervasives_Native.Some uu____6237 in + let uu____6161 = + let uu____6172 = + let uu____6175 = FStar_Util.format1 "alien term (%s)" desc in + FStar_Pervasives_Native.Some uu____6175 in ((FStar_Pervasives_Native.fst tsym), [], - FStar_SMTEncoding_Term.Term_sort, uu____6234) in - FStar_SMTEncoding_Term.DeclFun uu____6223 in + FStar_SMTEncoding_Term.Term_sort, uu____6172) in + FStar_SMTEncoding_Term.DeclFun uu____6161 in (t1, [decl]) - | FStar_Syntax_Syntax.Tm_meta (t1,uu____6245) -> encode_term t1 env + | FStar_Syntax_Syntax.Tm_meta (t1,uu____6183) -> encode_term t1 env | FStar_Syntax_Syntax.Tm_name x -> let t1 = lookup_term_var env x in (t1, []) | FStar_Syntax_Syntax.Tm_fvar v1 -> - let uu____6255 = + let uu____6193 = lookup_free_var env v1.FStar_Syntax_Syntax.fv_name in - (uu____6255, []) - | FStar_Syntax_Syntax.Tm_type uu____6258 -> + (uu____6193, []) + | FStar_Syntax_Syntax.Tm_type uu____6196 -> (FStar_SMTEncoding_Term.mk_Term_type, []) - | FStar_Syntax_Syntax.Tm_uinst (t1,uu____6262) -> encode_term t1 env + | FStar_Syntax_Syntax.Tm_uinst (t1,uu____6200) -> encode_term t1 env | FStar_Syntax_Syntax.Tm_constant c -> encode_const c env | FStar_Syntax_Syntax.Tm_arrow (binders,c) -> let module_name = env.current_module_name in - let uu____6287 = FStar_Syntax_Subst.open_comp binders c in - (match uu____6287 with + let uu____6225 = FStar_Syntax_Subst.open_comp binders c in + (match uu____6225 with | (binders1,res) -> - let uu____6298 = + let uu____6236 = (env.encode_non_total_function_typ && (FStar_Syntax_Util.is_pure_or_ghost_comp res)) || (FStar_Syntax_Util.is_tot_or_gtot_comp res) in - if uu____6298 + if uu____6236 then - let uu____6303 = + let uu____6241 = encode_binders FStar_Pervasives_Native.None binders1 env in - (match uu____6303 with - | (vars,guards,env',decls,uu____6328) -> + (match uu____6241 with + | (vars,guards,env',decls,uu____6266) -> let fsym = - let uu____6346 = varops.fresh "f" in - (uu____6346, FStar_SMTEncoding_Term.Term_sort) in + let uu____6284 = varops.fresh "f" in + (uu____6284, FStar_SMTEncoding_Term.Term_sort) in let f = FStar_SMTEncoding_Util.mkFreeV fsym in let app = mk_Apply f vars in - let uu____6349 = + let uu____6287 = FStar_TypeChecker_Util.pure_or_ghost_pre_and_post - (let uu___109_6358 = env.tcenv in + (let uu___109_6296 = env.tcenv in { FStar_TypeChecker_Env.solver = - (uu___109_6358.FStar_TypeChecker_Env.solver); + (uu___109_6296.FStar_TypeChecker_Env.solver); FStar_TypeChecker_Env.range = - (uu___109_6358.FStar_TypeChecker_Env.range); + (uu___109_6296.FStar_TypeChecker_Env.range); FStar_TypeChecker_Env.curmodule = - (uu___109_6358.FStar_TypeChecker_Env.curmodule); + (uu___109_6296.FStar_TypeChecker_Env.curmodule); FStar_TypeChecker_Env.gamma = - (uu___109_6358.FStar_TypeChecker_Env.gamma); + (uu___109_6296.FStar_TypeChecker_Env.gamma); FStar_TypeChecker_Env.gamma_cache = - (uu___109_6358.FStar_TypeChecker_Env.gamma_cache); + (uu___109_6296.FStar_TypeChecker_Env.gamma_cache); FStar_TypeChecker_Env.modules = - (uu___109_6358.FStar_TypeChecker_Env.modules); + (uu___109_6296.FStar_TypeChecker_Env.modules); FStar_TypeChecker_Env.expected_typ = - (uu___109_6358.FStar_TypeChecker_Env.expected_typ); + (uu___109_6296.FStar_TypeChecker_Env.expected_typ); FStar_TypeChecker_Env.sigtab = - (uu___109_6358.FStar_TypeChecker_Env.sigtab); + (uu___109_6296.FStar_TypeChecker_Env.sigtab); FStar_TypeChecker_Env.is_pattern = - (uu___109_6358.FStar_TypeChecker_Env.is_pattern); + (uu___109_6296.FStar_TypeChecker_Env.is_pattern); FStar_TypeChecker_Env.instantiate_imp = - (uu___109_6358.FStar_TypeChecker_Env.instantiate_imp); + (uu___109_6296.FStar_TypeChecker_Env.instantiate_imp); FStar_TypeChecker_Env.effects = - (uu___109_6358.FStar_TypeChecker_Env.effects); + (uu___109_6296.FStar_TypeChecker_Env.effects); FStar_TypeChecker_Env.generalize = - (uu___109_6358.FStar_TypeChecker_Env.generalize); + (uu___109_6296.FStar_TypeChecker_Env.generalize); FStar_TypeChecker_Env.letrecs = - (uu___109_6358.FStar_TypeChecker_Env.letrecs); + (uu___109_6296.FStar_TypeChecker_Env.letrecs); FStar_TypeChecker_Env.top_level = - (uu___109_6358.FStar_TypeChecker_Env.top_level); + (uu___109_6296.FStar_TypeChecker_Env.top_level); FStar_TypeChecker_Env.check_uvars = - (uu___109_6358.FStar_TypeChecker_Env.check_uvars); + (uu___109_6296.FStar_TypeChecker_Env.check_uvars); FStar_TypeChecker_Env.use_eq = - (uu___109_6358.FStar_TypeChecker_Env.use_eq); + (uu___109_6296.FStar_TypeChecker_Env.use_eq); FStar_TypeChecker_Env.is_iface = - (uu___109_6358.FStar_TypeChecker_Env.is_iface); + (uu___109_6296.FStar_TypeChecker_Env.is_iface); FStar_TypeChecker_Env.admit = - (uu___109_6358.FStar_TypeChecker_Env.admit); + (uu___109_6296.FStar_TypeChecker_Env.admit); FStar_TypeChecker_Env.lax = true; FStar_TypeChecker_Env.lax_universes = - (uu___109_6358.FStar_TypeChecker_Env.lax_universes); + (uu___109_6296.FStar_TypeChecker_Env.lax_universes); FStar_TypeChecker_Env.failhard = - (uu___109_6358.FStar_TypeChecker_Env.failhard); + (uu___109_6296.FStar_TypeChecker_Env.failhard); FStar_TypeChecker_Env.nosynth = - (uu___109_6358.FStar_TypeChecker_Env.nosynth); + (uu___109_6296.FStar_TypeChecker_Env.nosynth); FStar_TypeChecker_Env.tc_term = - (uu___109_6358.FStar_TypeChecker_Env.tc_term); + (uu___109_6296.FStar_TypeChecker_Env.tc_term); FStar_TypeChecker_Env.type_of = - (uu___109_6358.FStar_TypeChecker_Env.type_of); + (uu___109_6296.FStar_TypeChecker_Env.type_of); FStar_TypeChecker_Env.universe_of = - (uu___109_6358.FStar_TypeChecker_Env.universe_of); + (uu___109_6296.FStar_TypeChecker_Env.universe_of); FStar_TypeChecker_Env.use_bv_sorts = - (uu___109_6358.FStar_TypeChecker_Env.use_bv_sorts); + (uu___109_6296.FStar_TypeChecker_Env.use_bv_sorts); FStar_TypeChecker_Env.qname_and_index = - (uu___109_6358.FStar_TypeChecker_Env.qname_and_index); + (uu___109_6296.FStar_TypeChecker_Env.qname_and_index); FStar_TypeChecker_Env.proof_ns = - (uu___109_6358.FStar_TypeChecker_Env.proof_ns); + (uu___109_6296.FStar_TypeChecker_Env.proof_ns); FStar_TypeChecker_Env.synth = - (uu___109_6358.FStar_TypeChecker_Env.synth); + (uu___109_6296.FStar_TypeChecker_Env.synth); FStar_TypeChecker_Env.is_native_tactic = - (uu___109_6358.FStar_TypeChecker_Env.is_native_tactic); + (uu___109_6296.FStar_TypeChecker_Env.is_native_tactic); FStar_TypeChecker_Env.identifier_info = - (uu___109_6358.FStar_TypeChecker_Env.identifier_info); + (uu___109_6296.FStar_TypeChecker_Env.identifier_info); FStar_TypeChecker_Env.tc_hooks = - (uu___109_6358.FStar_TypeChecker_Env.tc_hooks); + (uu___109_6296.FStar_TypeChecker_Env.tc_hooks); FStar_TypeChecker_Env.dsenv = - (uu___109_6358.FStar_TypeChecker_Env.dsenv); + (uu___109_6296.FStar_TypeChecker_Env.dsenv); FStar_TypeChecker_Env.dep_graph = - (uu___109_6358.FStar_TypeChecker_Env.dep_graph) + (uu___109_6296.FStar_TypeChecker_Env.dep_graph) }) res in - (match uu____6349 with + (match uu____6287 with | (pre_opt,res_t) -> - let uu____6369 = + let uu____6307 = encode_term_pred FStar_Pervasives_Native.None res_t env' app in - (match uu____6369 with + (match uu____6307 with | (res_pred,decls') -> - let uu____6380 = + let uu____6318 = match pre_opt with | FStar_Pervasives_Native.None -> - let uu____6393 = + let uu____6331 = FStar_SMTEncoding_Util.mk_and_l guards in - (uu____6393, []) + (uu____6331, []) | FStar_Pervasives_Native.Some pre -> - let uu____6397 = + let uu____6335 = encode_formula pre env' in - (match uu____6397 with + (match uu____6335 with | (guard,decls0) -> - let uu____6410 = + let uu____6348 = FStar_SMTEncoding_Util.mk_and_l (guard :: guards) in - (uu____6410, decls0)) in - (match uu____6380 with + (uu____6348, decls0)) in + (match uu____6318 with | (guards1,guard_decls) -> let t_interp = - let uu____6422 = - let uu____6433 = + let uu____6360 = + let uu____6371 = FStar_SMTEncoding_Util.mkImp (guards1, res_pred) in - ([[app]], vars, uu____6433) in + ([[app]], vars, uu____6371) in FStar_SMTEncoding_Util.mkForall - uu____6422 in + uu____6360 in let cvars = - let uu____6451 = + let uu____6389 = FStar_SMTEncoding_Term.free_variables t_interp in - FStar_All.pipe_right uu____6451 + FStar_All.pipe_right uu____6389 (FStar_List.filter - (fun uu____6465 -> - match uu____6465 with - | (x,uu____6471) -> + (fun uu____6403 -> + match uu____6403 with + | (x,uu____6409) -> x <> (FStar_Pervasives_Native.fst fsym))) in @@ -1969,23 +1948,23 @@ and encode_term: let tkey_hash = FStar_SMTEncoding_Term.hash_of_term tkey in - let uu____6490 = + let uu____6428 = FStar_Util.smap_try_find env.cache tkey_hash in - (match uu____6490 with + (match uu____6428 with | FStar_Pervasives_Native.Some cache_entry -> - let uu____6498 = - let uu____6499 = - let uu____6506 = + let uu____6436 = + let uu____6437 = + let uu____6444 = FStar_All.pipe_right cvars (FStar_List.map FStar_SMTEncoding_Util.mkFreeV) in ((cache_entry.cache_symbol_name), - uu____6506) in + uu____6444) in FStar_SMTEncoding_Util.mkApp - uu____6499 in - (uu____6498, + uu____6437 in + (uu____6436, (FStar_List.append decls (FStar_List.append decls' (FStar_List.append @@ -1994,27 +1973,27 @@ and encode_term: cache_entry))))) | FStar_Pervasives_Native.None -> let tsym = - let uu____6526 = - let uu____6527 = + let uu____6464 = + let uu____6465 = FStar_Util.digest_of_string tkey_hash in Prims.strcat "Tm_arrow_" - uu____6527 in - varops.mk_unique uu____6526 in + uu____6465 in + varops.mk_unique uu____6464 in let cvar_sorts = FStar_List.map FStar_Pervasives_Native.snd cvars in let caption = - let uu____6538 = + let uu____6476 = FStar_Options.log_queries () in - if uu____6538 + if uu____6476 then - let uu____6541 = + let uu____6479 = FStar_TypeChecker_Normalize.term_to_string env.tcenv t0 in FStar_Pervasives_Native.Some - uu____6541 + uu____6479 else FStar_Pervasives_Native.None in let tdecl = @@ -2023,14 +2002,14 @@ and encode_term: FStar_SMTEncoding_Term.Term_sort, caption) in let t1 = - let uu____6549 = - let uu____6556 = + let uu____6487 = + let uu____6494 = FStar_List.map FStar_SMTEncoding_Util.mkFreeV cvars in - (tsym, uu____6556) in + (tsym, uu____6494) in FStar_SMTEncoding_Util.mkApp - uu____6549 in + uu____6487 in let t_has_kind = FStar_SMTEncoding_Term.mk_HasType t1 @@ -2038,16 +2017,16 @@ and encode_term: let k_assumption = let a_name = Prims.strcat "kinding_" tsym in - let uu____6568 = - let uu____6575 = + let uu____6506 = + let uu____6513 = FStar_SMTEncoding_Util.mkForall ([[t_has_kind]], cvars, t_has_kind) in - (uu____6575, + (uu____6513, (FStar_Pervasives_Native.Some a_name), a_name) in FStar_SMTEncoding_Util.mkAssume - uu____6568 in + uu____6506 in let f_has_t = FStar_SMTEncoding_Term.mk_HasType f t1 in @@ -2058,52 +2037,52 @@ and encode_term: let a_name = Prims.strcat "pre_typing_" tsym in - let uu____6596 = - let uu____6603 = - let uu____6604 = - let uu____6615 = - let uu____6616 = - let uu____6621 = - let uu____6622 = + let uu____6534 = + let uu____6541 = + let uu____6542 = + let uu____6553 = + let uu____6554 = + let uu____6559 = + let uu____6560 = FStar_SMTEncoding_Term.mk_PreType f in FStar_SMTEncoding_Term.mk_tester "Tm_arrow" - uu____6622 in - (f_has_t, uu____6621) in + uu____6560 in + (f_has_t, uu____6559) in FStar_SMTEncoding_Util.mkImp - uu____6616 in + uu____6554 in ([[f_has_t]], (fsym :: - cvars), uu____6615) in - mkForall_fuel uu____6604 in - (uu____6603, + cvars), uu____6553) in + mkForall_fuel uu____6542 in + (uu____6541, (FStar_Pervasives_Native.Some "pre-typing for functions"), (Prims.strcat module_name (Prims.strcat "_" a_name))) in FStar_SMTEncoding_Util.mkAssume - uu____6596 in + uu____6534 in let t_interp1 = let a_name = Prims.strcat "interpretation_" tsym in - let uu____6645 = - let uu____6652 = - let uu____6653 = - let uu____6664 = + let uu____6583 = + let uu____6590 = + let uu____6591 = + let uu____6602 = FStar_SMTEncoding_Util.mkIff (f_has_t_z, t_interp) in ([[f_has_t_z]], (fsym :: - cvars), uu____6664) in + cvars), uu____6602) in FStar_SMTEncoding_Util.mkForall - uu____6653 in - (uu____6652, + uu____6591 in + (uu____6590, (FStar_Pervasives_Native.Some a_name), (Prims.strcat module_name (Prims.strcat "_" a_name))) in FStar_SMTEncoding_Util.mkAssume - uu____6645 in + uu____6583 in let t_decls = FStar_List.append (tdecl :: decls) @@ -2113,11 +2092,11 @@ and encode_term: [k_assumption; pre_typing; t_interp1])) in - ((let uu____6689 = + ((let uu____6627 = mk_cache_entry env tsym cvar_sorts t_decls in FStar_Util.smap_add env.cache - tkey_hash uu____6689); + tkey_hash uu____6627); (t1, t_decls))))))) else (let tsym = varops.fresh "Non_total_Tm_arrow" in @@ -2129,74 +2108,74 @@ and encode_term: let t_kinding = let a_name = Prims.strcat "non_total_function_typing_" tsym in - let uu____6704 = - let uu____6711 = + let uu____6642 = + let uu____6649 = FStar_SMTEncoding_Term.mk_HasType t1 FStar_SMTEncoding_Term.mk_Term_type in - (uu____6711, + (uu____6649, (FStar_Pervasives_Native.Some "Typing for non-total arrows"), (Prims.strcat module_name (Prims.strcat "_" a_name))) in - FStar_SMTEncoding_Util.mkAssume uu____6704 in + FStar_SMTEncoding_Util.mkAssume uu____6642 in let fsym = ("f", FStar_SMTEncoding_Term.Term_sort) in let f = FStar_SMTEncoding_Util.mkFreeV fsym in let f_has_t = FStar_SMTEncoding_Term.mk_HasType f t1 in let t_interp = let a_name = Prims.strcat "pre_typing_" tsym in - let uu____6723 = - let uu____6730 = - let uu____6731 = - let uu____6742 = - let uu____6743 = - let uu____6748 = - let uu____6749 = + let uu____6661 = + let uu____6668 = + let uu____6669 = + let uu____6680 = + let uu____6681 = + let uu____6686 = + let uu____6687 = FStar_SMTEncoding_Term.mk_PreType f in FStar_SMTEncoding_Term.mk_tester "Tm_arrow" - uu____6749 in - (f_has_t, uu____6748) in - FStar_SMTEncoding_Util.mkImp uu____6743 in - ([[f_has_t]], [fsym], uu____6742) in - mkForall_fuel uu____6731 in - (uu____6730, (FStar_Pervasives_Native.Some a_name), + uu____6687 in + (f_has_t, uu____6686) in + FStar_SMTEncoding_Util.mkImp uu____6681 in + ([[f_has_t]], [fsym], uu____6680) in + mkForall_fuel uu____6669 in + (uu____6668, (FStar_Pervasives_Native.Some a_name), (Prims.strcat module_name (Prims.strcat "_" a_name))) in - FStar_SMTEncoding_Util.mkAssume uu____6723 in + FStar_SMTEncoding_Util.mkAssume uu____6661 in (t1, [tdecl; t_kinding; t_interp]))) - | FStar_Syntax_Syntax.Tm_refine uu____6776 -> - let uu____6783 = - let uu____6788 = + | FStar_Syntax_Syntax.Tm_refine uu____6714 -> + let uu____6721 = + let uu____6726 = FStar_TypeChecker_Normalize.normalize_refinement [FStar_TypeChecker_Normalize.Weak; FStar_TypeChecker_Normalize.HNF; FStar_TypeChecker_Normalize.EraseUniverses] env.tcenv t0 in - match uu____6788 with + match uu____6726 with | { FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_refine (x,f); - FStar_Syntax_Syntax.pos = uu____6795; - FStar_Syntax_Syntax.vars = uu____6796;_} -> - let uu____6803 = + FStar_Syntax_Syntax.pos = uu____6733; + FStar_Syntax_Syntax.vars = uu____6734;_} -> + let uu____6741 = FStar_Syntax_Subst.open_term [(x, FStar_Pervasives_Native.None)] f in - (match uu____6803 with + (match uu____6741 with | (b,f1) -> - let uu____6828 = - let uu____6829 = FStar_List.hd b in - FStar_Pervasives_Native.fst uu____6829 in - (uu____6828, f1)) - | uu____6838 -> failwith "impossible" in - (match uu____6783 with + let uu____6766 = + let uu____6767 = FStar_List.hd b in + FStar_Pervasives_Native.fst uu____6767 in + (uu____6766, f1)) + | uu____6776 -> failwith "impossible" in + (match uu____6721 with | (x,f) -> - let uu____6849 = encode_term x.FStar_Syntax_Syntax.sort env in - (match uu____6849 with + let uu____6787 = encode_term x.FStar_Syntax_Syntax.sort env in + (match uu____6787 with | (base_t,decls) -> - let uu____6860 = gen_term_var env x in - (match uu____6860 with + let uu____6798 = gen_term_var env x in + (match uu____6798 with | (x1,xtm,env') -> - let uu____6874 = encode_formula f env' in - (match uu____6874 with + let uu____6812 = encode_formula f env' in + (match uu____6812 with | (refinement,decls') -> - let uu____6885 = + let uu____6823 = fresh_fvar "f" FStar_SMTEncoding_Term.Fuel_sort in - (match uu____6885 with + (match uu____6823 with | (fsym,fterm) -> let tm_has_type_with_fuel = FStar_SMTEncoding_Term.mk_HasTypeWithFuel @@ -2206,24 +2185,24 @@ and encode_term: FStar_SMTEncoding_Util.mkAnd (tm_has_type_with_fuel, refinement) in let cvars = - let uu____6901 = - let uu____6904 = + let uu____6839 = + let uu____6842 = FStar_SMTEncoding_Term.free_variables refinement in - let uu____6911 = + let uu____6849 = FStar_SMTEncoding_Term.free_variables tm_has_type_with_fuel in - FStar_List.append uu____6904 - uu____6911 in + FStar_List.append uu____6842 + uu____6849 in FStar_Util.remove_dups FStar_SMTEncoding_Term.fv_eq - uu____6901 in + uu____6839 in let cvars1 = FStar_All.pipe_right cvars (FStar_List.filter - (fun uu____6944 -> - match uu____6944 with - | (y,uu____6950) -> + (fun uu____6882 -> + match uu____6882 with + | (y,uu____6888) -> (y <> x1) && (y <> fsym))) in let xfv = (x1, FStar_SMTEncoding_Term.Term_sort) in @@ -2237,23 +2216,23 @@ and encode_term: let tkey_hash = FStar_SMTEncoding_Term.hash_of_term tkey in - let uu____6983 = + let uu____6921 = FStar_Util.smap_try_find env.cache tkey_hash in - (match uu____6983 with + (match uu____6921 with | FStar_Pervasives_Native.Some cache_entry -> - let uu____6991 = - let uu____6992 = - let uu____6999 = + let uu____6929 = + let uu____6930 = + let uu____6937 = FStar_All.pipe_right cvars1 (FStar_List.map FStar_SMTEncoding_Util.mkFreeV) in ((cache_entry.cache_symbol_name), - uu____6999) in + uu____6937) in FStar_SMTEncoding_Util.mkApp - uu____6992 in - (uu____6991, + uu____6930 in + (uu____6929, (FStar_List.append decls (FStar_List.append decls' (use_cache_entry cache_entry)))) @@ -2261,16 +2240,16 @@ and encode_term: let module_name = env.current_module_name in let tsym = - let uu____7020 = - let uu____7021 = - let uu____7022 = + let uu____6958 = + let uu____6959 = + let uu____6960 = FStar_Util.digest_of_string tkey_hash in Prims.strcat "_Tm_refine_" - uu____7022 in + uu____6960 in Prims.strcat module_name - uu____7021 in - varops.mk_unique uu____7020 in + uu____6959 in + varops.mk_unique uu____6958 in let cvar_sorts = FStar_List.map FStar_Pervasives_Native.snd @@ -2281,14 +2260,14 @@ and encode_term: FStar_SMTEncoding_Term.Term_sort, FStar_Pervasives_Native.None) in let t1 = - let uu____7036 = - let uu____7043 = + let uu____6974 = + let uu____6981 = FStar_List.map FStar_SMTEncoding_Util.mkFreeV cvars1 in - (tsym, uu____7043) in + (tsym, uu____6981) in FStar_SMTEncoding_Util.mkApp - uu____7036 in + uu____6974 in let x_has_base_t = FStar_SMTEncoding_Term.mk_HasType xtm base_t in @@ -2306,60 +2285,60 @@ and encode_term: let t_haseq_ref = FStar_SMTEncoding_Term.mk_haseq t1 in let t_haseq1 = - let uu____7058 = - let uu____7065 = - let uu____7066 = - let uu____7077 = + let uu____6996 = + let uu____7003 = + let uu____7004 = + let uu____7015 = FStar_SMTEncoding_Util.mkIff (t_haseq_ref, t_haseq_base) in ([[t_haseq_ref]], cvars1, - uu____7077) in + uu____7015) in FStar_SMTEncoding_Util.mkForall - uu____7066 in - (uu____7065, + uu____7004 in + (uu____7003, (FStar_Pervasives_Native.Some (Prims.strcat "haseq for " tsym)), (Prims.strcat "haseq" tsym)) in FStar_SMTEncoding_Util.mkAssume - uu____7058 in + uu____6996 in let t_kinding = - let uu____7095 = - let uu____7102 = + let uu____7033 = + let uu____7040 = FStar_SMTEncoding_Util.mkForall ([[t_has_kind]], cvars1, t_has_kind) in - (uu____7102, + (uu____7040, (FStar_Pervasives_Native.Some "refinement kinding"), (Prims.strcat "refinement_kinding_" tsym)) in FStar_SMTEncoding_Util.mkAssume - uu____7095 in + uu____7033 in let t_interp = - let uu____7120 = - let uu____7127 = - let uu____7128 = - let uu____7139 = + let uu____7058 = + let uu____7065 = + let uu____7066 = + let uu____7077 = FStar_SMTEncoding_Util.mkIff (x_has_t, encoding) in ([[x_has_t]], (ffv :: xfv :: - cvars1), uu____7139) in + cvars1), uu____7077) in FStar_SMTEncoding_Util.mkForall - uu____7128 in - let uu____7162 = - let uu____7165 = + uu____7066 in + let uu____7100 = + let uu____7103 = FStar_Syntax_Print.term_to_string t0 in FStar_Pervasives_Native.Some - uu____7165 in - (uu____7127, uu____7162, + uu____7103 in + (uu____7065, uu____7100, (Prims.strcat "refinement_interpretation_" tsym)) in FStar_SMTEncoding_Util.mkAssume - uu____7120 in + uu____7058 in let t_decls = FStar_List.append decls (FStar_List.append decls' @@ -2367,131 +2346,131 @@ and encode_term: t_kinding; t_interp; t_haseq1]) in - ((let uu____7172 = + ((let uu____7110 = mk_cache_entry env tsym cvar_sorts t_decls in FStar_Util.smap_add env.cache - tkey_hash uu____7172); + tkey_hash uu____7110); (t1, t_decls)))))))) | FStar_Syntax_Syntax.Tm_uvar (uv,k) -> let ttm = - let uu____7202 = FStar_Syntax_Unionfind.uvar_id uv in - FStar_SMTEncoding_Util.mk_Term_uvar uu____7202 in - let uu____7203 = + let uu____7140 = FStar_Syntax_Unionfind.uvar_id uv in + FStar_SMTEncoding_Util.mk_Term_uvar uu____7140 in + let uu____7141 = encode_term_pred FStar_Pervasives_Native.None k env ttm in - (match uu____7203 with + (match uu____7141 with | (t_has_k,decls) -> let d = - let uu____7215 = - let uu____7222 = - let uu____7223 = - let uu____7224 = - let uu____7225 = FStar_Syntax_Unionfind.uvar_id uv in + let uu____7153 = + let uu____7160 = + let uu____7161 = + let uu____7162 = + let uu____7163 = FStar_Syntax_Unionfind.uvar_id uv in FStar_All.pipe_left FStar_Util.string_of_int - uu____7225 in - FStar_Util.format1 "uvar_typing_%s" uu____7224 in - varops.mk_unique uu____7223 in + uu____7163 in + FStar_Util.format1 "uvar_typing_%s" uu____7162 in + varops.mk_unique uu____7161 in (t_has_k, (FStar_Pervasives_Native.Some "Uvar typing"), - uu____7222) in - FStar_SMTEncoding_Util.mkAssume uu____7215 in + uu____7160) in + FStar_SMTEncoding_Util.mkAssume uu____7153 in (ttm, (FStar_List.append decls [d]))) - | FStar_Syntax_Syntax.Tm_app uu____7230 -> - let uu____7245 = FStar_Syntax_Util.head_and_args t0 in - (match uu____7245 with + | FStar_Syntax_Syntax.Tm_app uu____7168 -> + let uu____7183 = FStar_Syntax_Util.head_and_args t0 in + (match uu____7183 with | (head1,args_e) -> - let uu____7286 = - let uu____7299 = - let uu____7300 = FStar_Syntax_Subst.compress head1 in - uu____7300.FStar_Syntax_Syntax.n in - (uu____7299, args_e) in - (match uu____7286 with - | uu____7315 when head_redex env head1 -> - let uu____7328 = whnf env t in - encode_term uu____7328 env - | uu____7329 when is_arithmetic_primitive head1 args_e -> + let uu____7224 = + let uu____7237 = + let uu____7238 = FStar_Syntax_Subst.compress head1 in + uu____7238.FStar_Syntax_Syntax.n in + (uu____7237, args_e) in + (match uu____7224 with + | uu____7253 when head_redex env head1 -> + let uu____7266 = whnf env t in + encode_term uu____7266 env + | uu____7267 when is_arithmetic_primitive head1 args_e -> encode_arith_term env head1 args_e - | uu____7348 when is_BitVector_primitive head1 args_e -> + | uu____7286 when is_BitVector_primitive head1 args_e -> encode_BitVector_term env head1 args_e | (FStar_Syntax_Syntax.Tm_uinst ({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_fvar fv; - FStar_Syntax_Syntax.pos = uu____7362; - FStar_Syntax_Syntax.vars = uu____7363;_},uu____7364),uu____7365:: - (v1,uu____7367)::(v2,uu____7369)::[]) when + FStar_Syntax_Syntax.pos = uu____7300; + FStar_Syntax_Syntax.vars = uu____7301;_},uu____7302),uu____7303:: + (v1,uu____7305)::(v2,uu____7307)::[]) when FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.lexcons_lid -> - let uu____7420 = encode_term v1 env in - (match uu____7420 with + let uu____7358 = encode_term v1 env in + (match uu____7358 with | (v11,decls1) -> - let uu____7431 = encode_term v2 env in - (match uu____7431 with + let uu____7369 = encode_term v2 env in + (match uu____7369 with | (v21,decls2) -> - let uu____7442 = + let uu____7380 = FStar_SMTEncoding_Util.mk_LexCons v11 v21 in - (uu____7442, + (uu____7380, (FStar_List.append decls1 decls2)))) | (FStar_Syntax_Syntax.Tm_fvar - fv,uu____7446::(v1,uu____7448)::(v2,uu____7450)::[]) when + fv,uu____7384::(v1,uu____7386)::(v2,uu____7388)::[]) when FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.lexcons_lid -> - let uu____7497 = encode_term v1 env in - (match uu____7497 with + let uu____7435 = encode_term v1 env in + (match uu____7435 with | (v11,decls1) -> - let uu____7508 = encode_term v2 env in - (match uu____7508 with + let uu____7446 = encode_term v2 env in + (match uu____7446 with | (v21,decls2) -> - let uu____7519 = + let uu____7457 = FStar_SMTEncoding_Util.mk_LexCons v11 v21 in - (uu____7519, + (uu____7457, (FStar_List.append decls1 decls2)))) | (FStar_Syntax_Syntax.Tm_constant - (FStar_Const.Const_range_of ),(arg,uu____7523)::[]) -> + (FStar_Const.Const_range_of ),(arg,uu____7461)::[]) -> encode_const (FStar_Const.Const_range (arg.FStar_Syntax_Syntax.pos)) env | (FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_set_range_of - ),(arg,uu____7549)::(rng,uu____7551)::[]) -> + ),(arg,uu____7487)::(rng,uu____7489)::[]) -> encode_term arg env | (FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_reify - ),uu____7586) -> + ),uu____7524) -> let e0 = - let uu____7604 = FStar_List.hd args_e in + let uu____7542 = FStar_List.hd args_e in FStar_TypeChecker_Util.reify_body_with_arg env.tcenv - head1 uu____7604 in - ((let uu____7612 = + head1 uu____7542 in + ((let uu____7550 = FStar_All.pipe_left (FStar_TypeChecker_Env.debug env.tcenv) (FStar_Options.Other "SMTEncodingReify") in - if uu____7612 + if uu____7550 then - let uu____7613 = + let uu____7551 = FStar_Syntax_Print.term_to_string e0 in FStar_Util.print1 "Result of normalization %s\n" - uu____7613 + uu____7551 else ()); (let e = - let uu____7618 = - let uu____7619 = + let uu____7556 = + let uu____7557 = FStar_TypeChecker_Util.remove_reify e0 in - let uu____7620 = FStar_List.tl args_e in - FStar_Syntax_Syntax.mk_Tm_app uu____7619 - uu____7620 in - uu____7618 FStar_Pervasives_Native.None + let uu____7558 = FStar_List.tl args_e in + FStar_Syntax_Syntax.mk_Tm_app uu____7557 + uu____7558 in + uu____7556 FStar_Pervasives_Native.None t0.FStar_Syntax_Syntax.pos in encode_term e env)) | (FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_reflect - uu____7629),(arg,uu____7631)::[]) -> encode_term arg env - | uu____7656 -> - let uu____7669 = encode_args args_e env in - (match uu____7669 with + uu____7567),(arg,uu____7569)::[]) -> encode_term arg env + | uu____7594 -> + let uu____7607 = encode_args args_e env in + (match uu____7607 with | (args,decls) -> let encode_partial_app ht_opt = - let uu____7724 = encode_term head1 env in - match uu____7724 with + let uu____7662 = encode_term head1 env in + match uu____7662 with | (head2,decls') -> let app_tm = mk_Apply_args head2 args in (match ht_opt with @@ -2500,71 +2479,71 @@ and encode_term: (FStar_List.append decls decls')) | FStar_Pervasives_Native.Some (formals,c) -> - let uu____7788 = + let uu____7726 = FStar_Util.first_N (FStar_List.length args_e) formals in - (match uu____7788 with + (match uu____7726 with | (formals1,rest) -> let subst1 = FStar_List.map2 - (fun uu____7866 -> - fun uu____7867 -> - match (uu____7866, - uu____7867) + (fun uu____7804 -> + fun uu____7805 -> + match (uu____7804, + uu____7805) with - | ((bv,uu____7889), - (a,uu____7891)) -> + | ((bv,uu____7827), + (a,uu____7829)) -> FStar_Syntax_Syntax.NT (bv, a)) formals1 args_e in let ty = - let uu____7909 = + let uu____7847 = FStar_Syntax_Util.arrow rest c in - FStar_All.pipe_right uu____7909 + FStar_All.pipe_right uu____7847 (FStar_Syntax_Subst.subst subst1) in - let uu____7914 = + let uu____7852 = encode_term_pred FStar_Pervasives_Native.None ty env app_tm in - (match uu____7914 with + (match uu____7852 with | (has_type,decls'') -> let cvars = FStar_SMTEncoding_Term.free_variables has_type in let e_typing = - let uu____7929 = - let uu____7936 = + let uu____7867 = + let uu____7874 = FStar_SMTEncoding_Util.mkForall ([[has_type]], cvars, has_type) in - let uu____7945 = - let uu____7946 = - let uu____7947 = - let uu____7948 = + let uu____7883 = + let uu____7884 = + let uu____7885 = + let uu____7886 = FStar_SMTEncoding_Term.hash_of_term app_tm in FStar_Util.digest_of_string - uu____7948 in + uu____7886 in Prims.strcat "partial_app_typing_" - uu____7947 in + uu____7885 in varops.mk_unique - uu____7946 in - (uu____7936, + uu____7884 in + (uu____7874, (FStar_Pervasives_Native.Some "Partial app typing"), - uu____7945) in + uu____7883) in FStar_SMTEncoding_Util.mkAssume - uu____7929 in + uu____7867 in (app_tm, (FStar_List.append decls (FStar_List.append decls' (FStar_List.append decls'' [e_typing]))))))) in let encode_full_app fv = - let uu____7965 = lookup_free_var_sym env fv in - match uu____7965 with + let uu____7903 = lookup_free_var_sym env fv in + match uu____7903 with | (fname,fuel_args) -> let tm = FStar_SMTEncoding_Util.mkApp' @@ -2578,8 +2557,8 @@ and encode_term: ({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_name x; - FStar_Syntax_Syntax.pos = uu____7996; - FStar_Syntax_Syntax.vars = uu____7997;_},uu____7998) + FStar_Syntax_Syntax.pos = uu____7934; + FStar_Syntax_Syntax.vars = uu____7935;_},uu____7936) -> FStar_Pervasives_Native.Some (x.FStar_Syntax_Syntax.sort) @@ -2590,58 +2569,58 @@ and encode_term: ({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_fvar fv; - FStar_Syntax_Syntax.pos = uu____8009; - FStar_Syntax_Syntax.vars = uu____8010;_},uu____8011) + FStar_Syntax_Syntax.pos = uu____7947; + FStar_Syntax_Syntax.vars = uu____7948;_},uu____7949) -> - let uu____8016 = - let uu____8017 = - let uu____8022 = + let uu____7954 = + let uu____7955 = + let uu____7960 = FStar_TypeChecker_Env.lookup_lid env.tcenv (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in - FStar_All.pipe_right uu____8022 + FStar_All.pipe_right uu____7960 FStar_Pervasives_Native.fst in - FStar_All.pipe_right uu____8017 + FStar_All.pipe_right uu____7955 FStar_Pervasives_Native.snd in - FStar_Pervasives_Native.Some uu____8016 + FStar_Pervasives_Native.Some uu____7954 | FStar_Syntax_Syntax.Tm_fvar fv -> - let uu____8052 = - let uu____8053 = - let uu____8058 = + let uu____7990 = + let uu____7991 = + let uu____7996 = FStar_TypeChecker_Env.lookup_lid env.tcenv (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in - FStar_All.pipe_right uu____8058 + FStar_All.pipe_right uu____7996 FStar_Pervasives_Native.fst in - FStar_All.pipe_right uu____8053 + FStar_All.pipe_right uu____7991 FStar_Pervasives_Native.snd in - FStar_Pervasives_Native.Some uu____8052 + FStar_Pervasives_Native.Some uu____7990 | FStar_Syntax_Syntax.Tm_ascribed - (uu____8087,(FStar_Util.Inl t1,uu____8089),uu____8090) + (uu____8025,(FStar_Util.Inl t1,uu____8027),uu____8028) -> FStar_Pervasives_Native.Some t1 | FStar_Syntax_Syntax.Tm_ascribed - (uu____8139,(FStar_Util.Inr c,uu____8141),uu____8142) + (uu____8077,(FStar_Util.Inr c,uu____8079),uu____8080) -> FStar_Pervasives_Native.Some (FStar_Syntax_Util.comp_result c) - | uu____8191 -> FStar_Pervasives_Native.None in + | uu____8129 -> FStar_Pervasives_Native.None in (match head_type with | FStar_Pervasives_Native.None -> encode_partial_app FStar_Pervasives_Native.None | FStar_Pervasives_Native.Some head_type1 -> let head_type2 = - let uu____8218 = + let uu____8156 = FStar_TypeChecker_Normalize.normalize_refinement [FStar_TypeChecker_Normalize.Weak; FStar_TypeChecker_Normalize.HNF; FStar_TypeChecker_Normalize.EraseUniverses] env.tcenv head_type1 in FStar_All.pipe_left - FStar_Syntax_Util.unrefine uu____8218 in - let uu____8219 = + FStar_Syntax_Util.unrefine uu____8156 in + let uu____8157 = curried_arrow_formals_comp head_type2 in - (match uu____8219 with + (match uu____8157 with | (formals,c) -> (match head2.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Tm_uinst @@ -2649,9 +2628,9 @@ and encode_term: FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_fvar fv; FStar_Syntax_Syntax.pos = - uu____8235; + uu____8173; FStar_Syntax_Syntax.vars = - uu____8236;_},uu____8237) + uu____8174;_},uu____8175) when (FStar_List.length formals) = (FStar_List.length args) @@ -2664,7 +2643,7 @@ and encode_term: -> encode_full_app fv.FStar_Syntax_Syntax.fv_name - | uu____8251 -> + | uu____8189 -> if (FStar_List.length formals) > (FStar_List.length args) @@ -2676,34 +2655,34 @@ and encode_term: encode_partial_app FStar_Pervasives_Native.None)))))) | FStar_Syntax_Syntax.Tm_abs (bs,body,lopt) -> - let uu____8300 = FStar_Syntax_Subst.open_term' bs body in - (match uu____8300 with + let uu____8238 = FStar_Syntax_Subst.open_term' bs body in + (match uu____8238 with | (bs1,body1,opening) -> - let fallback uu____8323 = + let fallback uu____8261 = let f = varops.fresh "Tm_abs" in let decl = FStar_SMTEncoding_Term.DeclFun (f, [], FStar_SMTEncoding_Term.Term_sort, (FStar_Pervasives_Native.Some "Imprecise function encoding")) in - let uu____8330 = + let uu____8268 = FStar_SMTEncoding_Util.mkFreeV (f, FStar_SMTEncoding_Term.Term_sort) in - (uu____8330, [decl]) in + (uu____8268, [decl]) in let is_impure rc = - let uu____8337 = + let uu____8275 = FStar_TypeChecker_Util.is_pure_or_ghost_effect env.tcenv rc.FStar_Syntax_Syntax.residual_effect in - FStar_All.pipe_right uu____8337 Prims.op_Negation in + FStar_All.pipe_right uu____8275 Prims.op_Negation in let codomain_eff rc = let res_typ = match rc.FStar_Syntax_Syntax.residual_typ with | FStar_Pervasives_Native.None -> - let uu____8347 = + let uu____8285 = FStar_TypeChecker_Rel.new_uvar FStar_Range.dummyRange [] FStar_Syntax_Util.ktype0 in - FStar_All.pipe_right uu____8347 + FStar_All.pipe_right uu____8285 FStar_Pervasives_Native.fst | FStar_Pervasives_Native.Some t1 -> t1 in if @@ -2711,85 +2690,85 @@ and encode_term: rc.FStar_Syntax_Syntax.residual_effect FStar_Parser_Const.effect_Tot_lid then - let uu____8367 = FStar_Syntax_Syntax.mk_Total res_typ in - FStar_Pervasives_Native.Some uu____8367 + let uu____8305 = FStar_Syntax_Syntax.mk_Total res_typ in + FStar_Pervasives_Native.Some uu____8305 else if FStar_Ident.lid_equals rc.FStar_Syntax_Syntax.residual_effect FStar_Parser_Const.effect_GTot_lid then - (let uu____8371 = FStar_Syntax_Syntax.mk_GTotal res_typ in - FStar_Pervasives_Native.Some uu____8371) + (let uu____8309 = FStar_Syntax_Syntax.mk_GTotal res_typ in + FStar_Pervasives_Native.Some uu____8309) else FStar_Pervasives_Native.None in (match lopt with | FStar_Pervasives_Native.None -> - ((let uu____8378 = - let uu____8383 = - let uu____8384 = + ((let uu____8316 = + let uu____8321 = + let uu____8322 = FStar_Syntax_Print.term_to_string t0 in FStar_Util.format1 "Losing precision when encoding a function literal: %s\n(Unnannotated abstraction in the compiler ?)" - uu____8384 in + uu____8322 in (FStar_Errors.Warning_FunctionLiteralPrecisionLoss, - uu____8383) in + uu____8321) in FStar_Errors.log_issue t0.FStar_Syntax_Syntax.pos - uu____8378); + uu____8316); fallback ()) | FStar_Pervasives_Native.Some rc -> - let uu____8386 = + let uu____8324 = (is_impure rc) && - (let uu____8388 = + (let uu____8326 = FStar_TypeChecker_Env.is_reifiable env.tcenv rc in - Prims.op_Negation uu____8388) in - if uu____8386 + Prims.op_Negation uu____8326) in + if uu____8324 then fallback () else (let cache_size = FStar_Util.smap_size env.cache in - let uu____8395 = + let uu____8333 = encode_binders FStar_Pervasives_Native.None bs1 env in - match uu____8395 with - | (vars,guards,envbody,decls,uu____8420) -> + match uu____8333 with + | (vars,guards,envbody,decls,uu____8358) -> let body2 = - let uu____8434 = + let uu____8372 = FStar_TypeChecker_Env.is_reifiable env.tcenv rc in - if uu____8434 + if uu____8372 then FStar_TypeChecker_Util.reify_body env.tcenv body1 else body1 in - let uu____8436 = encode_term body2 envbody in - (match uu____8436 with + let uu____8374 = encode_term body2 envbody in + (match uu____8374 with | (body3,decls') -> - let uu____8447 = - let uu____8456 = codomain_eff rc in - match uu____8456 with + let uu____8385 = + let uu____8394 = codomain_eff rc in + match uu____8394 with | FStar_Pervasives_Native.None -> (FStar_Pervasives_Native.None, []) | FStar_Pervasives_Native.Some c -> let tfun = FStar_Syntax_Util.arrow bs1 c in - let uu____8475 = encode_term tfun env in - (match uu____8475 with + let uu____8413 = encode_term tfun env in + (match uu____8413 with | (t1,decls1) -> ((FStar_Pervasives_Native.Some t1), decls1)) in - (match uu____8447 with + (match uu____8385 with | (arrow_t_opt,decls'') -> let key_body = - let uu____8507 = - let uu____8518 = - let uu____8519 = - let uu____8524 = + let uu____8445 = + let uu____8456 = + let uu____8457 = + let uu____8462 = FStar_SMTEncoding_Util.mk_and_l guards in - (uu____8524, body3) in + (uu____8462, body3) in FStar_SMTEncoding_Util.mkImp - uu____8519 in - ([], vars, uu____8518) in + uu____8457 in + ([], vars, uu____8456) in FStar_SMTEncoding_Util.mkForall - uu____8507 in + uu____8445 in let cvars = FStar_SMTEncoding_Term.free_variables key_body in @@ -2798,57 +2777,57 @@ and encode_term: | FStar_Pervasives_Native.None -> cvars | FStar_Pervasives_Native.Some t1 -> - let uu____8536 = - let uu____8539 = + let uu____8474 = + let uu____8477 = FStar_SMTEncoding_Term.free_variables t1 in - FStar_List.append uu____8539 + FStar_List.append uu____8477 cvars in FStar_Util.remove_dups FStar_SMTEncoding_Term.fv_eq - uu____8536 in + uu____8474 in let tkey = FStar_SMTEncoding_Util.mkForall ([], cvars1, key_body) in let tkey_hash = FStar_SMTEncoding_Term.hash_of_term tkey in - let uu____8558 = + let uu____8496 = FStar_Util.smap_try_find env.cache tkey_hash in - (match uu____8558 with + (match uu____8496 with | FStar_Pervasives_Native.Some cache_entry -> - let uu____8566 = - let uu____8567 = - let uu____8574 = + let uu____8504 = + let uu____8505 = + let uu____8512 = FStar_List.map FStar_SMTEncoding_Util.mkFreeV cvars1 in ((cache_entry.cache_symbol_name), - uu____8574) in + uu____8512) in FStar_SMTEncoding_Util.mkApp - uu____8567 in - (uu____8566, + uu____8505 in + (uu____8504, (FStar_List.append decls (FStar_List.append decls' (FStar_List.append decls'' (use_cache_entry cache_entry))))) | FStar_Pervasives_Native.None -> - let uu____8585 = + let uu____8523 = is_an_eta_expansion env vars body3 in - (match uu____8585 with + (match uu____8523 with | FStar_Pervasives_Native.Some t1 -> let decls1 = - let uu____8596 = - let uu____8597 = + let uu____8534 = + let uu____8535 = FStar_Util.smap_size env.cache in - uu____8597 = cache_size in - if uu____8596 + uu____8535 = cache_size in + if uu____8534 then [] else FStar_List.append decls @@ -2865,14 +2844,14 @@ and encode_term: let module_name = env.current_module_name in let fsym = - let uu____8613 = - let uu____8614 = + let uu____8551 = + let uu____8552 = FStar_Util.digest_of_string tkey_hash in Prims.strcat "Tm_abs_" - uu____8614 in + uu____8552 in varops.mk_unique - uu____8613 in + uu____8551 in Prims.strcat module_name (Prims.strcat "_" fsym) in let fdecl = @@ -2881,14 +2860,14 @@ and encode_term: FStar_SMTEncoding_Term.Term_sort, FStar_Pervasives_Native.None) in let f = - let uu____8621 = - let uu____8628 = + let uu____8559 = + let uu____8566 = FStar_List.map FStar_SMTEncoding_Util.mkFreeV cvars1 in - (fsym, uu____8628) in + (fsym, uu____8566) in FStar_SMTEncoding_Util.mkApp - uu____8621 in + uu____8559 in let app = mk_Apply f vars in let typing_f = match arrow_t_opt with @@ -2903,40 +2882,40 @@ and encode_term: let a_name = Prims.strcat "typing_" fsym in - let uu____8646 = - let uu____8647 = - let uu____8654 = + let uu____8584 = + let uu____8585 = + let uu____8592 = FStar_SMTEncoding_Util.mkForall ([[f]], cvars1, f_has_t) in - (uu____8654, + (uu____8592, (FStar_Pervasives_Native.Some a_name), a_name) in FStar_SMTEncoding_Util.mkAssume - uu____8647 in - [uu____8646] in + uu____8585 in + [uu____8584] in let interp_f = let a_name = Prims.strcat "interpretation_" fsym in - let uu____8667 = - let uu____8674 = - let uu____8675 = - let uu____8686 = + let uu____8605 = + let uu____8612 = + let uu____8613 = + let uu____8624 = FStar_SMTEncoding_Util.mkEq (app, body3) in ([[app]], (FStar_List.append vars cvars1), - uu____8686) in + uu____8624) in FStar_SMTEncoding_Util.mkForall - uu____8675 in - (uu____8674, + uu____8613 in + (uu____8612, (FStar_Pervasives_Native.Some a_name), a_name) in FStar_SMTEncoding_Util.mkAssume - uu____8667 in + uu____8605 in let f_decls = FStar_List.append decls (FStar_List.append decls' @@ -2946,31 +2925,31 @@ and encode_term: (fdecl :: typing_f) [interp_f]))) in - ((let uu____8703 = + ((let uu____8641 = mk_cache_entry env fsym cvar_sorts f_decls in FStar_Util.smap_add env.cache tkey_hash - uu____8703); + uu____8641); (f, f_decls))))))))) | FStar_Syntax_Syntax.Tm_let - ((uu____8706,{ + ((uu____8644,{ FStar_Syntax_Syntax.lbname = FStar_Util.Inr - uu____8707; - FStar_Syntax_Syntax.lbunivs = uu____8708; - FStar_Syntax_Syntax.lbtyp = uu____8709; - FStar_Syntax_Syntax.lbeff = uu____8710; - FStar_Syntax_Syntax.lbdef = uu____8711;_}::uu____8712),uu____8713) + uu____8645; + FStar_Syntax_Syntax.lbunivs = uu____8646; + FStar_Syntax_Syntax.lbtyp = uu____8647; + FStar_Syntax_Syntax.lbeff = uu____8648; + FStar_Syntax_Syntax.lbdef = uu____8649;_}::uu____8650),uu____8651) -> failwith "Impossible: already handled by encoding of Sig_let" | FStar_Syntax_Syntax.Tm_let ((false ,{ FStar_Syntax_Syntax.lbname = FStar_Util.Inl x; - FStar_Syntax_Syntax.lbunivs = uu____8739; + FStar_Syntax_Syntax.lbunivs = uu____8677; FStar_Syntax_Syntax.lbtyp = t1; - FStar_Syntax_Syntax.lbeff = uu____8741; + FStar_Syntax_Syntax.lbeff = uu____8679; FStar_Syntax_Syntax.lbdef = e1;_}::[]),e2) -> encode_let x t1 e1 e2 env encode_term - | FStar_Syntax_Syntax.Tm_let uu____8762 -> + | FStar_Syntax_Syntax.Tm_let uu____8700 -> (FStar_Errors.diag t0.FStar_Syntax_Syntax.pos "Non-top-level recursive functions, and their enclosings let bindings (including the top-level let) are not yet fully encoded to the SMT solver; you may not be able to prove some facts"; FStar_Exn.raise Inner_let_rec) @@ -2997,20 +2976,20 @@ and encode_let: fun e2 -> fun env -> fun encode_body -> - let uu____8832 = encode_term e1 env in - match uu____8832 with + let uu____8770 = encode_term e1 env in + match uu____8770 with | (ee1,decls1) -> - let uu____8843 = + let uu____8781 = FStar_Syntax_Subst.open_term [(x, FStar_Pervasives_Native.None)] e2 in - (match uu____8843 with + (match uu____8781 with | (xs,e21) -> - let uu____8868 = FStar_List.hd xs in - (match uu____8868 with - | (x1,uu____8882) -> + let uu____8806 = FStar_List.hd xs in + (match uu____8806 with + | (x1,uu____8820) -> let env' = push_term_var env x1 ee1 in - let uu____8884 = encode_body e21 env' in - (match uu____8884 with + let uu____8822 = encode_body e21 env' in + (match uu____8822 with | (ee2,decls2) -> (ee2, (FStar_List.append decls1 decls2))))) and encode_match: @@ -3031,28 +3010,28 @@ and encode_match: fun default_case -> fun env -> fun encode_br -> - let uu____8916 = - let uu____8923 = - let uu____8924 = + let uu____8854 = + let uu____8861 = + let uu____8862 = FStar_Syntax_Syntax.mk FStar_Syntax_Syntax.Tm_unknown FStar_Pervasives_Native.None FStar_Range.dummyRange in - FStar_Syntax_Syntax.null_bv uu____8924 in - gen_term_var env uu____8923 in - match uu____8916 with + FStar_Syntax_Syntax.null_bv uu____8862 in + gen_term_var env uu____8861 in + match uu____8854 with | (scrsym,scr',env1) -> - let uu____8932 = encode_term e env1 in - (match uu____8932 with + let uu____8870 = encode_term e env1 in + (match uu____8870 with | (scr,decls) -> - let uu____8943 = - let encode_branch b uu____8968 = - match uu____8968 with + let uu____8881 = + let encode_branch b uu____8906 = + match uu____8906 with | (else_case,decls1) -> - let uu____8987 = + let uu____8925 = FStar_Syntax_Subst.open_branch b in - (match uu____8987 with + (match uu____8925 with | (p,w,br) -> - let uu____9013 = encode_pat env1 p in - (match uu____9013 with + let uu____8951 = encode_pat env1 p in + (match uu____8951 with | (env0,pattern) -> let guard = pattern.guard scr' in let projections = @@ -3061,118 +3040,118 @@ and encode_match: FStar_All.pipe_right projections (FStar_List.fold_left (fun env2 -> - fun uu____9050 -> - match uu____9050 with + fun uu____8988 -> + match uu____8988 with | (x,t) -> push_term_var env2 x t) env1) in - let uu____9057 = + let uu____8995 = match w with | FStar_Pervasives_Native.None -> (guard, []) | FStar_Pervasives_Native.Some w1 -> - let uu____9079 = + let uu____9017 = encode_term w1 env2 in - (match uu____9079 with + (match uu____9017 with | (w2,decls2) -> - let uu____9092 = - let uu____9093 = - let uu____9098 = - let uu____9099 = - let uu____9104 = + let uu____9030 = + let uu____9031 = + let uu____9036 = + let uu____9037 = + let uu____9042 = FStar_SMTEncoding_Term.boxBool FStar_SMTEncoding_Util.mkTrue in - (w2, uu____9104) in + (w2, uu____9042) in FStar_SMTEncoding_Util.mkEq - uu____9099 in - (guard, uu____9098) in + uu____9037 in + (guard, uu____9036) in FStar_SMTEncoding_Util.mkAnd - uu____9093 in - (uu____9092, decls2)) in - (match uu____9057 with + uu____9031 in + (uu____9030, decls2)) in + (match uu____8995 with | (guard1,decls2) -> - let uu____9117 = + let uu____9055 = encode_br br env2 in - (match uu____9117 with + (match uu____9055 with | (br1,decls3) -> - let uu____9130 = + let uu____9068 = FStar_SMTEncoding_Util.mkITE (guard1, br1, else_case) in - (uu____9130, + (uu____9068, (FStar_List.append decls1 (FStar_List.append decls2 decls3))))))) in FStar_List.fold_right encode_branch pats (default_case, decls) in - (match uu____8943 with + (match uu____8881 with | (match_tm,decls1) -> - let uu____9149 = + let uu____9087 = FStar_SMTEncoding_Term.mkLet' ([((scrsym, FStar_SMTEncoding_Term.Term_sort), scr)], match_tm) FStar_Range.dummyRange in - (uu____9149, decls1))) + (uu____9087, decls1))) and encode_pat: env_t -> FStar_Syntax_Syntax.pat -> (env_t,pattern) FStar_Pervasives_Native.tuple2 = fun env -> fun pat -> - (let uu____9189 = + (let uu____9127 = FStar_TypeChecker_Env.debug env.tcenv FStar_Options.Low in - if uu____9189 + if uu____9127 then - let uu____9190 = FStar_Syntax_Print.pat_to_string pat in - FStar_Util.print1 "Encoding pattern %s\n" uu____9190 + let uu____9128 = FStar_Syntax_Print.pat_to_string pat in + FStar_Util.print1 "Encoding pattern %s\n" uu____9128 else ()); - (let uu____9192 = FStar_TypeChecker_Util.decorated_pattern_as_term pat in - match uu____9192 with + (let uu____9130 = FStar_TypeChecker_Util.decorated_pattern_as_term pat in + match uu____9130 with | (vars,pat_term) -> - let uu____9209 = + let uu____9147 = FStar_All.pipe_right vars (FStar_List.fold_left - (fun uu____9262 -> + (fun uu____9200 -> fun v1 -> - match uu____9262 with + match uu____9200 with | (env1,vars1) -> - let uu____9314 = gen_term_var env1 v1 in - (match uu____9314 with - | (xx,uu____9336,env2) -> + let uu____9252 = gen_term_var env1 v1 in + (match uu____9252 with + | (xx,uu____9274,env2) -> (env2, ((v1, (xx, FStar_SMTEncoding_Term.Term_sort)) :: vars1)))) (env, [])) in - (match uu____9209 with + (match uu____9147 with | (env1,vars1) -> let rec mk_guard pat1 scrutinee = match pat1.FStar_Syntax_Syntax.v with - | FStar_Syntax_Syntax.Pat_var uu____9415 -> + | FStar_Syntax_Syntax.Pat_var uu____9353 -> FStar_SMTEncoding_Util.mkTrue - | FStar_Syntax_Syntax.Pat_wild uu____9416 -> + | FStar_Syntax_Syntax.Pat_wild uu____9354 -> FStar_SMTEncoding_Util.mkTrue - | FStar_Syntax_Syntax.Pat_dot_term uu____9417 -> + | FStar_Syntax_Syntax.Pat_dot_term uu____9355 -> FStar_SMTEncoding_Util.mkTrue | FStar_Syntax_Syntax.Pat_constant c -> - let uu____9425 = encode_const c env1 in - (match uu____9425 with + let uu____9363 = encode_const c env1 in + (match uu____9363 with | (tm,decls) -> ((match decls with - | uu____9439::uu____9440 -> + | uu____9377::uu____9378 -> failwith "Unexpected encoding of constant pattern" - | uu____9443 -> ()); + | uu____9381 -> ()); FStar_SMTEncoding_Util.mkEq (scrutinee, tm))) | FStar_Syntax_Syntax.Pat_cons (f,args) -> let is_f = let tc_name = FStar_TypeChecker_Env.typ_of_datacon env1.tcenv (f.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in - let uu____9466 = + let uu____9404 = FStar_TypeChecker_Env.datacons_of_typ env1.tcenv tc_name in - match uu____9466 with - | (uu____9473,uu____9474::[]) -> + match uu____9404 with + | (uu____9411,uu____9412::[]) -> FStar_SMTEncoding_Util.mkTrue - | uu____9477 -> + | uu____9415 -> mk_data_tester env1 (f.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v scrutinee in @@ -3180,44 +3159,44 @@ and encode_pat: FStar_All.pipe_right args (FStar_List.mapi (fun i -> - fun uu____9510 -> - match uu____9510 with - | (arg,uu____9518) -> + fun uu____9448 -> + match uu____9448 with + | (arg,uu____9456) -> let proj = primitive_projector_by_pos env1.tcenv (f.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v i in - let uu____9524 = + let uu____9462 = FStar_SMTEncoding_Util.mkApp (proj, [scrutinee]) in - mk_guard arg uu____9524)) in + mk_guard arg uu____9462)) in FStar_SMTEncoding_Util.mk_and_l (is_f :: sub_term_guards) in let rec mk_projections pat1 scrutinee = match pat1.FStar_Syntax_Syntax.v with - | FStar_Syntax_Syntax.Pat_dot_term (x,uu____9551) -> + | FStar_Syntax_Syntax.Pat_dot_term (x,uu____9489) -> [(x, scrutinee)] | FStar_Syntax_Syntax.Pat_var x -> [(x, scrutinee)] | FStar_Syntax_Syntax.Pat_wild x -> [(x, scrutinee)] - | FStar_Syntax_Syntax.Pat_constant uu____9582 -> [] + | FStar_Syntax_Syntax.Pat_constant uu____9520 -> [] | FStar_Syntax_Syntax.Pat_cons (f,args) -> - let uu____9605 = + let uu____9543 = FStar_All.pipe_right args (FStar_List.mapi (fun i -> - fun uu____9649 -> - match uu____9649 with - | (arg,uu____9663) -> + fun uu____9587 -> + match uu____9587 with + | (arg,uu____9601) -> let proj = primitive_projector_by_pos env1.tcenv (f.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v i in - let uu____9669 = + let uu____9607 = FStar_SMTEncoding_Util.mkApp (proj, [scrutinee]) in - mk_projections arg uu____9669)) in - FStar_All.pipe_right uu____9605 FStar_List.flatten in - let pat_term1 uu____9697 = encode_term pat_term env1 in + mk_projections arg uu____9607)) in + FStar_All.pipe_right uu____9543 FStar_List.flatten in + let pat_term1 uu____9635 = encode_term pat_term env1 in let pattern = { pat_vars = vars1; @@ -3234,19 +3213,19 @@ and encode_args: = fun l -> fun env -> - let uu____9707 = + let uu____9645 = FStar_All.pipe_right l (FStar_List.fold_left - (fun uu____9745 -> - fun uu____9746 -> - match (uu____9745, uu____9746) with - | ((tms,decls),(t,uu____9782)) -> - let uu____9803 = encode_term t env in - (match uu____9803 with + (fun uu____9683 -> + fun uu____9684 -> + match (uu____9683, uu____9684) with + | ((tms,decls),(t,uu____9720)) -> + let uu____9741 = encode_term t env in + (match uu____9741 with | (t1,decls') -> ((t1 :: tms), (FStar_List.append decls decls')))) ([], [])) in - match uu____9707 with | (l1,decls) -> ((FStar_List.rev l1), decls) + match uu____9645 with | (l1,decls) -> ((FStar_List.rev l1), decls) and encode_function_type_as_formula: FStar_Syntax_Syntax.typ -> env_t -> @@ -3256,8 +3235,8 @@ and encode_function_type_as_formula: fun t -> fun env -> let list_elements1 e = - let uu____9860 = FStar_Syntax_Util.list_elements e in - match uu____9860 with + let uu____9798 = FStar_Syntax_Util.list_elements e in + match uu____9798 with | FStar_Pervasives_Native.Some l -> l | FStar_Pervasives_Native.None -> (FStar_Errors.log_issue e.FStar_Syntax_Syntax.pos @@ -3265,165 +3244,165 @@ and encode_function_type_as_formula: "SMT pattern is not a list literal; ignoring the pattern"); []) in let one_pat p = - let uu____9881 = - let uu____9896 = FStar_Syntax_Util.unmeta p in - FStar_All.pipe_right uu____9896 FStar_Syntax_Util.head_and_args in - match uu____9881 with + let uu____9819 = + let uu____9834 = FStar_Syntax_Util.unmeta p in + FStar_All.pipe_right uu____9834 FStar_Syntax_Util.head_and_args in + match uu____9819 with | (head1,args) -> - let uu____9935 = - let uu____9948 = - let uu____9949 = FStar_Syntax_Util.un_uinst head1 in - uu____9949.FStar_Syntax_Syntax.n in - (uu____9948, args) in - (match uu____9935 with + let uu____9873 = + let uu____9886 = + let uu____9887 = FStar_Syntax_Util.un_uinst head1 in + uu____9887.FStar_Syntax_Syntax.n in + (uu____9886, args) in + (match uu____9873 with | (FStar_Syntax_Syntax.Tm_fvar - fv,(uu____9963,uu____9964)::(e,uu____9966)::[]) when + fv,(uu____9901,uu____9902)::(e,uu____9904)::[]) when FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.smtpat_lid -> e - | uu____10001 -> failwith "Unexpected pattern term") in + | uu____9939 -> failwith "Unexpected pattern term") in let lemma_pats p = let elts = list_elements1 p in let smt_pat_or1 t1 = - let uu____10037 = - let uu____10052 = FStar_Syntax_Util.unmeta t1 in - FStar_All.pipe_right uu____10052 FStar_Syntax_Util.head_and_args in - match uu____10037 with + let uu____9975 = + let uu____9990 = FStar_Syntax_Util.unmeta t1 in + FStar_All.pipe_right uu____9990 FStar_Syntax_Util.head_and_args in + match uu____9975 with | (head1,args) -> - let uu____10093 = - let uu____10106 = - let uu____10107 = FStar_Syntax_Util.un_uinst head1 in - uu____10107.FStar_Syntax_Syntax.n in - (uu____10106, args) in - (match uu____10093 with - | (FStar_Syntax_Syntax.Tm_fvar fv,(e,uu____10124)::[]) when + let uu____10031 = + let uu____10044 = + let uu____10045 = FStar_Syntax_Util.un_uinst head1 in + uu____10045.FStar_Syntax_Syntax.n in + (uu____10044, args) in + (match uu____10031 with + | (FStar_Syntax_Syntax.Tm_fvar fv,(e,uu____10062)::[]) when FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.smtpatOr_lid -> FStar_Pervasives_Native.Some e - | uu____10151 -> FStar_Pervasives_Native.None) in + | uu____10089 -> FStar_Pervasives_Native.None) in match elts with | t1::[] -> - let uu____10173 = smt_pat_or1 t1 in - (match uu____10173 with + let uu____10111 = smt_pat_or1 t1 in + (match uu____10111 with | FStar_Pervasives_Native.Some e -> - let uu____10189 = list_elements1 e in - FStar_All.pipe_right uu____10189 + let uu____10127 = list_elements1 e in + FStar_All.pipe_right uu____10127 (FStar_List.map (fun branch1 -> - let uu____10207 = list_elements1 branch1 in - FStar_All.pipe_right uu____10207 + let uu____10145 = list_elements1 branch1 in + FStar_All.pipe_right uu____10145 (FStar_List.map one_pat))) - | uu____10218 -> - let uu____10223 = + | uu____10156 -> + let uu____10161 = FStar_All.pipe_right elts (FStar_List.map one_pat) in - [uu____10223]) - | uu____10244 -> - let uu____10247 = + [uu____10161]) + | uu____10182 -> + let uu____10185 = FStar_All.pipe_right elts (FStar_List.map one_pat) in - [uu____10247] in - let uu____10268 = - let uu____10287 = - let uu____10288 = FStar_Syntax_Subst.compress t in - uu____10288.FStar_Syntax_Syntax.n in - match uu____10287 with + [uu____10185] in + let uu____10206 = + let uu____10225 = + let uu____10226 = FStar_Syntax_Subst.compress t in + uu____10226.FStar_Syntax_Syntax.n in + match uu____10225 with | FStar_Syntax_Syntax.Tm_arrow (binders,c) -> - let uu____10327 = FStar_Syntax_Subst.open_comp binders c in - (match uu____10327 with + let uu____10265 = FStar_Syntax_Subst.open_comp binders c in + (match uu____10265 with | (binders1,c1) -> (match c1.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Comp - { FStar_Syntax_Syntax.comp_univs = uu____10370; - FStar_Syntax_Syntax.effect_name = uu____10371; - FStar_Syntax_Syntax.result_typ = uu____10372; + { FStar_Syntax_Syntax.comp_univs = uu____10308; + FStar_Syntax_Syntax.effect_name = uu____10309; + FStar_Syntax_Syntax.result_typ = uu____10310; FStar_Syntax_Syntax.effect_args = - (pre,uu____10374)::(post,uu____10376)::(pats,uu____10378)::[]; - FStar_Syntax_Syntax.flags = uu____10379;_} + (pre,uu____10312)::(post,uu____10314)::(pats,uu____10316)::[]; + FStar_Syntax_Syntax.flags = uu____10317;_} -> - let uu____10420 = lemma_pats pats in - (binders1, pre, post, uu____10420) - | uu____10437 -> failwith "impos")) - | uu____10456 -> failwith "Impos" in - match uu____10268 with + let uu____10358 = lemma_pats pats in + (binders1, pre, post, uu____10358) + | uu____10375 -> failwith "impos")) + | uu____10394 -> failwith "Impos" in + match uu____10206 with | (binders,pre,post,patterns) -> let env1 = - let uu___110_10504 = env in + let uu___110_10442 = env in { - bindings = (uu___110_10504.bindings); - depth = (uu___110_10504.depth); - tcenv = (uu___110_10504.tcenv); - warn = (uu___110_10504.warn); - cache = (uu___110_10504.cache); - nolabels = (uu___110_10504.nolabels); + bindings = (uu___110_10442.bindings); + depth = (uu___110_10442.depth); + tcenv = (uu___110_10442.tcenv); + warn = (uu___110_10442.warn); + cache = (uu___110_10442.cache); + nolabels = (uu___110_10442.nolabels); use_zfuel_name = true; encode_non_total_function_typ = - (uu___110_10504.encode_non_total_function_typ); - current_module_name = (uu___110_10504.current_module_name) + (uu___110_10442.encode_non_total_function_typ); + current_module_name = (uu___110_10442.current_module_name) } in - let uu____10505 = + let uu____10443 = encode_binders FStar_Pervasives_Native.None binders env1 in - (match uu____10505 with - | (vars,guards,env2,decls,uu____10530) -> - let uu____10543 = - let uu____10558 = + (match uu____10443 with + | (vars,guards,env2,decls,uu____10468) -> + let uu____10481 = + let uu____10496 = FStar_All.pipe_right patterns (FStar_List.map (fun branch1 -> - let uu____10612 = - let uu____10623 = + let uu____10550 = + let uu____10561 = FStar_All.pipe_right branch1 (FStar_List.map (fun t1 -> encode_smt_pattern t1 env2)) in - FStar_All.pipe_right uu____10623 + FStar_All.pipe_right uu____10561 FStar_List.unzip in - match uu____10612 with + match uu____10550 with | (pats,decls1) -> (pats, decls1))) in - FStar_All.pipe_right uu____10558 FStar_List.unzip in - (match uu____10543 with + FStar_All.pipe_right uu____10496 FStar_List.unzip in + (match uu____10481 with | (pats,decls') -> let decls'1 = FStar_List.flatten decls' in let post1 = FStar_Syntax_Util.unthunk_lemma_post post in let env3 = - let uu___111_10775 = env2 in + let uu___111_10713 = env2 in { - bindings = (uu___111_10775.bindings); - depth = (uu___111_10775.depth); - tcenv = (uu___111_10775.tcenv); - warn = (uu___111_10775.warn); - cache = (uu___111_10775.cache); + bindings = (uu___111_10713.bindings); + depth = (uu___111_10713.depth); + tcenv = (uu___111_10713.tcenv); + warn = (uu___111_10713.warn); + cache = (uu___111_10713.cache); nolabels = true; - use_zfuel_name = (uu___111_10775.use_zfuel_name); + use_zfuel_name = (uu___111_10713.use_zfuel_name); encode_non_total_function_typ = - (uu___111_10775.encode_non_total_function_typ); + (uu___111_10713.encode_non_total_function_typ); current_module_name = - (uu___111_10775.current_module_name) + (uu___111_10713.current_module_name) } in - let uu____10776 = - let uu____10781 = FStar_Syntax_Util.unmeta pre in - encode_formula uu____10781 env3 in - (match uu____10776 with + let uu____10714 = + let uu____10719 = FStar_Syntax_Util.unmeta pre in + encode_formula uu____10719 env3 in + (match uu____10714 with | (pre1,decls'') -> - let uu____10788 = - let uu____10793 = FStar_Syntax_Util.unmeta post1 in - encode_formula uu____10793 env3 in - (match uu____10788 with + let uu____10726 = + let uu____10731 = FStar_Syntax_Util.unmeta post1 in + encode_formula uu____10731 env3 in + (match uu____10726 with | (post2,decls''') -> let decls1 = FStar_List.append decls (FStar_List.append (FStar_List.flatten decls'1) (FStar_List.append decls'' decls''')) in - let uu____10803 = - let uu____10804 = - let uu____10815 = - let uu____10816 = - let uu____10821 = + let uu____10741 = + let uu____10742 = + let uu____10753 = + let uu____10754 = + let uu____10759 = FStar_SMTEncoding_Util.mk_and_l (pre1 :: guards) in - (uu____10821, post2) in - FStar_SMTEncoding_Util.mkImp uu____10816 in - (pats, vars, uu____10815) in - FStar_SMTEncoding_Util.mkForall uu____10804 in - (uu____10803, decls1))))) + (uu____10759, post2) in + FStar_SMTEncoding_Util.mkImp uu____10754 in + (pats, vars, uu____10753) in + FStar_SMTEncoding_Util.mkForall uu____10742 in + (uu____10741, decls1))))) and encode_smt_pattern: FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax -> env_t -> @@ -3432,26 +3411,26 @@ and encode_smt_pattern: = fun t -> fun env -> - let uu____10834 = FStar_Syntax_Util.head_and_args t in - match uu____10834 with + let uu____10772 = FStar_Syntax_Util.head_and_args t in + match uu____10772 with | (head1,args) -> let head2 = FStar_Syntax_Util.un_uinst head1 in (match ((head2.FStar_Syntax_Syntax.n), args) with | (FStar_Syntax_Syntax.Tm_fvar - fv,uu____10893::(x,uu____10895)::(t1,uu____10897)::[]) when + fv,uu____10831::(x,uu____10833)::(t1,uu____10835)::[]) when FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.has_type_lid -> - let uu____10944 = encode_term x env in - (match uu____10944 with + let uu____10882 = encode_term x env in + (match uu____10882 with | (x1,decls) -> - let uu____10957 = encode_term t1 env in - (match uu____10957 with + let uu____10895 = encode_term t1 env in + (match uu____10895 with | (t2,decls') -> - let uu____10970 = + let uu____10908 = FStar_SMTEncoding_Term.mk_HasType x1 t2 in - (uu____10970, (FStar_List.append decls decls')))) - | uu____10973 -> encode_term t env) + (uu____10908, (FStar_List.append decls decls')))) + | uu____10911 -> encode_term t env) and encode_formula: FStar_Syntax_Syntax.typ -> env_t -> @@ -3461,223 +3440,223 @@ and encode_formula: fun phi -> fun env -> let debug1 phi1 = - let uu____10996 = + let uu____10934 = FStar_All.pipe_left (FStar_TypeChecker_Env.debug env.tcenv) (FStar_Options.Other "SMTEncoding") in - if uu____10996 + if uu____10934 then - let uu____10997 = FStar_Syntax_Print.tag_of_term phi1 in - let uu____10998 = FStar_Syntax_Print.term_to_string phi1 in - FStar_Util.print2 "Formula (%s) %s\n" uu____10997 uu____10998 + let uu____10935 = FStar_Syntax_Print.tag_of_term phi1 in + let uu____10936 = FStar_Syntax_Print.term_to_string phi1 in + FStar_Util.print2 "Formula (%s) %s\n" uu____10935 uu____10936 else () in let enc f r l = - let uu____11031 = + let uu____10969 = FStar_Util.fold_map (fun decls -> fun x -> - let uu____11059 = + let uu____10997 = encode_term (FStar_Pervasives_Native.fst x) env in - match uu____11059 with + match uu____10997 with | (t,decls') -> ((FStar_List.append decls decls'), t)) [] l in - match uu____11031 with + match uu____10969 with | (decls,args) -> - let uu____11088 = - let uu___112_11089 = f args in + let uu____11026 = + let uu___112_11027 = f args in { FStar_SMTEncoding_Term.tm = - (uu___112_11089.FStar_SMTEncoding_Term.tm); + (uu___112_11027.FStar_SMTEncoding_Term.tm); FStar_SMTEncoding_Term.freevars = - (uu___112_11089.FStar_SMTEncoding_Term.freevars); + (uu___112_11027.FStar_SMTEncoding_Term.freevars); FStar_SMTEncoding_Term.rng = r } in - (uu____11088, decls) in - let const_op f r uu____11120 = - let uu____11133 = f r in (uu____11133, []) in + (uu____11026, decls) in + let const_op f r uu____11058 = + let uu____11071 = f r in (uu____11071, []) in let un_op f l = - let uu____11152 = FStar_List.hd l in - FStar_All.pipe_left f uu____11152 in - let bin_op f uu___86_11168 = - match uu___86_11168 with + let uu____11090 = FStar_List.hd l in + FStar_All.pipe_left f uu____11090 in + let bin_op f uu___86_11106 = + match uu___86_11106 with | t1::t2::[] -> f (t1, t2) - | uu____11179 -> failwith "Impossible" in + | uu____11117 -> failwith "Impossible" in let enc_prop_c f r l = - let uu____11213 = + let uu____11151 = FStar_Util.fold_map (fun decls -> - fun uu____11236 -> - match uu____11236 with - | (t,uu____11250) -> - let uu____11251 = encode_formula t env in - (match uu____11251 with + fun uu____11174 -> + match uu____11174 with + | (t,uu____11188) -> + let uu____11189 = encode_formula t env in + (match uu____11189 with | (phi1,decls') -> ((FStar_List.append decls decls'), phi1))) [] l in - match uu____11213 with + match uu____11151 with | (decls,phis) -> - let uu____11280 = - let uu___113_11281 = f phis in + let uu____11218 = + let uu___113_11219 = f phis in { FStar_SMTEncoding_Term.tm = - (uu___113_11281.FStar_SMTEncoding_Term.tm); + (uu___113_11219.FStar_SMTEncoding_Term.tm); FStar_SMTEncoding_Term.freevars = - (uu___113_11281.FStar_SMTEncoding_Term.freevars); + (uu___113_11219.FStar_SMTEncoding_Term.freevars); FStar_SMTEncoding_Term.rng = r } in - (uu____11280, decls) in + (uu____11218, decls) in let eq_op r args = let rf = FStar_List.filter - (fun uu____11342 -> - match uu____11342 with + (fun uu____11280 -> + match uu____11280 with | (a,q) -> (match q with | FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.Implicit uu____11361) -> false - | uu____11362 -> true)) args in + (FStar_Syntax_Syntax.Implicit uu____11299) -> false + | uu____11300 -> true)) args in if (FStar_List.length rf) <> (Prims.parse_int "2") then - let uu____11377 = + let uu____11315 = FStar_Util.format1 "eq_op: got %s non-implicit arguments instead of 2?" (Prims.string_of_int (FStar_List.length rf)) in - failwith uu____11377 + failwith uu____11315 else - (let uu____11391 = enc (bin_op FStar_SMTEncoding_Util.mkEq) in - uu____11391 r rf) in - let mk_imp1 r uu___87_11416 = - match uu___87_11416 with - | (lhs,uu____11422)::(rhs,uu____11424)::[] -> - let uu____11451 = encode_formula rhs env in - (match uu____11451 with + (let uu____11329 = enc (bin_op FStar_SMTEncoding_Util.mkEq) in + uu____11329 r rf) in + let mk_imp1 r uu___87_11354 = + match uu___87_11354 with + | (lhs,uu____11360)::(rhs,uu____11362)::[] -> + let uu____11389 = encode_formula rhs env in + (match uu____11389 with | (l1,decls1) -> (match l1.FStar_SMTEncoding_Term.tm with | FStar_SMTEncoding_Term.App - (FStar_SMTEncoding_Term.TrueOp ,uu____11466) -> + (FStar_SMTEncoding_Term.TrueOp ,uu____11404) -> (l1, decls1) - | uu____11471 -> - let uu____11472 = encode_formula lhs env in - (match uu____11472 with + | uu____11409 -> + let uu____11410 = encode_formula lhs env in + (match uu____11410 with | (l2,decls2) -> - let uu____11483 = + let uu____11421 = FStar_SMTEncoding_Term.mkImp (l2, l1) r in - (uu____11483, (FStar_List.append decls1 decls2))))) - | uu____11486 -> failwith "impossible" in - let mk_ite r uu___88_11507 = - match uu___88_11507 with - | (guard,uu____11513)::(_then,uu____11515)::(_else,uu____11517)::[] + (uu____11421, (FStar_List.append decls1 decls2))))) + | uu____11424 -> failwith "impossible" in + let mk_ite r uu___88_11445 = + match uu___88_11445 with + | (guard,uu____11451)::(_then,uu____11453)::(_else,uu____11455)::[] -> - let uu____11554 = encode_formula guard env in - (match uu____11554 with + let uu____11492 = encode_formula guard env in + (match uu____11492 with | (g,decls1) -> - let uu____11565 = encode_formula _then env in - (match uu____11565 with + let uu____11503 = encode_formula _then env in + (match uu____11503 with | (t,decls2) -> - let uu____11576 = encode_formula _else env in - (match uu____11576 with + let uu____11514 = encode_formula _else env in + (match uu____11514 with | (e,decls3) -> let res = FStar_SMTEncoding_Term.mkITE (g, t, e) r in (res, (FStar_List.append decls1 (FStar_List.append decls2 decls3)))))) - | uu____11590 -> failwith "impossible" in + | uu____11528 -> failwith "impossible" in let unboxInt_l f l = - let uu____11615 = FStar_List.map FStar_SMTEncoding_Term.unboxInt l in - f uu____11615 in + let uu____11553 = FStar_List.map FStar_SMTEncoding_Term.unboxInt l in + f uu____11553 in let connectives = - let uu____11633 = - let uu____11646 = enc_prop_c (bin_op FStar_SMTEncoding_Util.mkAnd) in - (FStar_Parser_Const.and_lid, uu____11646) in - let uu____11663 = - let uu____11678 = - let uu____11691 = enc_prop_c (bin_op FStar_SMTEncoding_Util.mkOr) in - (FStar_Parser_Const.or_lid, uu____11691) in - let uu____11708 = - let uu____11723 = - let uu____11738 = - let uu____11751 = + let uu____11571 = + let uu____11584 = enc_prop_c (bin_op FStar_SMTEncoding_Util.mkAnd) in + (FStar_Parser_Const.and_lid, uu____11584) in + let uu____11601 = + let uu____11616 = + let uu____11629 = enc_prop_c (bin_op FStar_SMTEncoding_Util.mkOr) in + (FStar_Parser_Const.or_lid, uu____11629) in + let uu____11646 = + let uu____11661 = + let uu____11676 = + let uu____11689 = enc_prop_c (bin_op FStar_SMTEncoding_Util.mkIff) in - (FStar_Parser_Const.iff_lid, uu____11751) in - let uu____11768 = - let uu____11783 = - let uu____11798 = - let uu____11811 = + (FStar_Parser_Const.iff_lid, uu____11689) in + let uu____11706 = + let uu____11721 = + let uu____11736 = + let uu____11749 = enc_prop_c (un_op FStar_SMTEncoding_Util.mkNot) in - (FStar_Parser_Const.not_lid, uu____11811) in - [uu____11798; + (FStar_Parser_Const.not_lid, uu____11749) in + [uu____11736; (FStar_Parser_Const.eq2_lid, eq_op); (FStar_Parser_Const.eq3_lid, eq_op); (FStar_Parser_Const.true_lid, (const_op FStar_SMTEncoding_Term.mkTrue)); (FStar_Parser_Const.false_lid, (const_op FStar_SMTEncoding_Term.mkFalse))] in - (FStar_Parser_Const.ite_lid, mk_ite) :: uu____11783 in - uu____11738 :: uu____11768 in - (FStar_Parser_Const.imp_lid, mk_imp1) :: uu____11723 in - uu____11678 :: uu____11708 in - uu____11633 :: uu____11663 in + (FStar_Parser_Const.ite_lid, mk_ite) :: uu____11721 in + uu____11676 :: uu____11706 in + (FStar_Parser_Const.imp_lid, mk_imp1) :: uu____11661 in + uu____11616 :: uu____11646 in + uu____11571 :: uu____11601 in let rec fallback phi1 = match phi1.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Tm_meta (phi',FStar_Syntax_Syntax.Meta_labeled (msg,r,b)) -> - let uu____12132 = encode_formula phi' env in - (match uu____12132 with + let uu____12070 = encode_formula phi' env in + (match uu____12070 with | (phi2,decls) -> - let uu____12143 = + let uu____12081 = FStar_SMTEncoding_Term.mk (FStar_SMTEncoding_Term.Labeled (phi2, msg, r)) r in - (uu____12143, decls)) - | FStar_Syntax_Syntax.Tm_meta uu____12144 -> - let uu____12151 = FStar_Syntax_Util.unmeta phi1 in - encode_formula uu____12151 env + (uu____12081, decls)) + | FStar_Syntax_Syntax.Tm_meta uu____12082 -> + let uu____12089 = FStar_Syntax_Util.unmeta phi1 in + encode_formula uu____12089 env | FStar_Syntax_Syntax.Tm_match (e,pats) -> - let uu____12190 = + let uu____12128 = encode_match e pats FStar_SMTEncoding_Util.mkFalse env encode_formula in - (match uu____12190 with | (t,decls) -> (t, decls)) + (match uu____12128 with | (t,decls) -> (t, decls)) | FStar_Syntax_Syntax.Tm_let ((false ,{ FStar_Syntax_Syntax.lbname = FStar_Util.Inl x; - FStar_Syntax_Syntax.lbunivs = uu____12202; + FStar_Syntax_Syntax.lbunivs = uu____12140; FStar_Syntax_Syntax.lbtyp = t1; - FStar_Syntax_Syntax.lbeff = uu____12204; + FStar_Syntax_Syntax.lbeff = uu____12142; FStar_Syntax_Syntax.lbdef = e1;_}::[]),e2) -> - let uu____12225 = encode_let x t1 e1 e2 env encode_formula in - (match uu____12225 with | (t,decls) -> (t, decls)) + let uu____12163 = encode_let x t1 e1 e2 env encode_formula in + (match uu____12163 with | (t,decls) -> (t, decls)) | FStar_Syntax_Syntax.Tm_app (head1,args) -> let head2 = FStar_Syntax_Util.un_uinst head1 in (match ((head2.FStar_Syntax_Syntax.n), args) with | (FStar_Syntax_Syntax.Tm_fvar - fv,uu____12272::(x,uu____12274)::(t,uu____12276)::[]) when + fv,uu____12210::(x,uu____12212)::(t,uu____12214)::[]) when FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.has_type_lid -> - let uu____12323 = encode_term x env in - (match uu____12323 with + let uu____12261 = encode_term x env in + (match uu____12261 with | (x1,decls) -> - let uu____12334 = encode_term t env in - (match uu____12334 with + let uu____12272 = encode_term t env in + (match uu____12272 with | (t1,decls') -> - let uu____12345 = + let uu____12283 = FStar_SMTEncoding_Term.mk_HasType x1 t1 in - (uu____12345, (FStar_List.append decls decls')))) + (uu____12283, (FStar_List.append decls decls')))) | (FStar_Syntax_Syntax.Tm_fvar - fv,(r,uu____12350)::(msg,uu____12352)::(phi2,uu____12354)::[]) + fv,(r,uu____12288)::(msg,uu____12290)::(phi2,uu____12292)::[]) when FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.labeled_lid -> - let uu____12399 = - let uu____12404 = - let uu____12405 = FStar_Syntax_Subst.compress r in - uu____12405.FStar_Syntax_Syntax.n in - let uu____12408 = - let uu____12409 = FStar_Syntax_Subst.compress msg in - uu____12409.FStar_Syntax_Syntax.n in - (uu____12404, uu____12408) in - (match uu____12399 with + let uu____12337 = + let uu____12342 = + let uu____12343 = FStar_Syntax_Subst.compress r in + uu____12343.FStar_Syntax_Syntax.n in + let uu____12346 = + let uu____12347 = FStar_Syntax_Subst.compress msg in + uu____12347.FStar_Syntax_Syntax.n in + (uu____12342, uu____12346) in + (match uu____12337 with | (FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_range r1),FStar_Syntax_Syntax.Tm_constant - (FStar_Const.Const_string (s,uu____12418))) -> + (FStar_Const.Const_string (s,uu____12356))) -> let phi3 = FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_meta @@ -3686,90 +3665,90 @@ and encode_formula: (s, r1, false)))) FStar_Pervasives_Native.None r1 in fallback phi3 - | uu____12424 -> fallback phi2) - | (FStar_Syntax_Syntax.Tm_fvar fv,(t,uu____12431)::[]) when + | uu____12362 -> fallback phi2) + | (FStar_Syntax_Syntax.Tm_fvar fv,(t,uu____12369)::[]) when (FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.squash_lid) || (FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.auto_squash_lid) -> encode_formula t env - | uu____12456 when head_redex env head2 -> - let uu____12469 = whnf env phi1 in - encode_formula uu____12469 env - | uu____12470 -> - let uu____12483 = encode_term phi1 env in - (match uu____12483 with + | uu____12394 when head_redex env head2 -> + let uu____12407 = whnf env phi1 in + encode_formula uu____12407 env + | uu____12408 -> + let uu____12421 = encode_term phi1 env in + (match uu____12421 with | (tt,decls) -> - let uu____12494 = + let uu____12432 = FStar_SMTEncoding_Term.mk_Valid - (let uu___114_12497 = tt in + (let uu___114_12435 = tt in { FStar_SMTEncoding_Term.tm = - (uu___114_12497.FStar_SMTEncoding_Term.tm); + (uu___114_12435.FStar_SMTEncoding_Term.tm); FStar_SMTEncoding_Term.freevars = - (uu___114_12497.FStar_SMTEncoding_Term.freevars); + (uu___114_12435.FStar_SMTEncoding_Term.freevars); FStar_SMTEncoding_Term.rng = (phi1.FStar_Syntax_Syntax.pos) }) in - (uu____12494, decls))) - | uu____12498 -> - let uu____12499 = encode_term phi1 env in - (match uu____12499 with + (uu____12432, decls))) + | uu____12436 -> + let uu____12437 = encode_term phi1 env in + (match uu____12437 with | (tt,decls) -> - let uu____12510 = + let uu____12448 = FStar_SMTEncoding_Term.mk_Valid - (let uu___115_12513 = tt in + (let uu___115_12451 = tt in { FStar_SMTEncoding_Term.tm = - (uu___115_12513.FStar_SMTEncoding_Term.tm); + (uu___115_12451.FStar_SMTEncoding_Term.tm); FStar_SMTEncoding_Term.freevars = - (uu___115_12513.FStar_SMTEncoding_Term.freevars); + (uu___115_12451.FStar_SMTEncoding_Term.freevars); FStar_SMTEncoding_Term.rng = (phi1.FStar_Syntax_Syntax.pos) }) in - (uu____12510, decls)) in + (uu____12448, decls)) in let encode_q_body env1 bs ps body = - let uu____12549 = encode_binders FStar_Pervasives_Native.None bs env1 in - match uu____12549 with - | (vars,guards,env2,decls,uu____12588) -> - let uu____12601 = - let uu____12614 = + let uu____12487 = encode_binders FStar_Pervasives_Native.None bs env1 in + match uu____12487 with + | (vars,guards,env2,decls,uu____12526) -> + let uu____12539 = + let uu____12552 = FStar_All.pipe_right ps (FStar_List.map (fun p -> - let uu____12666 = - let uu____12677 = + let uu____12604 = + let uu____12615 = FStar_All.pipe_right p (FStar_List.map - (fun uu____12717 -> - match uu____12717 with - | (t,uu____12731) -> + (fun uu____12655 -> + match uu____12655 with + | (t,uu____12669) -> encode_smt_pattern t - (let uu___116_12737 = env2 in + (let uu___116_12675 = env2 in { bindings = - (uu___116_12737.bindings); - depth = (uu___116_12737.depth); - tcenv = (uu___116_12737.tcenv); - warn = (uu___116_12737.warn); - cache = (uu___116_12737.cache); + (uu___116_12675.bindings); + depth = (uu___116_12675.depth); + tcenv = (uu___116_12675.tcenv); + warn = (uu___116_12675.warn); + cache = (uu___116_12675.cache); nolabels = - (uu___116_12737.nolabels); + (uu___116_12675.nolabels); use_zfuel_name = true; encode_non_total_function_typ = - (uu___116_12737.encode_non_total_function_typ); + (uu___116_12675.encode_non_total_function_typ); current_module_name = - (uu___116_12737.current_module_name) + (uu___116_12675.current_module_name) }))) in - FStar_All.pipe_right uu____12677 FStar_List.unzip in - match uu____12666 with + FStar_All.pipe_right uu____12615 FStar_List.unzip in + match uu____12604 with | (p1,decls1) -> (p1, (FStar_List.flatten decls1)))) in - FStar_All.pipe_right uu____12614 FStar_List.unzip in - (match uu____12601 with + FStar_All.pipe_right uu____12552 FStar_List.unzip in + (match uu____12539 with | (pats,decls') -> - let uu____12846 = encode_formula body env2 in - (match uu____12846 with + let uu____12784 = encode_formula body env2 in + (match uu____12784 with | (body1,decls'') -> let guards1 = match pats with @@ -3777,17 +3756,17 @@ and encode_formula: FStar_SMTEncoding_Term.tm = FStar_SMTEncoding_Term.App (FStar_SMTEncoding_Term.Var gf,p::[]); - FStar_SMTEncoding_Term.freevars = uu____12878; - FStar_SMTEncoding_Term.rng = uu____12879;_}::[])::[] + FStar_SMTEncoding_Term.freevars = uu____12816; + FStar_SMTEncoding_Term.rng = uu____12817;_}::[])::[] when (FStar_Ident.text_of_lid FStar_Parser_Const.guard_free) = gf -> [] - | uu____12894 -> guards in - let uu____12899 = + | uu____12832 -> guards in + let uu____12837 = FStar_SMTEncoding_Util.mk_and_l guards1 in - (vars, pats, uu____12899, body1, + (vars, pats, uu____12837, body1, (FStar_List.append decls (FStar_List.append (FStar_List.flatten decls') decls''))))) in @@ -3797,9 +3776,9 @@ and encode_formula: let pats1 = FStar_All.pipe_right pats (FStar_List.map - (fun uu____12959 -> - match uu____12959 with - | (x,uu____12965) -> + (fun uu____12897 -> + match uu____12897 with + | (x,uu____12903) -> FStar_TypeChecker_Normalize.normalize [FStar_TypeChecker_Normalize.Beta; FStar_TypeChecker_Normalize.AllowUnboundUniverses; @@ -3809,23 +3788,23 @@ and encode_formula: | [] -> () | hd1::tl1 -> let pat_vars = - let uu____12973 = FStar_Syntax_Free.names hd1 in + let uu____12911 = FStar_Syntax_Free.names hd1 in FStar_List.fold_left (fun out -> fun x -> - let uu____12985 = FStar_Syntax_Free.names x in - FStar_Util.set_union out uu____12985) uu____12973 tl1 in - let uu____12988 = + let uu____12923 = FStar_Syntax_Free.names x in + FStar_Util.set_union out uu____12923) uu____12911 tl1 in + let uu____12926 = FStar_All.pipe_right vars (FStar_Util.find_opt - (fun uu____13015 -> - match uu____13015 with - | (b,uu____13021) -> - let uu____13022 = FStar_Util.set_mem b pat_vars in - Prims.op_Negation uu____13022)) in - (match uu____12988 with + (fun uu____12953 -> + match uu____12953 with + | (b,uu____12959) -> + let uu____12960 = FStar_Util.set_mem b pat_vars in + Prims.op_Negation uu____12960)) in + (match uu____12926 with | FStar_Pervasives_Native.None -> () - | FStar_Pervasives_Native.Some (x,uu____13028) -> + | FStar_Pervasives_Native.Some (x,uu____12966) -> let pos = FStar_List.fold_left (fun out -> @@ -3833,60 +3812,60 @@ and encode_formula: FStar_Range.union_ranges out t.FStar_Syntax_Syntax.pos) hd1.FStar_Syntax_Syntax.pos tl1 in - let uu____13042 = - let uu____13047 = - let uu____13048 = FStar_Syntax_Print.bv_to_string x in + let uu____12980 = + let uu____12985 = + let uu____12986 = FStar_Syntax_Print.bv_to_string x in FStar_Util.format1 "SMT pattern misses at least one bound variable: %s" - uu____13048 in + uu____12986 in (FStar_Errors.Warning_SMTPatternMissingBoundVar, - uu____13047) in - FStar_Errors.log_issue pos uu____13042) in - let uu____13049 = FStar_Syntax_Util.destruct_typ_as_formula phi1 in - match uu____13049 with + uu____12985) in + FStar_Errors.log_issue pos uu____12980) in + let uu____12987 = FStar_Syntax_Util.destruct_typ_as_formula phi1 in + match uu____12987 with | FStar_Pervasives_Native.None -> fallback phi1 | FStar_Pervasives_Native.Some (FStar_Syntax_Util.BaseConn (op,arms)) -> - let uu____13058 = + let uu____12996 = FStar_All.pipe_right connectives (FStar_List.tryFind - (fun uu____13116 -> - match uu____13116 with - | (l,uu____13130) -> FStar_Ident.lid_equals op l)) in - (match uu____13058 with + (fun uu____13054 -> + match uu____13054 with + | (l,uu____13068) -> FStar_Ident.lid_equals op l)) in + (match uu____12996 with | FStar_Pervasives_Native.None -> fallback phi1 - | FStar_Pervasives_Native.Some (uu____13163,f) -> + | FStar_Pervasives_Native.Some (uu____13101,f) -> f phi1.FStar_Syntax_Syntax.pos arms) | FStar_Pervasives_Native.Some (FStar_Syntax_Util.QAll (vars,pats,body)) -> (FStar_All.pipe_right pats (FStar_List.iter (check_pattern_vars vars)); - (let uu____13203 = encode_q_body env vars pats body in - match uu____13203 with + (let uu____13141 = encode_q_body env vars pats body in + match uu____13141 with | (vars1,pats1,guard,body1,decls) -> let tm = - let uu____13248 = - let uu____13259 = + let uu____13186 = + let uu____13197 = FStar_SMTEncoding_Util.mkImp (guard, body1) in - (pats1, vars1, uu____13259) in - FStar_SMTEncoding_Term.mkForall uu____13248 + (pats1, vars1, uu____13197) in + FStar_SMTEncoding_Term.mkForall uu____13186 phi1.FStar_Syntax_Syntax.pos in (tm, decls))) | FStar_Pervasives_Native.Some (FStar_Syntax_Util.QEx (vars,pats,body)) -> (FStar_All.pipe_right pats (FStar_List.iter (check_pattern_vars vars)); - (let uu____13278 = encode_q_body env vars pats body in - match uu____13278 with + (let uu____13216 = encode_q_body env vars pats body in + match uu____13216 with | (vars1,pats1,guard,body1,decls) -> - let uu____13322 = - let uu____13323 = - let uu____13334 = + let uu____13260 = + let uu____13261 = + let uu____13272 = FStar_SMTEncoding_Util.mkAnd (guard, body1) in - (pats1, vars1, uu____13334) in - FStar_SMTEncoding_Term.mkExists uu____13323 + (pats1, vars1, uu____13272) in + FStar_SMTEncoding_Term.mkExists uu____13261 phi1.FStar_Syntax_Syntax.pos in - (uu____13322, decls)))) + (uu____13260, decls)))) type prims_t = { mk: @@ -3911,71 +3890,71 @@ let __proj__Mkprims_t__item__is: prims_t -> FStar_Ident.lident -> Prims.bool match projectee with | { mk = __fname__mk; is = __fname__is;_} -> __fname__is let prims: prims_t = - let uu____13427 = fresh_fvar "a" FStar_SMTEncoding_Term.Term_sort in - match uu____13427 with + let uu____13365 = fresh_fvar "a" FStar_SMTEncoding_Term.Term_sort in + match uu____13365 with | (asym,a) -> - let uu____13434 = fresh_fvar "x" FStar_SMTEncoding_Term.Term_sort in - (match uu____13434 with + let uu____13372 = fresh_fvar "x" FStar_SMTEncoding_Term.Term_sort in + (match uu____13372 with | (xsym,x) -> - let uu____13441 = fresh_fvar "y" FStar_SMTEncoding_Term.Term_sort in - (match uu____13441 with + let uu____13379 = fresh_fvar "y" FStar_SMTEncoding_Term.Term_sort in + (match uu____13379 with | (ysym,y) -> let quant vars body x1 = let xname_decl = - let uu____13485 = - let uu____13496 = + let uu____13423 = + let uu____13434 = FStar_All.pipe_right vars (FStar_List.map FStar_Pervasives_Native.snd) in - (x1, uu____13496, FStar_SMTEncoding_Term.Term_sort, + (x1, uu____13434, FStar_SMTEncoding_Term.Term_sort, FStar_Pervasives_Native.None) in - FStar_SMTEncoding_Term.DeclFun uu____13485 in + FStar_SMTEncoding_Term.DeclFun uu____13423 in let xtok = Prims.strcat x1 "@tok" in let xtok_decl = FStar_SMTEncoding_Term.DeclFun (xtok, [], FStar_SMTEncoding_Term.Term_sort, FStar_Pervasives_Native.None) in let xapp = - let uu____13522 = - let uu____13529 = + let uu____13460 = + let uu____13467 = FStar_List.map FStar_SMTEncoding_Util.mkFreeV vars in - (x1, uu____13529) in - FStar_SMTEncoding_Util.mkApp uu____13522 in + (x1, uu____13467) in + FStar_SMTEncoding_Util.mkApp uu____13460 in let xtok1 = FStar_SMTEncoding_Util.mkApp (xtok, []) in let xtok_app = mk_Apply xtok1 vars in - let uu____13542 = - let uu____13545 = - let uu____13548 = - let uu____13551 = - let uu____13552 = - let uu____13559 = - let uu____13560 = - let uu____13571 = + let uu____13480 = + let uu____13483 = + let uu____13486 = + let uu____13489 = + let uu____13490 = + let uu____13497 = + let uu____13498 = + let uu____13509 = FStar_SMTEncoding_Util.mkEq (xapp, body) in - ([[xapp]], vars, uu____13571) in - FStar_SMTEncoding_Util.mkForall uu____13560 in - (uu____13559, FStar_Pervasives_Native.None, + ([[xapp]], vars, uu____13509) in + FStar_SMTEncoding_Util.mkForall uu____13498 in + (uu____13497, FStar_Pervasives_Native.None, (Prims.strcat "primitive_" x1)) in - FStar_SMTEncoding_Util.mkAssume uu____13552 in - let uu____13588 = - let uu____13591 = - let uu____13592 = - let uu____13599 = - let uu____13600 = - let uu____13611 = + FStar_SMTEncoding_Util.mkAssume uu____13490 in + let uu____13526 = + let uu____13529 = + let uu____13530 = + let uu____13537 = + let uu____13538 = + let uu____13549 = FStar_SMTEncoding_Util.mkEq (xtok_app, xapp) in - ([[xtok_app]], vars, uu____13611) in - FStar_SMTEncoding_Util.mkForall uu____13600 in - (uu____13599, + ([[xtok_app]], vars, uu____13549) in + FStar_SMTEncoding_Util.mkForall uu____13538 in + (uu____13537, (FStar_Pervasives_Native.Some "Name-token correspondence"), (Prims.strcat "token_correspondence_" x1)) in - FStar_SMTEncoding_Util.mkAssume uu____13592 in - [uu____13591] in - uu____13551 :: uu____13588 in - xtok_decl :: uu____13548 in - xname_decl :: uu____13545 in - (xtok1, uu____13542) in + FStar_SMTEncoding_Util.mkAssume uu____13530 in + [uu____13529] in + uu____13489 :: uu____13526 in + xtok_decl :: uu____13486 in + xname_decl :: uu____13483 in + (xtok1, uu____13480) in let axy = [(asym, FStar_SMTEncoding_Term.Term_sort); (xsym, FStar_SMTEncoding_Term.Term_sort); @@ -3985,303 +3964,303 @@ let prims: prims_t = (ysym, FStar_SMTEncoding_Term.Term_sort)] in let qx = [(xsym, FStar_SMTEncoding_Term.Term_sort)] in let prims1 = - let uu____13702 = - let uu____13715 = - let uu____13724 = - let uu____13725 = FStar_SMTEncoding_Util.mkEq (x, y) in + let uu____13640 = + let uu____13653 = + let uu____13662 = + let uu____13663 = FStar_SMTEncoding_Util.mkEq (x, y) in FStar_All.pipe_left FStar_SMTEncoding_Term.boxBool - uu____13725 in - quant axy uu____13724 in - (FStar_Parser_Const.op_Eq, uu____13715) in - let uu____13734 = - let uu____13749 = - let uu____13762 = - let uu____13771 = - let uu____13772 = - let uu____13773 = + uu____13663 in + quant axy uu____13662 in + (FStar_Parser_Const.op_Eq, uu____13653) in + let uu____13672 = + let uu____13687 = + let uu____13700 = + let uu____13709 = + let uu____13710 = + let uu____13711 = FStar_SMTEncoding_Util.mkEq (x, y) in - FStar_SMTEncoding_Util.mkNot uu____13773 in + FStar_SMTEncoding_Util.mkNot uu____13711 in FStar_All.pipe_left FStar_SMTEncoding_Term.boxBool - uu____13772 in - quant axy uu____13771 in - (FStar_Parser_Const.op_notEq, uu____13762) in - let uu____13782 = - let uu____13797 = - let uu____13810 = - let uu____13819 = - let uu____13820 = - let uu____13821 = - let uu____13826 = + uu____13710 in + quant axy uu____13709 in + (FStar_Parser_Const.op_notEq, uu____13700) in + let uu____13720 = + let uu____13735 = + let uu____13748 = + let uu____13757 = + let uu____13758 = + let uu____13759 = + let uu____13764 = FStar_SMTEncoding_Term.unboxInt x in - let uu____13827 = + let uu____13765 = FStar_SMTEncoding_Term.unboxInt y in - (uu____13826, uu____13827) in - FStar_SMTEncoding_Util.mkLT uu____13821 in + (uu____13764, uu____13765) in + FStar_SMTEncoding_Util.mkLT uu____13759 in FStar_All.pipe_left - FStar_SMTEncoding_Term.boxBool uu____13820 in - quant xy uu____13819 in - (FStar_Parser_Const.op_LT, uu____13810) in - let uu____13836 = - let uu____13851 = - let uu____13864 = - let uu____13873 = - let uu____13874 = - let uu____13875 = - let uu____13880 = + FStar_SMTEncoding_Term.boxBool uu____13758 in + quant xy uu____13757 in + (FStar_Parser_Const.op_LT, uu____13748) in + let uu____13774 = + let uu____13789 = + let uu____13802 = + let uu____13811 = + let uu____13812 = + let uu____13813 = + let uu____13818 = FStar_SMTEncoding_Term.unboxInt x in - let uu____13881 = + let uu____13819 = FStar_SMTEncoding_Term.unboxInt y in - (uu____13880, uu____13881) in - FStar_SMTEncoding_Util.mkLTE uu____13875 in + (uu____13818, uu____13819) in + FStar_SMTEncoding_Util.mkLTE uu____13813 in FStar_All.pipe_left - FStar_SMTEncoding_Term.boxBool uu____13874 in - quant xy uu____13873 in - (FStar_Parser_Const.op_LTE, uu____13864) in - let uu____13890 = - let uu____13905 = - let uu____13918 = - let uu____13927 = - let uu____13928 = - let uu____13929 = - let uu____13934 = + FStar_SMTEncoding_Term.boxBool uu____13812 in + quant xy uu____13811 in + (FStar_Parser_Const.op_LTE, uu____13802) in + let uu____13828 = + let uu____13843 = + let uu____13856 = + let uu____13865 = + let uu____13866 = + let uu____13867 = + let uu____13872 = FStar_SMTEncoding_Term.unboxInt x in - let uu____13935 = + let uu____13873 = FStar_SMTEncoding_Term.unboxInt y in - (uu____13934, uu____13935) in - FStar_SMTEncoding_Util.mkGT uu____13929 in + (uu____13872, uu____13873) in + FStar_SMTEncoding_Util.mkGT uu____13867 in FStar_All.pipe_left - FStar_SMTEncoding_Term.boxBool uu____13928 in - quant xy uu____13927 in - (FStar_Parser_Const.op_GT, uu____13918) in - let uu____13944 = - let uu____13959 = - let uu____13972 = - let uu____13981 = - let uu____13982 = - let uu____13983 = - let uu____13988 = + FStar_SMTEncoding_Term.boxBool uu____13866 in + quant xy uu____13865 in + (FStar_Parser_Const.op_GT, uu____13856) in + let uu____13882 = + let uu____13897 = + let uu____13910 = + let uu____13919 = + let uu____13920 = + let uu____13921 = + let uu____13926 = FStar_SMTEncoding_Term.unboxInt x in - let uu____13989 = + let uu____13927 = FStar_SMTEncoding_Term.unboxInt y in - (uu____13988, uu____13989) in - FStar_SMTEncoding_Util.mkGTE uu____13983 in + (uu____13926, uu____13927) in + FStar_SMTEncoding_Util.mkGTE uu____13921 in FStar_All.pipe_left FStar_SMTEncoding_Term.boxBool - uu____13982 in - quant xy uu____13981 in - (FStar_Parser_Const.op_GTE, uu____13972) in - let uu____13998 = - let uu____14013 = - let uu____14026 = - let uu____14035 = - let uu____14036 = - let uu____14037 = - let uu____14042 = + uu____13920 in + quant xy uu____13919 in + (FStar_Parser_Const.op_GTE, uu____13910) in + let uu____13936 = + let uu____13951 = + let uu____13964 = + let uu____13973 = + let uu____13974 = + let uu____13975 = + let uu____13980 = FStar_SMTEncoding_Term.unboxInt x in - let uu____14043 = + let uu____13981 = FStar_SMTEncoding_Term.unboxInt y in - (uu____14042, uu____14043) in + (uu____13980, uu____13981) in FStar_SMTEncoding_Util.mkSub - uu____14037 in + uu____13975 in FStar_All.pipe_left FStar_SMTEncoding_Term.boxInt - uu____14036 in - quant xy uu____14035 in + uu____13974 in + quant xy uu____13973 in (FStar_Parser_Const.op_Subtraction, - uu____14026) in - let uu____14052 = - let uu____14067 = - let uu____14080 = - let uu____14089 = - let uu____14090 = - let uu____14091 = + uu____13964) in + let uu____13990 = + let uu____14005 = + let uu____14018 = + let uu____14027 = + let uu____14028 = + let uu____14029 = FStar_SMTEncoding_Term.unboxInt x in FStar_SMTEncoding_Util.mkMinus - uu____14091 in + uu____14029 in FStar_All.pipe_left FStar_SMTEncoding_Term.boxInt - uu____14090 in - quant qx uu____14089 in - (FStar_Parser_Const.op_Minus, uu____14080) in - let uu____14100 = - let uu____14115 = - let uu____14128 = - let uu____14137 = - let uu____14138 = - let uu____14139 = - let uu____14144 = + uu____14028 in + quant qx uu____14027 in + (FStar_Parser_Const.op_Minus, uu____14018) in + let uu____14038 = + let uu____14053 = + let uu____14066 = + let uu____14075 = + let uu____14076 = + let uu____14077 = + let uu____14082 = FStar_SMTEncoding_Term.unboxInt x in - let uu____14145 = + let uu____14083 = FStar_SMTEncoding_Term.unboxInt y in - (uu____14144, uu____14145) in + (uu____14082, uu____14083) in FStar_SMTEncoding_Util.mkAdd - uu____14139 in + uu____14077 in FStar_All.pipe_left FStar_SMTEncoding_Term.boxInt - uu____14138 in - quant xy uu____14137 in + uu____14076 in + quant xy uu____14075 in (FStar_Parser_Const.op_Addition, - uu____14128) in - let uu____14154 = - let uu____14169 = - let uu____14182 = - let uu____14191 = - let uu____14192 = - let uu____14193 = - let uu____14198 = + uu____14066) in + let uu____14092 = + let uu____14107 = + let uu____14120 = + let uu____14129 = + let uu____14130 = + let uu____14131 = + let uu____14136 = FStar_SMTEncoding_Term.unboxInt x in - let uu____14199 = + let uu____14137 = FStar_SMTEncoding_Term.unboxInt y in - (uu____14198, uu____14199) in + (uu____14136, uu____14137) in FStar_SMTEncoding_Util.mkMul - uu____14193 in + uu____14131 in FStar_All.pipe_left FStar_SMTEncoding_Term.boxInt - uu____14192 in - quant xy uu____14191 in + uu____14130 in + quant xy uu____14129 in (FStar_Parser_Const.op_Multiply, - uu____14182) in - let uu____14208 = - let uu____14223 = - let uu____14236 = - let uu____14245 = - let uu____14246 = - let uu____14247 = - let uu____14252 = + uu____14120) in + let uu____14146 = + let uu____14161 = + let uu____14174 = + let uu____14183 = + let uu____14184 = + let uu____14185 = + let uu____14190 = FStar_SMTEncoding_Term.unboxInt x in - let uu____14253 = + let uu____14191 = FStar_SMTEncoding_Term.unboxInt y in - (uu____14252, uu____14253) in + (uu____14190, uu____14191) in FStar_SMTEncoding_Util.mkDiv - uu____14247 in + uu____14185 in FStar_All.pipe_left FStar_SMTEncoding_Term.boxInt - uu____14246 in - quant xy uu____14245 in + uu____14184 in + quant xy uu____14183 in (FStar_Parser_Const.op_Division, - uu____14236) in - let uu____14262 = - let uu____14277 = - let uu____14290 = - let uu____14299 = - let uu____14300 = - let uu____14301 = - let uu____14306 = + uu____14174) in + let uu____14200 = + let uu____14215 = + let uu____14228 = + let uu____14237 = + let uu____14238 = + let uu____14239 = + let uu____14244 = FStar_SMTEncoding_Term.unboxInt x in - let uu____14307 = + let uu____14245 = FStar_SMTEncoding_Term.unboxInt y in - (uu____14306, uu____14307) in + (uu____14244, uu____14245) in FStar_SMTEncoding_Util.mkMod - uu____14301 in + uu____14239 in FStar_All.pipe_left FStar_SMTEncoding_Term.boxInt - uu____14300 in - quant xy uu____14299 in + uu____14238 in + quant xy uu____14237 in (FStar_Parser_Const.op_Modulus, - uu____14290) in - let uu____14316 = - let uu____14331 = - let uu____14344 = - let uu____14353 = - let uu____14354 = - let uu____14355 = - let uu____14360 = + uu____14228) in + let uu____14254 = + let uu____14269 = + let uu____14282 = + let uu____14291 = + let uu____14292 = + let uu____14293 = + let uu____14298 = FStar_SMTEncoding_Term.unboxBool x in - let uu____14361 = + let uu____14299 = FStar_SMTEncoding_Term.unboxBool y in - (uu____14360, - uu____14361) in + (uu____14298, + uu____14299) in FStar_SMTEncoding_Util.mkAnd - uu____14355 in + uu____14293 in FStar_All.pipe_left FStar_SMTEncoding_Term.boxBool - uu____14354 in - quant xy uu____14353 in + uu____14292 in + quant xy uu____14291 in (FStar_Parser_Const.op_And, - uu____14344) in - let uu____14370 = - let uu____14385 = - let uu____14398 = - let uu____14407 = - let uu____14408 = - let uu____14409 = - let uu____14414 = + uu____14282) in + let uu____14308 = + let uu____14323 = + let uu____14336 = + let uu____14345 = + let uu____14346 = + let uu____14347 = + let uu____14352 = FStar_SMTEncoding_Term.unboxBool x in - let uu____14415 = + let uu____14353 = FStar_SMTEncoding_Term.unboxBool y in - (uu____14414, - uu____14415) in + (uu____14352, + uu____14353) in FStar_SMTEncoding_Util.mkOr - uu____14409 in + uu____14347 in FStar_All.pipe_left FStar_SMTEncoding_Term.boxBool - uu____14408 in - quant xy uu____14407 in + uu____14346 in + quant xy uu____14345 in (FStar_Parser_Const.op_Or, - uu____14398) in - let uu____14424 = - let uu____14439 = - let uu____14452 = - let uu____14461 = - let uu____14462 = - let uu____14463 = + uu____14336) in + let uu____14362 = + let uu____14377 = + let uu____14390 = + let uu____14399 = + let uu____14400 = + let uu____14401 = FStar_SMTEncoding_Term.unboxBool x in FStar_SMTEncoding_Util.mkNot - uu____14463 in + uu____14401 in FStar_All.pipe_left FStar_SMTEncoding_Term.boxBool - uu____14462 in - quant qx uu____14461 in + uu____14400 in + quant qx uu____14399 in (FStar_Parser_Const.op_Negation, - uu____14452) in - [uu____14439] in - uu____14385 :: uu____14424 in - uu____14331 :: uu____14370 in - uu____14277 :: uu____14316 in - uu____14223 :: uu____14262 in - uu____14169 :: uu____14208 in - uu____14115 :: uu____14154 in - uu____14067 :: uu____14100 in - uu____14013 :: uu____14052 in - uu____13959 :: uu____13998 in - uu____13905 :: uu____13944 in - uu____13851 :: uu____13890 in - uu____13797 :: uu____13836 in - uu____13749 :: uu____13782 in - uu____13702 :: uu____13734 in + uu____14390) in + [uu____14377] in + uu____14323 :: uu____14362 in + uu____14269 :: uu____14308 in + uu____14215 :: uu____14254 in + uu____14161 :: uu____14200 in + uu____14107 :: uu____14146 in + uu____14053 :: uu____14092 in + uu____14005 :: uu____14038 in + uu____13951 :: uu____13990 in + uu____13897 :: uu____13936 in + uu____13843 :: uu____13882 in + uu____13789 :: uu____13828 in + uu____13735 :: uu____13774 in + uu____13687 :: uu____13720 in + uu____13640 :: uu____13672 in let mk1 l v1 = - let uu____14677 = - let uu____14686 = + let uu____14615 = + let uu____14624 = FStar_All.pipe_right prims1 (FStar_List.find - (fun uu____14744 -> - match uu____14744 with - | (l',uu____14758) -> + (fun uu____14682 -> + match uu____14682 with + | (l',uu____14696) -> FStar_Ident.lid_equals l l')) in - FStar_All.pipe_right uu____14686 + FStar_All.pipe_right uu____14624 (FStar_Option.map - (fun uu____14818 -> - match uu____14818 with | (uu____14837,b) -> b v1)) in - FStar_All.pipe_right uu____14677 FStar_Option.get in + (fun uu____14756 -> + match uu____14756 with | (uu____14775,b) -> b v1)) in + FStar_All.pipe_right uu____14615 FStar_Option.get in let is l = FStar_All.pipe_right prims1 (FStar_Util.for_some - (fun uu____14908 -> - match uu____14908 with - | (l',uu____14922) -> FStar_Ident.lid_equals l l')) in + (fun uu____14846 -> + match uu____14846 with + | (l',uu____14860) -> FStar_Ident.lid_equals l l')) in { mk = mk1; is })) let pretype_axiom: env_t -> @@ -4293,46 +4272,46 @@ let pretype_axiom: fun env -> fun tapp -> fun vars -> - let uu____14960 = fresh_fvar "x" FStar_SMTEncoding_Term.Term_sort in - match uu____14960 with + let uu____14898 = fresh_fvar "x" FStar_SMTEncoding_Term.Term_sort in + match uu____14898 with | (xxsym,xx) -> - let uu____14967 = fresh_fvar "f" FStar_SMTEncoding_Term.Fuel_sort in - (match uu____14967 with + let uu____14905 = fresh_fvar "f" FStar_SMTEncoding_Term.Fuel_sort in + (match uu____14905 with | (ffsym,ff) -> let xx_has_type = FStar_SMTEncoding_Term.mk_HasTypeFuel ff xx tapp in let tapp_hash = FStar_SMTEncoding_Term.hash_of_term tapp in let module_name = env.current_module_name in - let uu____14977 = - let uu____14984 = - let uu____14985 = - let uu____14996 = - let uu____14997 = - let uu____15002 = - let uu____15003 = - let uu____15008 = + let uu____14915 = + let uu____14922 = + let uu____14923 = + let uu____14934 = + let uu____14935 = + let uu____14940 = + let uu____14941 = + let uu____14946 = FStar_SMTEncoding_Util.mkApp ("PreType", [xx]) in - (tapp, uu____15008) in - FStar_SMTEncoding_Util.mkEq uu____15003 in - (xx_has_type, uu____15002) in - FStar_SMTEncoding_Util.mkImp uu____14997 in + (tapp, uu____14946) in + FStar_SMTEncoding_Util.mkEq uu____14941 in + (xx_has_type, uu____14940) in + FStar_SMTEncoding_Util.mkImp uu____14935 in ([[xx_has_type]], ((xxsym, FStar_SMTEncoding_Term.Term_sort) :: (ffsym, FStar_SMTEncoding_Term.Fuel_sort) :: vars), - uu____14996) in - FStar_SMTEncoding_Util.mkForall uu____14985 in - let uu____15033 = - let uu____15034 = - let uu____15035 = - let uu____15036 = + uu____14934) in + FStar_SMTEncoding_Util.mkForall uu____14923 in + let uu____14971 = + let uu____14972 = + let uu____14973 = + let uu____14974 = FStar_Util.digest_of_string tapp_hash in - Prims.strcat "_pretyping_" uu____15036 in - Prims.strcat module_name uu____15035 in - varops.mk_unique uu____15034 in - (uu____14984, (FStar_Pervasives_Native.Some "pretyping"), - uu____15033) in - FStar_SMTEncoding_Util.mkAssume uu____14977) + Prims.strcat "_pretyping_" uu____14974 in + Prims.strcat module_name uu____14973 in + varops.mk_unique uu____14972 in + (uu____14922, (FStar_Pervasives_Native.Some "pretyping"), + uu____14971) in + FStar_SMTEncoding_Util.mkAssume uu____14915) let primitive_type_axioms: FStar_TypeChecker_Env.env -> FStar_Ident.lident -> @@ -4345,74 +4324,74 @@ let primitive_type_axioms: let y = FStar_SMTEncoding_Util.mkFreeV yy in let mk_unit env nm tt = let typing_pred = FStar_SMTEncoding_Term.mk_HasType x tt in - let uu____15072 = - let uu____15073 = - let uu____15080 = + let uu____15010 = + let uu____15011 = + let uu____15018 = FStar_SMTEncoding_Term.mk_HasType FStar_SMTEncoding_Term.mk_Term_unit tt in - (uu____15080, (FStar_Pervasives_Native.Some "unit typing"), + (uu____15018, (FStar_Pervasives_Native.Some "unit typing"), "unit_typing") in - FStar_SMTEncoding_Util.mkAssume uu____15073 in - let uu____15083 = - let uu____15086 = - let uu____15087 = - let uu____15094 = - let uu____15095 = - let uu____15106 = - let uu____15107 = - let uu____15112 = + FStar_SMTEncoding_Util.mkAssume uu____15011 in + let uu____15021 = + let uu____15024 = + let uu____15025 = + let uu____15032 = + let uu____15033 = + let uu____15044 = + let uu____15045 = + let uu____15050 = FStar_SMTEncoding_Util.mkEq (x, FStar_SMTEncoding_Term.mk_Term_unit) in - (typing_pred, uu____15112) in - FStar_SMTEncoding_Util.mkImp uu____15107 in - ([[typing_pred]], [xx], uu____15106) in - mkForall_fuel uu____15095 in - (uu____15094, (FStar_Pervasives_Native.Some "unit inversion"), + (typing_pred, uu____15050) in + FStar_SMTEncoding_Util.mkImp uu____15045 in + ([[typing_pred]], [xx], uu____15044) in + mkForall_fuel uu____15033 in + (uu____15032, (FStar_Pervasives_Native.Some "unit inversion"), "unit_inversion") in - FStar_SMTEncoding_Util.mkAssume uu____15087 in - [uu____15086] in - uu____15072 :: uu____15083 in + FStar_SMTEncoding_Util.mkAssume uu____15025 in + [uu____15024] in + uu____15010 :: uu____15021 in let mk_bool env nm tt = let typing_pred = FStar_SMTEncoding_Term.mk_HasType x tt in let bb = ("b", FStar_SMTEncoding_Term.Bool_sort) in let b = FStar_SMTEncoding_Util.mkFreeV bb in - let uu____15154 = - let uu____15155 = - let uu____15162 = - let uu____15163 = - let uu____15174 = - let uu____15179 = - let uu____15182 = FStar_SMTEncoding_Term.boxBool b in - [uu____15182] in - [uu____15179] in - let uu____15187 = - let uu____15188 = FStar_SMTEncoding_Term.boxBool b in - FStar_SMTEncoding_Term.mk_HasType uu____15188 tt in - (uu____15174, [bb], uu____15187) in - FStar_SMTEncoding_Util.mkForall uu____15163 in - (uu____15162, (FStar_Pervasives_Native.Some "bool typing"), + let uu____15092 = + let uu____15093 = + let uu____15100 = + let uu____15101 = + let uu____15112 = + let uu____15117 = + let uu____15120 = FStar_SMTEncoding_Term.boxBool b in + [uu____15120] in + [uu____15117] in + let uu____15125 = + let uu____15126 = FStar_SMTEncoding_Term.boxBool b in + FStar_SMTEncoding_Term.mk_HasType uu____15126 tt in + (uu____15112, [bb], uu____15125) in + FStar_SMTEncoding_Util.mkForall uu____15101 in + (uu____15100, (FStar_Pervasives_Native.Some "bool typing"), "bool_typing") in - FStar_SMTEncoding_Util.mkAssume uu____15155 in - let uu____15209 = - let uu____15212 = - let uu____15213 = - let uu____15220 = - let uu____15221 = - let uu____15232 = - let uu____15233 = - let uu____15238 = + FStar_SMTEncoding_Util.mkAssume uu____15093 in + let uu____15147 = + let uu____15150 = + let uu____15151 = + let uu____15158 = + let uu____15159 = + let uu____15170 = + let uu____15171 = + let uu____15176 = FStar_SMTEncoding_Term.mk_tester (FStar_Pervasives_Native.fst FStar_SMTEncoding_Term.boxBoolFun) x in - (typing_pred, uu____15238) in - FStar_SMTEncoding_Util.mkImp uu____15233 in - ([[typing_pred]], [xx], uu____15232) in - mkForall_fuel uu____15221 in - (uu____15220, (FStar_Pervasives_Native.Some "bool inversion"), + (typing_pred, uu____15176) in + FStar_SMTEncoding_Util.mkImp uu____15171 in + ([[typing_pred]], [xx], uu____15170) in + mkForall_fuel uu____15159 in + (uu____15158, (FStar_Pervasives_Native.Some "bool inversion"), "bool_inversion") in - FStar_SMTEncoding_Util.mkAssume uu____15213 in - [uu____15212] in - uu____15154 :: uu____15209 in + FStar_SMTEncoding_Util.mkAssume uu____15151 in + [uu____15150] in + uu____15092 :: uu____15147 in let mk_int env nm tt = let typing_pred = FStar_SMTEncoding_Term.mk_HasType x tt in let typing_pred_y = FStar_SMTEncoding_Term.mk_HasType y tt in @@ -4421,158 +4400,158 @@ let primitive_type_axioms: let bb = ("b", FStar_SMTEncoding_Term.Int_sort) in let b = FStar_SMTEncoding_Util.mkFreeV bb in let precedes = - let uu____15288 = - let uu____15289 = - let uu____15296 = - let uu____15299 = - let uu____15302 = - let uu____15305 = FStar_SMTEncoding_Term.boxInt a in - let uu____15306 = - let uu____15309 = FStar_SMTEncoding_Term.boxInt b in - [uu____15309] in - uu____15305 :: uu____15306 in - tt :: uu____15302 in - tt :: uu____15299 in - ("Prims.Precedes", uu____15296) in - FStar_SMTEncoding_Util.mkApp uu____15289 in - FStar_All.pipe_left FStar_SMTEncoding_Term.mk_Valid uu____15288 in + let uu____15226 = + let uu____15227 = + let uu____15234 = + let uu____15237 = + let uu____15240 = + let uu____15243 = FStar_SMTEncoding_Term.boxInt a in + let uu____15244 = + let uu____15247 = FStar_SMTEncoding_Term.boxInt b in + [uu____15247] in + uu____15243 :: uu____15244 in + tt :: uu____15240 in + tt :: uu____15237 in + ("Prims.Precedes", uu____15234) in + FStar_SMTEncoding_Util.mkApp uu____15227 in + FStar_All.pipe_left FStar_SMTEncoding_Term.mk_Valid uu____15226 in let precedes_y_x = - let uu____15313 = FStar_SMTEncoding_Util.mkApp ("Precedes", [y; x]) in - FStar_All.pipe_left FStar_SMTEncoding_Term.mk_Valid uu____15313 in - let uu____15316 = - let uu____15317 = - let uu____15324 = - let uu____15325 = - let uu____15336 = - let uu____15341 = - let uu____15344 = FStar_SMTEncoding_Term.boxInt b in - [uu____15344] in - [uu____15341] in - let uu____15349 = - let uu____15350 = FStar_SMTEncoding_Term.boxInt b in - FStar_SMTEncoding_Term.mk_HasType uu____15350 tt in - (uu____15336, [bb], uu____15349) in - FStar_SMTEncoding_Util.mkForall uu____15325 in - (uu____15324, (FStar_Pervasives_Native.Some "int typing"), + let uu____15251 = FStar_SMTEncoding_Util.mkApp ("Precedes", [y; x]) in + FStar_All.pipe_left FStar_SMTEncoding_Term.mk_Valid uu____15251 in + let uu____15254 = + let uu____15255 = + let uu____15262 = + let uu____15263 = + let uu____15274 = + let uu____15279 = + let uu____15282 = FStar_SMTEncoding_Term.boxInt b in + [uu____15282] in + [uu____15279] in + let uu____15287 = + let uu____15288 = FStar_SMTEncoding_Term.boxInt b in + FStar_SMTEncoding_Term.mk_HasType uu____15288 tt in + (uu____15274, [bb], uu____15287) in + FStar_SMTEncoding_Util.mkForall uu____15263 in + (uu____15262, (FStar_Pervasives_Native.Some "int typing"), "int_typing") in - FStar_SMTEncoding_Util.mkAssume uu____15317 in - let uu____15371 = - let uu____15374 = - let uu____15375 = - let uu____15382 = - let uu____15383 = - let uu____15394 = - let uu____15395 = - let uu____15400 = + FStar_SMTEncoding_Util.mkAssume uu____15255 in + let uu____15309 = + let uu____15312 = + let uu____15313 = + let uu____15320 = + let uu____15321 = + let uu____15332 = + let uu____15333 = + let uu____15338 = FStar_SMTEncoding_Term.mk_tester (FStar_Pervasives_Native.fst FStar_SMTEncoding_Term.boxIntFun) x in - (typing_pred, uu____15400) in - FStar_SMTEncoding_Util.mkImp uu____15395 in - ([[typing_pred]], [xx], uu____15394) in - mkForall_fuel uu____15383 in - (uu____15382, (FStar_Pervasives_Native.Some "int inversion"), + (typing_pred, uu____15338) in + FStar_SMTEncoding_Util.mkImp uu____15333 in + ([[typing_pred]], [xx], uu____15332) in + mkForall_fuel uu____15321 in + (uu____15320, (FStar_Pervasives_Native.Some "int inversion"), "int_inversion") in - FStar_SMTEncoding_Util.mkAssume uu____15375 in - let uu____15425 = - let uu____15428 = - let uu____15429 = - let uu____15436 = - let uu____15437 = - let uu____15448 = - let uu____15449 = - let uu____15454 = - let uu____15455 = - let uu____15458 = - let uu____15461 = - let uu____15464 = - let uu____15465 = - let uu____15470 = + FStar_SMTEncoding_Util.mkAssume uu____15313 in + let uu____15363 = + let uu____15366 = + let uu____15367 = + let uu____15374 = + let uu____15375 = + let uu____15386 = + let uu____15387 = + let uu____15392 = + let uu____15393 = + let uu____15396 = + let uu____15399 = + let uu____15402 = + let uu____15403 = + let uu____15408 = FStar_SMTEncoding_Term.unboxInt x in - let uu____15471 = + let uu____15409 = FStar_SMTEncoding_Util.mkInteger' (Prims.parse_int "0") in - (uu____15470, uu____15471) in - FStar_SMTEncoding_Util.mkGT uu____15465 in - let uu____15472 = - let uu____15475 = - let uu____15476 = - let uu____15481 = + (uu____15408, uu____15409) in + FStar_SMTEncoding_Util.mkGT uu____15403 in + let uu____15410 = + let uu____15413 = + let uu____15414 = + let uu____15419 = FStar_SMTEncoding_Term.unboxInt y in - let uu____15482 = + let uu____15420 = FStar_SMTEncoding_Util.mkInteger' (Prims.parse_int "0") in - (uu____15481, uu____15482) in - FStar_SMTEncoding_Util.mkGTE uu____15476 in - let uu____15483 = - let uu____15486 = - let uu____15487 = - let uu____15492 = + (uu____15419, uu____15420) in + FStar_SMTEncoding_Util.mkGTE uu____15414 in + let uu____15421 = + let uu____15424 = + let uu____15425 = + let uu____15430 = FStar_SMTEncoding_Term.unboxInt y in - let uu____15493 = + let uu____15431 = FStar_SMTEncoding_Term.unboxInt x in - (uu____15492, uu____15493) in - FStar_SMTEncoding_Util.mkLT uu____15487 in - [uu____15486] in - uu____15475 :: uu____15483 in - uu____15464 :: uu____15472 in - typing_pred_y :: uu____15461 in - typing_pred :: uu____15458 in - FStar_SMTEncoding_Util.mk_and_l uu____15455 in - (uu____15454, precedes_y_x) in - FStar_SMTEncoding_Util.mkImp uu____15449 in + (uu____15430, uu____15431) in + FStar_SMTEncoding_Util.mkLT uu____15425 in + [uu____15424] in + uu____15413 :: uu____15421 in + uu____15402 :: uu____15410 in + typing_pred_y :: uu____15399 in + typing_pred :: uu____15396 in + FStar_SMTEncoding_Util.mk_and_l uu____15393 in + (uu____15392, precedes_y_x) in + FStar_SMTEncoding_Util.mkImp uu____15387 in ([[typing_pred; typing_pred_y; precedes_y_x]], [xx; yy], - uu____15448) in - mkForall_fuel uu____15437 in - (uu____15436, + uu____15386) in + mkForall_fuel uu____15375 in + (uu____15374, (FStar_Pervasives_Native.Some "well-founded ordering on nat (alt)"), "well-founded-ordering-on-nat") in - FStar_SMTEncoding_Util.mkAssume uu____15429 in - [uu____15428] in - uu____15374 :: uu____15425 in - uu____15316 :: uu____15371 in + FStar_SMTEncoding_Util.mkAssume uu____15367 in + [uu____15366] in + uu____15312 :: uu____15363 in + uu____15254 :: uu____15309 in let mk_str env nm tt = let typing_pred = FStar_SMTEncoding_Term.mk_HasType x tt in let bb = ("b", FStar_SMTEncoding_Term.String_sort) in let b = FStar_SMTEncoding_Util.mkFreeV bb in - let uu____15539 = - let uu____15540 = - let uu____15547 = - let uu____15548 = - let uu____15559 = - let uu____15564 = - let uu____15567 = FStar_SMTEncoding_Term.boxString b in - [uu____15567] in - [uu____15564] in - let uu____15572 = - let uu____15573 = FStar_SMTEncoding_Term.boxString b in - FStar_SMTEncoding_Term.mk_HasType uu____15573 tt in - (uu____15559, [bb], uu____15572) in - FStar_SMTEncoding_Util.mkForall uu____15548 in - (uu____15547, (FStar_Pervasives_Native.Some "string typing"), + let uu____15477 = + let uu____15478 = + let uu____15485 = + let uu____15486 = + let uu____15497 = + let uu____15502 = + let uu____15505 = FStar_SMTEncoding_Term.boxString b in + [uu____15505] in + [uu____15502] in + let uu____15510 = + let uu____15511 = FStar_SMTEncoding_Term.boxString b in + FStar_SMTEncoding_Term.mk_HasType uu____15511 tt in + (uu____15497, [bb], uu____15510) in + FStar_SMTEncoding_Util.mkForall uu____15486 in + (uu____15485, (FStar_Pervasives_Native.Some "string typing"), "string_typing") in - FStar_SMTEncoding_Util.mkAssume uu____15540 in - let uu____15594 = - let uu____15597 = - let uu____15598 = - let uu____15605 = - let uu____15606 = - let uu____15617 = - let uu____15618 = - let uu____15623 = + FStar_SMTEncoding_Util.mkAssume uu____15478 in + let uu____15532 = + let uu____15535 = + let uu____15536 = + let uu____15543 = + let uu____15544 = + let uu____15555 = + let uu____15556 = + let uu____15561 = FStar_SMTEncoding_Term.mk_tester (FStar_Pervasives_Native.fst FStar_SMTEncoding_Term.boxStringFun) x in - (typing_pred, uu____15623) in - FStar_SMTEncoding_Util.mkImp uu____15618 in - ([[typing_pred]], [xx], uu____15617) in - mkForall_fuel uu____15606 in - (uu____15605, (FStar_Pervasives_Native.Some "string inversion"), + (typing_pred, uu____15561) in + FStar_SMTEncoding_Util.mkImp uu____15556 in + ([[typing_pred]], [xx], uu____15555) in + mkForall_fuel uu____15544 in + (uu____15543, (FStar_Pervasives_Native.Some "string inversion"), "string_inversion") in - FStar_SMTEncoding_Util.mkAssume uu____15598 in - [uu____15597] in - uu____15539 :: uu____15594 in + FStar_SMTEncoding_Util.mkAssume uu____15536 in + [uu____15535] in + uu____15477 :: uu____15532 in let mk_true_interp env nm true_tm = let valid = FStar_SMTEncoding_Util.mkApp ("Valid", [true_tm]) in [FStar_SMTEncoding_Util.mkAssume @@ -4580,16 +4559,16 @@ let primitive_type_axioms: "true_interp")] in let mk_false_interp env nm false_tm = let valid = FStar_SMTEncoding_Util.mkApp ("Valid", [false_tm]) in - let uu____15676 = - let uu____15677 = - let uu____15684 = + let uu____15614 = + let uu____15615 = + let uu____15622 = FStar_SMTEncoding_Util.mkIff (FStar_SMTEncoding_Util.mkFalse, valid) in - (uu____15684, (FStar_Pervasives_Native.Some "False interpretation"), + (uu____15622, (FStar_Pervasives_Native.Some "False interpretation"), "false_interp") in - FStar_SMTEncoding_Util.mkAssume uu____15677 in - [uu____15676] in - let mk_and_interp env conj uu____15696 = + FStar_SMTEncoding_Util.mkAssume uu____15615 in + [uu____15614] in + let mk_and_interp env conj uu____15634 = let aa = ("a", FStar_SMTEncoding_Term.Term_sort) in let bb = ("b", FStar_SMTEncoding_Term.Term_sort) in let a = FStar_SMTEncoding_Util.mkFreeV aa in @@ -4598,23 +4577,23 @@ let primitive_type_axioms: let valid = FStar_SMTEncoding_Util.mkApp ("Valid", [l_and_a_b]) in let valid_a = FStar_SMTEncoding_Util.mkApp ("Valid", [a]) in let valid_b = FStar_SMTEncoding_Util.mkApp ("Valid", [b]) in - let uu____15721 = - let uu____15722 = - let uu____15729 = - let uu____15730 = - let uu____15741 = - let uu____15742 = - let uu____15747 = + let uu____15659 = + let uu____15660 = + let uu____15667 = + let uu____15668 = + let uu____15679 = + let uu____15680 = + let uu____15685 = FStar_SMTEncoding_Util.mkAnd (valid_a, valid_b) in - (uu____15747, valid) in - FStar_SMTEncoding_Util.mkIff uu____15742 in - ([[l_and_a_b]], [aa; bb], uu____15741) in - FStar_SMTEncoding_Util.mkForall uu____15730 in - (uu____15729, (FStar_Pervasives_Native.Some "/\\ interpretation"), + (uu____15685, valid) in + FStar_SMTEncoding_Util.mkIff uu____15680 in + ([[l_and_a_b]], [aa; bb], uu____15679) in + FStar_SMTEncoding_Util.mkForall uu____15668 in + (uu____15667, (FStar_Pervasives_Native.Some "/\\ interpretation"), "l_and-interp") in - FStar_SMTEncoding_Util.mkAssume uu____15722 in - [uu____15721] in - let mk_or_interp env disj uu____15785 = + FStar_SMTEncoding_Util.mkAssume uu____15660 in + [uu____15659] in + let mk_or_interp env disj uu____15723 = let aa = ("a", FStar_SMTEncoding_Term.Term_sort) in let bb = ("b", FStar_SMTEncoding_Term.Term_sort) in let a = FStar_SMTEncoding_Util.mkFreeV aa in @@ -4623,22 +4602,22 @@ let primitive_type_axioms: let valid = FStar_SMTEncoding_Util.mkApp ("Valid", [l_or_a_b]) in let valid_a = FStar_SMTEncoding_Util.mkApp ("Valid", [a]) in let valid_b = FStar_SMTEncoding_Util.mkApp ("Valid", [b]) in - let uu____15810 = - let uu____15811 = - let uu____15818 = - let uu____15819 = - let uu____15830 = - let uu____15831 = - let uu____15836 = + let uu____15748 = + let uu____15749 = + let uu____15756 = + let uu____15757 = + let uu____15768 = + let uu____15769 = + let uu____15774 = FStar_SMTEncoding_Util.mkOr (valid_a, valid_b) in - (uu____15836, valid) in - FStar_SMTEncoding_Util.mkIff uu____15831 in - ([[l_or_a_b]], [aa; bb], uu____15830) in - FStar_SMTEncoding_Util.mkForall uu____15819 in - (uu____15818, (FStar_Pervasives_Native.Some "\\/ interpretation"), + (uu____15774, valid) in + FStar_SMTEncoding_Util.mkIff uu____15769 in + ([[l_or_a_b]], [aa; bb], uu____15768) in + FStar_SMTEncoding_Util.mkForall uu____15757 in + (uu____15756, (FStar_Pervasives_Native.Some "\\/ interpretation"), "l_or-interp") in - FStar_SMTEncoding_Util.mkAssume uu____15811 in - [uu____15810] in + FStar_SMTEncoding_Util.mkAssume uu____15749 in + [uu____15748] in let mk_eq2_interp env eq2 tt = let aa = ("a", FStar_SMTEncoding_Term.Term_sort) in let xx1 = ("x", FStar_SMTEncoding_Term.Term_sort) in @@ -4648,21 +4627,21 @@ let primitive_type_axioms: let y1 = FStar_SMTEncoding_Util.mkFreeV yy1 in let eq2_x_y = FStar_SMTEncoding_Util.mkApp (eq2, [a; x1; y1]) in let valid = FStar_SMTEncoding_Util.mkApp ("Valid", [eq2_x_y]) in - let uu____15899 = - let uu____15900 = - let uu____15907 = - let uu____15908 = - let uu____15919 = - let uu____15920 = - let uu____15925 = FStar_SMTEncoding_Util.mkEq (x1, y1) in - (uu____15925, valid) in - FStar_SMTEncoding_Util.mkIff uu____15920 in - ([[eq2_x_y]], [aa; xx1; yy1], uu____15919) in - FStar_SMTEncoding_Util.mkForall uu____15908 in - (uu____15907, (FStar_Pervasives_Native.Some "Eq2 interpretation"), + let uu____15837 = + let uu____15838 = + let uu____15845 = + let uu____15846 = + let uu____15857 = + let uu____15858 = + let uu____15863 = FStar_SMTEncoding_Util.mkEq (x1, y1) in + (uu____15863, valid) in + FStar_SMTEncoding_Util.mkIff uu____15858 in + ([[eq2_x_y]], [aa; xx1; yy1], uu____15857) in + FStar_SMTEncoding_Util.mkForall uu____15846 in + (uu____15845, (FStar_Pervasives_Native.Some "Eq2 interpretation"), "eq2-interp") in - FStar_SMTEncoding_Util.mkAssume uu____15900 in - [uu____15899] in + FStar_SMTEncoding_Util.mkAssume uu____15838 in + [uu____15837] in let mk_eq3_interp env eq3 tt = let aa = ("a", FStar_SMTEncoding_Term.Term_sort) in let bb = ("b", FStar_SMTEncoding_Term.Term_sort) in @@ -4674,21 +4653,21 @@ let primitive_type_axioms: let y1 = FStar_SMTEncoding_Util.mkFreeV yy1 in let eq3_x_y = FStar_SMTEncoding_Util.mkApp (eq3, [a; b; x1; y1]) in let valid = FStar_SMTEncoding_Util.mkApp ("Valid", [eq3_x_y]) in - let uu____15998 = - let uu____15999 = - let uu____16006 = - let uu____16007 = - let uu____16018 = - let uu____16019 = - let uu____16024 = FStar_SMTEncoding_Util.mkEq (x1, y1) in - (uu____16024, valid) in - FStar_SMTEncoding_Util.mkIff uu____16019 in - ([[eq3_x_y]], [aa; bb; xx1; yy1], uu____16018) in - FStar_SMTEncoding_Util.mkForall uu____16007 in - (uu____16006, (FStar_Pervasives_Native.Some "Eq3 interpretation"), + let uu____15936 = + let uu____15937 = + let uu____15944 = + let uu____15945 = + let uu____15956 = + let uu____15957 = + let uu____15962 = FStar_SMTEncoding_Util.mkEq (x1, y1) in + (uu____15962, valid) in + FStar_SMTEncoding_Util.mkIff uu____15957 in + ([[eq3_x_y]], [aa; bb; xx1; yy1], uu____15956) in + FStar_SMTEncoding_Util.mkForall uu____15945 in + (uu____15944, (FStar_Pervasives_Native.Some "Eq3 interpretation"), "eq3-interp") in - FStar_SMTEncoding_Util.mkAssume uu____15999 in - [uu____15998] in + FStar_SMTEncoding_Util.mkAssume uu____15937 in + [uu____15936] in let mk_imp_interp env imp tt = let aa = ("a", FStar_SMTEncoding_Term.Term_sort) in let bb = ("b", FStar_SMTEncoding_Term.Term_sort) in @@ -4698,22 +4677,22 @@ let primitive_type_axioms: let valid = FStar_SMTEncoding_Util.mkApp ("Valid", [l_imp_a_b]) in let valid_a = FStar_SMTEncoding_Util.mkApp ("Valid", [a]) in let valid_b = FStar_SMTEncoding_Util.mkApp ("Valid", [b]) in - let uu____16095 = - let uu____16096 = - let uu____16103 = - let uu____16104 = - let uu____16115 = - let uu____16116 = - let uu____16121 = + let uu____16033 = + let uu____16034 = + let uu____16041 = + let uu____16042 = + let uu____16053 = + let uu____16054 = + let uu____16059 = FStar_SMTEncoding_Util.mkImp (valid_a, valid_b) in - (uu____16121, valid) in - FStar_SMTEncoding_Util.mkIff uu____16116 in - ([[l_imp_a_b]], [aa; bb], uu____16115) in - FStar_SMTEncoding_Util.mkForall uu____16104 in - (uu____16103, (FStar_Pervasives_Native.Some "==> interpretation"), + (uu____16059, valid) in + FStar_SMTEncoding_Util.mkIff uu____16054 in + ([[l_imp_a_b]], [aa; bb], uu____16053) in + FStar_SMTEncoding_Util.mkForall uu____16042 in + (uu____16041, (FStar_Pervasives_Native.Some "==> interpretation"), "l_imp-interp") in - FStar_SMTEncoding_Util.mkAssume uu____16096 in - [uu____16095] in + FStar_SMTEncoding_Util.mkAssume uu____16034 in + [uu____16033] in let mk_iff_interp env iff tt = let aa = ("a", FStar_SMTEncoding_Term.Term_sort) in let bb = ("b", FStar_SMTEncoding_Term.Term_sort) in @@ -4723,42 +4702,42 @@ let primitive_type_axioms: let valid = FStar_SMTEncoding_Util.mkApp ("Valid", [l_iff_a_b]) in let valid_a = FStar_SMTEncoding_Util.mkApp ("Valid", [a]) in let valid_b = FStar_SMTEncoding_Util.mkApp ("Valid", [b]) in - let uu____16184 = - let uu____16185 = - let uu____16192 = - let uu____16193 = - let uu____16204 = - let uu____16205 = - let uu____16210 = + let uu____16122 = + let uu____16123 = + let uu____16130 = + let uu____16131 = + let uu____16142 = + let uu____16143 = + let uu____16148 = FStar_SMTEncoding_Util.mkIff (valid_a, valid_b) in - (uu____16210, valid) in - FStar_SMTEncoding_Util.mkIff uu____16205 in - ([[l_iff_a_b]], [aa; bb], uu____16204) in - FStar_SMTEncoding_Util.mkForall uu____16193 in - (uu____16192, (FStar_Pervasives_Native.Some "<==> interpretation"), + (uu____16148, valid) in + FStar_SMTEncoding_Util.mkIff uu____16143 in + ([[l_iff_a_b]], [aa; bb], uu____16142) in + FStar_SMTEncoding_Util.mkForall uu____16131 in + (uu____16130, (FStar_Pervasives_Native.Some "<==> interpretation"), "l_iff-interp") in - FStar_SMTEncoding_Util.mkAssume uu____16185 in - [uu____16184] in + FStar_SMTEncoding_Util.mkAssume uu____16123 in + [uu____16122] in let mk_not_interp env l_not tt = let aa = ("a", FStar_SMTEncoding_Term.Term_sort) in let a = FStar_SMTEncoding_Util.mkFreeV aa in let l_not_a = FStar_SMTEncoding_Util.mkApp (l_not, [a]) in let valid = FStar_SMTEncoding_Util.mkApp ("Valid", [l_not_a]) in let not_valid_a = - let uu____16262 = FStar_SMTEncoding_Util.mkApp ("Valid", [a]) in - FStar_All.pipe_left FStar_SMTEncoding_Util.mkNot uu____16262 in - let uu____16265 = - let uu____16266 = - let uu____16273 = - let uu____16274 = - let uu____16285 = + let uu____16200 = FStar_SMTEncoding_Util.mkApp ("Valid", [a]) in + FStar_All.pipe_left FStar_SMTEncoding_Util.mkNot uu____16200 in + let uu____16203 = + let uu____16204 = + let uu____16211 = + let uu____16212 = + let uu____16223 = FStar_SMTEncoding_Util.mkIff (not_valid_a, valid) in - ([[l_not_a]], [aa], uu____16285) in - FStar_SMTEncoding_Util.mkForall uu____16274 in - (uu____16273, (FStar_Pervasives_Native.Some "not interpretation"), + ([[l_not_a]], [aa], uu____16223) in + FStar_SMTEncoding_Util.mkForall uu____16212 in + (uu____16211, (FStar_Pervasives_Native.Some "not interpretation"), "l_not-interp") in - FStar_SMTEncoding_Util.mkAssume uu____16266 in - [uu____16265] in + FStar_SMTEncoding_Util.mkAssume uu____16204 in + [uu____16203] in let mk_forall_interp env for_all1 tt = let aa = ("a", FStar_SMTEncoding_Term.Term_sort) in let bb = ("b", FStar_SMTEncoding_Term.Term_sort) in @@ -4769,42 +4748,42 @@ let primitive_type_axioms: let l_forall_a_b = FStar_SMTEncoding_Util.mkApp (for_all1, [a; b]) in let valid = FStar_SMTEncoding_Util.mkApp ("Valid", [l_forall_a_b]) in let valid_b_x = - let uu____16345 = - let uu____16352 = - let uu____16355 = FStar_SMTEncoding_Util.mk_ApplyTT b x1 in - [uu____16355] in - ("Valid", uu____16352) in - FStar_SMTEncoding_Util.mkApp uu____16345 in - let uu____16358 = - let uu____16359 = - let uu____16366 = - let uu____16367 = - let uu____16378 = - let uu____16379 = - let uu____16384 = - let uu____16385 = - let uu____16396 = - let uu____16401 = - let uu____16404 = + let uu____16283 = + let uu____16290 = + let uu____16293 = FStar_SMTEncoding_Util.mk_ApplyTT b x1 in + [uu____16293] in + ("Valid", uu____16290) in + FStar_SMTEncoding_Util.mkApp uu____16283 in + let uu____16296 = + let uu____16297 = + let uu____16304 = + let uu____16305 = + let uu____16316 = + let uu____16317 = + let uu____16322 = + let uu____16323 = + let uu____16334 = + let uu____16339 = + let uu____16342 = FStar_SMTEncoding_Term.mk_HasTypeZ x1 a in - [uu____16404] in - [uu____16401] in - let uu____16409 = - let uu____16410 = - let uu____16415 = + [uu____16342] in + [uu____16339] in + let uu____16347 = + let uu____16348 = + let uu____16353 = FStar_SMTEncoding_Term.mk_HasTypeZ x1 a in - (uu____16415, valid_b_x) in - FStar_SMTEncoding_Util.mkImp uu____16410 in - (uu____16396, [xx1], uu____16409) in - FStar_SMTEncoding_Util.mkForall uu____16385 in - (uu____16384, valid) in - FStar_SMTEncoding_Util.mkIff uu____16379 in - ([[l_forall_a_b]], [aa; bb], uu____16378) in - FStar_SMTEncoding_Util.mkForall uu____16367 in - (uu____16366, (FStar_Pervasives_Native.Some "forall interpretation"), + (uu____16353, valid_b_x) in + FStar_SMTEncoding_Util.mkImp uu____16348 in + (uu____16334, [xx1], uu____16347) in + FStar_SMTEncoding_Util.mkForall uu____16323 in + (uu____16322, valid) in + FStar_SMTEncoding_Util.mkIff uu____16317 in + ([[l_forall_a_b]], [aa; bb], uu____16316) in + FStar_SMTEncoding_Util.mkForall uu____16305 in + (uu____16304, (FStar_Pervasives_Native.Some "forall interpretation"), "forall-interp") in - FStar_SMTEncoding_Util.mkAssume uu____16359 in - [uu____16358] in + FStar_SMTEncoding_Util.mkAssume uu____16297 in + [uu____16296] in let mk_exists_interp env for_some1 tt = let aa = ("a", FStar_SMTEncoding_Term.Term_sort) in let bb = ("b", FStar_SMTEncoding_Term.Term_sort) in @@ -4815,54 +4794,54 @@ let primitive_type_axioms: let l_exists_a_b = FStar_SMTEncoding_Util.mkApp (for_some1, [a; b]) in let valid = FStar_SMTEncoding_Util.mkApp ("Valid", [l_exists_a_b]) in let valid_b_x = - let uu____16497 = - let uu____16504 = - let uu____16507 = FStar_SMTEncoding_Util.mk_ApplyTT b x1 in - [uu____16507] in - ("Valid", uu____16504) in - FStar_SMTEncoding_Util.mkApp uu____16497 in - let uu____16510 = - let uu____16511 = - let uu____16518 = - let uu____16519 = - let uu____16530 = - let uu____16531 = - let uu____16536 = - let uu____16537 = - let uu____16548 = - let uu____16553 = - let uu____16556 = + let uu____16435 = + let uu____16442 = + let uu____16445 = FStar_SMTEncoding_Util.mk_ApplyTT b x1 in + [uu____16445] in + ("Valid", uu____16442) in + FStar_SMTEncoding_Util.mkApp uu____16435 in + let uu____16448 = + let uu____16449 = + let uu____16456 = + let uu____16457 = + let uu____16468 = + let uu____16469 = + let uu____16474 = + let uu____16475 = + let uu____16486 = + let uu____16491 = + let uu____16494 = FStar_SMTEncoding_Term.mk_HasTypeZ x1 a in - [uu____16556] in - [uu____16553] in - let uu____16561 = - let uu____16562 = - let uu____16567 = + [uu____16494] in + [uu____16491] in + let uu____16499 = + let uu____16500 = + let uu____16505 = FStar_SMTEncoding_Term.mk_HasTypeZ x1 a in - (uu____16567, valid_b_x) in - FStar_SMTEncoding_Util.mkImp uu____16562 in - (uu____16548, [xx1], uu____16561) in - FStar_SMTEncoding_Util.mkExists uu____16537 in - (uu____16536, valid) in - FStar_SMTEncoding_Util.mkIff uu____16531 in - ([[l_exists_a_b]], [aa; bb], uu____16530) in - FStar_SMTEncoding_Util.mkForall uu____16519 in - (uu____16518, (FStar_Pervasives_Native.Some "exists interpretation"), + (uu____16505, valid_b_x) in + FStar_SMTEncoding_Util.mkImp uu____16500 in + (uu____16486, [xx1], uu____16499) in + FStar_SMTEncoding_Util.mkExists uu____16475 in + (uu____16474, valid) in + FStar_SMTEncoding_Util.mkIff uu____16469 in + ([[l_exists_a_b]], [aa; bb], uu____16468) in + FStar_SMTEncoding_Util.mkForall uu____16457 in + (uu____16456, (FStar_Pervasives_Native.Some "exists interpretation"), "exists-interp") in - FStar_SMTEncoding_Util.mkAssume uu____16511 in - [uu____16510] in + FStar_SMTEncoding_Util.mkAssume uu____16449 in + [uu____16448] in let mk_range_interp env range tt = let range_ty = FStar_SMTEncoding_Util.mkApp (range, []) in - let uu____16627 = - let uu____16628 = - let uu____16635 = - let uu____16636 = FStar_SMTEncoding_Term.mk_Range_const () in - FStar_SMTEncoding_Term.mk_HasTypeZ uu____16636 range_ty in - let uu____16637 = varops.mk_unique "typing_range_const" in - (uu____16635, (FStar_Pervasives_Native.Some "Range_const typing"), - uu____16637) in - FStar_SMTEncoding_Util.mkAssume uu____16628 in - [uu____16627] in + let uu____16565 = + let uu____16566 = + let uu____16573 = + let uu____16574 = FStar_SMTEncoding_Term.mk_Range_const () in + FStar_SMTEncoding_Term.mk_HasTypeZ uu____16574 range_ty in + let uu____16575 = varops.mk_unique "typing_range_const" in + (uu____16573, (FStar_Pervasives_Native.Some "Range_const typing"), + uu____16575) in + FStar_SMTEncoding_Util.mkAssume uu____16566 in + [uu____16565] in let mk_inversion_axiom env inversion tt = let tt1 = ("t", FStar_SMTEncoding_Term.Term_sort) in let t = FStar_SMTEncoding_Util.mkFreeV tt1 in @@ -4873,24 +4852,51 @@ let primitive_type_axioms: let body = let hastypeZ = FStar_SMTEncoding_Term.mk_HasTypeZ x1 t in let hastypeS = - let uu____16671 = FStar_SMTEncoding_Term.n_fuel (Prims.parse_int "1") in - FStar_SMTEncoding_Term.mk_HasTypeFuel uu____16671 x1 t in - let uu____16672 = - let uu____16683 = FStar_SMTEncoding_Util.mkImp (hastypeZ, hastypeS) in - ([[hastypeZ]], [xx1], uu____16683) in - FStar_SMTEncoding_Util.mkForall uu____16672 in - let uu____16706 = - let uu____16707 = - let uu____16714 = - let uu____16715 = - let uu____16726 = FStar_SMTEncoding_Util.mkImp (valid, body) in - ([[inversion_t]], [tt1], uu____16726) in - FStar_SMTEncoding_Util.mkForall uu____16715 in - (uu____16714, + let uu____16609 = FStar_SMTEncoding_Term.n_fuel (Prims.parse_int "1") in + FStar_SMTEncoding_Term.mk_HasTypeFuel uu____16609 x1 t in + let uu____16610 = + let uu____16621 = FStar_SMTEncoding_Util.mkImp (hastypeZ, hastypeS) in + ([[hastypeZ]], [xx1], uu____16621) in + FStar_SMTEncoding_Util.mkForall uu____16610 in + let uu____16644 = + let uu____16645 = + let uu____16652 = + let uu____16653 = + let uu____16664 = FStar_SMTEncoding_Util.mkImp (valid, body) in + ([[inversion_t]], [tt1], uu____16664) in + FStar_SMTEncoding_Util.mkForall uu____16653 in + (uu____16652, (FStar_Pervasives_Native.Some "inversion interpretation"), "inversion-interp") in - FStar_SMTEncoding_Util.mkAssume uu____16707 in - [uu____16706] in + FStar_SMTEncoding_Util.mkAssume uu____16645 in + [uu____16644] in + let mk_with_type_axiom env with_type1 tt = + let tt1 = ("t", FStar_SMTEncoding_Term.Term_sort) in + let t = FStar_SMTEncoding_Util.mkFreeV tt1 in + let ee = ("e", FStar_SMTEncoding_Term.Term_sort) in + let e = FStar_SMTEncoding_Util.mkFreeV ee in + let with_type_t_e = FStar_SMTEncoding_Util.mkApp (with_type1, [t; e]) in + let uu____16714 = + let uu____16715 = + let uu____16722 = + let uu____16723 = + let uu____16738 = + let uu____16739 = + let uu____16744 = + FStar_SMTEncoding_Util.mkEq (with_type_t_e, e) in + let uu____16745 = + FStar_SMTEncoding_Term.mk_HasType with_type_t_e t in + (uu____16744, uu____16745) in + FStar_SMTEncoding_Util.mkAnd uu____16739 in + ([[with_type_t_e]], + (FStar_Pervasives_Native.Some (Prims.parse_int "0")), + [tt1; ee], uu____16738) in + FStar_SMTEncoding_Util.mkForall' uu____16723 in + (uu____16722, + (FStar_Pervasives_Native.Some "with_type primitive axiom"), + "@with_type_primitive_axiom") in + FStar_SMTEncoding_Util.mkAssume uu____16715 in + [uu____16714] in let prims1 = [(FStar_Parser_Const.unit_lid, mk_unit); (FStar_Parser_Const.bool_lid, mk_bool); @@ -4908,19 +4914,20 @@ let primitive_type_axioms: (FStar_Parser_Const.forall_lid, mk_forall_interp); (FStar_Parser_Const.exists_lid, mk_exists_interp); (FStar_Parser_Const.range_lid, mk_range_interp); - (FStar_Parser_Const.inversion_lid, mk_inversion_axiom)] in + (FStar_Parser_Const.inversion_lid, mk_inversion_axiom); + (FStar_Parser_Const.with_type_lid, mk_with_type_axiom)] in fun env -> fun t -> fun s -> fun tt -> - let uu____17050 = + let uu____17091 = FStar_Util.find_opt - (fun uu____17076 -> - match uu____17076 with - | (l,uu____17088) -> FStar_Ident.lid_equals l t) prims1 in - match uu____17050 with + (fun uu____17117 -> + match uu____17117 with + | (l,uu____17129) -> FStar_Ident.lid_equals l t) prims1 in + match uu____17091 with | FStar_Pervasives_Native.None -> [] - | FStar_Pervasives_Native.Some (uu____17113,f) -> f env s tt + | FStar_Pervasives_Native.Some (uu____17154,f) -> f env s tt let encode_smt_lemma: env_t -> FStar_Syntax_Syntax.fv -> @@ -4930,8 +4937,8 @@ let encode_smt_lemma: fun fv -> fun t -> let lid = (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in - let uu____17149 = encode_function_type_as_formula t env in - match uu____17149 with + let uu____17190 = encode_function_type_as_formula t env in + match uu____17190 with | (form,decls) -> FStar_List.append decls [FStar_SMTEncoding_Util.mkAssume @@ -4957,30 +4964,30 @@ let encode_free_var: fun quals -> let lid = (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in - let uu____17189 = - ((let uu____17192 = + let uu____17230 = + ((let uu____17233 = (FStar_Syntax_Util.is_pure_or_ghost_function t_norm) || (FStar_TypeChecker_Env.is_reifiable_function env.tcenv t_norm) in - FStar_All.pipe_left Prims.op_Negation uu____17192) || + FStar_All.pipe_left Prims.op_Negation uu____17233) || (FStar_Syntax_Util.is_lemma t_norm)) || uninterpreted in - if uu____17189 + if uu____17230 then - let uu____17199 = new_term_constant_and_tok_from_lid env lid in - match uu____17199 with + let uu____17240 = new_term_constant_and_tok_from_lid env lid in + match uu____17240 with | (vname,vtok,env1) -> let arg_sorts = - let uu____17218 = - let uu____17219 = FStar_Syntax_Subst.compress t_norm in - uu____17219.FStar_Syntax_Syntax.n in - match uu____17218 with - | FStar_Syntax_Syntax.Tm_arrow (binders,uu____17225) -> + let uu____17259 = + let uu____17260 = FStar_Syntax_Subst.compress t_norm in + uu____17260.FStar_Syntax_Syntax.n in + match uu____17259 with + | FStar_Syntax_Syntax.Tm_arrow (binders,uu____17266) -> FStar_All.pipe_right binders (FStar_List.map - (fun uu____17255 -> + (fun uu____17296 -> FStar_SMTEncoding_Term.Term_sort)) - | uu____17260 -> [] in + | uu____17301 -> [] in let d = FStar_SMTEncoding_Term.DeclFun (vname, arg_sorts, FStar_SMTEncoding_Term.Term_sort, @@ -4993,12 +5000,12 @@ let encode_free_var: "Uninterpreted name for impure function")) in ([d; dd], env1) else - (let uu____17274 = prims.is lid in - if uu____17274 + (let uu____17315 = prims.is lid in + if uu____17315 then let vname = varops.new_fvar lid in - let uu____17282 = prims.mk lid vname in - match uu____17282 with + let uu____17323 = prims.mk lid vname in + match uu____17323 with | (tok,definition) -> let env1 = push_free_var env lid vname @@ -5007,105 +5014,105 @@ let encode_free_var: else (let encode_non_total_function_typ = lid.FStar_Ident.nsstr <> "Prims" in - let uu____17306 = - let uu____17317 = curried_arrow_formals_comp t_norm in - match uu____17317 with + let uu____17347 = + let uu____17358 = curried_arrow_formals_comp t_norm in + match uu____17358 with | (args,comp) -> let comp1 = - let uu____17335 = + let uu____17376 = FStar_TypeChecker_Env.is_reifiable_comp env.tcenv comp in - if uu____17335 + if uu____17376 then - let uu____17336 = + let uu____17377 = FStar_TypeChecker_Env.reify_comp - (let uu___117_17339 = env.tcenv in + (let uu___117_17380 = env.tcenv in { FStar_TypeChecker_Env.solver = - (uu___117_17339.FStar_TypeChecker_Env.solver); + (uu___117_17380.FStar_TypeChecker_Env.solver); FStar_TypeChecker_Env.range = - (uu___117_17339.FStar_TypeChecker_Env.range); + (uu___117_17380.FStar_TypeChecker_Env.range); FStar_TypeChecker_Env.curmodule = - (uu___117_17339.FStar_TypeChecker_Env.curmodule); + (uu___117_17380.FStar_TypeChecker_Env.curmodule); FStar_TypeChecker_Env.gamma = - (uu___117_17339.FStar_TypeChecker_Env.gamma); + (uu___117_17380.FStar_TypeChecker_Env.gamma); FStar_TypeChecker_Env.gamma_cache = - (uu___117_17339.FStar_TypeChecker_Env.gamma_cache); + (uu___117_17380.FStar_TypeChecker_Env.gamma_cache); FStar_TypeChecker_Env.modules = - (uu___117_17339.FStar_TypeChecker_Env.modules); + (uu___117_17380.FStar_TypeChecker_Env.modules); FStar_TypeChecker_Env.expected_typ = - (uu___117_17339.FStar_TypeChecker_Env.expected_typ); + (uu___117_17380.FStar_TypeChecker_Env.expected_typ); FStar_TypeChecker_Env.sigtab = - (uu___117_17339.FStar_TypeChecker_Env.sigtab); + (uu___117_17380.FStar_TypeChecker_Env.sigtab); FStar_TypeChecker_Env.is_pattern = - (uu___117_17339.FStar_TypeChecker_Env.is_pattern); + (uu___117_17380.FStar_TypeChecker_Env.is_pattern); FStar_TypeChecker_Env.instantiate_imp = - (uu___117_17339.FStar_TypeChecker_Env.instantiate_imp); + (uu___117_17380.FStar_TypeChecker_Env.instantiate_imp); FStar_TypeChecker_Env.effects = - (uu___117_17339.FStar_TypeChecker_Env.effects); + (uu___117_17380.FStar_TypeChecker_Env.effects); FStar_TypeChecker_Env.generalize = - (uu___117_17339.FStar_TypeChecker_Env.generalize); + (uu___117_17380.FStar_TypeChecker_Env.generalize); FStar_TypeChecker_Env.letrecs = - (uu___117_17339.FStar_TypeChecker_Env.letrecs); + (uu___117_17380.FStar_TypeChecker_Env.letrecs); FStar_TypeChecker_Env.top_level = - (uu___117_17339.FStar_TypeChecker_Env.top_level); + (uu___117_17380.FStar_TypeChecker_Env.top_level); FStar_TypeChecker_Env.check_uvars = - (uu___117_17339.FStar_TypeChecker_Env.check_uvars); + (uu___117_17380.FStar_TypeChecker_Env.check_uvars); FStar_TypeChecker_Env.use_eq = - (uu___117_17339.FStar_TypeChecker_Env.use_eq); + (uu___117_17380.FStar_TypeChecker_Env.use_eq); FStar_TypeChecker_Env.is_iface = - (uu___117_17339.FStar_TypeChecker_Env.is_iface); + (uu___117_17380.FStar_TypeChecker_Env.is_iface); FStar_TypeChecker_Env.admit = - (uu___117_17339.FStar_TypeChecker_Env.admit); + (uu___117_17380.FStar_TypeChecker_Env.admit); FStar_TypeChecker_Env.lax = true; FStar_TypeChecker_Env.lax_universes = - (uu___117_17339.FStar_TypeChecker_Env.lax_universes); + (uu___117_17380.FStar_TypeChecker_Env.lax_universes); FStar_TypeChecker_Env.failhard = - (uu___117_17339.FStar_TypeChecker_Env.failhard); + (uu___117_17380.FStar_TypeChecker_Env.failhard); FStar_TypeChecker_Env.nosynth = - (uu___117_17339.FStar_TypeChecker_Env.nosynth); + (uu___117_17380.FStar_TypeChecker_Env.nosynth); FStar_TypeChecker_Env.tc_term = - (uu___117_17339.FStar_TypeChecker_Env.tc_term); + (uu___117_17380.FStar_TypeChecker_Env.tc_term); FStar_TypeChecker_Env.type_of = - (uu___117_17339.FStar_TypeChecker_Env.type_of); + (uu___117_17380.FStar_TypeChecker_Env.type_of); FStar_TypeChecker_Env.universe_of = - (uu___117_17339.FStar_TypeChecker_Env.universe_of); + (uu___117_17380.FStar_TypeChecker_Env.universe_of); FStar_TypeChecker_Env.use_bv_sorts = - (uu___117_17339.FStar_TypeChecker_Env.use_bv_sorts); + (uu___117_17380.FStar_TypeChecker_Env.use_bv_sorts); FStar_TypeChecker_Env.qname_and_index = - (uu___117_17339.FStar_TypeChecker_Env.qname_and_index); + (uu___117_17380.FStar_TypeChecker_Env.qname_and_index); FStar_TypeChecker_Env.proof_ns = - (uu___117_17339.FStar_TypeChecker_Env.proof_ns); + (uu___117_17380.FStar_TypeChecker_Env.proof_ns); FStar_TypeChecker_Env.synth = - (uu___117_17339.FStar_TypeChecker_Env.synth); + (uu___117_17380.FStar_TypeChecker_Env.synth); FStar_TypeChecker_Env.is_native_tactic = - (uu___117_17339.FStar_TypeChecker_Env.is_native_tactic); + (uu___117_17380.FStar_TypeChecker_Env.is_native_tactic); FStar_TypeChecker_Env.identifier_info = - (uu___117_17339.FStar_TypeChecker_Env.identifier_info); + (uu___117_17380.FStar_TypeChecker_Env.identifier_info); FStar_TypeChecker_Env.tc_hooks = - (uu___117_17339.FStar_TypeChecker_Env.tc_hooks); + (uu___117_17380.FStar_TypeChecker_Env.tc_hooks); FStar_TypeChecker_Env.dsenv = - (uu___117_17339.FStar_TypeChecker_Env.dsenv); + (uu___117_17380.FStar_TypeChecker_Env.dsenv); FStar_TypeChecker_Env.dep_graph = - (uu___117_17339.FStar_TypeChecker_Env.dep_graph) + (uu___117_17380.FStar_TypeChecker_Env.dep_graph) }) comp FStar_Syntax_Syntax.U_unknown in - FStar_Syntax_Syntax.mk_Total uu____17336 + FStar_Syntax_Syntax.mk_Total uu____17377 else comp in if encode_non_total_function_typ then - let uu____17351 = + let uu____17392 = FStar_TypeChecker_Util.pure_or_ghost_pre_and_post env.tcenv comp1 in - (args, uu____17351) + (args, uu____17392) else (args, (FStar_Pervasives_Native.None, (FStar_Syntax_Util.comp_result comp1))) in - match uu____17306 with + match uu____17347 with | (formals,(pre_opt,res_t)) -> - let uu____17396 = + let uu____17437 = new_term_constant_and_tok_from_lid env lid in - (match uu____17396 with + (match uu____17437 with | (vname,vtok,env1) -> let vtok_tm = match formals with @@ -5113,33 +5120,33 @@ let encode_free_var: FStar_SMTEncoding_Util.mkFreeV (vname, FStar_SMTEncoding_Term.Term_sort) - | uu____17417 -> + | uu____17458 -> FStar_SMTEncoding_Util.mkApp (vtok, []) in let mk_disc_proj_axioms guard encoded_res_t vapp vars = FStar_All.pipe_right quals (FStar_List.collect - (fun uu___89_17459 -> - match uu___89_17459 with + (fun uu___89_17500 -> + match uu___89_17500 with | FStar_Syntax_Syntax.Discriminator d -> - let uu____17463 = + let uu____17504 = FStar_Util.prefix vars in - (match uu____17463 with - | (uu____17484,(xxsym,uu____17486)) + (match uu____17504 with + | (uu____17525,(xxsym,uu____17527)) -> let xx = FStar_SMTEncoding_Util.mkFreeV (xxsym, FStar_SMTEncoding_Term.Term_sort) in - let uu____17504 = - let uu____17505 = - let uu____17512 = - let uu____17513 = - let uu____17524 = - let uu____17525 = - let uu____17530 = - let uu____17531 + let uu____17545 = + let uu____17546 = + let uu____17553 = + let uu____17554 = + let uu____17565 = + let uu____17566 = + let uu____17571 = + let uu____17572 = FStar_SMTEncoding_Term.mk_tester (escape @@ -5147,16 +5154,16 @@ let encode_free_var: xx in FStar_All.pipe_left FStar_SMTEncoding_Term.boxBool - uu____17531 in + uu____17572 in (vapp, - uu____17530) in + uu____17571) in FStar_SMTEncoding_Util.mkEq - uu____17525 in + uu____17566 in ([[vapp]], vars, - uu____17524) in + uu____17565) in FStar_SMTEncoding_Util.mkForall - uu____17513 in - (uu____17512, + uu____17554 in + (uu____17553, (FStar_Pervasives_Native.Some "Discriminator equation"), (Prims.strcat @@ -5164,14 +5171,14 @@ let encode_free_var: (escape d.FStar_Ident.str))) in FStar_SMTEncoding_Util.mkAssume - uu____17505 in - [uu____17504]) + uu____17546 in + [uu____17545]) | FStar_Syntax_Syntax.Projector (d,f) -> - let uu____17550 = + let uu____17591 = FStar_Util.prefix vars in - (match uu____17550 with - | (uu____17571,(xxsym,uu____17573)) + (match uu____17591 with + | (uu____17612,(xxsym,uu____17614)) -> let xx = FStar_SMTEncoding_Util.mkFreeV @@ -5192,97 +5199,97 @@ let encode_free_var: let prim_app = FStar_SMTEncoding_Util.mkApp (tp_name, [xx]) in - let uu____17596 = - let uu____17597 = - let uu____17604 = - let uu____17605 = - let uu____17616 = + let uu____17637 = + let uu____17638 = + let uu____17645 = + let uu____17646 = + let uu____17657 = FStar_SMTEncoding_Util.mkEq (vapp, prim_app) in ([[vapp]], vars, - uu____17616) in + uu____17657) in FStar_SMTEncoding_Util.mkForall - uu____17605 in - (uu____17604, + uu____17646 in + (uu____17645, (FStar_Pervasives_Native.Some "Projector equation"), (Prims.strcat "proj_equation_" tp_name)) in FStar_SMTEncoding_Util.mkAssume - uu____17597 in - [uu____17596]) - | uu____17633 -> [])) in - let uu____17634 = + uu____17638 in + [uu____17637]) + | uu____17674 -> [])) in + let uu____17675 = encode_binders FStar_Pervasives_Native.None formals env1 in - (match uu____17634 with - | (vars,guards,env',decls1,uu____17661) -> - let uu____17674 = + (match uu____17675 with + | (vars,guards,env',decls1,uu____17702) -> + let uu____17715 = match pre_opt with | FStar_Pervasives_Native.None -> - let uu____17683 = + let uu____17724 = FStar_SMTEncoding_Util.mk_and_l guards in - (uu____17683, decls1) + (uu____17724, decls1) | FStar_Pervasives_Native.Some p -> - let uu____17685 = + let uu____17726 = encode_formula p env' in - (match uu____17685 with + (match uu____17726 with | (g,ds) -> - let uu____17696 = + let uu____17737 = FStar_SMTEncoding_Util.mk_and_l (g :: guards) in - (uu____17696, + (uu____17737, (FStar_List.append decls1 ds))) in - (match uu____17674 with + (match uu____17715 with | (guard,decls11) -> let vtok_app = mk_Apply vtok_tm vars in let vapp = - let uu____17709 = - let uu____17716 = + let uu____17750 = + let uu____17757 = FStar_List.map FStar_SMTEncoding_Util.mkFreeV vars in - (vname, uu____17716) in + (vname, uu____17757) in FStar_SMTEncoding_Util.mkApp - uu____17709 in - let uu____17725 = + uu____17750 in + let uu____17766 = let vname_decl = - let uu____17733 = - let uu____17744 = + let uu____17774 = + let uu____17785 = FStar_All.pipe_right formals (FStar_List.map - (fun uu____17754 -> + (fun uu____17795 -> FStar_SMTEncoding_Term.Term_sort)) in - (vname, uu____17744, + (vname, uu____17785, FStar_SMTEncoding_Term.Term_sort, FStar_Pervasives_Native.None) in FStar_SMTEncoding_Term.DeclFun - uu____17733 in - let uu____17763 = + uu____17774 in + let uu____17804 = let env2 = - let uu___118_17769 = env1 in + let uu___118_17810 = env1 in { bindings = - (uu___118_17769.bindings); - depth = (uu___118_17769.depth); - tcenv = (uu___118_17769.tcenv); - warn = (uu___118_17769.warn); - cache = (uu___118_17769.cache); + (uu___118_17810.bindings); + depth = (uu___118_17810.depth); + tcenv = (uu___118_17810.tcenv); + warn = (uu___118_17810.warn); + cache = (uu___118_17810.cache); nolabels = - (uu___118_17769.nolabels); + (uu___118_17810.nolabels); use_zfuel_name = - (uu___118_17769.use_zfuel_name); + (uu___118_17810.use_zfuel_name); encode_non_total_function_typ; current_module_name = - (uu___118_17769.current_module_name) + (uu___118_17810.current_module_name) } in - let uu____17770 = - let uu____17771 = + let uu____17811 = + let uu____17812 = head_normal env2 tt in - Prims.op_Negation uu____17771 in - if uu____17770 + Prims.op_Negation uu____17812 in + if uu____17811 then encode_term_pred FStar_Pervasives_Native.None @@ -5291,11 +5298,11 @@ let encode_free_var: encode_term_pred FStar_Pervasives_Native.None t_norm env2 vtok_tm in - match uu____17763 with + match uu____17804 with | (tok_typing,decls2) -> let tok_typing1 = match formals with - | uu____17786::uu____17787 -> + | uu____17827::uu____17828 -> let ff = ("ty", FStar_SMTEncoding_Term.Term_sort) in @@ -5309,15 +5316,15 @@ let encode_free_var: [(vtok, FStar_SMTEncoding_Term.Term_sort)] in let guarded_tok_typing = - let uu____17827 = - let uu____17838 = + let uu____17868 = + let uu____17879 = FStar_SMTEncoding_Term.mk_NoHoist f tok_typing in ([[vtok_app_l]; [vtok_app_r]], - [ff], uu____17838) in + [ff], uu____17879) in FStar_SMTEncoding_Util.mkForall - uu____17827 in + uu____17868 in FStar_SMTEncoding_Util.mkAssume (guarded_tok_typing, (FStar_Pervasives_Native.Some @@ -5325,7 +5332,7 @@ let encode_free_var: (Prims.strcat "function_token_typing_" vname)) - | uu____17865 -> + | uu____17906 -> FStar_SMTEncoding_Util.mkAssume (tok_typing, (FStar_Pervasives_Native.Some @@ -5333,12 +5340,12 @@ let encode_free_var: (Prims.strcat "function_token_typing_" vname)) in - let uu____17868 = + let uu____17909 = match formals with | [] -> - let uu____17885 = - let uu____17886 = - let uu____17889 = + let uu____17926 = + let uu____17927 = + let uu____17930 = FStar_SMTEncoding_Util.mkFreeV (vname, FStar_SMTEncoding_Term.Term_sort) in @@ -5346,134 +5353,134 @@ let encode_free_var: (fun _0_42 -> FStar_Pervasives_Native.Some _0_42) - uu____17889 in + uu____17930 in push_free_var env1 lid - vname uu____17886 in + vname uu____17927 in ((FStar_List.append decls2 [tok_typing1]), - uu____17885) - | uu____17894 -> + uu____17926) + | uu____17935 -> let vtok_decl = FStar_SMTEncoding_Term.DeclFun (vtok, [], FStar_SMTEncoding_Term.Term_sort, FStar_Pervasives_Native.None) in let name_tok_corr = - let uu____17901 = - let uu____17908 = - let uu____17909 = - let uu____17920 = + let uu____17942 = + let uu____17949 = + let uu____17950 = + let uu____17961 = FStar_SMTEncoding_Util.mkEq (vtok_app, vapp) in ([[vtok_app]; [vapp]], vars, - uu____17920) in + uu____17961) in FStar_SMTEncoding_Util.mkForall - uu____17909 in - (uu____17908, + uu____17950 in + (uu____17949, (FStar_Pervasives_Native.Some "Name-token correspondence"), (Prims.strcat "token_correspondence_" vname)) in FStar_SMTEncoding_Util.mkAssume - uu____17901 in + uu____17942 in ((FStar_List.append decls2 [vtok_decl; name_tok_corr; tok_typing1]), env1) in - (match uu____17868 with + (match uu____17909 with | (tok_decl,env2) -> ((vname_decl :: tok_decl), env2)) in - (match uu____17725 with + (match uu____17766 with | (decls2,env2) -> - let uu____17963 = + let uu____18004 = let res_t1 = FStar_Syntax_Subst.compress res_t in - let uu____17971 = + let uu____18012 = encode_term res_t1 env' in - match uu____17971 with + match uu____18012 with | (encoded_res_t,decls) -> - let uu____17984 = + let uu____18025 = FStar_SMTEncoding_Term.mk_HasType vapp encoded_res_t in (encoded_res_t, - uu____17984, decls) in - (match uu____17963 with + uu____18025, decls) in + (match uu____18004 with | (encoded_res_t,ty_pred,decls3) -> let typingAx = - let uu____17995 = - let uu____18002 = - let uu____18003 = - let uu____18014 = + let uu____18036 = + let uu____18043 = + let uu____18044 = + let uu____18055 = FStar_SMTEncoding_Util.mkImp (guard, ty_pred) in ([[vapp]], vars, - uu____18014) in + uu____18055) in FStar_SMTEncoding_Util.mkForall - uu____18003 in - (uu____18002, + uu____18044 in + (uu____18043, (FStar_Pervasives_Native.Some "free var typing"), (Prims.strcat "typing_" vname)) in FStar_SMTEncoding_Util.mkAssume - uu____17995 in + uu____18036 in let freshness = - let uu____18030 = + let uu____18071 = FStar_All.pipe_right quals (FStar_List.contains FStar_Syntax_Syntax.New) in - if uu____18030 + if uu____18071 then - let uu____18035 = - let uu____18036 = - let uu____18047 = + let uu____18076 = + let uu____18077 = + let uu____18088 = FStar_All.pipe_right vars (FStar_List.map FStar_Pervasives_Native.snd) in - let uu____18058 = + let uu____18099 = varops.next_id () in - (vname, uu____18047, + (vname, uu____18088, FStar_SMTEncoding_Term.Term_sort, - uu____18058) in + uu____18099) in FStar_SMTEncoding_Term.fresh_constructor - uu____18036 in - let uu____18061 = - let uu____18064 = + uu____18077 in + let uu____18102 = + let uu____18105 = pretype_axiom env2 vapp vars in - [uu____18064] in - uu____18035 :: - uu____18061 + [uu____18105] in + uu____18076 :: + uu____18102 else [] in let g = - let uu____18069 = - let uu____18072 = - let uu____18075 = - let uu____18078 = - let uu____18081 = + let uu____18110 = + let uu____18113 = + let uu____18116 = + let uu____18119 = + let uu____18122 = mk_disc_proj_axioms guard encoded_res_t vapp vars in typingAx :: - uu____18081 in + uu____18122 in FStar_List.append freshness - uu____18078 in + uu____18119 in FStar_List.append - decls3 uu____18075 in + decls3 uu____18116 in FStar_List.append decls2 - uu____18072 in + uu____18113 in FStar_List.append decls11 - uu____18069 in + uu____18110 in (g, env2)))))))) let declare_top_level_let: env_t -> @@ -5490,20 +5497,20 @@ let declare_top_level_let: fun x -> fun t -> fun t_norm -> - let uu____18112 = + let uu____18153 = try_lookup_lid env (x.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in - match uu____18112 with + match uu____18153 with | FStar_Pervasives_Native.None -> - let uu____18149 = encode_free_var false env x t t_norm [] in - (match uu____18149 with + let uu____18190 = encode_free_var false env x t t_norm [] in + (match uu____18190 with | (decls,env1) -> - let uu____18176 = + let uu____18217 = lookup_lid env1 (x.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in - (match uu____18176 with - | (n1,x',uu____18203) -> ((n1, x'), decls, env1))) - | FStar_Pervasives_Native.Some (n1,x1,uu____18224) -> + (match uu____18217 with + | (n1,x',uu____18244) -> ((n1, x'), decls, env1))) + | FStar_Pervasives_Native.Some (n1,x1,uu____18265) -> ((n1, x1), [], env) let encode_top_level_val: Prims.bool -> @@ -5520,17 +5527,17 @@ let encode_top_level_val: fun t -> fun quals -> let tt = norm env t in - let uu____18279 = + let uu____18320 = encode_free_var uninterpreted env lid t tt quals in - match uu____18279 with + match uu____18320 with | (decls,env1) -> - let uu____18298 = FStar_Syntax_Util.is_smt_lemma t in - if uu____18298 + let uu____18339 = FStar_Syntax_Util.is_smt_lemma t in + if uu____18339 then - let uu____18305 = - let uu____18308 = encode_smt_lemma env1 lid tt in - FStar_List.append decls uu____18308 in - (uu____18305, env1) + let uu____18346 = + let uu____18349 = encode_smt_lemma env1 lid tt in + FStar_List.append decls uu____18349 in + (uu____18346, env1) else (decls, env1) let encode_top_level_vals: env_t -> @@ -5544,16 +5551,16 @@ let encode_top_level_vals: fun quals -> FStar_All.pipe_right bindings (FStar_List.fold_left - (fun uu____18360 -> + (fun uu____18401 -> fun lb -> - match uu____18360 with + match uu____18401 with | (decls,env1) -> - let uu____18380 = - let uu____18387 = + let uu____18421 = + let uu____18428 = FStar_Util.right lb.FStar_Syntax_Syntax.lbname in - encode_top_level_val false env1 uu____18387 + encode_top_level_val false env1 uu____18428 lb.FStar_Syntax_Syntax.lbtyp quals in - (match uu____18380 with + (match uu____18421 with | (decls',env2) -> ((FStar_List.append decls decls'), env2))) ([], env)) @@ -5561,21 +5568,21 @@ let is_tactic: FStar_Syntax_Syntax.term -> Prims.bool = fun t -> let fstar_tactics_tactic_lid = FStar_Parser_Const.p2l ["FStar"; "Tactics"; "tactic"] in - let uu____18408 = FStar_Syntax_Util.head_and_args t in - match uu____18408 with + let uu____18449 = FStar_Syntax_Util.head_and_args t in + match uu____18449 with | (hd1,args) -> - let uu____18445 = - let uu____18446 = FStar_Syntax_Util.un_uinst hd1 in - uu____18446.FStar_Syntax_Syntax.n in - (match uu____18445 with + let uu____18486 = + let uu____18487 = FStar_Syntax_Util.un_uinst hd1 in + uu____18487.FStar_Syntax_Syntax.n in + (match uu____18486 with | FStar_Syntax_Syntax.Tm_fvar fv when FStar_Syntax_Syntax.fv_eq_lid fv fstar_tactics_tactic_lid -> true - | FStar_Syntax_Syntax.Tm_arrow (uu____18450,c) -> + | FStar_Syntax_Syntax.Tm_arrow (uu____18491,c) -> let effect_name = FStar_Syntax_Util.comp_effect_name c in FStar_Util.starts_with "FStar.Tactics" effect_name.FStar_Ident.str - | uu____18469 -> false) + | uu____18510 -> false) let encode_top_level_let: env_t -> (Prims.bool,FStar_Syntax_Syntax.letbinding Prims.list) @@ -5585,219 +5592,219 @@ let encode_top_level_let: FStar_Pervasives_Native.tuple2 = fun env -> - fun uu____18491 -> + fun uu____18532 -> fun quals -> - match uu____18491 with + match uu____18532 with | (is_rec,bindings) -> let eta_expand1 binders formals body t = let nbinders = FStar_List.length binders in - let uu____18567 = FStar_Util.first_N nbinders formals in - match uu____18567 with + let uu____18608 = FStar_Util.first_N nbinders formals in + match uu____18608 with | (formals1,extra_formals) -> let subst1 = FStar_List.map2 - (fun uu____18648 -> - fun uu____18649 -> - match (uu____18648, uu____18649) with - | ((formal,uu____18667),(binder,uu____18669)) -> - let uu____18678 = - let uu____18685 = + (fun uu____18689 -> + fun uu____18690 -> + match (uu____18689, uu____18690) with + | ((formal,uu____18708),(binder,uu____18710)) -> + let uu____18719 = + let uu____18726 = FStar_Syntax_Syntax.bv_to_name binder in - (formal, uu____18685) in - FStar_Syntax_Syntax.NT uu____18678) formals1 + (formal, uu____18726) in + FStar_Syntax_Syntax.NT uu____18719) formals1 binders in let extra_formals1 = - let uu____18693 = + let uu____18734 = FStar_All.pipe_right extra_formals (FStar_List.map - (fun uu____18724 -> - match uu____18724 with + (fun uu____18765 -> + match uu____18765 with | (x,i) -> - let uu____18735 = - let uu___119_18736 = x in - let uu____18737 = + let uu____18776 = + let uu___119_18777 = x in + let uu____18778 = FStar_Syntax_Subst.subst subst1 x.FStar_Syntax_Syntax.sort in { FStar_Syntax_Syntax.ppname = - (uu___119_18736.FStar_Syntax_Syntax.ppname); + (uu___119_18777.FStar_Syntax_Syntax.ppname); FStar_Syntax_Syntax.index = - (uu___119_18736.FStar_Syntax_Syntax.index); - FStar_Syntax_Syntax.sort = uu____18737 + (uu___119_18777.FStar_Syntax_Syntax.index); + FStar_Syntax_Syntax.sort = uu____18778 } in - (uu____18735, i))) in - FStar_All.pipe_right uu____18693 + (uu____18776, i))) in + FStar_All.pipe_right uu____18734 FStar_Syntax_Util.name_binders in let body1 = - let uu____18755 = - let uu____18756 = FStar_Syntax_Subst.compress body in - let uu____18757 = - let uu____18758 = + let uu____18796 = + let uu____18797 = FStar_Syntax_Subst.compress body in + let uu____18798 = + let uu____18799 = FStar_Syntax_Util.args_of_binders extra_formals1 in FStar_All.pipe_left FStar_Pervasives_Native.snd - uu____18758 in - FStar_Syntax_Syntax.extend_app_n uu____18756 - uu____18757 in - uu____18755 FStar_Pervasives_Native.None + uu____18799 in + FStar_Syntax_Syntax.extend_app_n uu____18797 + uu____18798 in + uu____18796 FStar_Pervasives_Native.None body.FStar_Syntax_Syntax.pos in ((FStar_List.append binders extra_formals1), body1) in let destruct_bound_function flid t_norm e = let get_result_type c = - let uu____18819 = + let uu____18860 = FStar_TypeChecker_Env.is_reifiable_comp env.tcenv c in - if uu____18819 + if uu____18860 then FStar_TypeChecker_Env.reify_comp - (let uu___120_18822 = env.tcenv in + (let uu___120_18863 = env.tcenv in { FStar_TypeChecker_Env.solver = - (uu___120_18822.FStar_TypeChecker_Env.solver); + (uu___120_18863.FStar_TypeChecker_Env.solver); FStar_TypeChecker_Env.range = - (uu___120_18822.FStar_TypeChecker_Env.range); + (uu___120_18863.FStar_TypeChecker_Env.range); FStar_TypeChecker_Env.curmodule = - (uu___120_18822.FStar_TypeChecker_Env.curmodule); + (uu___120_18863.FStar_TypeChecker_Env.curmodule); FStar_TypeChecker_Env.gamma = - (uu___120_18822.FStar_TypeChecker_Env.gamma); + (uu___120_18863.FStar_TypeChecker_Env.gamma); FStar_TypeChecker_Env.gamma_cache = - (uu___120_18822.FStar_TypeChecker_Env.gamma_cache); + (uu___120_18863.FStar_TypeChecker_Env.gamma_cache); FStar_TypeChecker_Env.modules = - (uu___120_18822.FStar_TypeChecker_Env.modules); + (uu___120_18863.FStar_TypeChecker_Env.modules); FStar_TypeChecker_Env.expected_typ = - (uu___120_18822.FStar_TypeChecker_Env.expected_typ); + (uu___120_18863.FStar_TypeChecker_Env.expected_typ); FStar_TypeChecker_Env.sigtab = - (uu___120_18822.FStar_TypeChecker_Env.sigtab); + (uu___120_18863.FStar_TypeChecker_Env.sigtab); FStar_TypeChecker_Env.is_pattern = - (uu___120_18822.FStar_TypeChecker_Env.is_pattern); + (uu___120_18863.FStar_TypeChecker_Env.is_pattern); FStar_TypeChecker_Env.instantiate_imp = - (uu___120_18822.FStar_TypeChecker_Env.instantiate_imp); + (uu___120_18863.FStar_TypeChecker_Env.instantiate_imp); FStar_TypeChecker_Env.effects = - (uu___120_18822.FStar_TypeChecker_Env.effects); + (uu___120_18863.FStar_TypeChecker_Env.effects); FStar_TypeChecker_Env.generalize = - (uu___120_18822.FStar_TypeChecker_Env.generalize); + (uu___120_18863.FStar_TypeChecker_Env.generalize); FStar_TypeChecker_Env.letrecs = - (uu___120_18822.FStar_TypeChecker_Env.letrecs); + (uu___120_18863.FStar_TypeChecker_Env.letrecs); FStar_TypeChecker_Env.top_level = - (uu___120_18822.FStar_TypeChecker_Env.top_level); + (uu___120_18863.FStar_TypeChecker_Env.top_level); FStar_TypeChecker_Env.check_uvars = - (uu___120_18822.FStar_TypeChecker_Env.check_uvars); + (uu___120_18863.FStar_TypeChecker_Env.check_uvars); FStar_TypeChecker_Env.use_eq = - (uu___120_18822.FStar_TypeChecker_Env.use_eq); + (uu___120_18863.FStar_TypeChecker_Env.use_eq); FStar_TypeChecker_Env.is_iface = - (uu___120_18822.FStar_TypeChecker_Env.is_iface); + (uu___120_18863.FStar_TypeChecker_Env.is_iface); FStar_TypeChecker_Env.admit = - (uu___120_18822.FStar_TypeChecker_Env.admit); + (uu___120_18863.FStar_TypeChecker_Env.admit); FStar_TypeChecker_Env.lax = true; FStar_TypeChecker_Env.lax_universes = - (uu___120_18822.FStar_TypeChecker_Env.lax_universes); + (uu___120_18863.FStar_TypeChecker_Env.lax_universes); FStar_TypeChecker_Env.failhard = - (uu___120_18822.FStar_TypeChecker_Env.failhard); + (uu___120_18863.FStar_TypeChecker_Env.failhard); FStar_TypeChecker_Env.nosynth = - (uu___120_18822.FStar_TypeChecker_Env.nosynth); + (uu___120_18863.FStar_TypeChecker_Env.nosynth); FStar_TypeChecker_Env.tc_term = - (uu___120_18822.FStar_TypeChecker_Env.tc_term); + (uu___120_18863.FStar_TypeChecker_Env.tc_term); FStar_TypeChecker_Env.type_of = - (uu___120_18822.FStar_TypeChecker_Env.type_of); + (uu___120_18863.FStar_TypeChecker_Env.type_of); FStar_TypeChecker_Env.universe_of = - (uu___120_18822.FStar_TypeChecker_Env.universe_of); + (uu___120_18863.FStar_TypeChecker_Env.universe_of); FStar_TypeChecker_Env.use_bv_sorts = - (uu___120_18822.FStar_TypeChecker_Env.use_bv_sorts); + (uu___120_18863.FStar_TypeChecker_Env.use_bv_sorts); FStar_TypeChecker_Env.qname_and_index = - (uu___120_18822.FStar_TypeChecker_Env.qname_and_index); + (uu___120_18863.FStar_TypeChecker_Env.qname_and_index); FStar_TypeChecker_Env.proof_ns = - (uu___120_18822.FStar_TypeChecker_Env.proof_ns); + (uu___120_18863.FStar_TypeChecker_Env.proof_ns); FStar_TypeChecker_Env.synth = - (uu___120_18822.FStar_TypeChecker_Env.synth); + (uu___120_18863.FStar_TypeChecker_Env.synth); FStar_TypeChecker_Env.is_native_tactic = - (uu___120_18822.FStar_TypeChecker_Env.is_native_tactic); + (uu___120_18863.FStar_TypeChecker_Env.is_native_tactic); FStar_TypeChecker_Env.identifier_info = - (uu___120_18822.FStar_TypeChecker_Env.identifier_info); + (uu___120_18863.FStar_TypeChecker_Env.identifier_info); FStar_TypeChecker_Env.tc_hooks = - (uu___120_18822.FStar_TypeChecker_Env.tc_hooks); + (uu___120_18863.FStar_TypeChecker_Env.tc_hooks); FStar_TypeChecker_Env.dsenv = - (uu___120_18822.FStar_TypeChecker_Env.dsenv); + (uu___120_18863.FStar_TypeChecker_Env.dsenv); FStar_TypeChecker_Env.dep_graph = - (uu___120_18822.FStar_TypeChecker_Env.dep_graph) + (uu___120_18863.FStar_TypeChecker_Env.dep_graph) }) c FStar_Syntax_Syntax.U_unknown else FStar_Syntax_Util.comp_result c in let rec aux norm1 t_norm1 = - let uu____18855 = FStar_Syntax_Util.abs_formals e in - match uu____18855 with + let uu____18896 = FStar_Syntax_Util.abs_formals e in + match uu____18896 with | (binders,body,lopt) -> (match binders with - | uu____18919::uu____18920 -> - let uu____18935 = - let uu____18936 = - let uu____18939 = + | uu____18960::uu____18961 -> + let uu____18976 = + let uu____18977 = + let uu____18980 = FStar_Syntax_Subst.compress t_norm1 in FStar_All.pipe_left FStar_Syntax_Util.unascribe - uu____18939 in - uu____18936.FStar_Syntax_Syntax.n in - (match uu____18935 with + uu____18980 in + uu____18977.FStar_Syntax_Syntax.n in + (match uu____18976 with | FStar_Syntax_Syntax.Tm_arrow (formals,c) -> - let uu____18982 = + let uu____19023 = FStar_Syntax_Subst.open_comp formals c in - (match uu____18982 with + (match uu____19023 with | (formals1,c1) -> let nformals = FStar_List.length formals1 in let nbinders = FStar_List.length binders in let tres = get_result_type c1 in - let uu____19024 = + let uu____19065 = (nformals < nbinders) && (FStar_Syntax_Util.is_total_comp c1) in - if uu____19024 + if uu____19065 then - let uu____19059 = + let uu____19100 = FStar_Util.first_N nformals binders in - (match uu____19059 with + (match uu____19100 with | (bs0,rest) -> let c2 = let subst1 = FStar_List.map2 - (fun uu____19153 -> - fun uu____19154 -> - match (uu____19153, - uu____19154) + (fun uu____19194 -> + fun uu____19195 -> + match (uu____19194, + uu____19195) with - | ((x,uu____19172), - (b,uu____19174)) -> - let uu____19183 = - let uu____19190 = + | ((x,uu____19213), + (b,uu____19215)) -> + let uu____19224 = + let uu____19231 = FStar_Syntax_Syntax.bv_to_name b in - (x, uu____19190) in + (x, uu____19231) in FStar_Syntax_Syntax.NT - uu____19183) + uu____19224) formals1 bs0 in FStar_Syntax_Subst.subst_comp subst1 c1 in let body1 = FStar_Syntax_Util.abs rest body lopt in - let uu____19192 = - let uu____19213 = + let uu____19233 = + let uu____19254 = get_result_type c2 in - (bs0, body1, bs0, uu____19213) in - (uu____19192, false)) + (bs0, body1, bs0, uu____19254) in + (uu____19233, false)) else if nformals > nbinders then - (let uu____19281 = + (let uu____19322 = eta_expand1 binders formals1 body tres in - match uu____19281 with + match uu____19322 with | (binders1,body1) -> ((binders1, body1, formals1, tres), false)) else ((binders, body, formals1, tres), false)) - | FStar_Syntax_Syntax.Tm_refine (x,uu____19370) -> - let uu____19375 = - let uu____19396 = + | FStar_Syntax_Syntax.Tm_refine (x,uu____19411) -> + let uu____19416 = + let uu____19437 = aux norm1 x.FStar_Syntax_Syntax.sort in - FStar_Pervasives_Native.fst uu____19396 in - (uu____19375, true) - | uu____19461 when Prims.op_Negation norm1 -> + FStar_Pervasives_Native.fst uu____19437 in + (uu____19416, true) + | uu____19502 when Prims.op_Negation norm1 -> let t_norm2 = FStar_TypeChecker_Normalize.normalize [FStar_TypeChecker_Normalize.AllowUnboundUniverses; @@ -5811,86 +5818,86 @@ let encode_top_level_let: FStar_TypeChecker_Normalize.EraseUniverses] env.tcenv t_norm1 in aux true t_norm2 - | uu____19463 -> - let uu____19464 = - let uu____19465 = + | uu____19504 -> + let uu____19505 = + let uu____19506 = FStar_Syntax_Print.term_to_string e in - let uu____19466 = + let uu____19507 = FStar_Syntax_Print.term_to_string t_norm1 in FStar_Util.format3 "Impossible! let-bound lambda %s = %s has a type that's not a function: %s\n" - flid.FStar_Ident.str uu____19465 - uu____19466 in - failwith uu____19464) - | uu____19491 -> + flid.FStar_Ident.str uu____19506 + uu____19507 in + failwith uu____19505) + | uu____19532 -> let rec aux' t_norm2 = - let uu____19516 = - let uu____19517 = + let uu____19557 = + let uu____19558 = FStar_Syntax_Subst.compress t_norm2 in - uu____19517.FStar_Syntax_Syntax.n in - match uu____19516 with + uu____19558.FStar_Syntax_Syntax.n in + match uu____19557 with | FStar_Syntax_Syntax.Tm_arrow (formals,c) -> - let uu____19558 = + let uu____19599 = FStar_Syntax_Subst.open_comp formals c in - (match uu____19558 with + (match uu____19599 with | (formals1,c1) -> let tres = get_result_type c1 in - let uu____19586 = + let uu____19627 = eta_expand1 [] formals1 e tres in - (match uu____19586 with + (match uu____19627 with | (binders1,body1) -> ((binders1, body1, formals1, tres), false))) - | FStar_Syntax_Syntax.Tm_refine (bv,uu____19666) + | FStar_Syntax_Syntax.Tm_refine (bv,uu____19707) -> aux' bv.FStar_Syntax_Syntax.sort - | uu____19671 -> (([], e, [], t_norm2), false) in + | uu____19712 -> (([], e, [], t_norm2), false) in aux' t_norm1) in aux false t_norm in (try - let uu____19727 = + let uu____19768 = FStar_All.pipe_right bindings (FStar_Util.for_all (fun lb -> (FStar_Syntax_Util.is_lemma lb.FStar_Syntax_Syntax.lbtyp) || (is_tactic lb.FStar_Syntax_Syntax.lbtyp))) in - if uu____19727 + if uu____19768 then encode_top_level_vals env bindings quals else - (let uu____19739 = + (let uu____19780 = FStar_All.pipe_right bindings (FStar_List.fold_left - (fun uu____19833 -> + (fun uu____19874 -> fun lb -> - match uu____19833 with + match uu____19874 with | (toks,typs,decls,env1) -> - ((let uu____19928 = + ((let uu____19969 = FStar_Syntax_Util.is_lemma lb.FStar_Syntax_Syntax.lbtyp in - if uu____19928 + if uu____19969 then FStar_Exn.raise Let_rec_unencodeable else ()); (let t_norm = whnf env1 lb.FStar_Syntax_Syntax.lbtyp in - let uu____19931 = - let uu____19946 = + let uu____19972 = + let uu____19987 = FStar_Util.right lb.FStar_Syntax_Syntax.lbname in - declare_top_level_let env1 uu____19946 + declare_top_level_let env1 uu____19987 lb.FStar_Syntax_Syntax.lbtyp t_norm in - match uu____19931 with + match uu____19972 with | (tok,decl,env2) -> - let uu____19992 = - let uu____20005 = - let uu____20016 = + let uu____20033 = + let uu____20046 = + let uu____20057 = FStar_Util.right lb.FStar_Syntax_Syntax.lbname in - (uu____20016, tok) in - uu____20005 :: toks in - (uu____19992, (t_norm :: typs), (decl + (uu____20057, tok) in + uu____20046 :: toks in + (uu____20033, (t_norm :: typs), (decl :: decls), env2)))) ([], [], [], env)) in - match uu____19739 with + match uu____19780 with | (toks,typs,decls,env1) -> let toks1 = FStar_List.rev toks in let decls1 = @@ -5902,339 +5909,339 @@ let encode_top_level_let: | [] -> FStar_SMTEncoding_Util.mkFreeV (f, FStar_SMTEncoding_Term.Term_sort) - | uu____20199 -> + | uu____20240 -> if curry then (match ftok with | FStar_Pervasives_Native.Some ftok1 -> mk_Apply ftok1 vars | FStar_Pervasives_Native.None -> - let uu____20207 = + let uu____20248 = FStar_SMTEncoding_Util.mkFreeV (f, FStar_SMTEncoding_Term.Term_sort) in - mk_Apply uu____20207 vars) + mk_Apply uu____20248 vars) else - (let uu____20209 = - let uu____20216 = + (let uu____20250 = + let uu____20257 = FStar_List.map FStar_SMTEncoding_Util.mkFreeV vars in - (f, uu____20216) in - FStar_SMTEncoding_Util.mkApp uu____20209) in + (f, uu____20257) in + FStar_SMTEncoding_Util.mkApp uu____20250) in let encode_non_rec_lbdef bindings1 typs2 toks2 env2 = match (bindings1, typs2, toks2) with - | ({ FStar_Syntax_Syntax.lbname = uu____20298; + | ({ FStar_Syntax_Syntax.lbname = uu____20339; FStar_Syntax_Syntax.lbunivs = uvs; - FStar_Syntax_Syntax.lbtyp = uu____20300; - FStar_Syntax_Syntax.lbeff = uu____20301; + FStar_Syntax_Syntax.lbtyp = uu____20341; + FStar_Syntax_Syntax.lbeff = uu____20342; FStar_Syntax_Syntax.lbdef = e;_}::[],t_norm::[], (flid_fv,(f,ftok))::[]) -> let flid = (flid_fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in - let uu____20364 = - let uu____20371 = + let uu____20405 = + let uu____20412 = FStar_TypeChecker_Env.open_universes_in env2.tcenv uvs [e; t_norm] in - match uu____20371 with - | (tcenv',uu____20389,e_t) -> - let uu____20395 = + match uu____20412 with + | (tcenv',uu____20430,e_t) -> + let uu____20436 = match e_t with | e1::t_norm1::[] -> (e1, t_norm1) - | uu____20406 -> failwith "Impossible" in - (match uu____20395 with + | uu____20447 -> failwith "Impossible" in + (match uu____20436 with | (e1,t_norm1) -> - ((let uu___123_20422 = env2 in + ((let uu___123_20463 = env2 in { bindings = - (uu___123_20422.bindings); - depth = (uu___123_20422.depth); + (uu___123_20463.bindings); + depth = (uu___123_20463.depth); tcenv = tcenv'; - warn = (uu___123_20422.warn); - cache = (uu___123_20422.cache); + warn = (uu___123_20463.warn); + cache = (uu___123_20463.cache); nolabels = - (uu___123_20422.nolabels); + (uu___123_20463.nolabels); use_zfuel_name = - (uu___123_20422.use_zfuel_name); + (uu___123_20463.use_zfuel_name); encode_non_total_function_typ = - (uu___123_20422.encode_non_total_function_typ); + (uu___123_20463.encode_non_total_function_typ); current_module_name = - (uu___123_20422.current_module_name) + (uu___123_20463.current_module_name) }), e1, t_norm1)) in - (match uu____20364 with + (match uu____20405 with | (env',e1,t_norm1) -> - let uu____20432 = + let uu____20473 = destruct_bound_function flid t_norm1 e1 in - (match uu____20432 with - | ((binders,body,uu____20453,uu____20454),curry) + (match uu____20473 with + | ((binders,body,uu____20494,uu____20495),curry) -> - ((let uu____20465 = + ((let uu____20506 = FStar_All.pipe_left (FStar_TypeChecker_Env.debug env2.tcenv) (FStar_Options.Other "SMTEncoding") in - if uu____20465 + if uu____20506 then - let uu____20466 = + let uu____20507 = FStar_Syntax_Print.binders_to_string ", " binders in - let uu____20467 = + let uu____20508 = FStar_Syntax_Print.term_to_string body in FStar_Util.print2 "Encoding let : binders=[%s], body=%s\n" - uu____20466 uu____20467 + uu____20507 uu____20508 else ()); - (let uu____20469 = + (let uu____20510 = encode_binders FStar_Pervasives_Native.None binders env' in - match uu____20469 with - | (vars,guards,env'1,binder_decls,uu____20496) + match uu____20510 with + | (vars,guards,env'1,binder_decls,uu____20537) -> let body1 = - let uu____20510 = + let uu____20551 = FStar_TypeChecker_Env.is_reifiable_function env'1.tcenv t_norm1 in - if uu____20510 + if uu____20551 then FStar_TypeChecker_Util.reify_body env'1.tcenv body else body in let app = mk_app1 curry f ftok vars in - let uu____20513 = - let uu____20522 = + let uu____20554 = + let uu____20563 = FStar_All.pipe_right quals (FStar_List.contains FStar_Syntax_Syntax.Logic) in - if uu____20522 + if uu____20563 then - let uu____20533 = + let uu____20574 = FStar_SMTEncoding_Term.mk_Valid app in - let uu____20534 = + let uu____20575 = encode_formula body1 env'1 in - (uu____20533, uu____20534) + (uu____20574, uu____20575) else - (let uu____20544 = + (let uu____20585 = encode_term body1 env'1 in - (app, uu____20544)) in - (match uu____20513 with + (app, uu____20585)) in + (match uu____20554 with | (app1,(body2,decls2)) -> let eqn = - let uu____20567 = - let uu____20574 = - let uu____20575 = - let uu____20586 = + let uu____20608 = + let uu____20615 = + let uu____20616 = + let uu____20627 = FStar_SMTEncoding_Util.mkEq (app1, body2) in ([[app1]], vars, - uu____20586) in + uu____20627) in FStar_SMTEncoding_Util.mkForall - uu____20575 in - let uu____20597 = - let uu____20600 = + uu____20616 in + let uu____20638 = + let uu____20641 = FStar_Util.format1 "Equation for %s" flid.FStar_Ident.str in FStar_Pervasives_Native.Some - uu____20600 in - (uu____20574, - uu____20597, + uu____20641 in + (uu____20615, + uu____20638, (Prims.strcat "equation_" f)) in FStar_SMTEncoding_Util.mkAssume - uu____20567 in - let uu____20603 = - let uu____20606 = - let uu____20609 = - let uu____20612 = - let uu____20615 = + uu____20608 in + let uu____20644 = + let uu____20647 = + let uu____20650 = + let uu____20653 = + let uu____20656 = primitive_type_axioms env2.tcenv flid f app1 in FStar_List.append - [eqn] uu____20615 in + [eqn] uu____20656 in FStar_List.append - decls2 uu____20612 in + decls2 uu____20653 in FStar_List.append binder_decls - uu____20609 in + uu____20650 in FStar_List.append decls1 - uu____20606 in - (uu____20603, env2)))))) - | uu____20620 -> failwith "Impossible" in + uu____20647 in + (uu____20644, env2)))))) + | uu____20661 -> failwith "Impossible" in let encode_rec_lbdefs bindings1 typs2 toks2 env2 = let fuel = - let uu____20705 = varops.fresh "fuel" in - (uu____20705, FStar_SMTEncoding_Term.Fuel_sort) in + let uu____20746 = varops.fresh "fuel" in + (uu____20746, FStar_SMTEncoding_Term.Fuel_sort) in let fuel_tm = FStar_SMTEncoding_Util.mkFreeV fuel in let env0 = env2 in - let uu____20708 = + let uu____20749 = FStar_All.pipe_right toks2 (FStar_List.fold_left - (fun uu____20796 -> - fun uu____20797 -> - match (uu____20796, uu____20797) with + (fun uu____20837 -> + fun uu____20838 -> + match (uu____20837, uu____20838) with | ((gtoks,env3),(flid_fv,(f,ftok))) -> let flid = (flid_fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in let g = - let uu____20945 = + let uu____20986 = FStar_Ident.lid_add_suffix flid "fuel_instrumented" in - varops.new_fvar uu____20945 in + varops.new_fvar uu____20986 in let gtok = - let uu____20947 = + let uu____20988 = FStar_Ident.lid_add_suffix flid "fuel_instrumented_token" in - varops.new_fvar uu____20947 in + varops.new_fvar uu____20988 in let env4 = - let uu____20949 = - let uu____20952 = + let uu____20990 = + let uu____20993 = FStar_SMTEncoding_Util.mkApp (g, [fuel_tm]) in FStar_All.pipe_left (fun _0_43 -> FStar_Pervasives_Native.Some - _0_43) uu____20952 in + _0_43) uu____20993 in push_free_var env3 flid gtok - uu____20949 in + uu____20990 in (((flid, f, ftok, g, gtok) :: gtoks), env4)) ([], env2)) in - match uu____20708 with + match uu____20749 with | (gtoks,env3) -> let gtoks1 = FStar_List.rev gtoks in - let encode_one_binding env01 uu____21108 t_norm - uu____21110 = - match (uu____21108, uu____21110) with + let encode_one_binding env01 uu____21149 t_norm + uu____21151 = + match (uu____21149, uu____21151) with | ((flid,f,ftok,g,gtok),{ FStar_Syntax_Syntax.lbname = lbn; FStar_Syntax_Syntax.lbunivs = uvs; FStar_Syntax_Syntax.lbtyp - = uu____21154; + = uu____21195; FStar_Syntax_Syntax.lbeff - = uu____21155; + = uu____21196; FStar_Syntax_Syntax.lbdef = e;_}) -> - let uu____21183 = - let uu____21190 = + let uu____21224 = + let uu____21231 = FStar_TypeChecker_Env.open_universes_in env3.tcenv uvs [e; t_norm] in - match uu____21190 with - | (tcenv',uu____21212,e_t) -> - let uu____21218 = + match uu____21231 with + | (tcenv',uu____21253,e_t) -> + let uu____21259 = match e_t with | e1::t_norm1::[] -> (e1, t_norm1) - | uu____21229 -> + | uu____21270 -> failwith "Impossible" in - (match uu____21218 with + (match uu____21259 with | (e1,t_norm1) -> - ((let uu___124_21245 = env3 in + ((let uu___124_21286 = env3 in { bindings = - (uu___124_21245.bindings); + (uu___124_21286.bindings); depth = - (uu___124_21245.depth); + (uu___124_21286.depth); tcenv = tcenv'; - warn = (uu___124_21245.warn); + warn = (uu___124_21286.warn); cache = - (uu___124_21245.cache); + (uu___124_21286.cache); nolabels = - (uu___124_21245.nolabels); + (uu___124_21286.nolabels); use_zfuel_name = - (uu___124_21245.use_zfuel_name); + (uu___124_21286.use_zfuel_name); encode_non_total_function_typ = - (uu___124_21245.encode_non_total_function_typ); + (uu___124_21286.encode_non_total_function_typ); current_module_name = - (uu___124_21245.current_module_name) + (uu___124_21286.current_module_name) }), e1, t_norm1)) in - (match uu____21183 with + (match uu____21224 with | (env',e1,t_norm1) -> - ((let uu____21260 = + ((let uu____21301 = FStar_All.pipe_left (FStar_TypeChecker_Env.debug env01.tcenv) (FStar_Options.Other "SMTEncoding") in - if uu____21260 + if uu____21301 then - let uu____21261 = + let uu____21302 = FStar_Syntax_Print.lbname_to_string lbn in - let uu____21262 = + let uu____21303 = FStar_Syntax_Print.term_to_string t_norm1 in - let uu____21263 = + let uu____21304 = FStar_Syntax_Print.term_to_string e1 in FStar_Util.print3 "Encoding let rec %s : %s = %s\n" - uu____21261 uu____21262 - uu____21263 + uu____21302 uu____21303 + uu____21304 else ()); - (let uu____21265 = + (let uu____21306 = destruct_bound_function flid t_norm1 e1 in - match uu____21265 with + match uu____21306 with | ((binders,body,formals,tres),curry) -> - ((let uu____21302 = + ((let uu____21343 = FStar_All.pipe_left (FStar_TypeChecker_Env.debug env01.tcenv) (FStar_Options.Other "SMTEncoding") in - if uu____21302 + if uu____21343 then - let uu____21303 = + let uu____21344 = FStar_Syntax_Print.binders_to_string ", " binders in - let uu____21304 = + let uu____21345 = FStar_Syntax_Print.term_to_string body in - let uu____21305 = + let uu____21346 = FStar_Syntax_Print.binders_to_string ", " formals in - let uu____21306 = + let uu____21347 = FStar_Syntax_Print.term_to_string tres in FStar_Util.print4 "Encoding let rec: binders=[%s], body=%s, formals=[%s], tres=%s\n" - uu____21303 uu____21304 - uu____21305 uu____21306 + uu____21344 uu____21345 + uu____21346 uu____21347 else ()); if curry then failwith "Unexpected type of let rec in SMT Encoding; expected it to be annotated with an arrow type" else (); - (let uu____21310 = + (let uu____21351 = encode_binders FStar_Pervasives_Native.None binders env' in - match uu____21310 with - | (vars,guards,env'1,binder_decls,uu____21341) + match uu____21351 with + | (vars,guards,env'1,binder_decls,uu____21382) -> let decl_g = - let uu____21355 = - let uu____21366 = - let uu____21369 = + let uu____21396 = + let uu____21407 = + let uu____21410 = FStar_List.map FStar_Pervasives_Native.snd vars in FStar_SMTEncoding_Term.Fuel_sort - :: uu____21369 in - (g, uu____21366, + :: uu____21410 in + (g, uu____21407, FStar_SMTEncoding_Term.Term_sort, (FStar_Pervasives_Native.Some "Fuel-instrumented function name")) in FStar_SMTEncoding_Term.DeclFun - uu____21355 in + uu____21396 in let env02 = push_zfuel_name env01 flid g in @@ -6249,56 +6256,56 @@ let encode_top_level_let: FStar_SMTEncoding_Util.mkFreeV vars in let app = - let uu____21394 = - let uu____21401 = + let uu____21435 = + let uu____21442 = FStar_List.map FStar_SMTEncoding_Util.mkFreeV vars in - (f, uu____21401) in + (f, uu____21442) in FStar_SMTEncoding_Util.mkApp - uu____21394 in + uu____21435 in let gsapp = - let uu____21411 = - let uu____21418 = - let uu____21421 = + let uu____21452 = + let uu____21459 = + let uu____21462 = FStar_SMTEncoding_Util.mkApp ("SFuel", [fuel_tm]) in - uu____21421 :: + uu____21462 :: vars_tm in - (g, uu____21418) in + (g, uu____21459) in FStar_SMTEncoding_Util.mkApp - uu____21411 in + uu____21452 in let gmax = - let uu____21427 = - let uu____21434 = - let uu____21437 = + let uu____21468 = + let uu____21475 = + let uu____21478 = FStar_SMTEncoding_Util.mkApp ("MaxFuel", []) in - uu____21437 :: + uu____21478 :: vars_tm in - (g, uu____21434) in + (g, uu____21475) in FStar_SMTEncoding_Util.mkApp - uu____21427 in + uu____21468 in let body1 = - let uu____21443 = + let uu____21484 = FStar_TypeChecker_Env.is_reifiable_function env'1.tcenv t_norm1 in - if uu____21443 + if uu____21484 then FStar_TypeChecker_Util.reify_body env'1.tcenv body else body in - let uu____21445 = + let uu____21486 = encode_term body1 env'1 in - (match uu____21445 with + (match uu____21486 with | (body_tm,decls2) -> let eqn_g = - let uu____21463 = - let uu____21470 = - let uu____21471 + let uu____21504 = + let uu____21511 = + let uu____21512 = - let uu____21486 + let uu____21527 = FStar_SMTEncoding_Util.mkEq (gsapp, @@ -6309,100 +6316,100 @@ let encode_top_level_let: "0")), (fuel :: vars), - uu____21486) in + uu____21527) in FStar_SMTEncoding_Util.mkForall' - uu____21471 in - let uu____21507 = - let uu____21510 + uu____21512 in + let uu____21548 = + let uu____21551 = FStar_Util.format1 "Equation for fuel-instrumented recursive function: %s" flid.FStar_Ident.str in FStar_Pervasives_Native.Some - uu____21510 in - (uu____21470, - uu____21507, + uu____21551 in + (uu____21511, + uu____21548, (Prims.strcat "equation_with_fuel_" g)) in FStar_SMTEncoding_Util.mkAssume - uu____21463 in + uu____21504 in let eqn_f = - let uu____21514 = - let uu____21521 = - let uu____21522 + let uu____21555 = + let uu____21562 = + let uu____21563 = - let uu____21533 + let uu____21574 = FStar_SMTEncoding_Util.mkEq (app, gmax) in ([[app]], vars, - uu____21533) in + uu____21574) in FStar_SMTEncoding_Util.mkForall - uu____21522 in - (uu____21521, + uu____21563 in + (uu____21562, (FStar_Pervasives_Native.Some "Correspondence of recursive function to instrumented version"), (Prims.strcat "@fuel_correspondence_" g)) in FStar_SMTEncoding_Util.mkAssume - uu____21514 in + uu____21555 in let eqn_g' = - let uu____21547 = - let uu____21554 = - let uu____21555 + let uu____21588 = + let uu____21595 = + let uu____21596 = - let uu____21566 + let uu____21607 = - let uu____21567 + let uu____21608 = - let uu____21572 + let uu____21613 = - let uu____21573 + let uu____21614 = - let uu____21580 + let uu____21621 = - let uu____21583 + let uu____21624 = FStar_SMTEncoding_Term.n_fuel (Prims.parse_int "0") in - uu____21583 + uu____21624 :: vars_tm in (g, - uu____21580) in + uu____21621) in FStar_SMTEncoding_Util.mkApp - uu____21573 in + uu____21614 in (gsapp, - uu____21572) in + uu____21613) in FStar_SMTEncoding_Util.mkEq - uu____21567 in + uu____21608 in ([[gsapp]], (fuel :: vars), - uu____21566) in + uu____21607) in FStar_SMTEncoding_Util.mkForall - uu____21555 in - (uu____21554, + uu____21596 in + (uu____21595, (FStar_Pervasives_Native.Some "Fuel irrelevance"), (Prims.strcat "@fuel_irrelevance_" g)) in FStar_SMTEncoding_Util.mkAssume - uu____21547 in - let uu____21606 = - let uu____21615 = + uu____21588 in + let uu____21647 = + let uu____21656 = encode_binders FStar_Pervasives_Native.None formals env02 in - match uu____21615 + match uu____21656 with - | (vars1,v_guards,env4,binder_decls1,uu____21644) + | (vars1,v_guards,env4,binder_decls1,uu____21685) -> let vars_tm1 = FStar_List.map @@ -6416,22 +6423,22 @@ let encode_top_level_let: vars_tm1)) in let tok_corr = let tok_app = - let uu____21669 + let uu____21710 = FStar_SMTEncoding_Util.mkFreeV (gtok, FStar_SMTEncoding_Term.Term_sort) in mk_Apply - uu____21669 + uu____21710 (fuel :: vars1) in - let uu____21674 + let uu____21715 = - let uu____21681 + let uu____21722 = - let uu____21682 + let uu____21723 = - let uu____21693 + let uu____21734 = FStar_SMTEncoding_Util.mkEq (tok_app, @@ -6440,10 +6447,10 @@ let encode_top_level_let: [tok_app]], (fuel :: vars1), - uu____21693) in + uu____21734) in FStar_SMTEncoding_Util.mkForall - uu____21682 in - (uu____21681, + uu____21723 in + (uu____21722, ( FStar_Pervasives_Native.Some "Fuel token correspondence"), @@ -6452,59 +6459,59 @@ let encode_top_level_let: "fuel_token_correspondence_" gtok)) in FStar_SMTEncoding_Util.mkAssume - uu____21674 in - let uu____21714 + uu____21715 in + let uu____21755 = - let uu____21721 + let uu____21762 = encode_term_pred FStar_Pervasives_Native.None tres env4 gapp in - match uu____21721 + match uu____21762 with | (g_typing,d3) -> - let uu____21734 + let uu____21775 = - let uu____21737 + let uu____21778 = - let uu____21738 + let uu____21779 = - let uu____21745 + let uu____21786 = - let uu____21746 + let uu____21787 = - let uu____21757 + let uu____21798 = - let uu____21758 + let uu____21799 = - let uu____21763 + let uu____21804 = FStar_SMTEncoding_Util.mk_and_l v_guards in - (uu____21763, + (uu____21804, g_typing) in FStar_SMTEncoding_Util.mkImp - uu____21758 in + uu____21799 in ([[gapp]], (fuel :: vars1), - uu____21757) in + uu____21798) in FStar_SMTEncoding_Util.mkForall - uu____21746 in - (uu____21745, + uu____21787 in + (uu____21786, (FStar_Pervasives_Native.Some "Typing correspondence of token to term"), (Prims.strcat "token_correspondence_" g)) in FStar_SMTEncoding_Util.mkAssume - uu____21738 in - [uu____21737] in + uu____21779 in + [uu____21778] in (d3, - uu____21734) in - (match uu____21714 + uu____21775) in + (match uu____21755 with | (aux_decls,typing_corr) -> @@ -6514,7 +6521,7 @@ let encode_top_level_let: (FStar_List.append typing_corr [tok_corr]))) in - (match uu____21606 + (match uu____21647 with | (aux_decls,g_typing) -> @@ -6533,63 +6540,63 @@ let encode_top_level_let: eqn_f] g_typing), env02)))))))) in - let uu____21828 = - let uu____21841 = + let uu____21869 = + let uu____21882 = FStar_List.zip3 gtoks1 typs2 bindings1 in FStar_List.fold_left - (fun uu____21920 -> - fun uu____21921 -> - match (uu____21920, uu____21921) with + (fun uu____21961 -> + fun uu____21962 -> + match (uu____21961, uu____21962) with | ((decls2,eqns,env01),(gtok,ty,lb)) -> - let uu____22076 = + let uu____22117 = encode_one_binding env01 gtok ty lb in - (match uu____22076 with + (match uu____22117 with | (decls',eqns',env02) -> ((decls' :: decls2), (FStar_List.append eqns' eqns), env02))) ([decls1], [], env0) - uu____21841 in - (match uu____21828 with + uu____21882 in + (match uu____21869 with | (decls2,eqns,env01) -> - let uu____22149 = - let isDeclFun uu___90_22161 = - match uu___90_22161 with + let uu____22190 = + let isDeclFun uu___90_22202 = + match uu___90_22202 with | FStar_SMTEncoding_Term.DeclFun - uu____22162 -> true - | uu____22173 -> false in - let uu____22174 = + uu____22203 -> true + | uu____22214 -> false in + let uu____22215 = FStar_All.pipe_right decls2 FStar_List.flatten in - FStar_All.pipe_right uu____22174 + FStar_All.pipe_right uu____22215 (FStar_List.partition isDeclFun) in - (match uu____22149 with + (match uu____22190 with | (prefix_decls,rest) -> let eqns1 = FStar_List.rev eqns in ((FStar_List.append prefix_decls (FStar_List.append rest eqns1)), env01))) in - let uu____22214 = + let uu____22255 = (FStar_All.pipe_right quals (FStar_Util.for_some - (fun uu___91_22218 -> - match uu___91_22218 with + (fun uu___91_22259 -> + match uu___91_22259 with | FStar_Syntax_Syntax.HasMaskedEffect -> true - | uu____22219 -> false))) + | uu____22260 -> false))) || (FStar_All.pipe_right typs1 (FStar_Util.for_some (fun t -> - let uu____22225 = + let uu____22266 = (FStar_Syntax_Util.is_pure_or_ghost_function t) || (FStar_TypeChecker_Env.is_reifiable_function env1.tcenv t) in FStar_All.pipe_left Prims.op_Negation - uu____22225))) in - if uu____22214 + uu____22266))) in + if uu____22255 then (decls1, env1) else (try @@ -6601,13 +6608,13 @@ let encode_top_level_let: with | Let_rec_unencodeable -> let msg = - let uu____22277 = + let uu____22318 = FStar_All.pipe_right bindings (FStar_List.map (fun lb -> FStar_Syntax_Print.lbname_to_string lb.FStar_Syntax_Syntax.lbname)) in - FStar_All.pipe_right uu____22277 + FStar_All.pipe_right uu____22318 (FStar_String.concat " and ") in let decl = FStar_SMTEncoding_Term.Caption @@ -6621,34 +6628,34 @@ let rec encode_sigelt: fun env -> fun se -> let nm = - let uu____22326 = FStar_Syntax_Util.lid_of_sigelt se in - match uu____22326 with + let uu____22367 = FStar_Syntax_Util.lid_of_sigelt se in + match uu____22367 with | FStar_Pervasives_Native.None -> "" | FStar_Pervasives_Native.Some l -> l.FStar_Ident.str in - let uu____22330 = encode_sigelt' env se in - match uu____22330 with + let uu____22371 = encode_sigelt' env se in + match uu____22371 with | (g,env1) -> let g1 = match g with | [] -> - let uu____22346 = - let uu____22347 = FStar_Util.format1 "" nm in - FStar_SMTEncoding_Term.Caption uu____22347 in - [uu____22346] - | uu____22348 -> - let uu____22349 = - let uu____22352 = - let uu____22353 = + let uu____22387 = + let uu____22388 = FStar_Util.format1 "" nm in + FStar_SMTEncoding_Term.Caption uu____22388 in + [uu____22387] + | uu____22389 -> + let uu____22390 = + let uu____22393 = + let uu____22394 = FStar_Util.format1 "" nm in - FStar_SMTEncoding_Term.Caption uu____22353 in - uu____22352 :: g in - let uu____22354 = - let uu____22357 = - let uu____22358 = + FStar_SMTEncoding_Term.Caption uu____22394 in + uu____22393 :: g in + let uu____22395 = + let uu____22398 = + let uu____22399 = FStar_Util.format1 "" nm in - FStar_SMTEncoding_Term.Caption uu____22358 in - [uu____22357] in - FStar_List.append uu____22349 uu____22354 in + FStar_SMTEncoding_Term.Caption uu____22399 in + [uu____22398] in + FStar_List.append uu____22390 uu____22395 in (g1, env1) and encode_sigelt': env_t -> @@ -6658,41 +6665,41 @@ and encode_sigelt': fun env -> fun se -> let is_opaque_to_smt t = - let uu____22371 = - let uu____22372 = FStar_Syntax_Subst.compress t in - uu____22372.FStar_Syntax_Syntax.n in - match uu____22371 with + let uu____22412 = + let uu____22413 = FStar_Syntax_Subst.compress t in + uu____22413.FStar_Syntax_Syntax.n in + match uu____22412 with | FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_string - (s,uu____22376)) -> s = "opaque_to_smt" - | uu____22377 -> false in + (s,uu____22417)) -> s = "opaque_to_smt" + | uu____22418 -> false in let is_uninterpreted_by_smt t = - let uu____22382 = - let uu____22383 = FStar_Syntax_Subst.compress t in - uu____22383.FStar_Syntax_Syntax.n in - match uu____22382 with + let uu____22423 = + let uu____22424 = FStar_Syntax_Subst.compress t in + uu____22424.FStar_Syntax_Syntax.n in + match uu____22423 with | FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_string - (s,uu____22387)) -> s = "uninterpreted_by_smt" - | uu____22388 -> false in + (s,uu____22428)) -> s = "uninterpreted_by_smt" + | uu____22429 -> false in match se.FStar_Syntax_Syntax.sigel with - | FStar_Syntax_Syntax.Sig_new_effect_for_free uu____22393 -> + | FStar_Syntax_Syntax.Sig_new_effect_for_free uu____22434 -> failwith "impossible -- removed by tc.fs" - | FStar_Syntax_Syntax.Sig_pragma uu____22398 -> ([], env) - | FStar_Syntax_Syntax.Sig_main uu____22401 -> ([], env) - | FStar_Syntax_Syntax.Sig_effect_abbrev uu____22404 -> ([], env) - | FStar_Syntax_Syntax.Sig_sub_effect uu____22419 -> ([], env) + | FStar_Syntax_Syntax.Sig_pragma uu____22439 -> ([], env) + | FStar_Syntax_Syntax.Sig_main uu____22442 -> ([], env) + | FStar_Syntax_Syntax.Sig_effect_abbrev uu____22445 -> ([], env) + | FStar_Syntax_Syntax.Sig_sub_effect uu____22460 -> ([], env) | FStar_Syntax_Syntax.Sig_new_effect ed -> - let uu____22423 = - let uu____22424 = + let uu____22464 = + let uu____22465 = FStar_All.pipe_right se.FStar_Syntax_Syntax.sigquals (FStar_List.contains FStar_Syntax_Syntax.Reifiable) in - FStar_All.pipe_right uu____22424 Prims.op_Negation in - if uu____22423 + FStar_All.pipe_right uu____22465 Prims.op_Negation in + if uu____22464 then ([], env) else (let close_effect_params tm = match ed.FStar_Syntax_Syntax.binders with | [] -> tm - | uu____22450 -> + | uu____22491 -> FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_abs ((ed.FStar_Syntax_Syntax.binders), tm, @@ -6703,46 +6710,46 @@ and encode_sigelt': [FStar_Syntax_Syntax.TOTAL])))) FStar_Pervasives_Native.None tm.FStar_Syntax_Syntax.pos in let encode_action env1 a = - let uu____22470 = + let uu____22511 = new_term_constant_and_tok_from_lid env1 a.FStar_Syntax_Syntax.action_name in - match uu____22470 with + match uu____22511 with | (aname,atok,env2) -> - let uu____22486 = + let uu____22527 = FStar_Syntax_Util.arrow_formals_comp a.FStar_Syntax_Syntax.action_typ in - (match uu____22486 with - | (formals,uu____22504) -> - let uu____22517 = - let uu____22522 = + (match uu____22527 with + | (formals,uu____22545) -> + let uu____22558 = + let uu____22563 = close_effect_params a.FStar_Syntax_Syntax.action_defn in - encode_term uu____22522 env2 in - (match uu____22517 with + encode_term uu____22563 env2 in + (match uu____22558 with | (tm,decls) -> let a_decls = - let uu____22534 = - let uu____22535 = - let uu____22546 = + let uu____22575 = + let uu____22576 = + let uu____22587 = FStar_All.pipe_right formals (FStar_List.map - (fun uu____22562 -> + (fun uu____22603 -> FStar_SMTEncoding_Term.Term_sort)) in - (aname, uu____22546, + (aname, uu____22587, FStar_SMTEncoding_Term.Term_sort, (FStar_Pervasives_Native.Some "Action")) in - FStar_SMTEncoding_Term.DeclFun uu____22535 in - [uu____22534; + FStar_SMTEncoding_Term.DeclFun uu____22576 in + [uu____22575; FStar_SMTEncoding_Term.DeclFun (atok, [], FStar_SMTEncoding_Term.Term_sort, (FStar_Pervasives_Native.Some "Action token"))] in - let uu____22575 = - let aux uu____22627 uu____22628 = - match (uu____22627, uu____22628) with - | ((bv,uu____22680),(env3,acc_sorts,acc)) -> - let uu____22718 = gen_term_var env3 bv in - (match uu____22718 with + let uu____22616 = + let aux uu____22668 uu____22669 = + match (uu____22668, uu____22669) with + | ((bv,uu____22721),(env3,acc_sorts,acc)) -> + let uu____22759 = gen_term_var env3 bv in + (match uu____22759 with | (xxsym,xx,env4) -> (env4, ((xxsym, @@ -6750,80 +6757,80 @@ and encode_sigelt': :: acc_sorts), (xx :: acc))) in FStar_List.fold_right aux formals (env2, [], []) in - (match uu____22575 with - | (uu____22790,xs_sorts,xs) -> + (match uu____22616 with + | (uu____22831,xs_sorts,xs) -> let app = FStar_SMTEncoding_Util.mkApp (aname, xs) in let a_eq = - let uu____22813 = - let uu____22820 = - let uu____22821 = - let uu____22832 = - let uu____22833 = - let uu____22838 = + let uu____22854 = + let uu____22861 = + let uu____22862 = + let uu____22873 = + let uu____22874 = + let uu____22879 = mk_Apply tm xs_sorts in - (app, uu____22838) in + (app, uu____22879) in FStar_SMTEncoding_Util.mkEq - uu____22833 in - ([[app]], xs_sorts, uu____22832) in + uu____22874 in + ([[app]], xs_sorts, uu____22873) in FStar_SMTEncoding_Util.mkForall - uu____22821 in - (uu____22820, + uu____22862 in + (uu____22861, (FStar_Pervasives_Native.Some "Action equality"), (Prims.strcat aname "_equality")) in FStar_SMTEncoding_Util.mkAssume - uu____22813 in + uu____22854 in let tok_correspondence = let tok_term = FStar_SMTEncoding_Util.mkFreeV (atok, FStar_SMTEncoding_Term.Term_sort) in let tok_app = mk_Apply tok_term xs_sorts in - let uu____22858 = - let uu____22865 = - let uu____22866 = - let uu____22877 = + let uu____22899 = + let uu____22906 = + let uu____22907 = + let uu____22918 = FStar_SMTEncoding_Util.mkEq (tok_app, app) in ([[tok_app]], xs_sorts, - uu____22877) in + uu____22918) in FStar_SMTEncoding_Util.mkForall - uu____22866 in - (uu____22865, + uu____22907 in + (uu____22906, (FStar_Pervasives_Native.Some "Action token correspondence"), (Prims.strcat aname "_token_correspondence")) in FStar_SMTEncoding_Util.mkAssume - uu____22858 in + uu____22899 in (env2, (FStar_List.append decls (FStar_List.append a_decls [a_eq; tok_correspondence])))))) in - let uu____22896 = + let uu____22937 = FStar_Util.fold_map encode_action env ed.FStar_Syntax_Syntax.actions in - match uu____22896 with + match uu____22937 with | (env1,decls2) -> ((FStar_List.flatten decls2), env1)) - | FStar_Syntax_Syntax.Sig_declare_typ (lid,uu____22924,uu____22925) + | FStar_Syntax_Syntax.Sig_declare_typ (lid,uu____22965,uu____22966) when FStar_Ident.lid_equals lid FStar_Parser_Const.precedes_lid -> - let uu____22926 = new_term_constant_and_tok_from_lid env lid in - (match uu____22926 with | (tname,ttok,env1) -> ([], env1)) - | FStar_Syntax_Syntax.Sig_declare_typ (lid,uu____22943,t) -> + let uu____22967 = new_term_constant_and_tok_from_lid env lid in + (match uu____22967 with | (tname,ttok,env1) -> ([], env1)) + | FStar_Syntax_Syntax.Sig_declare_typ (lid,uu____22984,t) -> let quals = se.FStar_Syntax_Syntax.sigquals in let will_encode_definition = - let uu____22949 = + let uu____22990 = FStar_All.pipe_right quals (FStar_Util.for_some - (fun uu___92_22953 -> - match uu___92_22953 with + (fun uu___92_22994 -> + match uu___92_22994 with | FStar_Syntax_Syntax.Assumption -> true - | FStar_Syntax_Syntax.Projector uu____22954 -> true - | FStar_Syntax_Syntax.Discriminator uu____22959 -> true + | FStar_Syntax_Syntax.Projector uu____22995 -> true + | FStar_Syntax_Syntax.Discriminator uu____23000 -> true | FStar_Syntax_Syntax.Irreducible -> true - | uu____22960 -> false)) in - Prims.op_Negation uu____22949 in + | uu____23001 -> false)) in + Prims.op_Negation uu____22990 in if will_encode_definition then ([], env) else @@ -6831,46 +6838,46 @@ and encode_sigelt': FStar_Syntax_Syntax.lid_as_fv lid FStar_Syntax_Syntax.Delta_constant FStar_Pervasives_Native.None in - let uu____22969 = - let uu____22976 = + let uu____23010 = + let uu____23017 = FStar_All.pipe_right se.FStar_Syntax_Syntax.sigattrs (FStar_Util.for_some is_uninterpreted_by_smt) in - encode_top_level_val uu____22976 env fv t quals in - match uu____22969 with + encode_top_level_val uu____23017 env fv t quals in + match uu____23010 with | (decls,env1) -> let tname = lid.FStar_Ident.str in let tsym = FStar_SMTEncoding_Util.mkFreeV (tname, FStar_SMTEncoding_Term.Term_sort) in - let uu____22991 = - let uu____22994 = + let uu____23032 = + let uu____23035 = primitive_type_axioms env1.tcenv lid tname tsym in - FStar_List.append decls uu____22994 in - (uu____22991, env1)) + FStar_List.append decls uu____23035 in + (uu____23032, env1)) | FStar_Syntax_Syntax.Sig_assume (l,us,f) -> - let uu____23002 = FStar_Syntax_Subst.open_univ_vars us f in - (match uu____23002 with - | (uu____23011,f1) -> - let uu____23013 = encode_formula f1 env in - (match uu____23013 with + let uu____23043 = FStar_Syntax_Subst.open_univ_vars us f in + (match uu____23043 with + | (uu____23052,f1) -> + let uu____23054 = encode_formula f1 env in + (match uu____23054 with | (f2,decls) -> let g = - let uu____23027 = - let uu____23028 = - let uu____23035 = - let uu____23038 = - let uu____23039 = + let uu____23068 = + let uu____23069 = + let uu____23076 = + let uu____23079 = + let uu____23080 = FStar_Syntax_Print.lid_to_string l in - FStar_Util.format1 "Assumption: %s" uu____23039 in - FStar_Pervasives_Native.Some uu____23038 in - let uu____23040 = + FStar_Util.format1 "Assumption: %s" uu____23080 in + FStar_Pervasives_Native.Some uu____23079 in + let uu____23081 = varops.mk_unique (Prims.strcat "assumption_" l.FStar_Ident.str) in - (f2, uu____23035, uu____23040) in - FStar_SMTEncoding_Util.mkAssume uu____23028 in - [uu____23027] in + (f2, uu____23076, uu____23081) in + FStar_SMTEncoding_Util.mkAssume uu____23069 in + [uu____23068] in ((FStar_List.append decls g), env))) - | FStar_Syntax_Syntax.Sig_let (lbs,uu____23046) when + | FStar_Syntax_Syntax.Sig_let (lbs,uu____23087) when (FStar_All.pipe_right se.FStar_Syntax_Syntax.sigquals (FStar_List.contains FStar_Syntax_Syntax.Irreducible)) || @@ -6878,57 +6885,57 @@ and encode_sigelt': (FStar_Util.for_some is_opaque_to_smt)) -> let attrs = se.FStar_Syntax_Syntax.sigattrs in - let uu____23058 = + let uu____23099 = FStar_Util.fold_map (fun env1 -> fun lb -> let lid = - let uu____23076 = - let uu____23079 = + let uu____23117 = + let uu____23120 = FStar_Util.right lb.FStar_Syntax_Syntax.lbname in - uu____23079.FStar_Syntax_Syntax.fv_name in - uu____23076.FStar_Syntax_Syntax.v in - let uu____23080 = - let uu____23081 = + uu____23120.FStar_Syntax_Syntax.fv_name in + uu____23117.FStar_Syntax_Syntax.v in + let uu____23121 = + let uu____23122 = FStar_TypeChecker_Env.try_lookup_val_decl env1.tcenv lid in - FStar_All.pipe_left FStar_Option.isNone uu____23081 in - if uu____23080 + FStar_All.pipe_left FStar_Option.isNone uu____23122 in + if uu____23121 then let val_decl = - let uu___127_23109 = se in + let uu___127_23150 = se in { FStar_Syntax_Syntax.sigel = (FStar_Syntax_Syntax.Sig_declare_typ (lid, (lb.FStar_Syntax_Syntax.lbunivs), (lb.FStar_Syntax_Syntax.lbtyp))); FStar_Syntax_Syntax.sigrng = - (uu___127_23109.FStar_Syntax_Syntax.sigrng); + (uu___127_23150.FStar_Syntax_Syntax.sigrng); FStar_Syntax_Syntax.sigquals = (FStar_Syntax_Syntax.Irreducible :: (se.FStar_Syntax_Syntax.sigquals)); FStar_Syntax_Syntax.sigmeta = - (uu___127_23109.FStar_Syntax_Syntax.sigmeta); + (uu___127_23150.FStar_Syntax_Syntax.sigmeta); FStar_Syntax_Syntax.sigattrs = - (uu___127_23109.FStar_Syntax_Syntax.sigattrs) + (uu___127_23150.FStar_Syntax_Syntax.sigattrs) } in - let uu____23114 = encode_sigelt' env1 val_decl in - match uu____23114 with | (decls,env2) -> (env2, decls) + let uu____23155 = encode_sigelt' env1 val_decl in + match uu____23155 with | (decls,env2) -> (env2, decls) else (env1, [])) env (FStar_Pervasives_Native.snd lbs) in - (match uu____23058 with + (match uu____23099 with | (env1,decls) -> ((FStar_List.flatten decls), env1)) | FStar_Syntax_Syntax.Sig_let - ((uu____23142,{ FStar_Syntax_Syntax.lbname = FStar_Util.Inr b2t1; - FStar_Syntax_Syntax.lbunivs = uu____23144; - FStar_Syntax_Syntax.lbtyp = uu____23145; - FStar_Syntax_Syntax.lbeff = uu____23146; - FStar_Syntax_Syntax.lbdef = uu____23147;_}::[]),uu____23148) + ((uu____23183,{ FStar_Syntax_Syntax.lbname = FStar_Util.Inr b2t1; + FStar_Syntax_Syntax.lbunivs = uu____23185; + FStar_Syntax_Syntax.lbtyp = uu____23186; + FStar_Syntax_Syntax.lbeff = uu____23187; + FStar_Syntax_Syntax.lbdef = uu____23188;_}::[]),uu____23189) when FStar_Syntax_Syntax.fv_eq_lid b2t1 FStar_Parser_Const.b2t_lid -> - let uu____23167 = + let uu____23208 = new_term_constant_and_tok_from_lid env (b2t1.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in - (match uu____23167 with + (match uu____23208 with | (tname,ttok,env1) -> let xx = ("x", FStar_SMTEncoding_Term.Term_sort) in let x = FStar_SMTEncoding_Util.mkFreeV xx in @@ -6936,73 +6943,73 @@ and encode_sigelt': let valid_b2t_x = FStar_SMTEncoding_Util.mkApp ("Valid", [b2t_x]) in let decls = - let uu____23196 = - let uu____23199 = - let uu____23200 = - let uu____23207 = - let uu____23208 = - let uu____23219 = - let uu____23220 = - let uu____23225 = + let uu____23237 = + let uu____23240 = + let uu____23241 = + let uu____23248 = + let uu____23249 = + let uu____23260 = + let uu____23261 = + let uu____23266 = FStar_SMTEncoding_Util.mkApp ((FStar_Pervasives_Native.snd FStar_SMTEncoding_Term.boxBoolFun), [x]) in - (valid_b2t_x, uu____23225) in - FStar_SMTEncoding_Util.mkEq uu____23220 in - ([[b2t_x]], [xx], uu____23219) in - FStar_SMTEncoding_Util.mkForall uu____23208 in - (uu____23207, + (valid_b2t_x, uu____23266) in + FStar_SMTEncoding_Util.mkEq uu____23261 in + ([[b2t_x]], [xx], uu____23260) in + FStar_SMTEncoding_Util.mkForall uu____23249 in + (uu____23248, (FStar_Pervasives_Native.Some "b2t def"), "b2t_def") in - FStar_SMTEncoding_Util.mkAssume uu____23200 in - [uu____23199] in + FStar_SMTEncoding_Util.mkAssume uu____23241 in + [uu____23240] in (FStar_SMTEncoding_Term.DeclFun (tname, [FStar_SMTEncoding_Term.Term_sort], FStar_SMTEncoding_Term.Term_sort, FStar_Pervasives_Native.None)) - :: uu____23196 in + :: uu____23237 in (decls, env1)) - | FStar_Syntax_Syntax.Sig_let (uu____23258,uu____23259) when + | FStar_Syntax_Syntax.Sig_let (uu____23299,uu____23300) when FStar_All.pipe_right se.FStar_Syntax_Syntax.sigquals (FStar_Util.for_some - (fun uu___93_23268 -> - match uu___93_23268 with - | FStar_Syntax_Syntax.Discriminator uu____23269 -> true - | uu____23270 -> false)) + (fun uu___93_23309 -> + match uu___93_23309 with + | FStar_Syntax_Syntax.Discriminator uu____23310 -> true + | uu____23311 -> false)) -> ([], env) - | FStar_Syntax_Syntax.Sig_let (uu____23273,lids) when + | FStar_Syntax_Syntax.Sig_let (uu____23314,lids) when (FStar_All.pipe_right lids (FStar_Util.for_some (fun l -> - let uu____23284 = - let uu____23285 = FStar_List.hd l.FStar_Ident.ns in - uu____23285.FStar_Ident.idText in - uu____23284 = "Prims"))) + let uu____23325 = + let uu____23326 = FStar_List.hd l.FStar_Ident.ns in + uu____23326.FStar_Ident.idText in + uu____23325 = "Prims"))) && (FStar_All.pipe_right se.FStar_Syntax_Syntax.sigquals (FStar_Util.for_some - (fun uu___94_23289 -> - match uu___94_23289 with + (fun uu___94_23330 -> + match uu___94_23330 with | FStar_Syntax_Syntax.Unfold_for_unification_and_vcgen -> true - | uu____23290 -> false))) + | uu____23331 -> false))) -> ([], env) - | FStar_Syntax_Syntax.Sig_let ((false ,lb::[]),uu____23294) when + | FStar_Syntax_Syntax.Sig_let ((false ,lb::[]),uu____23335) when FStar_All.pipe_right se.FStar_Syntax_Syntax.sigquals (FStar_Util.for_some - (fun uu___95_23311 -> - match uu___95_23311 with - | FStar_Syntax_Syntax.Projector uu____23312 -> true - | uu____23317 -> false)) + (fun uu___95_23352 -> + match uu___95_23352 with + | FStar_Syntax_Syntax.Projector uu____23353 -> true + | uu____23358 -> false)) -> let fv = FStar_Util.right lb.FStar_Syntax_Syntax.lbname in let l = (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in - let uu____23320 = try_lookup_free_var env l in - (match uu____23320 with - | FStar_Pervasives_Native.Some uu____23327 -> ([], env) + let uu____23361 = try_lookup_free_var env l in + (match uu____23361 with + | FStar_Pervasives_Native.Some uu____23368 -> ([], env) | FStar_Pervasives_Native.None -> let se1 = - let uu___128_23331 = se in + let uu___128_23372 = se in { FStar_Syntax_Syntax.sigel = (FStar_Syntax_Syntax.Sig_declare_typ @@ -7010,152 +7017,152 @@ and encode_sigelt': (lb.FStar_Syntax_Syntax.lbtyp))); FStar_Syntax_Syntax.sigrng = (FStar_Ident.range_of_lid l); FStar_Syntax_Syntax.sigquals = - (uu___128_23331.FStar_Syntax_Syntax.sigquals); + (uu___128_23372.FStar_Syntax_Syntax.sigquals); FStar_Syntax_Syntax.sigmeta = - (uu___128_23331.FStar_Syntax_Syntax.sigmeta); + (uu___128_23372.FStar_Syntax_Syntax.sigmeta); FStar_Syntax_Syntax.sigattrs = - (uu___128_23331.FStar_Syntax_Syntax.sigattrs) + (uu___128_23372.FStar_Syntax_Syntax.sigattrs) } in encode_sigelt env se1) - | FStar_Syntax_Syntax.Sig_let ((is_rec,bindings),uu____23338) -> + | FStar_Syntax_Syntax.Sig_let ((is_rec,bindings),uu____23379) -> encode_top_level_let env (is_rec, bindings) se.FStar_Syntax_Syntax.sigquals - | FStar_Syntax_Syntax.Sig_bundle (ses,uu____23356) -> - let uu____23365 = encode_sigelts env ses in - (match uu____23365 with + | FStar_Syntax_Syntax.Sig_bundle (ses,uu____23397) -> + let uu____23406 = encode_sigelts env ses in + (match uu____23406 with | (g,env1) -> - let uu____23382 = + let uu____23423 = FStar_All.pipe_right g (FStar_List.partition - (fun uu___96_23405 -> - match uu___96_23405 with + (fun uu___96_23446 -> + match uu___96_23446 with | FStar_SMTEncoding_Term.Assume { FStar_SMTEncoding_Term.assumption_term = - uu____23406; + uu____23447; FStar_SMTEncoding_Term.assumption_caption = FStar_Pervasives_Native.Some "inversion axiom"; FStar_SMTEncoding_Term.assumption_name = - uu____23407; + uu____23448; FStar_SMTEncoding_Term.assumption_fact_ids = - uu____23408;_} + uu____23449;_} -> false - | uu____23411 -> true)) in - (match uu____23382 with + | uu____23452 -> true)) in + (match uu____23423 with | (g',inversions) -> - let uu____23426 = + let uu____23467 = FStar_All.pipe_right g' (FStar_List.partition - (fun uu___97_23447 -> - match uu___97_23447 with - | FStar_SMTEncoding_Term.DeclFun uu____23448 -> + (fun uu___97_23488 -> + match uu___97_23488 with + | FStar_SMTEncoding_Term.DeclFun uu____23489 -> true - | uu____23459 -> false)) in - (match uu____23426 with + | uu____23500 -> false)) in + (match uu____23467 with | (decls,rest) -> ((FStar_List.append decls (FStar_List.append rest inversions)), env1)))) | FStar_Syntax_Syntax.Sig_inductive_typ - (t,uu____23477,tps,k,uu____23480,datas) -> + (t,uu____23518,tps,k,uu____23521,datas) -> let quals = se.FStar_Syntax_Syntax.sigquals in let is_logical = FStar_All.pipe_right quals (FStar_Util.for_some - (fun uu___98_23497 -> - match uu___98_23497 with + (fun uu___98_23538 -> + match uu___98_23538 with | FStar_Syntax_Syntax.Logic -> true | FStar_Syntax_Syntax.Assumption -> true - | uu____23498 -> false)) in + | uu____23539 -> false)) in let constructor_or_logic_type_decl c = if is_logical then - let uu____23507 = c in - match uu____23507 with - | (name,args,uu____23512,uu____23513,uu____23514) -> - let uu____23519 = - let uu____23520 = - let uu____23531 = + let uu____23548 = c in + match uu____23548 with + | (name,args,uu____23553,uu____23554,uu____23555) -> + let uu____23560 = + let uu____23561 = + let uu____23572 = FStar_All.pipe_right args (FStar_List.map - (fun uu____23548 -> - match uu____23548 with - | (uu____23555,sort,uu____23557) -> sort)) in - (name, uu____23531, FStar_SMTEncoding_Term.Term_sort, + (fun uu____23589 -> + match uu____23589 with + | (uu____23596,sort,uu____23598) -> sort)) in + (name, uu____23572, FStar_SMTEncoding_Term.Term_sort, FStar_Pervasives_Native.None) in - FStar_SMTEncoding_Term.DeclFun uu____23520 in - [uu____23519] + FStar_SMTEncoding_Term.DeclFun uu____23561 in + [uu____23560] else FStar_SMTEncoding_Term.constructor_to_decl c in let inversion_axioms tapp vars = - let uu____23584 = + let uu____23625 = FStar_All.pipe_right datas (FStar_Util.for_some (fun l -> - let uu____23590 = + let uu____23631 = FStar_TypeChecker_Env.try_lookup_lid env.tcenv l in - FStar_All.pipe_right uu____23590 FStar_Option.isNone)) in - if uu____23584 + FStar_All.pipe_right uu____23631 FStar_Option.isNone)) in + if uu____23625 then [] else - (let uu____23622 = + (let uu____23663 = fresh_fvar "x" FStar_SMTEncoding_Term.Term_sort in - match uu____23622 with + match uu____23663 with | (xxsym,xx) -> - let uu____23631 = + let uu____23672 = FStar_All.pipe_right datas (FStar_List.fold_left - (fun uu____23670 -> + (fun uu____23711 -> fun l -> - match uu____23670 with + match uu____23711 with | (out,decls) -> - let uu____23690 = + let uu____23731 = FStar_TypeChecker_Env.lookup_datacon env.tcenv l in - (match uu____23690 with - | (uu____23701,data_t) -> - let uu____23703 = + (match uu____23731 with + | (uu____23742,data_t) -> + let uu____23744 = FStar_Syntax_Util.arrow_formals data_t in - (match uu____23703 with + (match uu____23744 with | (args,res) -> let indices = - let uu____23749 = - let uu____23750 = + let uu____23790 = + let uu____23791 = FStar_Syntax_Subst.compress res in - uu____23750.FStar_Syntax_Syntax.n in - match uu____23749 with + uu____23791.FStar_Syntax_Syntax.n in + match uu____23790 with | FStar_Syntax_Syntax.Tm_app - (uu____23761,indices) -> + (uu____23802,indices) -> indices - | uu____23783 -> [] in + | uu____23824 -> [] in let env1 = FStar_All.pipe_right args (FStar_List.fold_left (fun env1 -> - fun uu____23807 -> - match uu____23807 + fun uu____23848 -> + match uu____23848 with - | (x,uu____23813) -> - let uu____23814 + | (x,uu____23854) -> + let uu____23855 = - let uu____23815 + let uu____23856 = - let uu____23822 + let uu____23863 = mk_term_projector_name l x in - (uu____23822, + (uu____23863, [xx]) in FStar_SMTEncoding_Util.mkApp - uu____23815 in + uu____23856 in push_term_var env1 x - uu____23814) + uu____23855) env) in - let uu____23825 = + let uu____23866 = encode_args indices env1 in - (match uu____23825 with + (match uu____23866 with | (indices1,decls') -> (if (FStar_List.length @@ -7166,47 +7173,47 @@ and encode_sigelt': then failwith "Impossible" else (); (let eqs = - let uu____23851 = + let uu____23892 = FStar_List.map2 (fun v1 -> fun a -> - let uu____23867 + let uu____23908 = - let uu____23872 + let uu____23913 = FStar_SMTEncoding_Util.mkFreeV v1 in - (uu____23872, + (uu____23913, a) in FStar_SMTEncoding_Util.mkEq - uu____23867) + uu____23908) vars indices1 in FStar_All.pipe_right - uu____23851 + uu____23892 FStar_SMTEncoding_Util.mk_and_l in - let uu____23875 = - let uu____23876 = - let uu____23881 = - let uu____23882 = - let uu____23887 = + let uu____23916 = + let uu____23917 = + let uu____23922 = + let uu____23923 = + let uu____23928 = mk_data_tester env1 l xx in - (uu____23887, + (uu____23928, eqs) in FStar_SMTEncoding_Util.mkAnd - uu____23882 in - (out, uu____23881) in + uu____23923 in + (out, uu____23922) in FStar_SMTEncoding_Util.mkOr - uu____23876 in - (uu____23875, + uu____23917 in + (uu____23916, (FStar_List.append decls decls')))))))) (FStar_SMTEncoding_Util.mkFalse, [])) in - (match uu____23631 with + (match uu____23672 with | (data_ax,decls) -> - let uu____23900 = + let uu____23941 = fresh_fvar "f" FStar_SMTEncoding_Term.Fuel_sort in - (match uu____23900 with + (match uu____23941 with | (ffsym,ff) -> let fuel_guarded_inversion = let xx_has_type_sfuel = @@ -7214,106 +7221,106 @@ and encode_sigelt': (FStar_List.length datas) > (Prims.parse_int "1") then - let uu____23911 = + let uu____23952 = FStar_SMTEncoding_Util.mkApp ("SFuel", [ff]) in FStar_SMTEncoding_Term.mk_HasTypeFuel - uu____23911 xx tapp + uu____23952 xx tapp else FStar_SMTEncoding_Term.mk_HasTypeFuel ff xx tapp in - let uu____23915 = - let uu____23922 = - let uu____23923 = - let uu____23934 = + let uu____23956 = + let uu____23963 = + let uu____23964 = + let uu____23975 = add_fuel (ffsym, FStar_SMTEncoding_Term.Fuel_sort) ((xxsym, FStar_SMTEncoding_Term.Term_sort) :: vars) in - let uu____23949 = + let uu____23990 = FStar_SMTEncoding_Util.mkImp (xx_has_type_sfuel, data_ax) in - ([[xx_has_type_sfuel]], uu____23934, - uu____23949) in + ([[xx_has_type_sfuel]], uu____23975, + uu____23990) in FStar_SMTEncoding_Util.mkForall - uu____23923 in - let uu____23964 = + uu____23964 in + let uu____24005 = varops.mk_unique (Prims.strcat "fuel_guarded_inversion_" t.FStar_Ident.str) in - (uu____23922, + (uu____23963, (FStar_Pervasives_Native.Some - "inversion axiom"), uu____23964) in - FStar_SMTEncoding_Util.mkAssume uu____23915 in + "inversion axiom"), uu____24005) in + FStar_SMTEncoding_Util.mkAssume uu____23956 in FStar_List.append decls [fuel_guarded_inversion]))) in - let uu____23967 = - let uu____23980 = - let uu____23981 = FStar_Syntax_Subst.compress k in - uu____23981.FStar_Syntax_Syntax.n in - match uu____23980 with + let uu____24008 = + let uu____24021 = + let uu____24022 = FStar_Syntax_Subst.compress k in + uu____24022.FStar_Syntax_Syntax.n in + match uu____24021 with | FStar_Syntax_Syntax.Tm_arrow (formals,kres) -> ((FStar_List.append tps formals), (FStar_Syntax_Util.comp_result kres)) - | uu____24026 -> (tps, k) in - (match uu____23967 with + | uu____24067 -> (tps, k) in + (match uu____24008 with | (formals,res) -> - let uu____24049 = FStar_Syntax_Subst.open_term formals res in - (match uu____24049 with + let uu____24090 = FStar_Syntax_Subst.open_term formals res in + (match uu____24090 with | (formals1,res1) -> - let uu____24060 = + let uu____24101 = encode_binders FStar_Pervasives_Native.None formals1 env in - (match uu____24060 with - | (vars,guards,env',binder_decls,uu____24085) -> - let uu____24098 = + (match uu____24101 with + | (vars,guards,env',binder_decls,uu____24126) -> + let uu____24139 = new_term_constant_and_tok_from_lid env t in - (match uu____24098 with + (match uu____24139 with | (tname,ttok,env1) -> let ttok_tm = FStar_SMTEncoding_Util.mkApp (ttok, []) in let guard = FStar_SMTEncoding_Util.mk_and_l guards in let tapp = - let uu____24117 = - let uu____24124 = + let uu____24158 = + let uu____24165 = FStar_List.map FStar_SMTEncoding_Util.mkFreeV vars in - (tname, uu____24124) in - FStar_SMTEncoding_Util.mkApp uu____24117 in - let uu____24133 = + (tname, uu____24165) in + FStar_SMTEncoding_Util.mkApp uu____24158 in + let uu____24174 = let tname_decl = - let uu____24143 = - let uu____24144 = + let uu____24184 = + let uu____24185 = FStar_All.pipe_right vars (FStar_List.map - (fun uu____24176 -> - match uu____24176 with + (fun uu____24217 -> + match uu____24217 with | (n1,s) -> ((Prims.strcat tname n1), s, false))) in - let uu____24189 = varops.next_id () in - (tname, uu____24144, + let uu____24230 = varops.next_id () in + (tname, uu____24185, FStar_SMTEncoding_Term.Term_sort, - uu____24189, false) in - constructor_or_logic_type_decl uu____24143 in - let uu____24198 = + uu____24230, false) in + constructor_or_logic_type_decl uu____24184 in + let uu____24239 = match vars with | [] -> - let uu____24211 = - let uu____24212 = - let uu____24215 = + let uu____24252 = + let uu____24253 = + let uu____24256 = FStar_SMTEncoding_Util.mkApp (tname, []) in FStar_All.pipe_left (fun _0_44 -> FStar_Pervasives_Native.Some - _0_44) uu____24215 in + _0_44) uu____24256 in push_free_var env1 t tname - uu____24212 in - ([], uu____24211) - | uu____24222 -> + uu____24253 in + ([], uu____24252) + | uu____24263 -> let ttok_decl = FStar_SMTEncoding_Term.DeclFun (ttok, [], @@ -7321,131 +7328,131 @@ and encode_sigelt': (FStar_Pervasives_Native.Some "token")) in let ttok_fresh = - let uu____24231 = varops.next_id () in + let uu____24272 = varops.next_id () in FStar_SMTEncoding_Term.fresh_token (ttok, FStar_SMTEncoding_Term.Term_sort) - uu____24231 in + uu____24272 in let ttok_app = mk_Apply ttok_tm vars in let pats = [[ttok_app]; [tapp]] in let name_tok_corr = - let uu____24245 = - let uu____24252 = - let uu____24253 = - let uu____24268 = + let uu____24286 = + let uu____24293 = + let uu____24294 = + let uu____24309 = FStar_SMTEncoding_Util.mkEq (ttok_app, tapp) in (pats, FStar_Pervasives_Native.None, - vars, uu____24268) in + vars, uu____24309) in FStar_SMTEncoding_Util.mkForall' - uu____24253 in - (uu____24252, + uu____24294 in + (uu____24293, (FStar_Pervasives_Native.Some "name-token correspondence"), (Prims.strcat "token_correspondence_" ttok)) in FStar_SMTEncoding_Util.mkAssume - uu____24245 in + uu____24286 in ([ttok_decl; ttok_fresh; name_tok_corr], env1) in - match uu____24198 with + match uu____24239 with | (tok_decls,env2) -> ((FStar_List.append tname_decl tok_decls), env2) in - (match uu____24133 with + (match uu____24174 with | (decls,env2) -> let kindingAx = - let uu____24308 = + let uu____24349 = encode_term_pred FStar_Pervasives_Native.None res1 env' tapp in - match uu____24308 with + match uu____24349 with | (k1,decls1) -> let karr = if (FStar_List.length formals1) > (Prims.parse_int "0") then - let uu____24326 = - let uu____24327 = - let uu____24334 = - let uu____24335 = + let uu____24367 = + let uu____24368 = + let uu____24375 = + let uu____24376 = FStar_SMTEncoding_Term.mk_PreType ttok_tm in FStar_SMTEncoding_Term.mk_tester - "Tm_arrow" uu____24335 in - (uu____24334, + "Tm_arrow" uu____24376 in + (uu____24375, (FStar_Pervasives_Native.Some "kinding"), (Prims.strcat "pre_kinding_" ttok)) in FStar_SMTEncoding_Util.mkAssume - uu____24327 in - [uu____24326] + uu____24368 in + [uu____24367] else [] in - let uu____24339 = - let uu____24342 = - let uu____24345 = - let uu____24346 = - let uu____24353 = - let uu____24354 = - let uu____24365 = + let uu____24380 = + let uu____24383 = + let uu____24386 = + let uu____24387 = + let uu____24394 = + let uu____24395 = + let uu____24406 = FStar_SMTEncoding_Util.mkImp (guard, k1) in ([[tapp]], vars, - uu____24365) in + uu____24406) in FStar_SMTEncoding_Util.mkForall - uu____24354 in - (uu____24353, + uu____24395 in + (uu____24394, FStar_Pervasives_Native.None, (Prims.strcat "kinding_" ttok)) in FStar_SMTEncoding_Util.mkAssume - uu____24346 in - [uu____24345] in - FStar_List.append karr uu____24342 in - FStar_List.append decls1 uu____24339 in + uu____24387 in + [uu____24386] in + FStar_List.append karr uu____24383 in + FStar_List.append decls1 uu____24380 in let aux = - let uu____24381 = - let uu____24384 = + let uu____24422 = + let uu____24425 = inversion_axioms tapp vars in - let uu____24387 = - let uu____24390 = + let uu____24428 = + let uu____24431 = pretype_axiom env2 tapp vars in - [uu____24390] in - FStar_List.append uu____24384 - uu____24387 in - FStar_List.append kindingAx uu____24381 in + [uu____24431] in + FStar_List.append uu____24425 + uu____24428 in + FStar_List.append kindingAx uu____24422 in let g = FStar_List.append decls (FStar_List.append binder_decls aux) in (g, env2)))))) | FStar_Syntax_Syntax.Sig_datacon - (d,uu____24397,uu____24398,uu____24399,uu____24400,uu____24401) + (d,uu____24438,uu____24439,uu____24440,uu____24441,uu____24442) when FStar_Ident.lid_equals d FStar_Parser_Const.lexcons_lid -> ([], env) | FStar_Syntax_Syntax.Sig_datacon - (d,uu____24409,t,uu____24411,n_tps,uu____24413) -> + (d,uu____24450,t,uu____24452,n_tps,uu____24454) -> let quals = se.FStar_Syntax_Syntax.sigquals in - let uu____24421 = new_term_constant_and_tok_from_lid env d in - (match uu____24421 with + let uu____24462 = new_term_constant_and_tok_from_lid env d in + (match uu____24462 with | (ddconstrsym,ddtok,env1) -> let ddtok_tm = FStar_SMTEncoding_Util.mkApp (ddtok, []) in - let uu____24438 = FStar_Syntax_Util.arrow_formals t in - (match uu____24438 with + let uu____24479 = FStar_Syntax_Util.arrow_formals t in + (match uu____24479 with | (formals,t_res) -> - let uu____24473 = + let uu____24514 = fresh_fvar "f" FStar_SMTEncoding_Term.Fuel_sort in - (match uu____24473 with + (match uu____24514 with | (fuel_var,fuel_tm) -> let s_fuel_tm = FStar_SMTEncoding_Util.mkApp ("SFuel", [fuel_tm]) in - let uu____24487 = + let uu____24528 = encode_binders (FStar_Pervasives_Native.Some fuel_tm) formals env1 in - (match uu____24487 with + (match uu____24528 with | (vars,guards,env',binder_decls,names1) -> let fields = FStar_All.pipe_right names1 @@ -7453,18 +7460,18 @@ and encode_sigelt': (fun n1 -> fun x -> let projectible = true in - let uu____24557 = + let uu____24598 = mk_term_projector_name d x in - (uu____24557, + (uu____24598, FStar_SMTEncoding_Term.Term_sort, projectible))) in let datacons = - let uu____24559 = - let uu____24578 = varops.next_id () in + let uu____24600 = + let uu____24619 = varops.next_id () in (ddconstrsym, fields, FStar_SMTEncoding_Term.Term_sort, - uu____24578, true) in - FStar_All.pipe_right uu____24559 + uu____24619, true) in + FStar_All.pipe_right uu____24600 FStar_SMTEncoding_Term.constructor_to_decl in let app = mk_Apply ddtok_tm vars in let guard = @@ -7475,14 +7482,14 @@ and encode_sigelt': let dapp = FStar_SMTEncoding_Util.mkApp (ddconstrsym, xvars) in - let uu____24617 = + let uu____24658 = encode_term_pred FStar_Pervasives_Native.None t env1 ddtok_tm in - (match uu____24617 with + (match uu____24658 with | (tok_typing,decls3) -> let tok_typing1 = match fields with - | uu____24629::uu____24630 -> + | uu____24670::uu____24671 -> let ff = ("ty", FStar_SMTEncoding_Term.Term_sort) in @@ -7494,23 +7501,23 @@ and encode_sigelt': mk_Apply f [(ddtok, FStar_SMTEncoding_Term.Term_sort)] in - let uu____24675 = - let uu____24686 = + let uu____24716 = + let uu____24727 = FStar_SMTEncoding_Term.mk_NoHoist f tok_typing in ([[vtok_app_l]; [vtok_app_r]], - [ff], uu____24686) in + [ff], uu____24727) in FStar_SMTEncoding_Util.mkForall - uu____24675 - | uu____24711 -> tok_typing in - let uu____24720 = + uu____24716 + | uu____24752 -> tok_typing in + let uu____24761 = encode_binders (FStar_Pervasives_Native.Some fuel_tm) formals env1 in - (match uu____24720 with - | (vars',guards',env'',decls_formals,uu____24745) + (match uu____24761 with + | (vars',guards',env'',decls_formals,uu____24786) -> - let uu____24758 = + let uu____24799 = let xvars1 = FStar_List.map FStar_SMTEncoding_Util.mkFreeV @@ -7521,7 +7528,7 @@ and encode_sigelt': encode_term_pred (FStar_Pervasives_Native.Some fuel_tm) t_res env'' dapp1 in - (match uu____24758 with + (match uu____24799 with | (ty_pred',decls_pred) -> let guard' = FStar_SMTEncoding_Util.mk_and_l @@ -7529,27 +7536,27 @@ and encode_sigelt': let proxy_fresh = match formals with | [] -> [] - | uu____24789 -> - let uu____24796 = - let uu____24797 = + | uu____24830 -> + let uu____24837 = + let uu____24838 = varops.next_id () in FStar_SMTEncoding_Term.fresh_token (ddtok, FStar_SMTEncoding_Term.Term_sort) - uu____24797 in - [uu____24796] in - let encode_elim uu____24807 = - let uu____24808 = + uu____24838 in + [uu____24837] in + let encode_elim uu____24848 = + let uu____24849 = FStar_Syntax_Util.head_and_args t_res in - match uu____24808 with + match uu____24849 with | (head1,args) -> - let uu____24851 = - let uu____24852 = + let uu____24892 = + let uu____24893 = FStar_Syntax_Subst.compress head1 in - uu____24852.FStar_Syntax_Syntax.n in - (match uu____24851 with + uu____24893.FStar_Syntax_Syntax.n in + (match uu____24892 with | FStar_Syntax_Syntax.Tm_uinst ({ FStar_Syntax_Syntax.n @@ -7557,18 +7564,18 @@ and encode_sigelt': FStar_Syntax_Syntax.Tm_fvar fv; FStar_Syntax_Syntax.pos - = uu____24862; + = uu____24903; FStar_Syntax_Syntax.vars - = uu____24863;_},uu____24864) + = uu____24904;_},uu____24905) -> let encoded_head = lookup_free_var_name env' fv.FStar_Syntax_Syntax.fv_name in - let uu____24870 = + let uu____24911 = encode_args args env' in - (match uu____24870 + (match uu____24911 with | (encoded_args,arg_decls) -> @@ -7582,23 +7589,23 @@ and encode_sigelt': | FStar_SMTEncoding_Term.FreeV fv1 -> fv1 - | uu____24913 + | uu____24954 -> - let uu____24914 + let uu____24955 = - let uu____24919 + let uu____24960 = - let uu____24920 + let uu____24961 = FStar_Syntax_Print.term_to_string orig_arg in FStar_Util.format1 "Inductive type parameter %s must be a variable ; You may want to change it to an index." - uu____24920 in - (FStar_Errors.Fatal_NonVaribleInductiveTypeParameter, - uu____24919) in + uu____24961 in + (FStar_Errors.Fatal_NonVariableInductiveTypeParameter, + uu____24960) in FStar_Errors.raise_error - uu____24914 + uu____24955 orig_arg.FStar_Syntax_Syntax.pos in let guards1 = FStar_All.pipe_right @@ -7606,83 +7613,83 @@ and encode_sigelt': (FStar_List.collect (fun g -> - let uu____24936 + let uu____24977 = - let uu____24937 + let uu____24978 = FStar_SMTEncoding_Term.free_variables g in FStar_List.contains fv1 - uu____24937 in + uu____24978 in if - uu____24936 + uu____24977 then - let uu____24950 + let uu____24991 = FStar_SMTEncoding_Term.subst g fv1 xv in - [uu____24950] + [uu____24991] else [])) in FStar_SMTEncoding_Util.mk_and_l guards1 in - let uu____24952 + let uu____24993 = - let uu____24965 + let uu____25006 = FStar_List.zip args encoded_args in FStar_List.fold_left (fun - uu____25015 + uu____25056 -> fun - uu____25016 + uu____25057 -> match - (uu____25015, - uu____25016) + (uu____25056, + uu____25057) with | ((env2,arg_vars,eqns_or_guards,i), (orig_arg,arg)) -> - let uu____25111 + let uu____25152 = - let uu____25118 + let uu____25159 = FStar_Syntax_Syntax.new_bv FStar_Pervasives_Native.None FStar_Syntax_Syntax.tun in gen_term_var env2 - uu____25118 in - (match uu____25111 + uu____25159 in + (match uu____25152 with | - (uu____25131,xv,env3) + (uu____25172,xv,env3) -> let eqns = if i < n_tps then - let uu____25139 + let uu____25180 = guards_for_parameter (FStar_Pervasives_Native.fst orig_arg) arg xv in - uu____25139 + uu____25180 :: eqns_or_guards else - (let uu____25141 + (let uu____25182 = FStar_SMTEncoding_Util.mkEq (arg, xv) in - uu____25141 + uu____25182 :: eqns_or_guards) in (env3, @@ -7696,10 +7703,10 @@ and encode_sigelt': [], (Prims.parse_int "0")) - uu____24965 in - (match uu____24952 + uu____25006 in + (match uu____24993 with - | (uu____25156,arg_vars,elim_eqns_or_guards,uu____25159) + | (uu____25197,arg_vars,elim_eqns_or_guards,uu____25200) -> let arg_vars1 = @@ -7731,13 +7738,13 @@ and encode_sigelt': arg_vars1 in let typing_inversion = - let uu____25189 + let uu____25230 = - let uu____25196 + let uu____25237 = - let uu____25197 + let uu____25238 = - let uu____25208 + let uu____25249 = add_fuel (fuel_var, @@ -7745,34 +7752,34 @@ and encode_sigelt': (FStar_List.append vars arg_binders) in - let uu____25219 + let uu____25260 = - let uu____25220 + let uu____25261 = - let uu____25225 + let uu____25266 = FStar_SMTEncoding_Util.mk_and_l (FStar_List.append elim_eqns_or_guards guards) in (ty_pred, - uu____25225) in + uu____25266) in FStar_SMTEncoding_Util.mkImp - uu____25220 in + uu____25261 in ([ [ty_pred]], - uu____25208, - uu____25219) in + uu____25249, + uu____25260) in FStar_SMTEncoding_Util.mkForall - uu____25197 in - (uu____25196, + uu____25238 in + (uu____25237, (FStar_Pervasives_Native.Some "data constructor typing elim"), (Prims.strcat "data_elim_" ddconstrsym)) in FStar_SMTEncoding_Util.mkAssume - uu____25189 in + uu____25230 in let subterm_ordering = if @@ -7781,67 +7788,67 @@ and encode_sigelt': FStar_Parser_Const.lextop_lid then let x = - let uu____25248 + let uu____25289 = varops.fresh "x" in - (uu____25248, + (uu____25289, FStar_SMTEncoding_Term.Term_sort) in let xtm = FStar_SMTEncoding_Util.mkFreeV x in - let uu____25250 + let uu____25291 = - let uu____25257 + let uu____25298 = - let uu____25258 + let uu____25299 = - let uu____25269 + let uu____25310 = - let uu____25274 + let uu____25315 = - let uu____25277 + let uu____25318 = FStar_SMTEncoding_Util.mk_Precedes xtm dapp1 in - [uu____25277] in - [uu____25274] in - let uu____25282 + [uu____25318] in + [uu____25315] in + let uu____25323 = - let uu____25283 + let uu____25324 = - let uu____25288 + let uu____25329 = FStar_SMTEncoding_Term.mk_tester "LexCons" xtm in - let uu____25289 + let uu____25330 = FStar_SMTEncoding_Util.mk_Precedes xtm dapp1 in - (uu____25288, - uu____25289) in + (uu____25329, + uu____25330) in FStar_SMTEncoding_Util.mkImp - uu____25283 in - (uu____25269, + uu____25324 in + (uu____25310, [x], - uu____25282) in + uu____25323) in FStar_SMTEncoding_Util.mkForall - uu____25258 in - let uu____25308 + uu____25299 in + let uu____25349 = varops.mk_unique "lextop" in - (uu____25257, + (uu____25298, (FStar_Pervasives_Native.Some "lextop is top"), - uu____25308) in + uu____25349) in FStar_SMTEncoding_Util.mkAssume - uu____25250 + uu____25291 else (let prec = - let uu____25315 + let uu____25356 = FStar_All.pipe_right vars @@ -7854,26 +7861,26 @@ and encode_sigelt': i < n_tps then [] else - (let uu____25343 + (let uu____25384 = - let uu____25344 + let uu____25385 = FStar_SMTEncoding_Util.mkFreeV v1 in FStar_SMTEncoding_Util.mk_Precedes - uu____25344 + uu____25385 dapp1 in - [uu____25343]))) in + [uu____25384]))) in FStar_All.pipe_right - uu____25315 + uu____25356 FStar_List.flatten in - let uu____25351 + let uu____25392 = - let uu____25358 + let uu____25399 = - let uu____25359 + let uu____25400 = - let uu____25370 + let uu____25411 = add_fuel (fuel_var, @@ -7881,32 +7888,32 @@ and encode_sigelt': (FStar_List.append vars arg_binders) in - let uu____25381 + let uu____25422 = - let uu____25382 + let uu____25423 = - let uu____25387 + let uu____25428 = FStar_SMTEncoding_Util.mk_and_l prec in (ty_pred, - uu____25387) in + uu____25428) in FStar_SMTEncoding_Util.mkImp - uu____25382 in + uu____25423 in ([ [ty_pred]], - uu____25370, - uu____25381) in + uu____25411, + uu____25422) in FStar_SMTEncoding_Util.mkForall - uu____25359 in - (uu____25358, + uu____25400 in + (uu____25399, (FStar_Pervasives_Native.Some "subterm ordering"), (Prims.strcat "subterm_ordering_" ddconstrsym)) in FStar_SMTEncoding_Util.mkAssume - uu____25351) in + uu____25392) in (arg_decls, [typing_inversion; subterm_ordering]))) @@ -7916,10 +7923,10 @@ and encode_sigelt': lookup_free_var_name env' fv.FStar_Syntax_Syntax.fv_name in - let uu____25408 = + let uu____25449 = encode_args args env' in - (match uu____25408 + (match uu____25449 with | (encoded_args,arg_decls) -> @@ -7933,23 +7940,23 @@ and encode_sigelt': | FStar_SMTEncoding_Term.FreeV fv1 -> fv1 - | uu____25451 + | uu____25492 -> - let uu____25452 + let uu____25493 = - let uu____25457 + let uu____25498 = - let uu____25458 + let uu____25499 = FStar_Syntax_Print.term_to_string orig_arg in FStar_Util.format1 "Inductive type parameter %s must be a variable ; You may want to change it to an index." - uu____25458 in - (FStar_Errors.Fatal_NonVaribleInductiveTypeParameter, - uu____25457) in + uu____25499 in + (FStar_Errors.Fatal_NonVariableInductiveTypeParameter, + uu____25498) in FStar_Errors.raise_error - uu____25452 + uu____25493 orig_arg.FStar_Syntax_Syntax.pos in let guards1 = FStar_All.pipe_right @@ -7957,83 +7964,83 @@ and encode_sigelt': (FStar_List.collect (fun g -> - let uu____25474 + let uu____25515 = - let uu____25475 + let uu____25516 = FStar_SMTEncoding_Term.free_variables g in FStar_List.contains fv1 - uu____25475 in + uu____25516 in if - uu____25474 + uu____25515 then - let uu____25488 + let uu____25529 = FStar_SMTEncoding_Term.subst g fv1 xv in - [uu____25488] + [uu____25529] else [])) in FStar_SMTEncoding_Util.mk_and_l guards1 in - let uu____25490 + let uu____25531 = - let uu____25503 + let uu____25544 = FStar_List.zip args encoded_args in FStar_List.fold_left (fun - uu____25553 + uu____25594 -> fun - uu____25554 + uu____25595 -> match - (uu____25553, - uu____25554) + (uu____25594, + uu____25595) with | ((env2,arg_vars,eqns_or_guards,i), (orig_arg,arg)) -> - let uu____25649 + let uu____25690 = - let uu____25656 + let uu____25697 = FStar_Syntax_Syntax.new_bv FStar_Pervasives_Native.None FStar_Syntax_Syntax.tun in gen_term_var env2 - uu____25656 in - (match uu____25649 + uu____25697 in + (match uu____25690 with | - (uu____25669,xv,env3) + (uu____25710,xv,env3) -> let eqns = if i < n_tps then - let uu____25677 + let uu____25718 = guards_for_parameter (FStar_Pervasives_Native.fst orig_arg) arg xv in - uu____25677 + uu____25718 :: eqns_or_guards else - (let uu____25679 + (let uu____25720 = FStar_SMTEncoding_Util.mkEq (arg, xv) in - uu____25679 + uu____25720 :: eqns_or_guards) in (env3, @@ -8047,10 +8054,10 @@ and encode_sigelt': [], (Prims.parse_int "0")) - uu____25503 in - (match uu____25490 + uu____25544 in + (match uu____25531 with - | (uu____25694,arg_vars,elim_eqns_or_guards,uu____25697) + | (uu____25735,arg_vars,elim_eqns_or_guards,uu____25738) -> let arg_vars1 = @@ -8082,13 +8089,13 @@ and encode_sigelt': arg_vars1 in let typing_inversion = - let uu____25727 + let uu____25768 = - let uu____25734 + let uu____25775 = - let uu____25735 + let uu____25776 = - let uu____25746 + let uu____25787 = add_fuel (fuel_var, @@ -8096,34 +8103,34 @@ and encode_sigelt': (FStar_List.append vars arg_binders) in - let uu____25757 + let uu____25798 = - let uu____25758 + let uu____25799 = - let uu____25763 + let uu____25804 = FStar_SMTEncoding_Util.mk_and_l (FStar_List.append elim_eqns_or_guards guards) in (ty_pred, - uu____25763) in + uu____25804) in FStar_SMTEncoding_Util.mkImp - uu____25758 in + uu____25799 in ([ [ty_pred]], - uu____25746, - uu____25757) in + uu____25787, + uu____25798) in FStar_SMTEncoding_Util.mkForall - uu____25735 in - (uu____25734, + uu____25776 in + (uu____25775, (FStar_Pervasives_Native.Some "data constructor typing elim"), (Prims.strcat "data_elim_" ddconstrsym)) in FStar_SMTEncoding_Util.mkAssume - uu____25727 in + uu____25768 in let subterm_ordering = if @@ -8132,67 +8139,67 @@ and encode_sigelt': FStar_Parser_Const.lextop_lid then let x = - let uu____25786 + let uu____25827 = varops.fresh "x" in - (uu____25786, + (uu____25827, FStar_SMTEncoding_Term.Term_sort) in let xtm = FStar_SMTEncoding_Util.mkFreeV x in - let uu____25788 + let uu____25829 = - let uu____25795 + let uu____25836 = - let uu____25796 + let uu____25837 = - let uu____25807 + let uu____25848 = - let uu____25812 + let uu____25853 = - let uu____25815 + let uu____25856 = FStar_SMTEncoding_Util.mk_Precedes xtm dapp1 in - [uu____25815] in - [uu____25812] in - let uu____25820 + [uu____25856] in + [uu____25853] in + let uu____25861 = - let uu____25821 + let uu____25862 = - let uu____25826 + let uu____25867 = FStar_SMTEncoding_Term.mk_tester "LexCons" xtm in - let uu____25827 + let uu____25868 = FStar_SMTEncoding_Util.mk_Precedes xtm dapp1 in - (uu____25826, - uu____25827) in + (uu____25867, + uu____25868) in FStar_SMTEncoding_Util.mkImp - uu____25821 in - (uu____25807, + uu____25862 in + (uu____25848, [x], - uu____25820) in + uu____25861) in FStar_SMTEncoding_Util.mkForall - uu____25796 in - let uu____25846 + uu____25837 in + let uu____25887 = varops.mk_unique "lextop" in - (uu____25795, + (uu____25836, (FStar_Pervasives_Native.Some "lextop is top"), - uu____25846) in + uu____25887) in FStar_SMTEncoding_Util.mkAssume - uu____25788 + uu____25829 else (let prec = - let uu____25853 + let uu____25894 = FStar_All.pipe_right vars @@ -8205,26 +8212,26 @@ and encode_sigelt': i < n_tps then [] else - (let uu____25881 + (let uu____25922 = - let uu____25882 + let uu____25923 = FStar_SMTEncoding_Util.mkFreeV v1 in FStar_SMTEncoding_Util.mk_Precedes - uu____25882 + uu____25923 dapp1 in - [uu____25881]))) in + [uu____25922]))) in FStar_All.pipe_right - uu____25853 + uu____25894 FStar_List.flatten in - let uu____25889 + let uu____25930 = - let uu____25896 + let uu____25937 = - let uu____25897 + let uu____25938 = - let uu____25908 + let uu____25949 = add_fuel (fuel_var, @@ -8232,161 +8239,161 @@ and encode_sigelt': (FStar_List.append vars arg_binders) in - let uu____25919 + let uu____25960 = - let uu____25920 + let uu____25961 = - let uu____25925 + let uu____25966 = FStar_SMTEncoding_Util.mk_and_l prec in (ty_pred, - uu____25925) in + uu____25966) in FStar_SMTEncoding_Util.mkImp - uu____25920 in + uu____25961 in ([ [ty_pred]], - uu____25908, - uu____25919) in + uu____25949, + uu____25960) in FStar_SMTEncoding_Util.mkForall - uu____25897 in - (uu____25896, + uu____25938 in + (uu____25937, (FStar_Pervasives_Native.Some "subterm ordering"), (Prims.strcat "subterm_ordering_" ddconstrsym)) in FStar_SMTEncoding_Util.mkAssume - uu____25889) in + uu____25930) in (arg_decls, [typing_inversion; subterm_ordering]))) - | uu____25944 -> - ((let uu____25946 = - let uu____25951 = - let uu____25952 + | uu____25985 -> + ((let uu____25987 = + let uu____25992 = + let uu____25993 = FStar_Syntax_Print.lid_to_string d in - let uu____25953 + let uu____25994 = FStar_Syntax_Print.term_to_string head1 in FStar_Util.format2 "Constructor %s builds an unexpected type %s\n" - uu____25952 - uu____25953 in + uu____25993 + uu____25994 in (FStar_Errors.Warning_ConstructorBuildsUnexpectedType, - uu____25951) in + uu____25992) in FStar_Errors.log_issue se.FStar_Syntax_Syntax.sigrng - uu____25946); + uu____25987); ([], []))) in - let uu____25958 = encode_elim () in - (match uu____25958 with + let uu____25999 = encode_elim () in + (match uu____25999 with | (decls2,elim) -> let g = - let uu____25978 = - let uu____25981 = - let uu____25984 = - let uu____25987 = - let uu____25990 = - let uu____25991 + let uu____26019 = + let uu____26022 = + let uu____26025 = + let uu____26028 = + let uu____26031 = + let uu____26032 = - let uu____26002 + let uu____26043 = - let uu____26005 + let uu____26046 = - let uu____26006 + let uu____26047 = FStar_Syntax_Print.lid_to_string d in FStar_Util.format1 "data constructor proxy: %s" - uu____26006 in + uu____26047 in FStar_Pervasives_Native.Some - uu____26005 in + uu____26046 in (ddtok, [], FStar_SMTEncoding_Term.Term_sort, - uu____26002) in + uu____26043) in FStar_SMTEncoding_Term.DeclFun - uu____25991 in - [uu____25990] in - let uu____26011 = - let uu____26014 = - let uu____26017 + uu____26032 in + [uu____26031] in + let uu____26052 = + let uu____26055 = + let uu____26058 = - let uu____26020 + let uu____26061 = - let uu____26023 + let uu____26064 = - let uu____26026 + let uu____26067 = - let uu____26029 + let uu____26070 = - let uu____26030 + let uu____26071 = - let uu____26037 + let uu____26078 = - let uu____26038 + let uu____26079 = - let uu____26049 + let uu____26090 = FStar_SMTEncoding_Util.mkEq (app, dapp) in ([[app]], vars, - uu____26049) in + uu____26090) in FStar_SMTEncoding_Util.mkForall - uu____26038 in - (uu____26037, + uu____26079 in + (uu____26078, (FStar_Pervasives_Native.Some "equality for proxy"), (Prims.strcat "equality_tok_" ddtok)) in FStar_SMTEncoding_Util.mkAssume - uu____26030 in - let uu____26062 + uu____26071 in + let uu____26103 = - let uu____26065 + let uu____26106 = - let uu____26066 + let uu____26107 = - let uu____26073 + let uu____26114 = - let uu____26074 + let uu____26115 = - let uu____26085 + let uu____26126 = add_fuel (fuel_var, FStar_SMTEncoding_Term.Fuel_sort) vars' in - let uu____26096 + let uu____26137 = FStar_SMTEncoding_Util.mkImp (guard', ty_pred') in ([ [ty_pred']], - uu____26085, - uu____26096) in + uu____26126, + uu____26137) in FStar_SMTEncoding_Util.mkForall - uu____26074 in - (uu____26073, + uu____26115 in + (uu____26114, (FStar_Pervasives_Native.Some "data constructor typing intro"), (Prims.strcat "data_typing_intro_" ddtok)) in FStar_SMTEncoding_Util.mkAssume - uu____26066 in - [uu____26065] in - uu____26029 + uu____26107 in + [uu____26106] in + uu____26070 :: - uu____26062 in + uu____26103 in (FStar_SMTEncoding_Util.mkAssume (tok_typing1, (FStar_Pervasives_Native.Some @@ -8395,29 +8402,29 @@ and encode_sigelt': "typing_tok_" ddtok))) :: - uu____26026 in + uu____26067 in FStar_List.append - uu____26023 + uu____26064 elim in FStar_List.append decls_pred - uu____26020 in + uu____26061 in FStar_List.append decls_formals - uu____26017 in + uu____26058 in FStar_List.append proxy_fresh - uu____26014 in + uu____26055 in FStar_List.append - uu____25987 - uu____26011 in + uu____26028 + uu____26052 in FStar_List.append - decls3 uu____25984 in + decls3 uu____26025 in FStar_List.append - decls2 uu____25981 in + decls2 uu____26022 in FStar_List.append binder_decls - uu____25978 in + uu____26019 in ((FStar_List.append datacons g), env1))))))))) and encode_sigelts: @@ -8430,12 +8437,12 @@ and encode_sigelts: fun ses -> FStar_All.pipe_right ses (FStar_List.fold_left - (fun uu____26142 -> + (fun uu____26183 -> fun se -> - match uu____26142 with + match uu____26183 with | (g,env1) -> - let uu____26162 = encode_sigelt env1 se in - (match uu____26162 with + let uu____26203 = encode_sigelt env1 se in + (match uu____26203 with | (g',env2) -> ((FStar_List.append g g'), env2))) ([], env)) let encode_env_bindings: @@ -8445,11 +8452,11 @@ let encode_env_bindings: = fun env -> fun bindings -> - let encode_binding b uu____26219 = - match uu____26219 with + let encode_binding b uu____26260 = + match uu____26260 with | (i,decls,env1) -> (match b with - | FStar_TypeChecker_Env.Binding_univ uu____26251 -> + | FStar_TypeChecker_Env.Binding_univ uu____26292 -> ((i + (Prims.parse_int "1")), [], env1) | FStar_TypeChecker_Env.Binding_var x -> let t1 = @@ -8460,53 +8467,53 @@ let encode_env_bindings: FStar_TypeChecker_Normalize.Primops; FStar_TypeChecker_Normalize.EraseUniverses] env1.tcenv x.FStar_Syntax_Syntax.sort in - ((let uu____26257 = + ((let uu____26298 = FStar_All.pipe_left (FStar_TypeChecker_Env.debug env1.tcenv) (FStar_Options.Other "SMTEncoding") in - if uu____26257 + if uu____26298 then - let uu____26258 = FStar_Syntax_Print.bv_to_string x in - let uu____26259 = + let uu____26299 = FStar_Syntax_Print.bv_to_string x in + let uu____26300 = FStar_Syntax_Print.term_to_string x.FStar_Syntax_Syntax.sort in - let uu____26260 = FStar_Syntax_Print.term_to_string t1 in + let uu____26301 = FStar_Syntax_Print.term_to_string t1 in FStar_Util.print3 "Normalized %s : %s to %s\n" - uu____26258 uu____26259 uu____26260 + uu____26299 uu____26300 uu____26301 else ()); - (let uu____26262 = encode_term t1 env1 in - match uu____26262 with + (let uu____26303 = encode_term t1 env1 in + match uu____26303 with | (t,decls') -> let t_hash = FStar_SMTEncoding_Term.hash_of_term t in - let uu____26278 = - let uu____26285 = - let uu____26286 = - let uu____26287 = + let uu____26319 = + let uu____26326 = + let uu____26327 = + let uu____26328 = FStar_Util.digest_of_string t_hash in - Prims.strcat uu____26287 + Prims.strcat uu____26328 (Prims.strcat "_" (Prims.string_of_int i)) in - Prims.strcat "x_" uu____26286 in - new_term_constant_from_string env1 x uu____26285 in - (match uu____26278 with + Prims.strcat "x_" uu____26327 in + new_term_constant_from_string env1 x uu____26326 in + (match uu____26319 with | (xxsym,xx,env') -> let t2 = FStar_SMTEncoding_Term.mk_HasTypeWithFuel FStar_Pervasives_Native.None xx t in let caption = - let uu____26303 = FStar_Options.log_queries () in - if uu____26303 + let uu____26344 = FStar_Options.log_queries () in + if uu____26344 then - let uu____26306 = - let uu____26307 = + let uu____26347 = + let uu____26348 = FStar_Syntax_Print.bv_to_string x in - let uu____26308 = + let uu____26349 = FStar_Syntax_Print.term_to_string x.FStar_Syntax_Syntax.sort in - let uu____26309 = + let uu____26350 = FStar_Syntax_Print.term_to_string t1 in FStar_Util.format3 "%s : %s (%s)" - uu____26307 uu____26308 uu____26309 in - FStar_Pervasives_Native.Some uu____26306 + uu____26348 uu____26349 uu____26350 in + FStar_Pervasives_Native.Some uu____26347 else FStar_Pervasives_Native.None in let ax = let a_name = Prims.strcat "binder_" xxsym in @@ -8522,38 +8529,38 @@ let encode_env_bindings: (FStar_List.append decls' [ax]) in ((i + (Prims.parse_int "1")), (FStar_List.append decls g), env')))) - | FStar_TypeChecker_Env.Binding_lid (x,(uu____26325,t)) -> + | FStar_TypeChecker_Env.Binding_lid (x,(uu____26366,t)) -> let t_norm = whnf env1 t in let fv = FStar_Syntax_Syntax.lid_as_fv x FStar_Syntax_Syntax.Delta_constant FStar_Pervasives_Native.None in - let uu____26339 = encode_free_var false env1 fv t t_norm [] in - (match uu____26339 with + let uu____26380 = encode_free_var false env1 fv t t_norm [] in + (match uu____26380 with | (g,env') -> ((i + (Prims.parse_int "1")), (FStar_List.append decls g), env')) | FStar_TypeChecker_Env.Binding_sig_inst - (uu____26362,se,uu____26364) -> - let uu____26369 = encode_sigelt env1 se in - (match uu____26369 with + (uu____26403,se,uu____26405) -> + let uu____26410 = encode_sigelt env1 se in + (match uu____26410 with | (g,env') -> ((i + (Prims.parse_int "1")), (FStar_List.append decls g), env')) - | FStar_TypeChecker_Env.Binding_sig (uu____26386,se) -> - let uu____26392 = encode_sigelt env1 se in - (match uu____26392 with + | FStar_TypeChecker_Env.Binding_sig (uu____26427,se) -> + let uu____26433 = encode_sigelt env1 se in + (match uu____26433 with | (g,env') -> ((i + (Prims.parse_int "1")), (FStar_List.append decls g), env'))) in - let uu____26409 = + let uu____26450 = FStar_List.fold_right encode_binding bindings ((Prims.parse_int "0"), [], env) in - match uu____26409 with | (uu____26432,decls,env1) -> (decls, env1) + match uu____26450 with | (uu____26473,decls,env1) -> (decls, env1) let encode_labels: - 'Auu____26444 'Auu____26445 . + 'Auu____26485 'Auu____26486 . ((Prims.string,FStar_SMTEncoding_Term.sort) - FStar_Pervasives_Native.tuple2,'Auu____26445,'Auu____26444) + FStar_Pervasives_Native.tuple2,'Auu____26486,'Auu____26485) FStar_Pervasives_Native.tuple3 Prims.list -> (FStar_SMTEncoding_Term.decl Prims.list,FStar_SMTEncoding_Term.decl Prims.list) @@ -8563,9 +8570,9 @@ let encode_labels: let prefix1 = FStar_All.pipe_right labs (FStar_List.map - (fun uu____26513 -> - match uu____26513 with - | (l,uu____26525,uu____26526) -> + (fun uu____26554 -> + match uu____26554 with + | (l,uu____26566,uu____26567) -> FStar_SMTEncoding_Term.DeclFun ((FStar_Pervasives_Native.fst l), [], FStar_SMTEncoding_Term.Bool_sort, @@ -8573,97 +8580,97 @@ let encode_labels: let suffix = FStar_All.pipe_right labs (FStar_List.collect - (fun uu____26572 -> - match uu____26572 with - | (l,uu____26586,uu____26587) -> - let uu____26596 = + (fun uu____26613 -> + match uu____26613 with + | (l,uu____26627,uu____26628) -> + let uu____26637 = FStar_All.pipe_left (fun _0_45 -> FStar_SMTEncoding_Term.Echo _0_45) (FStar_Pervasives_Native.fst l) in - let uu____26597 = - let uu____26600 = - let uu____26601 = FStar_SMTEncoding_Util.mkFreeV l in - FStar_SMTEncoding_Term.Eval uu____26601 in - [uu____26600] in - uu____26596 :: uu____26597)) in + let uu____26638 = + let uu____26641 = + let uu____26642 = FStar_SMTEncoding_Util.mkFreeV l in + FStar_SMTEncoding_Term.Eval uu____26642 in + [uu____26641] in + uu____26637 :: uu____26638)) in (prefix1, suffix) let last_env: env_t Prims.list FStar_ST.ref = FStar_Util.mk_ref [] let init_env: FStar_TypeChecker_Env.env -> Prims.unit = fun tcenv -> - let uu____26626 = - let uu____26629 = - let uu____26630 = FStar_Util.smap_create (Prims.parse_int "100") in - let uu____26633 = - let uu____26634 = FStar_TypeChecker_Env.current_module tcenv in - FStar_All.pipe_right uu____26634 FStar_Ident.string_of_lid in + let uu____26667 = + let uu____26670 = + let uu____26671 = FStar_Util.smap_create (Prims.parse_int "100") in + let uu____26674 = + let uu____26675 = FStar_TypeChecker_Env.current_module tcenv in + FStar_All.pipe_right uu____26675 FStar_Ident.string_of_lid in { bindings = []; depth = (Prims.parse_int "0"); tcenv; warn = true; - cache = uu____26630; + cache = uu____26671; nolabels = false; use_zfuel_name = false; encode_non_total_function_typ = true; - current_module_name = uu____26633 + current_module_name = uu____26674 } in - [uu____26629] in - FStar_ST.op_Colon_Equals last_env uu____26626 + [uu____26670] in + FStar_ST.op_Colon_Equals last_env uu____26667 let get_env: FStar_Ident.lident -> FStar_TypeChecker_Env.env -> env_t = fun cmn -> fun tcenv -> - let uu____26693 = FStar_ST.op_Bang last_env in - match uu____26693 with + let uu____26734 = FStar_ST.op_Bang last_env in + match uu____26734 with | [] -> failwith "No env; call init first!" - | e::uu____26749 -> - let uu___129_26752 = e in - let uu____26753 = FStar_Ident.string_of_lid cmn in + | e::uu____26790 -> + let uu___129_26793 = e in + let uu____26794 = FStar_Ident.string_of_lid cmn in { - bindings = (uu___129_26752.bindings); - depth = (uu___129_26752.depth); + bindings = (uu___129_26793.bindings); + depth = (uu___129_26793.depth); tcenv; - warn = (uu___129_26752.warn); - cache = (uu___129_26752.cache); - nolabels = (uu___129_26752.nolabels); - use_zfuel_name = (uu___129_26752.use_zfuel_name); + warn = (uu___129_26793.warn); + cache = (uu___129_26793.cache); + nolabels = (uu___129_26793.nolabels); + use_zfuel_name = (uu___129_26793.use_zfuel_name); encode_non_total_function_typ = - (uu___129_26752.encode_non_total_function_typ); - current_module_name = uu____26753 + (uu___129_26793.encode_non_total_function_typ); + current_module_name = uu____26794 } let set_env: env_t -> Prims.unit = fun env -> - let uu____26757 = FStar_ST.op_Bang last_env in - match uu____26757 with + let uu____26798 = FStar_ST.op_Bang last_env in + match uu____26798 with | [] -> failwith "Empty env stack" - | uu____26812::tl1 -> FStar_ST.op_Colon_Equals last_env (env :: tl1) + | uu____26853::tl1 -> FStar_ST.op_Colon_Equals last_env (env :: tl1) let push_env: Prims.unit -> Prims.unit = - fun uu____26870 -> - let uu____26871 = FStar_ST.op_Bang last_env in - match uu____26871 with + fun uu____26911 -> + let uu____26912 = FStar_ST.op_Bang last_env in + match uu____26912 with | [] -> failwith "Empty env stack" | hd1::tl1 -> let refs = FStar_Util.smap_copy hd1.cache in let top = - let uu___130_26934 = hd1 in + let uu___130_26975 = hd1 in { - bindings = (uu___130_26934.bindings); - depth = (uu___130_26934.depth); - tcenv = (uu___130_26934.tcenv); - warn = (uu___130_26934.warn); + bindings = (uu___130_26975.bindings); + depth = (uu___130_26975.depth); + tcenv = (uu___130_26975.tcenv); + warn = (uu___130_26975.warn); cache = refs; - nolabels = (uu___130_26934.nolabels); - use_zfuel_name = (uu___130_26934.use_zfuel_name); + nolabels = (uu___130_26975.nolabels); + use_zfuel_name = (uu___130_26975.use_zfuel_name); encode_non_total_function_typ = - (uu___130_26934.encode_non_total_function_typ); - current_module_name = (uu___130_26934.current_module_name) + (uu___130_26975.encode_non_total_function_typ); + current_module_name = (uu___130_26975.current_module_name) } in FStar_ST.op_Colon_Equals last_env (top :: hd1 :: tl1) let pop_env: Prims.unit -> Prims.unit = - fun uu____26989 -> - let uu____26990 = FStar_ST.op_Bang last_env in - match uu____26990 with + fun uu____27030 -> + let uu____27031 = FStar_ST.op_Bang last_env in + match uu____27031 with | [] -> failwith "Popping an empty stack" - | uu____27045::tl1 -> FStar_ST.op_Colon_Equals last_env tl1 + | uu____27086::tl1 -> FStar_ST.op_Colon_Equals last_env tl1 let init: FStar_TypeChecker_Env.env -> Prims.unit = fun tcenv -> init_env tcenv; @@ -8684,29 +8691,29 @@ let place_decl_in_fact_dbs: fun fact_db_ids -> fun d -> match (fact_db_ids, d) with - | (uu____27138::uu____27139,FStar_SMTEncoding_Term.Assume a) -> + | (uu____27179::uu____27180,FStar_SMTEncoding_Term.Assume a) -> FStar_SMTEncoding_Term.Assume - (let uu___131_27147 = a in + (let uu___131_27188 = a in { FStar_SMTEncoding_Term.assumption_term = - (uu___131_27147.FStar_SMTEncoding_Term.assumption_term); + (uu___131_27188.FStar_SMTEncoding_Term.assumption_term); FStar_SMTEncoding_Term.assumption_caption = - (uu___131_27147.FStar_SMTEncoding_Term.assumption_caption); + (uu___131_27188.FStar_SMTEncoding_Term.assumption_caption); FStar_SMTEncoding_Term.assumption_name = - (uu___131_27147.FStar_SMTEncoding_Term.assumption_name); + (uu___131_27188.FStar_SMTEncoding_Term.assumption_name); FStar_SMTEncoding_Term.assumption_fact_ids = fact_db_ids }) - | uu____27148 -> d + | uu____27189 -> d let fact_dbs_for_lid: env_t -> FStar_Ident.lid -> FStar_SMTEncoding_Term.fact_db_id Prims.list = fun env -> fun lid -> - let uu____27163 = - let uu____27166 = - let uu____27167 = FStar_Ident.lid_of_ids lid.FStar_Ident.ns in - FStar_SMTEncoding_Term.Namespace uu____27167 in - let uu____27168 = open_fact_db_tags env in uu____27166 :: uu____27168 in - (FStar_SMTEncoding_Term.Name lid) :: uu____27163 + let uu____27204 = + let uu____27207 = + let uu____27208 = FStar_Ident.lid_of_ids lid.FStar_Ident.ns in + FStar_SMTEncoding_Term.Namespace uu____27208 in + let uu____27209 = open_fact_db_tags env in uu____27207 :: uu____27209 in + (FStar_SMTEncoding_Term.Name lid) :: uu____27204 let encode_top_level_facts: env_t -> FStar_Syntax_Syntax.sigelt -> @@ -8718,8 +8725,8 @@ let encode_top_level_facts: let fact_db_ids = FStar_All.pipe_right (FStar_Syntax_Util.lids_of_sigelt se) (FStar_List.collect (fact_dbs_for_lid env)) in - let uu____27190 = encode_sigelt env se in - match uu____27190 with + let uu____27231 = encode_sigelt env se in + match uu____27231 with | (g,env1) -> let g1 = FStar_All.pipe_right g @@ -8730,35 +8737,35 @@ let encode_sig: fun tcenv -> fun se -> let caption decls = - let uu____27226 = FStar_Options.log_queries () in - if uu____27226 + let uu____27267 = FStar_Options.log_queries () in + if uu____27267 then - let uu____27229 = - let uu____27230 = - let uu____27231 = - let uu____27232 = + let uu____27270 = + let uu____27271 = + let uu____27272 = + let uu____27273 = FStar_All.pipe_right (FStar_Syntax_Util.lids_of_sigelt se) (FStar_List.map FStar_Syntax_Print.lid_to_string) in - FStar_All.pipe_right uu____27232 (FStar_String.concat ", ") in - Prims.strcat "encoding sigelt " uu____27231 in - FStar_SMTEncoding_Term.Caption uu____27230 in - uu____27229 :: decls + FStar_All.pipe_right uu____27273 (FStar_String.concat ", ") in + Prims.strcat "encoding sigelt " uu____27272 in + FStar_SMTEncoding_Term.Caption uu____27271 in + uu____27270 :: decls else decls in - (let uu____27243 = FStar_TypeChecker_Env.debug tcenv FStar_Options.Low in - if uu____27243 + (let uu____27284 = FStar_TypeChecker_Env.debug tcenv FStar_Options.Low in + if uu____27284 then - let uu____27244 = FStar_Syntax_Print.sigelt_to_string se in - FStar_Util.print1 "+++++++++++Encoding sigelt %s\n" uu____27244 + let uu____27285 = FStar_Syntax_Print.sigelt_to_string se in + FStar_Util.print1 "+++++++++++Encoding sigelt %s\n" uu____27285 else ()); (let env = - let uu____27247 = FStar_TypeChecker_Env.current_module tcenv in - get_env uu____27247 tcenv in - let uu____27248 = encode_top_level_facts env se in - match uu____27248 with + let uu____27288 = FStar_TypeChecker_Env.current_module tcenv in + get_env uu____27288 tcenv in + let uu____27289 = encode_top_level_facts env se in + match uu____27289 with | (decls,env1) -> (set_env env1; - (let uu____27262 = caption decls in - FStar_SMTEncoding_Z3.giveZ3 uu____27262))) + (let uu____27303 = caption decls in + FStar_SMTEncoding_Z3.giveZ3 uu____27303))) let encode_modul: FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.modul -> Prims.unit = fun tcenv -> @@ -8768,49 +8775,49 @@ let encode_modul: (if modul.FStar_Syntax_Syntax.is_interface then "interface" else "module") (modul.FStar_Syntax_Syntax.name).FStar_Ident.str in - (let uu____27274 = FStar_TypeChecker_Env.debug tcenv FStar_Options.Low in - if uu____27274 + (let uu____27315 = FStar_TypeChecker_Env.debug tcenv FStar_Options.Low in + if uu____27315 then - let uu____27275 = + let uu____27316 = FStar_All.pipe_right (FStar_List.length modul.FStar_Syntax_Syntax.exports) Prims.string_of_int in FStar_Util.print2 "+++++++++++Encoding externals for %s ... %s exports\n" name - uu____27275 + uu____27316 else ()); (let env = get_env modul.FStar_Syntax_Syntax.name tcenv in let encode_signature env1 ses = FStar_All.pipe_right ses (FStar_List.fold_left - (fun uu____27310 -> + (fun uu____27351 -> fun se -> - match uu____27310 with + match uu____27351 with | (g,env2) -> - let uu____27330 = encode_top_level_facts env2 se in - (match uu____27330 with + let uu____27371 = encode_top_level_facts env2 se in + (match uu____27371 with | (g',env3) -> ((FStar_List.append g g'), env3))) ([], env1)) in - let uu____27353 = + let uu____27394 = encode_signature - (let uu___132_27362 = env in + (let uu___132_27403 = env in { - bindings = (uu___132_27362.bindings); - depth = (uu___132_27362.depth); - tcenv = (uu___132_27362.tcenv); + bindings = (uu___132_27403.bindings); + depth = (uu___132_27403.depth); + tcenv = (uu___132_27403.tcenv); warn = false; - cache = (uu___132_27362.cache); - nolabels = (uu___132_27362.nolabels); - use_zfuel_name = (uu___132_27362.use_zfuel_name); + cache = (uu___132_27403.cache); + nolabels = (uu___132_27403.nolabels); + use_zfuel_name = (uu___132_27403.use_zfuel_name); encode_non_total_function_typ = - (uu___132_27362.encode_non_total_function_typ); - current_module_name = (uu___132_27362.current_module_name) + (uu___132_27403.encode_non_total_function_typ); + current_module_name = (uu___132_27403.current_module_name) }) modul.FStar_Syntax_Syntax.exports in - match uu____27353 with + match uu____27394 with | (decls,env1) -> let caption decls1 = - let uu____27379 = FStar_Options.log_queries () in - if uu____27379 + let uu____27420 = FStar_Options.log_queries () in + if uu____27420 then let msg = Prims.strcat "Externals for " name in FStar_List.append ((FStar_SMTEncoding_Term.Caption msg) :: @@ -8818,22 +8825,22 @@ let encode_modul: [FStar_SMTEncoding_Term.Caption (Prims.strcat "End " msg)] else decls1 in (set_env - (let uu___133_27387 = env1 in + (let uu___133_27428 = env1 in { - bindings = (uu___133_27387.bindings); - depth = (uu___133_27387.depth); - tcenv = (uu___133_27387.tcenv); + bindings = (uu___133_27428.bindings); + depth = (uu___133_27428.depth); + tcenv = (uu___133_27428.tcenv); warn = true; - cache = (uu___133_27387.cache); - nolabels = (uu___133_27387.nolabels); - use_zfuel_name = (uu___133_27387.use_zfuel_name); + cache = (uu___133_27428.cache); + nolabels = (uu___133_27428.nolabels); + use_zfuel_name = (uu___133_27428.use_zfuel_name); encode_non_total_function_typ = - (uu___133_27387.encode_non_total_function_typ); - current_module_name = (uu___133_27387.current_module_name) + (uu___133_27428.encode_non_total_function_typ); + current_module_name = (uu___133_27428.current_module_name) }); - (let uu____27389 = + (let uu____27430 = FStar_TypeChecker_Env.debug tcenv FStar_Options.Low in - if uu____27389 + if uu____27430 then FStar_Util.print1 "Done encoding externals for %s\n" name else ()); (let decls1 = caption decls in FStar_SMTEncoding_Z3.giveZ3 decls1))) @@ -8849,37 +8856,37 @@ let encode_query: fun use_env_msg -> fun tcenv -> fun q -> - (let uu____27441 = - let uu____27442 = FStar_TypeChecker_Env.current_module tcenv in - uu____27442.FStar_Ident.str in + (let uu____27482 = + let uu____27483 = FStar_TypeChecker_Env.current_module tcenv in + uu____27483.FStar_Ident.str in FStar_SMTEncoding_Z3.query_logging.FStar_SMTEncoding_Z3.set_module_name - uu____27441); + uu____27482); (let env = - let uu____27444 = FStar_TypeChecker_Env.current_module tcenv in - get_env uu____27444 tcenv in + let uu____27485 = FStar_TypeChecker_Env.current_module tcenv in + get_env uu____27485 tcenv in let bindings = FStar_TypeChecker_Env.fold_env tcenv (fun bs -> fun b -> b :: bs) [] in - let uu____27456 = + let uu____27497 = let rec aux bindings1 = match bindings1 with | (FStar_TypeChecker_Env.Binding_var x)::rest -> - let uu____27491 = aux rest in - (match uu____27491 with + let uu____27532 = aux rest in + (match uu____27532 with | (out,rest1) -> let t = - let uu____27521 = + let uu____27562 = FStar_Syntax_Util.destruct_typ_as_formula x.FStar_Syntax_Syntax.sort in - match uu____27521 with - | FStar_Pervasives_Native.Some uu____27526 -> - let uu____27527 = + match uu____27562 with + | FStar_Pervasives_Native.Some uu____27567 -> + let uu____27568 = FStar_Syntax_Syntax.new_bv FStar_Pervasives_Native.None FStar_Syntax_Syntax.t_unit in - FStar_Syntax_Util.refine uu____27527 + FStar_Syntax_Util.refine uu____27568 x.FStar_Syntax_Syntax.sort - | uu____27528 -> x.FStar_Syntax_Syntax.sort in + | uu____27569 -> x.FStar_Syntax_Syntax.sort in let t1 = FStar_TypeChecker_Normalize.normalize [FStar_TypeChecker_Normalize.Eager_unfolding; @@ -8888,41 +8895,41 @@ let encode_query: FStar_TypeChecker_Normalize.Primops; FStar_TypeChecker_Normalize.EraseUniverses] env.tcenv t in - let uu____27532 = - let uu____27535 = + let uu____27573 = + let uu____27576 = FStar_Syntax_Syntax.mk_binder - (let uu___134_27538 = x in + (let uu___134_27579 = x in { FStar_Syntax_Syntax.ppname = - (uu___134_27538.FStar_Syntax_Syntax.ppname); + (uu___134_27579.FStar_Syntax_Syntax.ppname); FStar_Syntax_Syntax.index = - (uu___134_27538.FStar_Syntax_Syntax.index); + (uu___134_27579.FStar_Syntax_Syntax.index); FStar_Syntax_Syntax.sort = t1 }) in - uu____27535 :: out in - (uu____27532, rest1)) - | uu____27543 -> ([], bindings1) in - let uu____27550 = aux bindings in - match uu____27550 with + uu____27576 :: out in + (uu____27573, rest1)) + | uu____27584 -> ([], bindings1) in + let uu____27591 = aux bindings in + match uu____27591 with | (closing,bindings1) -> - let uu____27575 = + let uu____27616 = FStar_Syntax_Util.close_forall_no_univs (FStar_List.rev closing) q in - (uu____27575, bindings1) in - match uu____27456 with + (uu____27616, bindings1) in + match uu____27497 with | (q1,bindings1) -> - let uu____27598 = - let uu____27603 = + let uu____27639 = + let uu____27644 = FStar_List.filter - (fun uu___99_27608 -> - match uu___99_27608 with - | FStar_TypeChecker_Env.Binding_sig uu____27609 -> + (fun uu___99_27649 -> + match uu___99_27649 with + | FStar_TypeChecker_Env.Binding_sig uu____27650 -> false - | uu____27616 -> true) bindings1 in - encode_env_bindings env uu____27603 in - (match uu____27598 with + | uu____27657 -> true) bindings1 in + encode_env_bindings env uu____27644 in + (match uu____27639 with | (env_decls,env1) -> - ((let uu____27634 = + ((let uu____27675 = ((FStar_TypeChecker_Env.debug tcenv FStar_Options.Low) || (FStar_All.pipe_left @@ -8932,39 +8939,39 @@ let encode_query: (FStar_All.pipe_left (FStar_TypeChecker_Env.debug tcenv) (FStar_Options.Other "SMTQuery")) in - if uu____27634 + if uu____27675 then - let uu____27635 = FStar_Syntax_Print.term_to_string q1 in + let uu____27676 = FStar_Syntax_Print.term_to_string q1 in FStar_Util.print1 "Encoding query formula: %s\n" - uu____27635 + uu____27676 else ()); - (let uu____27637 = encode_formula q1 env1 in - match uu____27637 with + (let uu____27678 = encode_formula q1 env1 in + match uu____27678 with | (phi,qdecls) -> - let uu____27658 = - let uu____27663 = + let uu____27699 = + let uu____27704 = FStar_TypeChecker_Env.get_range tcenv in FStar_SMTEncoding_ErrorReporting.label_goals - use_env_msg uu____27663 phi in - (match uu____27658 with + use_env_msg uu____27704 phi in + (match uu____27699 with | (labels,phi1) -> - let uu____27680 = encode_labels labels in - (match uu____27680 with + let uu____27721 = encode_labels labels in + (match uu____27721 with | (label_prefix,label_suffix) -> let query_prelude = FStar_List.append env_decls (FStar_List.append label_prefix qdecls) in let qry = - let uu____27717 = - let uu____27724 = + let uu____27758 = + let uu____27765 = FStar_SMTEncoding_Util.mkNot phi1 in - let uu____27725 = + let uu____27766 = varops.mk_unique "@query" in - (uu____27724, + (uu____27765, (FStar_Pervasives_Native.Some "query"), - uu____27725) in + uu____27766) in FStar_SMTEncoding_Util.mkAssume - uu____27717 in + uu____27758 in let suffix = FStar_List.append [FStar_SMTEncoding_Term.Echo ""] diff --git a/src/ocaml-output/FStar_SMTEncoding_Z3.ml b/src/ocaml-output/FStar_SMTEncoding_Z3.ml index b6785594519..fe1fab55730 100644 --- a/src/ocaml-output/FStar_SMTEncoding_Z3.ml +++ b/src/ocaml-output/FStar_SMTEncoding_Z3.ml @@ -95,8 +95,8 @@ let ini_params: Prims.unit -> Prims.string = FStar_Util.string_of_int uu____310 in FStar_Util.format1 "smt.random_seed=%s" uu____309 in [uu____308] in - "-smt2 -in auto_config=false model=true smt.relevancy=2" :: - uu____305 in + "-smt2 -in auto_config=false model=true smt.relevancy=2 smt.case_split=3" + :: uu____305 in let uu____311 = FStar_Options.z3_cliopt () in FStar_List.append uu____302 uu____311 in FStar_String.concat " " uu____299) diff --git a/src/ocaml-output/FStar_Syntax_Print.ml b/src/ocaml-output/FStar_Syntax_Print.ml index 8bb4dd4576f..d321146cdc1 100644 --- a/src/ocaml-output/FStar_Syntax_Print.ml +++ b/src/ocaml-output/FStar_Syntax_Print.ml @@ -667,7 +667,7 @@ and lcomp_to_string: FStar_Syntax_Syntax.lcomp -> Prims.string = let uu____1782 = FStar_Options.print_effect_args () in if uu____1782 then - let uu____1783 = lc.FStar_Syntax_Syntax.comp () in + let uu____1783 = FStar_Syntax_Syntax.lcomp_comp lc in comp_to_string uu____1783 else (let uu____1785 = sli lc.FStar_Syntax_Syntax.eff_name in @@ -915,6 +915,8 @@ and cflags_to_string: FStar_Syntax_Syntax.cflags -> Prims.string = | FStar_Syntax_Syntax.RETURN -> "return" | FStar_Syntax_Syntax.PARTIAL_RETURN -> "partial_return" | FStar_Syntax_Syntax.SOMETRIVIAL -> "sometrivial" + | FStar_Syntax_Syntax.TRIVIAL_POSTCONDITION -> "trivial_postcondition" + | FStar_Syntax_Syntax.SHOULD_NOT_INLINE -> "should_not_inline" | FStar_Syntax_Syntax.LEMMA -> "lemma" | FStar_Syntax_Syntax.CPS -> "cps" | FStar_Syntax_Syntax.DECREASES uu____2015 -> "" diff --git a/src/ocaml-output/FStar_Syntax_Resugar.ml b/src/ocaml-output/FStar_Syntax_Resugar.ml index 3df0fc727d5..ad5415b6f2a 100644 --- a/src/ocaml-output/FStar_Syntax_Resugar.ml +++ b/src/ocaml-output/FStar_Syntax_Resugar.ml @@ -540,125 +540,134 @@ let rec resugar_term: FStar_Syntax_Syntax.term -> FStar_Parser_AST.term = let uu____1215 = resugar_term phi1 in (b, uu____1215) in FStar_Parser_AST.Refine uu____1210 in mk1 uu____1209) + | FStar_Syntax_Syntax.Tm_app + ({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_fvar fv; + FStar_Syntax_Syntax.pos = uu____1217; + FStar_Syntax_Syntax.vars = uu____1218;_},(e,uu____1220)::[]) + when + (let uu____1251 = FStar_Options.print_implicits () in + Prims.op_Negation uu____1251) && + (FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.b2t_lid) + -> resugar_term e | FStar_Syntax_Syntax.Tm_app (e,args) -> - let rec last1 uu___68_1257 = - match uu___68_1257 with + let rec last1 uu___68_1293 = + match uu___68_1293 with | hd1::[] -> [hd1] | hd1::tl1 -> last1 tl1 - | uu____1327 -> failwith "last of an empty list" in - let rec last_two uu___69_1363 = - match uu___69_1363 with + | uu____1363 -> failwith "last of an empty list" in + let rec last_two uu___69_1399 = + match uu___69_1399 with | [] -> failwith "last two elements of a list with less than two elements " - | uu____1394::[] -> + | uu____1430::[] -> failwith "last two elements of a list with less than two elements " | a1::a2::[] -> [a1; a2] - | uu____1471::t1 -> last_two t1 in - let rec last_three uu___70_1512 = - match uu___70_1512 with + | uu____1507::t1 -> last_two t1 in + let rec last_three uu___70_1548 = + match uu___70_1548 with | [] -> failwith "last three elements of a list with less than three elements " - | uu____1543::[] -> + | uu____1579::[] -> failwith "last three elements of a list with less than three elements " - | uu____1570::uu____1571::[] -> + | uu____1606::uu____1607::[] -> failwith "last three elements of a list with less than three elements " | a1::a2::a3::[] -> [a1; a2; a3] - | uu____1679::t1 -> last_three t1 in + | uu____1715::t1 -> last_three t1 in let resugar_as_app e1 args1 = let args2 = FStar_All.pipe_right args1 (FStar_List.map - (fun uu____1765 -> - match uu____1765 with + (fun uu____1801 -> + match uu____1801 with | (e2,qual) -> - let uu____1784 = resugar_term e2 in - (uu____1784, qual))) in + let uu____1820 = resugar_term e2 in + (uu____1820, qual))) in let e2 = resugar_term e1 in let res_impl desugared_tm qual = - let uu____1799 = resugar_imp qual in - match uu____1799 with + let uu____1835 = resugar_imp qual in + match uu____1835 with | FStar_Pervasives_Native.Some imp -> imp | FStar_Pervasives_Native.None -> - ((let uu____1804 = - let uu____1809 = - let uu____1810 = parser_term_to_string desugared_tm in + ((let uu____1840 = + let uu____1845 = + let uu____1846 = parser_term_to_string desugared_tm in FStar_Util.format1 "Inaccessible argument %s in function application" - uu____1810 in - (FStar_Errors.Warning_InaccessibleArgument, uu____1809) in - FStar_Errors.log_issue t.FStar_Syntax_Syntax.pos uu____1804); + uu____1846 in + (FStar_Errors.Warning_InaccessibleArgument, uu____1845) in + FStar_Errors.log_issue t.FStar_Syntax_Syntax.pos uu____1840); FStar_Parser_AST.Nothing) in FStar_List.fold_left (fun acc -> - fun uu____1823 -> - match uu____1823 with + fun uu____1859 -> + match uu____1859 with | (x,qual) -> - let uu____1836 = - let uu____1837 = - let uu____1844 = res_impl x qual in - (acc, x, uu____1844) in - FStar_Parser_AST.App uu____1837 in - mk1 uu____1836) e2 args2 in + let uu____1872 = + let uu____1873 = + let uu____1880 = res_impl x qual in + (acc, x, uu____1880) in + FStar_Parser_AST.App uu____1873 in + mk1 uu____1872) e2 args2 in let args1 = - let uu____1854 = FStar_Options.print_implicits () in - if uu____1854 then args else filter_imp args in - let uu____1866 = resugar_term_as_op e in - (match uu____1866 with + let uu____1890 = FStar_Options.print_implicits () in + if uu____1890 then args else filter_imp args in + let uu____1902 = resugar_term_as_op e in + (match uu____1902 with | FStar_Pervasives_Native.None -> resugar_as_app e args1 - | FStar_Pervasives_Native.Some ("tuple",uu____1877) -> + | FStar_Pervasives_Native.Some ("tuple",uu____1913) -> (match args1 with - | (fst1,uu____1883)::(snd1,uu____1885)::rest -> + | (fst1,uu____1919)::(snd1,uu____1921)::rest -> let e1 = - let uu____1916 = - let uu____1917 = - let uu____1924 = - let uu____1927 = resugar_term fst1 in - let uu____1928 = - let uu____1931 = resugar_term snd1 in - [uu____1931] in - uu____1927 :: uu____1928 in - ((FStar_Ident.id_of_text "*"), uu____1924) in - FStar_Parser_AST.Op uu____1917 in - mk1 uu____1916 in + let uu____1952 = + let uu____1953 = + let uu____1960 = + let uu____1963 = resugar_term fst1 in + let uu____1964 = + let uu____1967 = resugar_term snd1 in + [uu____1967] in + uu____1963 :: uu____1964 in + ((FStar_Ident.id_of_text "*"), uu____1960) in + FStar_Parser_AST.Op uu____1953 in + mk1 uu____1952 in FStar_List.fold_left (fun acc -> - fun uu____1944 -> - match uu____1944 with - | (x,uu____1950) -> - let uu____1951 = - let uu____1952 = - let uu____1959 = - let uu____1962 = - let uu____1965 = resugar_term x in - [uu____1965] in - e1 :: uu____1962 in - ((FStar_Ident.id_of_text "*"), uu____1959) in - FStar_Parser_AST.Op uu____1952 in - mk1 uu____1951) e1 rest - | uu____1968 -> resugar_as_app e args1) - | FStar_Pervasives_Native.Some ("dtuple",uu____1977) when + fun uu____1980 -> + match uu____1980 with + | (x,uu____1986) -> + let uu____1987 = + let uu____1988 = + let uu____1995 = + let uu____1998 = + let uu____2001 = resugar_term x in + [uu____2001] in + e1 :: uu____1998 in + ((FStar_Ident.id_of_text "*"), uu____1995) in + FStar_Parser_AST.Op uu____1988 in + mk1 uu____1987) e1 rest + | uu____2004 -> resugar_as_app e args1) + | FStar_Pervasives_Native.Some ("dtuple",uu____2013) when (FStar_List.length args1) > (Prims.parse_int "0") -> let args2 = last1 args1 in let body = match args2 with - | (b,uu____2003)::[] -> b - | uu____2020 -> failwith "wrong arguments to dtuple" in - let uu____2031 = - let uu____2032 = FStar_Syntax_Subst.compress body in - uu____2032.FStar_Syntax_Syntax.n in - (match uu____2031 with - | FStar_Syntax_Syntax.Tm_abs (xs,body1,uu____2037) -> - let uu____2058 = FStar_Syntax_Subst.open_term xs body1 in - (match uu____2058 with + | (b,uu____2039)::[] -> b + | uu____2056 -> failwith "wrong arguments to dtuple" in + let uu____2067 = + let uu____2068 = FStar_Syntax_Subst.compress body in + uu____2068.FStar_Syntax_Syntax.n in + (match uu____2067 with + | FStar_Syntax_Syntax.Tm_abs (xs,body1,uu____2073) -> + let uu____2094 = FStar_Syntax_Subst.open_term xs body1 in + (match uu____2094 with | (xs1,body2) -> let xs2 = - let uu____2066 = FStar_Options.print_implicits () in - if uu____2066 then xs1 else filter_imp xs1 in + let uu____2102 = FStar_Options.print_implicits () in + if uu____2102 then xs1 else filter_imp xs1 in let xs3 = FStar_All.pipe_right xs2 ((map_opt ()) @@ -666,12 +675,12 @@ let rec resugar_term: FStar_Syntax_Syntax.term -> FStar_Parser_AST.term = resugar_binder b t.FStar_Syntax_Syntax.pos)) in let body3 = resugar_term body2 in mk1 (FStar_Parser_AST.Sum (xs3, body3))) - | uu____2078 -> + | uu____2114 -> let args3 = FStar_All.pipe_right args2 (FStar_List.map - (fun uu____2099 -> - match uu____2099 with + (fun uu____2135 -> + match uu____2135 with | (e1,qual) -> resugar_term e1)) in let e1 = resugar_term e in FStar_List.fold_left @@ -680,17 +689,17 @@ let rec resugar_term: FStar_Syntax_Syntax.term -> FStar_Parser_AST.term = mk1 (FStar_Parser_AST.App (acc, x, FStar_Parser_AST.Nothing))) e1 args3) - | FStar_Pervasives_Native.Some ("dtuple",uu____2111) -> + | FStar_Pervasives_Native.Some ("dtuple",uu____2147) -> resugar_as_app e args1 - | FStar_Pervasives_Native.Some (ref_read,uu____2117) when + | FStar_Pervasives_Native.Some (ref_read,uu____2153) when ref_read = FStar_Parser_Const.sread_lid.FStar_Ident.str -> - let uu____2122 = FStar_List.hd args1 in - (match uu____2122 with - | (t1,uu____2136) -> - let uu____2141 = - let uu____2142 = FStar_Syntax_Subst.compress t1 in - uu____2142.FStar_Syntax_Syntax.n in - (match uu____2141 with + let uu____2158 = FStar_List.hd args1 in + (match uu____2158 with + | (t1,uu____2172) -> + let uu____2177 = + let uu____2178 = FStar_Syntax_Subst.compress t1 in + uu____2178.FStar_Syntax_Syntax.n in + (match uu____2177 with | FStar_Syntax_Syntax.Tm_fvar fv when FStar_Syntax_Util.field_projector_contains_constructor ((fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v).FStar_Ident.str @@ -699,50 +708,50 @@ let rec resugar_term: FStar_Syntax_Syntax.term -> FStar_Parser_AST.term = FStar_Ident.lid_of_path [((fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v).FStar_Ident.str] t1.FStar_Syntax_Syntax.pos in - let uu____2147 = - let uu____2148 = - let uu____2153 = resugar_term t1 in - (uu____2153, f) in - FStar_Parser_AST.Project uu____2148 in - mk1 uu____2147 - | uu____2154 -> resugar_term t1)) - | FStar_Pervasives_Native.Some ("try_with",uu____2155) when + let uu____2183 = + let uu____2184 = + let uu____2189 = resugar_term t1 in + (uu____2189, f) in + FStar_Parser_AST.Project uu____2184 in + mk1 uu____2183 + | uu____2190 -> resugar_term t1)) + | FStar_Pervasives_Native.Some ("try_with",uu____2191) when (FStar_List.length args1) > (Prims.parse_int "1") -> let new_args = last_two args1 in - let uu____2175 = + let uu____2211 = match new_args with - | (a1,uu____2193)::(a2,uu____2195)::[] -> (a1, a2) - | uu____2226 -> failwith "wrong arguments to try_with" in - (match uu____2175 with + | (a1,uu____2229)::(a2,uu____2231)::[] -> (a1, a2) + | uu____2262 -> failwith "wrong arguments to try_with" in + (match uu____2211 with | (body,handler) -> let decomp term = - let uu____2257 = - let uu____2258 = FStar_Syntax_Subst.compress term in - uu____2258.FStar_Syntax_Syntax.n in - match uu____2257 with - | FStar_Syntax_Syntax.Tm_abs (x,e1,uu____2263) -> - let uu____2284 = FStar_Syntax_Subst.open_term x e1 in - (match uu____2284 with | (x1,e2) -> e2) - | uu____2291 -> + let uu____2293 = + let uu____2294 = FStar_Syntax_Subst.compress term in + uu____2294.FStar_Syntax_Syntax.n in + match uu____2293 with + | FStar_Syntax_Syntax.Tm_abs (x,e1,uu____2299) -> + let uu____2320 = FStar_Syntax_Subst.open_term x e1 in + (match uu____2320 with | (x1,e2) -> e2) + | uu____2327 -> failwith "wrong argument format to try_with" in let body1 = - let uu____2293 = decomp body in resugar_term uu____2293 in + let uu____2329 = decomp body in resugar_term uu____2329 in let handler1 = - let uu____2295 = decomp handler in - resugar_term uu____2295 in + let uu____2331 = decomp handler in + resugar_term uu____2331 in let rec resugar_body t1 = match t1.FStar_Parser_AST.tm with | FStar_Parser_AST.Match - (e1,(uu____2301,uu____2302,b)::[]) -> b - | FStar_Parser_AST.Let (uu____2334,uu____2335,b) -> b + (e1,(uu____2337,uu____2338,b)::[]) -> b + | FStar_Parser_AST.Let (uu____2370,uu____2371,b) -> b | FStar_Parser_AST.Ascribed (t11,t2,t3) -> - let uu____2356 = - let uu____2357 = - let uu____2366 = resugar_body t11 in - (uu____2366, t2, t3) in - FStar_Parser_AST.Ascribed uu____2357 in - mk1 uu____2356 - | uu____2369 -> + let uu____2392 = + let uu____2393 = + let uu____2402 = resugar_body t11 in + (uu____2402, t2, t3) in + FStar_Parser_AST.Ascribed uu____2393 in + mk1 uu____2392 + | uu____2405 -> failwith "unexpected body format to try_with" in let e1 = resugar_body body1 in let rec resugar_branches t1 = @@ -750,12 +759,12 @@ let rec resugar_term: FStar_Syntax_Syntax.term -> FStar_Parser_AST.term = | FStar_Parser_AST.Match (e2,branches) -> branches | FStar_Parser_AST.Ascribed (t11,t2,t3) -> resugar_branches t11 - | uu____2424 -> [] in + | uu____2460 -> [] in let branches = resugar_branches handler1 in mk1 (FStar_Parser_AST.TryWith (e1, branches))) - | FStar_Pervasives_Native.Some ("try_with",uu____2454) -> + | FStar_Pervasives_Native.Some ("try_with",uu____2490) -> resugar_as_app e args1 - | FStar_Pervasives_Native.Some (op,uu____2460) when + | FStar_Pervasives_Native.Some (op,uu____2496) when (op = "forall") || (op = "exists") -> let rec uncurry xs pat t1 = match t1.FStar_Parser_AST.tm with @@ -765,62 +774,64 @@ let rec resugar_term: FStar_Syntax_Syntax.term -> FStar_Parser_AST.term = | FStar_Parser_AST.QForall (x,p,body) -> uncurry (FStar_List.append x xs) (FStar_List.append p pat) body - | uu____2545 -> (xs, pat, t1) in + | uu____2581 -> (xs, pat, t1) in let resugar body = - let uu____2556 = - let uu____2557 = FStar_Syntax_Subst.compress body in - uu____2557.FStar_Syntax_Syntax.n in - match uu____2556 with - | FStar_Syntax_Syntax.Tm_abs (xs,body1,uu____2562) -> - let uu____2583 = FStar_Syntax_Subst.open_term xs body1 in - (match uu____2583 with + let uu____2592 = + let uu____2593 = FStar_Syntax_Subst.compress body in + uu____2593.FStar_Syntax_Syntax.n in + match uu____2592 with + | FStar_Syntax_Syntax.Tm_abs (xs,body1,uu____2598) -> + let uu____2619 = FStar_Syntax_Subst.open_term xs body1 in + (match uu____2619 with | (xs1,body2) -> let xs2 = - let uu____2591 = FStar_Options.print_implicits () in - if uu____2591 then xs1 else filter_imp xs1 in + let uu____2627 = FStar_Options.print_implicits () in + if uu____2627 then xs1 else filter_imp xs1 in let xs3 = FStar_All.pipe_right xs2 ((map_opt ()) (fun b -> resugar_binder b t.FStar_Syntax_Syntax.pos)) in - let uu____2600 = - let uu____2609 = - let uu____2610 = + let uu____2636 = + let uu____2645 = + let uu____2646 = FStar_Syntax_Subst.compress body2 in - uu____2610.FStar_Syntax_Syntax.n in - match uu____2609 with + uu____2646.FStar_Syntax_Syntax.n in + match uu____2645 with | FStar_Syntax_Syntax.Tm_meta (e1,m) -> let body3 = resugar_term e1 in - let pats = + let uu____2664 = match m with | FStar_Syntax_Syntax.Meta_pattern pats -> - FStar_List.map - (fun es -> - FStar_All.pipe_right es - (FStar_List.map - (fun uu____2679 -> - match uu____2679 with - | (e2,uu____2685) -> - resugar_term e2))) pats - | FStar_Syntax_Syntax.Meta_labeled - (s,r,uu____2688) -> - let uu____2689 = - let uu____2692 = - let uu____2693 = name s r in - mk1 uu____2693 in - [uu____2692] in - [uu____2689] - | uu____2698 -> + let uu____2692 = + FStar_List.map + (fun es -> + FStar_All.pipe_right es + (FStar_List.map + (fun uu____2728 -> + match uu____2728 with + | (e2,uu____2734) -> + resugar_term e2))) + pats in + (uu____2692, body3) + | FStar_Syntax_Syntax.Meta_labeled (s,r,p) -> + let uu____2742 = + mk1 + (FStar_Parser_AST.Labeled + (body3, s, p)) in + ([], uu____2742) + | uu____2749 -> failwith "wrong pattern format for QForall/QExists" in - (pats, body3) - | uu____2707 -> - let uu____2708 = resugar_term body2 in - ([], uu____2708) in - (match uu____2600 with + (match uu____2664 with + | (pats,body4) -> (pats, body4)) + | uu____2780 -> + let uu____2781 = resugar_term body2 in + ([], uu____2781) in + (match uu____2636 with | (pats,body3) -> - let uu____2725 = uncurry xs3 pats body3 in - (match uu____2725 with + let uu____2798 = uncurry xs3 pats body3 in + (match uu____2798 with | (xs4,pats1,body4) -> let xs5 = FStar_All.pipe_right xs4 FStar_List.rev in @@ -833,116 +844,116 @@ let rec resugar_term: FStar_Syntax_Syntax.term -> FStar_Parser_AST.term = mk1 (FStar_Parser_AST.QExists (xs5, pats1, body4))))) - | uu____2773 -> + | uu____2846 -> if op = "forall" then - let uu____2774 = - let uu____2775 = - let uu____2788 = resugar_term body in - ([], [[]], uu____2788) in - FStar_Parser_AST.QForall uu____2775 in - mk1 uu____2774 + let uu____2847 = + let uu____2848 = + let uu____2861 = resugar_term body in + ([], [[]], uu____2861) in + FStar_Parser_AST.QForall uu____2848 in + mk1 uu____2847 else - (let uu____2800 = - let uu____2801 = - let uu____2814 = resugar_term body in - ([], [[]], uu____2814) in - FStar_Parser_AST.QExists uu____2801 in - mk1 uu____2800) in + (let uu____2873 = + let uu____2874 = + let uu____2887 = resugar_term body in + ([], [[]], uu____2887) in + FStar_Parser_AST.QExists uu____2874 in + mk1 uu____2873) in if (FStar_List.length args1) > (Prims.parse_int "0") then let args2 = last1 args1 in (match args2 with - | (b,uu____2841)::[] -> resugar b - | uu____2858 -> failwith "wrong args format to QForall") + | (b,uu____2914)::[] -> resugar b + | uu____2931 -> failwith "wrong args format to QForall") else resugar_as_app e args1 - | FStar_Pervasives_Native.Some ("alloc",uu____2868) -> - let uu____2873 = FStar_List.hd args1 in - (match uu____2873 with | (e1,uu____2887) -> resugar_term e1) + | FStar_Pervasives_Native.Some ("alloc",uu____2941) -> + let uu____2946 = FStar_List.hd args1 in + (match uu____2946 with | (e1,uu____2960) -> resugar_term e1) | FStar_Pervasives_Native.Some (op,arity) -> let op1 = FStar_Ident.id_of_text op in let resugar args2 = FStar_All.pipe_right args2 (FStar_List.map - (fun uu____2932 -> - match uu____2932 with | (e1,qual) -> resugar_term e1)) in + (fun uu____3005 -> + match uu____3005 with | (e1,qual) -> resugar_term e1)) in (match arity with | _0_39 when _0_39 = (Prims.parse_int "0") -> - let uu____2939 = + let uu____3012 = FStar_Parser_ToDocument.handleable_args_length op1 in - (match uu____2939 with + (match uu____3012 with | _0_40 when (_0_40 = (Prims.parse_int "1")) && ((FStar_List.length args1) > (Prims.parse_int "0")) -> - let uu____2946 = - let uu____2947 = - let uu____2954 = - let uu____2957 = last1 args1 in - resugar uu____2957 in - (op1, uu____2954) in - FStar_Parser_AST.Op uu____2947 in - mk1 uu____2946 + let uu____3019 = + let uu____3020 = + let uu____3027 = + let uu____3030 = last1 args1 in + resugar uu____3030 in + (op1, uu____3027) in + FStar_Parser_AST.Op uu____3020 in + mk1 uu____3019 | _0_41 when (_0_41 = (Prims.parse_int "2")) && ((FStar_List.length args1) > (Prims.parse_int "1")) -> - let uu____2972 = - let uu____2973 = - let uu____2980 = - let uu____2983 = last_two args1 in - resugar uu____2983 in - (op1, uu____2980) in - FStar_Parser_AST.Op uu____2973 in - mk1 uu____2972 + let uu____3045 = + let uu____3046 = + let uu____3053 = + let uu____3056 = last_two args1 in + resugar uu____3056 in + (op1, uu____3053) in + FStar_Parser_AST.Op uu____3046 in + mk1 uu____3045 | _0_42 when (_0_42 = (Prims.parse_int "3")) && ((FStar_List.length args1) > (Prims.parse_int "2")) -> - let uu____2998 = - let uu____2999 = - let uu____3006 = - let uu____3009 = last_three args1 in - resugar uu____3009 in - (op1, uu____3006) in - FStar_Parser_AST.Op uu____2999 in - mk1 uu____2998 - | uu____3018 -> resugar_as_app e args1) + let uu____3071 = + let uu____3072 = + let uu____3079 = + let uu____3082 = last_three args1 in + resugar uu____3082 in + (op1, uu____3079) in + FStar_Parser_AST.Op uu____3072 in + mk1 uu____3071 + | uu____3091 -> resugar_as_app e args1) | _0_43 when (_0_43 = (Prims.parse_int "2")) && ((FStar_List.length args1) > (Prims.parse_int "1")) -> - let uu____3025 = - let uu____3026 = - let uu____3033 = - let uu____3036 = last_two args1 in resugar uu____3036 in - (op1, uu____3033) in - FStar_Parser_AST.Op uu____3026 in - mk1 uu____3025 - | uu____3045 -> resugar_as_app e args1)) - | FStar_Syntax_Syntax.Tm_match (e,(pat,uu____3048,t1)::[]) -> + let uu____3098 = + let uu____3099 = + let uu____3106 = + let uu____3109 = last_two args1 in resugar uu____3109 in + (op1, uu____3106) in + FStar_Parser_AST.Op uu____3099 in + mk1 uu____3098 + | uu____3118 -> resugar_as_app e args1)) + | FStar_Syntax_Syntax.Tm_match (e,(pat,uu____3121,t1)::[]) -> let bnds = - let uu____3121 = - let uu____3126 = resugar_pat pat in - let uu____3127 = resugar_term e in (uu____3126, uu____3127) in - [uu____3121] in + let uu____3194 = + let uu____3199 = resugar_pat pat in + let uu____3200 = resugar_term e in (uu____3199, uu____3200) in + [uu____3194] in let body = resugar_term t1 in mk1 (FStar_Parser_AST.Let (FStar_Parser_AST.NoLetQualifier, bnds, body)) | FStar_Syntax_Syntax.Tm_match - (e,(pat1,uu____3145,t1)::(pat2,uu____3148,t2)::[]) when + (e,(pat1,uu____3218,t1)::(pat2,uu____3221,t2)::[]) when (is_true_pat pat1) && (is_wild_pat pat2) -> - let uu____3244 = - let uu____3245 = - let uu____3252 = resugar_term e in - let uu____3253 = resugar_term t1 in - let uu____3254 = resugar_term t2 in - (uu____3252, uu____3253, uu____3254) in - FStar_Parser_AST.If uu____3245 in - mk1 uu____3244 + let uu____3317 = + let uu____3318 = + let uu____3325 = resugar_term e in + let uu____3326 = resugar_term t1 in + let uu____3327 = resugar_term t2 in + (uu____3325, uu____3326, uu____3327) in + FStar_Parser_AST.If uu____3318 in + mk1 uu____3317 | FStar_Syntax_Syntax.Tm_match (e,branches) -> - let resugar_branch uu____3312 = - match uu____3312 with + let resugar_branch uu____3385 = + match uu____3385 with | (pat,wopt,b) -> let pat1 = resugar_pat pat in let wopt1 = @@ -950,72 +961,72 @@ let rec resugar_term: FStar_Syntax_Syntax.term -> FStar_Parser_AST.term = | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None | FStar_Pervasives_Native.Some e1 -> - let uu____3343 = resugar_term e1 in - FStar_Pervasives_Native.Some uu____3343 in + let uu____3416 = resugar_term e1 in + FStar_Pervasives_Native.Some uu____3416 in let b1 = resugar_term b in (pat1, wopt1, b1) in - let uu____3347 = - let uu____3348 = - let uu____3363 = resugar_term e in - let uu____3364 = FStar_List.map resugar_branch branches in - (uu____3363, uu____3364) in - FStar_Parser_AST.Match uu____3348 in - mk1 uu____3347 - | FStar_Syntax_Syntax.Tm_ascribed (e,(asc,tac_opt),uu____3404) -> + let uu____3420 = + let uu____3421 = + let uu____3436 = resugar_term e in + let uu____3437 = FStar_List.map resugar_branch branches in + (uu____3436, uu____3437) in + FStar_Parser_AST.Match uu____3421 in + mk1 uu____3420 + | FStar_Syntax_Syntax.Tm_ascribed (e,(asc,tac_opt),uu____3477) -> let term = match asc with | FStar_Util.Inl n1 -> resugar_term n1 | FStar_Util.Inr n1 -> resugar_comp n1 in let tac_opt1 = FStar_Option.map resugar_term tac_opt in - let uu____3471 = - let uu____3472 = - let uu____3481 = resugar_term e in (uu____3481, term, tac_opt1) in - FStar_Parser_AST.Ascribed uu____3472 in - mk1 uu____3471 + let uu____3544 = + let uu____3545 = + let uu____3554 = resugar_term e in (uu____3554, term, tac_opt1) in + FStar_Parser_AST.Ascribed uu____3545 in + mk1 uu____3544 | FStar_Syntax_Syntax.Tm_let ((is_rec,bnds),body) -> let mk_pat a = FStar_Parser_AST.mk_pattern a t.FStar_Syntax_Syntax.pos in - let uu____3505 = FStar_Syntax_Subst.open_let_rec bnds body in - (match uu____3505 with + let uu____3578 = FStar_Syntax_Subst.open_let_rec bnds body in + (match uu____3578 with | (bnds1,body1) -> let resugar_one_binding bnd = - let uu____3530 = - let uu____3535 = + let uu____3603 = + let uu____3608 = FStar_Syntax_Util.mk_conj bnd.FStar_Syntax_Syntax.lbtyp bnd.FStar_Syntax_Syntax.lbdef in FStar_Syntax_Subst.open_univ_vars - bnd.FStar_Syntax_Syntax.lbunivs uu____3535 in - match uu____3530 with + bnd.FStar_Syntax_Syntax.lbunivs uu____3608 in + match uu____3603 with | (univs1,td) -> - let uu____3546 = - let uu____3555 = - let uu____3556 = FStar_Syntax_Subst.compress td in - uu____3556.FStar_Syntax_Syntax.n in - match uu____3555 with + let uu____3619 = + let uu____3628 = + let uu____3629 = FStar_Syntax_Subst.compress td in + uu____3629.FStar_Syntax_Syntax.n in + match uu____3628 with | FStar_Syntax_Syntax.Tm_app - (uu____3567,(t1,uu____3569)::(d,uu____3571)::[]) -> + (uu____3640,(t1,uu____3642)::(d,uu____3644)::[]) -> (t1, d) - | uu____3614 -> failwith "wrong let binding format" in - (match uu____3546 with + | uu____3687 -> failwith "wrong let binding format" in + (match uu____3619 with | (typ,def) -> - let uu____3641 = - let uu____3648 = - let uu____3649 = FStar_Syntax_Subst.compress def in - uu____3649.FStar_Syntax_Syntax.n in - match uu____3648 with - | FStar_Syntax_Syntax.Tm_abs (b,t1,uu____3660) -> - let uu____3681 = + let uu____3714 = + let uu____3721 = + let uu____3722 = FStar_Syntax_Subst.compress def in + uu____3722.FStar_Syntax_Syntax.n in + match uu____3721 with + | FStar_Syntax_Syntax.Tm_abs (b,t1,uu____3733) -> + let uu____3754 = FStar_Syntax_Subst.open_term b t1 in - (match uu____3681 with + (match uu____3754 with | (b1,t2) -> let b2 = - let uu____3695 = + let uu____3768 = FStar_Options.print_implicits () in - if uu____3695 then b1 else filter_imp b1 in + if uu____3768 then b1 else filter_imp b1 in (b2, t2, true)) - | uu____3697 -> ([], def, false) in - (match uu____3641 with + | uu____3770 -> ([], def, false) in + (match uu____3714 with | (binders,term,is_pat_app) -> - let uu____3721 = + let uu____3794 = match bnd.FStar_Syntax_Syntax.lbname with | FStar_Util.Inr fv -> ((mk_pat @@ -1023,66 +1034,66 @@ let rec resugar_term: FStar_Syntax_Syntax.term -> FStar_Parser_AST.term = ((fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v))), term) | FStar_Util.Inl bv -> - let uu____3732 = - let uu____3733 = - let uu____3734 = - let uu____3741 = + let uu____3805 = + let uu____3806 = + let uu____3807 = + let uu____3814 = bv_as_unique_ident bv in - (uu____3741, + (uu____3814, FStar_Pervasives_Native.None) in - FStar_Parser_AST.PatVar uu____3734 in - mk_pat uu____3733 in - (uu____3732, term) in - (match uu____3721 with + FStar_Parser_AST.PatVar uu____3807 in + mk_pat uu____3806 in + (uu____3805, term) in + (match uu____3794 with | (pat,term1) -> if is_pat_app then let args = FStar_All.pipe_right binders ((map_opt ()) - (fun uu____3777 -> - match uu____3777 with + (fun uu____3850 -> + match uu____3850 with | (bv,q) -> - let uu____3792 = + let uu____3865 = resugar_arg_qual q in FStar_Util.map_opt - uu____3792 + uu____3865 (fun q1 -> - let uu____3804 = - let uu____3805 = - let uu____3812 = + let uu____3877 = + let uu____3878 = + let uu____3885 = bv_as_unique_ident bv in - (uu____3812, q1) in + (uu____3885, q1) in FStar_Parser_AST.PatVar - uu____3805 in - mk_pat uu____3804))) in - let uu____3815 = - let uu____3820 = resugar_term term1 in + uu____3878 in + mk_pat uu____3877))) in + let uu____3888 = + let uu____3893 = resugar_term term1 in ((mk_pat (FStar_Parser_AST.PatApp - (pat, args))), uu____3820) in - let uu____3823 = + (pat, args))), uu____3893) in + let uu____3896 = universe_to_string univs1 in - (uu____3815, uu____3823) + (uu____3888, uu____3896) else - (let uu____3829 = - let uu____3834 = resugar_term term1 in - (pat, uu____3834) in - let uu____3835 = + (let uu____3902 = + let uu____3907 = resugar_term term1 in + (pat, uu____3907) in + let uu____3908 = universe_to_string univs1 in - (uu____3829, uu____3835))))) in + (uu____3902, uu____3908))))) in let r = FStar_List.map resugar_one_binding bnds1 in let bnds2 = let f = - let uu____3881 = - let uu____3882 = FStar_Options.print_universes () in - Prims.op_Negation uu____3882 in - if uu____3881 + let uu____3954 = + let uu____3955 = FStar_Options.print_universes () in + Prims.op_Negation uu____3955 in + if uu____3954 then FStar_Pervasives_Native.fst else - (fun uu___71_3902 -> - match uu___71_3902 with + (fun uu___71_3975 -> + match uu___71_3975 with | ((pat,body2),univs1) -> (pat, (label univs1 body2))) in FStar_List.map f r in let body2 = resugar_term body1 in @@ -1091,89 +1102,89 @@ let rec resugar_term: FStar_Syntax_Syntax.term -> FStar_Parser_AST.term = ((if is_rec then FStar_Parser_AST.Rec else FStar_Parser_AST.NoLetQualifier), bnds2, body2))) - | FStar_Syntax_Syntax.Tm_uvar (u,uu____3943) -> + | FStar_Syntax_Syntax.Tm_uvar (u,uu____4016) -> let s = - let uu____3969 = - let uu____3970 = FStar_Syntax_Unionfind.uvar_id u in - FStar_All.pipe_right uu____3970 FStar_Util.string_of_int in - Prims.strcat "?u" uu____3969 in - let uu____3971 = mk1 FStar_Parser_AST.Wild in label s uu____3971 + let uu____4042 = + let uu____4043 = FStar_Syntax_Unionfind.uvar_id u in + FStar_All.pipe_right uu____4043 FStar_Util.string_of_int in + Prims.strcat "?u" uu____4042 in + let uu____4044 = mk1 FStar_Parser_AST.Wild in label s uu____4044 | FStar_Syntax_Syntax.Tm_meta (e,m) -> - let resugar_meta_desugared uu___72_3981 = - match uu___72_3981 with + let resugar_meta_desugared uu___72_4054 = + match uu___72_4054 with | FStar_Syntax_Syntax.Data_app -> let rec head_fv_universes_args h = - let uu____4002 = - let uu____4003 = FStar_Syntax_Subst.compress h in - uu____4003.FStar_Syntax_Syntax.n in - match uu____4002 with + let uu____4075 = + let uu____4076 = FStar_Syntax_Subst.compress h in + uu____4076.FStar_Syntax_Syntax.n in + match uu____4075 with | FStar_Syntax_Syntax.Tm_fvar fv -> - let uu____4023 = FStar_Syntax_Syntax.lid_of_fv fv in - (uu____4023, [], []) + let uu____4096 = FStar_Syntax_Syntax.lid_of_fv fv in + (uu____4096, [], []) | FStar_Syntax_Syntax.Tm_uinst (h1,u) -> - let uu____4046 = head_fv_universes_args h1 in - (match uu____4046 with + let uu____4119 = head_fv_universes_args h1 in + (match uu____4119 with | (h2,uvs,args) -> (h2, (FStar_List.append uvs u), args)) | FStar_Syntax_Syntax.Tm_app (head1,args) -> - let uu____4134 = head_fv_universes_args head1 in - (match uu____4134 with + let uu____4207 = head_fv_universes_args head1 in + (match uu____4207 with | (h1,uvs,args') -> (h1, uvs, (FStar_List.append args' args))) - | uu____4206 -> - let uu____4207 = - let uu____4212 = - let uu____4213 = - let uu____4214 = resugar_term h in - parser_term_to_string uu____4214 in + | uu____4279 -> + let uu____4280 = + let uu____4285 = + let uu____4286 = + let uu____4287 = resugar_term h in + parser_term_to_string uu____4287 in FStar_Util.format1 "Not an application or a fv %s" - uu____4213 in - (FStar_Errors.Fatal_NotApplicationOrFv, uu____4212) in - FStar_Errors.raise_error uu____4207 + uu____4286 in + (FStar_Errors.Fatal_NotApplicationOrFv, uu____4285) in + FStar_Errors.raise_error uu____4280 e.FStar_Syntax_Syntax.pos in - let uu____4231 = + let uu____4304 = try - let uu____4283 = FStar_Syntax_Util.unmeta e in - head_fv_universes_args uu____4283 + let uu____4356 = FStar_Syntax_Util.unmeta e in + head_fv_universes_args uu____4356 with - | FStar_Errors.Err uu____4304 -> - let uu____4309 = - let uu____4314 = - let uu____4315 = - let uu____4316 = resugar_term e in - parser_term_to_string uu____4316 in + | FStar_Errors.Err uu____4377 -> + let uu____4382 = + let uu____4387 = + let uu____4388 = + let uu____4389 = resugar_term e in + parser_term_to_string uu____4389 in FStar_Util.format1 "wrong Data_app head format %s" - uu____4315 in - (FStar_Errors.Fatal_WrongDataAppHeadFormat, uu____4314) in - FStar_Errors.raise_error uu____4309 + uu____4388 in + (FStar_Errors.Fatal_WrongDataAppHeadFormat, uu____4387) in + FStar_Errors.raise_error uu____4382 e.FStar_Syntax_Syntax.pos in - (match uu____4231 with + (match uu____4304 with | (head1,universes,args) -> let universes1 = FStar_List.map (fun u -> - let uu____4370 = + let uu____4443 = resugar_universe u t.FStar_Syntax_Syntax.pos in - (uu____4370, FStar_Parser_AST.UnivApp)) universes in + (uu____4443, FStar_Parser_AST.UnivApp)) universes in let args1 = FStar_List.filter_map - (fun uu____4394 -> - match uu____4394 with + (fun uu____4467 -> + match uu____4467 with | (t1,q) -> - let uu____4413 = resugar_imp q in - (match uu____4413 with + let uu____4486 = resugar_imp q in + (match uu____4486 with | FStar_Pervasives_Native.Some rimp -> - let uu____4423 = - let uu____4428 = resugar_term t1 in - (uu____4428, rimp) in - FStar_Pervasives_Native.Some uu____4423 + let uu____4496 = + let uu____4501 = resugar_term t1 in + (uu____4501, rimp) in + FStar_Pervasives_Native.Some uu____4496 | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None)) args in let args2 = - let uu____4444 = + let uu____4517 = (FStar_Parser_Const.is_tuple_data_lid' head1) || - (let uu____4446 = FStar_Options.print_universes () in - Prims.op_Negation uu____4446) in - if uu____4444 + (let uu____4519 = FStar_Options.print_universes () in + Prims.op_Negation uu____4519) in + if uu____4517 then args1 else FStar_List.append universes1 args1 in mk1 (FStar_Parser_AST.Construct (head1, args2))) @@ -1181,16 +1192,16 @@ let rec resugar_term: FStar_Syntax_Syntax.term -> FStar_Parser_AST.term = let term = resugar_term e in let rec resugar_seq t1 = match t1.FStar_Parser_AST.tm with - | FStar_Parser_AST.Let (uu____4469,(p,t11)::[],t2) -> + | FStar_Parser_AST.Let (uu____4542,(p,t11)::[],t2) -> mk1 (FStar_Parser_AST.Seq (t11, t2)) | FStar_Parser_AST.Ascribed (t11,t2,t3) -> - let uu____4494 = - let uu____4495 = - let uu____4504 = resugar_seq t11 in - (uu____4504, t2, t3) in - FStar_Parser_AST.Ascribed uu____4495 in - mk1 uu____4494 - | uu____4507 -> t1 in + let uu____4567 = + let uu____4568 = + let uu____4577 = resugar_seq t11 in + (uu____4577, t2, t3) in + FStar_Parser_AST.Ascribed uu____4568 in + mk1 uu____4567 + | uu____4580 -> t1 in resugar_seq term | FStar_Syntax_Syntax.Primop -> resugar_term e | FStar_Syntax_Syntax.Masked_effect -> resugar_term e @@ -1202,7 +1213,7 @@ let rec resugar_term: FStar_Syntax_Syntax.term -> FStar_Parser_AST.term = -> mk1 (FStar_Parser_AST.Let (FStar_Parser_AST.Mutable, l, t1)) - | uu____4529 -> + | uu____4602 -> failwith "mutable_alloc should have let term with no qualifier") | FStar_Syntax_Syntax.Mutable_rval -> @@ -1210,34 +1221,34 @@ let rec resugar_term: FStar_Syntax_Syntax.term -> FStar_Parser_AST.term = FStar_Syntax_Syntax.lid_as_fv FStar_Parser_Const.sread_lid FStar_Syntax_Syntax.Delta_constant FStar_Pervasives_Native.None in - let uu____4531 = - let uu____4532 = FStar_Syntax_Subst.compress e in - uu____4532.FStar_Syntax_Syntax.n in - (match uu____4531 with + let uu____4604 = + let uu____4605 = FStar_Syntax_Subst.compress e in + uu____4605.FStar_Syntax_Syntax.n in + (match uu____4604 with | FStar_Syntax_Syntax.Tm_app ({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_fvar fv1; - FStar_Syntax_Syntax.pos = uu____4536; - FStar_Syntax_Syntax.vars = uu____4537;_},(term,uu____4539)::[]) + FStar_Syntax_Syntax.pos = uu____4609; + FStar_Syntax_Syntax.vars = uu____4610;_},(term,uu____4612)::[]) -> resugar_term term - | uu____4568 -> failwith "mutable_rval should have app term") in + | uu____4641 -> failwith "mutable_rval should have app term") in (match m with | FStar_Syntax_Syntax.Meta_pattern pats -> let pats1 = FStar_All.pipe_right (FStar_List.flatten pats) (FStar_List.map - (fun uu____4606 -> - match uu____4606 with - | (x,uu____4612) -> resugar_term x)) in + (fun uu____4679 -> + match uu____4679 with + | (x,uu____4685) -> resugar_term x)) in mk1 (FStar_Parser_AST.Attributes pats1) - | FStar_Syntax_Syntax.Meta_labeled (l,uu____4614,p) -> - let uu____4616 = - let uu____4617 = - let uu____4624 = resugar_term e in (uu____4624, l, p) in - FStar_Parser_AST.Labeled uu____4617 in - mk1 uu____4616 + | FStar_Syntax_Syntax.Meta_labeled (l,uu____4687,p) -> + let uu____4689 = + let uu____4690 = + let uu____4697 = resugar_term e in (uu____4697, l, p) in + FStar_Parser_AST.Labeled uu____4690 in + mk1 uu____4689 | FStar_Syntax_Syntax.Meta_desugared i -> resugar_meta_desugared i - | FStar_Syntax_Syntax.Meta_alien (uu____4626,s,uu____4628) -> + | FStar_Syntax_Syntax.Meta_alien (uu____4699,s,uu____4701) -> (match e.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Tm_unknown -> mk1 @@ -1245,7 +1256,7 @@ let rec resugar_term: FStar_Syntax_Syntax.term -> FStar_Parser_AST.term = (FStar_Const.Const_string ((Prims.strcat "(alien:" (Prims.strcat s ")")), (e.FStar_Syntax_Syntax.pos)))) - | uu____4633 -> + | uu____4706 -> (FStar_Errors.log_issue e.FStar_Syntax_Syntax.pos (FStar_Errors.Warning_MetaAlienNotATmUnknown, "Meta_alien was not a Tm_unknown"); @@ -1253,41 +1264,41 @@ let rec resugar_term: FStar_Syntax_Syntax.term -> FStar_Parser_AST.term = | FStar_Syntax_Syntax.Meta_named t1 -> mk1 (FStar_Parser_AST.Name t1) | FStar_Syntax_Syntax.Meta_monadic (name1,t1) -> - let uu____4642 = - let uu____4643 = - let uu____4652 = resugar_term e in - let uu____4653 = - let uu____4654 = - let uu____4655 = - let uu____4666 = - let uu____4673 = - let uu____4678 = resugar_term t1 in - (uu____4678, FStar_Parser_AST.Nothing) in - [uu____4673] in - (name1, uu____4666) in - FStar_Parser_AST.Construct uu____4655 in - mk1 uu____4654 in - (uu____4652, uu____4653, FStar_Pervasives_Native.None) in - FStar_Parser_AST.Ascribed uu____4643 in - mk1 uu____4642 - | FStar_Syntax_Syntax.Meta_monadic_lift (name1,uu____4696,t1) -> - let uu____4702 = - let uu____4703 = - let uu____4712 = resugar_term e in - let uu____4713 = - let uu____4714 = - let uu____4715 = - let uu____4726 = - let uu____4733 = - let uu____4738 = resugar_term t1 in - (uu____4738, FStar_Parser_AST.Nothing) in - [uu____4733] in - (name1, uu____4726) in - FStar_Parser_AST.Construct uu____4715 in - mk1 uu____4714 in - (uu____4712, uu____4713, FStar_Pervasives_Native.None) in - FStar_Parser_AST.Ascribed uu____4703 in - mk1 uu____4702) + let uu____4715 = + let uu____4716 = + let uu____4725 = resugar_term e in + let uu____4726 = + let uu____4727 = + let uu____4728 = + let uu____4739 = + let uu____4746 = + let uu____4751 = resugar_term t1 in + (uu____4751, FStar_Parser_AST.Nothing) in + [uu____4746] in + (name1, uu____4739) in + FStar_Parser_AST.Construct uu____4728 in + mk1 uu____4727 in + (uu____4725, uu____4726, FStar_Pervasives_Native.None) in + FStar_Parser_AST.Ascribed uu____4716 in + mk1 uu____4715 + | FStar_Syntax_Syntax.Meta_monadic_lift (name1,uu____4769,t1) -> + let uu____4775 = + let uu____4776 = + let uu____4785 = resugar_term e in + let uu____4786 = + let uu____4787 = + let uu____4788 = + let uu____4799 = + let uu____4806 = + let uu____4811 = resugar_term t1 in + (uu____4811, FStar_Parser_AST.Nothing) in + [uu____4806] in + (name1, uu____4799) in + FStar_Parser_AST.Construct uu____4788 in + mk1 uu____4787 in + (uu____4785, uu____4786, FStar_Pervasives_Native.None) in + FStar_Parser_AST.Ascribed uu____4776 in + mk1 uu____4775) | FStar_Syntax_Syntax.Tm_unknown -> mk1 FStar_Parser_AST.Wild and resugar_comp: FStar_Syntax_Syntax.comp -> FStar_Parser_AST.term = fun c -> @@ -1304,8 +1315,8 @@ and resugar_comp: FStar_Syntax_Syntax.comp -> FStar_Parser_AST.term = (FStar_Parser_Const.effect_Tot_lid, [(t, FStar_Parser_AST.Nothing)])) | FStar_Pervasives_Native.Some u1 -> - let uu____4786 = FStar_Options.print_universes () in - if uu____4786 + let uu____4859 = FStar_Options.print_universes () in + if uu____4859 then let u2 = resugar_universe u1 c.FStar_Syntax_Syntax.pos in mk1 @@ -1327,8 +1338,8 @@ and resugar_comp: FStar_Syntax_Syntax.comp -> FStar_Parser_AST.term = (FStar_Parser_Const.effect_GTot_lid, [(t, FStar_Parser_AST.Nothing)])) | FStar_Pervasives_Native.Some u1 -> - let uu____4847 = FStar_Options.print_universes () in - if uu____4847 + let uu____4920 = FStar_Options.print_universes () in + if uu____4920 then let u2 = resugar_universe u1 c.FStar_Syntax_Syntax.pos in mk1 @@ -1343,10 +1354,10 @@ and resugar_comp: FStar_Syntax_Syntax.comp -> FStar_Parser_AST.term = [(t, FStar_Parser_AST.Nothing)]))) | FStar_Syntax_Syntax.Comp c1 -> let result = - let uu____4888 = resugar_term c1.FStar_Syntax_Syntax.result_typ in - (uu____4888, FStar_Parser_AST.Nothing) in - let uu____4889 = FStar_Options.print_effect_args () in - if uu____4889 + let uu____4961 = resugar_term c1.FStar_Syntax_Syntax.result_typ in + (uu____4961, FStar_Parser_AST.Nothing) in + let uu____4962 = FStar_Options.print_effect_args () in + if uu____4962 then let universe = FStar_List.map (fun u -> resugar_universe u) @@ -1359,43 +1370,43 @@ and resugar_comp: FStar_Syntax_Syntax.comp -> FStar_Parser_AST.term = match c1.FStar_Syntax_Syntax.effect_args with | pre::post::pats::[] -> let post1 = - let uu____4976 = + let uu____5049 = FStar_Syntax_Util.unthunk_lemma_post (FStar_Pervasives_Native.fst post) in - (uu____4976, (FStar_Pervasives_Native.snd post)) in - let uu____4985 = - let uu____4994 = + (uu____5049, (FStar_Pervasives_Native.snd post)) in + let uu____5058 = + let uu____5067 = FStar_Syntax_Util.is_fvar FStar_Parser_Const.true_lid (FStar_Pervasives_Native.fst pre) in - if uu____4994 then [] else [pre] in - let uu____5024 = - let uu____5033 = - let uu____5042 = + if uu____5067 then [] else [pre] in + let uu____5097 = + let uu____5106 = + let uu____5115 = FStar_Syntax_Util.is_fvar FStar_Parser_Const.nil_lid (FStar_Pervasives_Native.fst pats) in - if uu____5042 then [] else [pats] in - FStar_List.append [post1] uu____5033 in - FStar_List.append uu____4985 uu____5024 - | uu____5096 -> c1.FStar_Syntax_Syntax.effect_args + if uu____5115 then [] else [pats] in + FStar_List.append [post1] uu____5106 in + FStar_List.append uu____5058 uu____5097 + | uu____5169 -> c1.FStar_Syntax_Syntax.effect_args else c1.FStar_Syntax_Syntax.effect_args in let args1 = FStar_List.map - (fun uu____5125 -> - match uu____5125 with - | (e,uu____5135) -> - let uu____5136 = resugar_term e in - (uu____5136, FStar_Parser_AST.Nothing)) args in - let rec aux l uu___73_5157 = - match uu___73_5157 with + (fun uu____5198 -> + match uu____5198 with + | (e,uu____5208) -> + let uu____5209 = resugar_term e in + (uu____5209, FStar_Parser_AST.Nothing)) args in + let rec aux l uu___73_5230 = + match uu___73_5230 with | [] -> l | hd1::tl1 -> (match hd1 with | FStar_Syntax_Syntax.DECREASES e -> let e1 = - let uu____5190 = resugar_term e in - (uu____5190, FStar_Parser_AST.Nothing) in + let uu____5263 = resugar_term e in + (uu____5263, FStar_Parser_AST.Nothing) in aux (e1 :: l) tl1 - | uu____5195 -> aux l tl1) in + | uu____5268 -> aux l tl1) in let decrease = aux [] c1.FStar_Syntax_Syntax.flags in mk1 (FStar_Parser_AST.Construct @@ -1412,33 +1423,33 @@ and resugar_binder: = fun b -> fun r -> - let uu____5240 = b in - match uu____5240 with + let uu____5313 = b in + match uu____5313 with | (x,aq) -> - let uu____5245 = resugar_arg_qual aq in - FStar_Util.map_opt uu____5245 + let uu____5318 = resugar_arg_qual aq in + FStar_Util.map_opt uu____5318 (fun imp -> let e = resugar_term x.FStar_Syntax_Syntax.sort in match e.FStar_Parser_AST.tm with | FStar_Parser_AST.Wild -> - let uu____5259 = - let uu____5260 = bv_as_unique_ident x in - FStar_Parser_AST.Variable uu____5260 in - FStar_Parser_AST.mk_binder uu____5259 r + let uu____5332 = + let uu____5333 = bv_as_unique_ident x in + FStar_Parser_AST.Variable uu____5333 in + FStar_Parser_AST.mk_binder uu____5332 r FStar_Parser_AST.Type_level imp - | uu____5261 -> - let uu____5262 = FStar_Syntax_Syntax.is_null_bv x in - if uu____5262 + | uu____5334 -> + let uu____5335 = FStar_Syntax_Syntax.is_null_bv x in + if uu____5335 then FStar_Parser_AST.mk_binder (FStar_Parser_AST.NoName e) r FStar_Parser_AST.Type_level imp else - (let uu____5264 = - let uu____5265 = - let uu____5270 = bv_as_unique_ident x in - (uu____5270, e) in - FStar_Parser_AST.Annotated uu____5265 in - FStar_Parser_AST.mk_binder uu____5264 r + (let uu____5337 = + let uu____5338 = + let uu____5343 = bv_as_unique_ident x in + (uu____5343, e) in + FStar_Parser_AST.Annotated uu____5338 in + FStar_Parser_AST.mk_binder uu____5337 r FStar_Parser_AST.Type_level imp)) and resugar_bv_as_pat: FStar_Syntax_Syntax.bv -> @@ -1448,13 +1459,13 @@ and resugar_bv_as_pat: fun x -> fun qual -> let mk1 a = - let uu____5279 = FStar_Syntax_Syntax.range_of_bv x in - FStar_Parser_AST.mk_pattern a uu____5279 in - let uu____5280 = - let uu____5281 = + let uu____5352 = FStar_Syntax_Syntax.range_of_bv x in + FStar_Parser_AST.mk_pattern a uu____5352 in + let uu____5353 = + let uu____5354 = FStar_Syntax_Subst.compress x.FStar_Syntax_Syntax.sort in - uu____5281.FStar_Syntax_Syntax.n in - match uu____5280 with + uu____5354.FStar_Syntax_Syntax.n in + match uu____5353 with | FStar_Syntax_Syntax.Tm_unknown -> let i = FStar_String.compare @@ -1462,43 +1473,43 @@ and resugar_bv_as_pat: FStar_Ident.reserved_prefix in if i = (Prims.parse_int "0") then - let uu____5289 = mk1 FStar_Parser_AST.PatWild in - FStar_Pervasives_Native.Some uu____5289 + let uu____5362 = mk1 FStar_Parser_AST.PatWild in + FStar_Pervasives_Native.Some uu____5362 else - (let uu____5291 = resugar_arg_qual qual in - FStar_Util.bind_opt uu____5291 + (let uu____5364 = resugar_arg_qual qual in + FStar_Util.bind_opt uu____5364 (fun aq -> - let uu____5303 = - let uu____5304 = - let uu____5305 = - let uu____5312 = bv_as_unique_ident x in - (uu____5312, aq) in - FStar_Parser_AST.PatVar uu____5305 in - mk1 uu____5304 in - FStar_Pervasives_Native.Some uu____5303)) - | uu____5315 -> - let uu____5316 = resugar_arg_qual qual in - FStar_Util.bind_opt uu____5316 + let uu____5376 = + let uu____5377 = + let uu____5378 = + let uu____5385 = bv_as_unique_ident x in + (uu____5385, aq) in + FStar_Parser_AST.PatVar uu____5378 in + mk1 uu____5377 in + FStar_Pervasives_Native.Some uu____5376)) + | uu____5388 -> + let uu____5389 = resugar_arg_qual qual in + FStar_Util.bind_opt uu____5389 (fun aq -> let pat = - let uu____5331 = - let uu____5332 = - let uu____5339 = bv_as_unique_ident x in - (uu____5339, aq) in - FStar_Parser_AST.PatVar uu____5332 in - mk1 uu____5331 in - let uu____5342 = FStar_Options.print_bound_var_types () in - if uu____5342 + let uu____5404 = + let uu____5405 = + let uu____5412 = bv_as_unique_ident x in + (uu____5412, aq) in + FStar_Parser_AST.PatVar uu____5405 in + mk1 uu____5404 in + let uu____5415 = FStar_Options.print_bound_var_types () in + if uu____5415 then - let uu____5345 = - let uu____5346 = - let uu____5347 = - let uu____5352 = + let uu____5418 = + let uu____5419 = + let uu____5420 = + let uu____5425 = resugar_term x.FStar_Syntax_Syntax.sort in - (pat, uu____5352) in - FStar_Parser_AST.PatAscribed uu____5347 in - mk1 uu____5346 in - FStar_Pervasives_Native.Some uu____5345 + (pat, uu____5425) in + FStar_Parser_AST.PatAscribed uu____5420 in + mk1 uu____5419 in + FStar_Pervasives_Native.Some uu____5418 else FStar_Pervasives_Native.Some pat) and resugar_pat: FStar_Syntax_Syntax.pat -> FStar_Parser_AST.pattern = fun p -> @@ -1524,8 +1535,8 @@ and resugar_pat: FStar_Syntax_Syntax.pat -> FStar_Parser_AST.pattern = -> let args1 = FStar_List.map - (fun uu____5429 -> - match uu____5429 with + (fun uu____5502 -> + match uu____5502 with | (p2,b) -> aux p2 (FStar_Pervasives_Native.Some b)) args in mk1 (FStar_Parser_AST.PatList args1) | FStar_Syntax_Syntax.Pat_cons (fv,args) when @@ -1537,52 +1548,52 @@ and resugar_pat: FStar_Syntax_Syntax.pat -> FStar_Parser_AST.pattern = -> let args1 = FStar_List.map - (fun uu____5464 -> - match uu____5464 with + (fun uu____5537 -> + match uu____5537 with | (p2,b) -> aux p2 (FStar_Pervasives_Native.Some b)) args in - let uu____5471 = + let uu____5544 = FStar_Parser_Const.is_dtuple_data_lid' (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in - if uu____5471 + if uu____5544 then mk1 (FStar_Parser_AST.PatTuple (args1, true)) else mk1 (FStar_Parser_AST.PatTuple (args1, false)) | FStar_Syntax_Syntax.Pat_cons - ({ FStar_Syntax_Syntax.fv_name = uu____5477; - FStar_Syntax_Syntax.fv_delta = uu____5478; + ({ FStar_Syntax_Syntax.fv_name = uu____5550; + FStar_Syntax_Syntax.fv_delta = uu____5551; FStar_Syntax_Syntax.fv_qual = FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Record_ctor (name,fields));_},args) -> let fields1 = - let uu____5505 = + let uu____5578 = FStar_All.pipe_right fields (FStar_List.map (fun f -> FStar_Ident.lid_of_ids [f])) in - FStar_All.pipe_right uu____5505 FStar_List.rev in + FStar_All.pipe_right uu____5578 FStar_List.rev in let args1 = - let uu____5521 = + let uu____5594 = FStar_All.pipe_right args (FStar_List.map - (fun uu____5541 -> - match uu____5541 with + (fun uu____5614 -> + match uu____5614 with | (p2,b) -> aux p2 (FStar_Pervasives_Native.Some b))) in - FStar_All.pipe_right uu____5521 FStar_List.rev in + FStar_All.pipe_right uu____5594 FStar_List.rev in let rec map21 l1 l2 = match (l1, l2) with | ([],[]) -> [] | ([],hd1::tl1) -> [] | (hd1::tl1,[]) -> - let uu____5611 = map21 tl1 [] in - (hd1, (mk1 FStar_Parser_AST.PatWild)) :: uu____5611 + let uu____5684 = map21 tl1 [] in + (hd1, (mk1 FStar_Parser_AST.PatWild)) :: uu____5684 | (hd1::tl1,hd2::tl2) -> - let uu____5634 = map21 tl1 tl2 in (hd1, hd2) :: uu____5634 in + let uu____5707 = map21 tl1 tl2 in (hd1, hd2) :: uu____5707 in let args2 = - let uu____5652 = map21 fields1 args1 in - FStar_All.pipe_right uu____5652 FStar_List.rev in + let uu____5725 = map21 fields1 args1 in + FStar_All.pipe_right uu____5725 FStar_List.rev in mk1 (FStar_Parser_AST.PatRecord args2) | FStar_Syntax_Syntax.Pat_cons (fv,args) -> let args1 = FStar_List.map - (fun uu____5703 -> - match uu____5703 with + (fun uu____5776 -> + match uu____5776 with | (p2,b) -> aux p2 (FStar_Pervasives_Native.Some b)) args in mk1 (FStar_Parser_AST.PatApp @@ -1591,50 +1602,50 @@ and resugar_pat: FStar_Syntax_Syntax.pat -> FStar_Parser_AST.pattern = ((fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v))), args1)) | FStar_Syntax_Syntax.Pat_var v1 -> - let uu____5713 = + let uu____5786 = string_to_op (v1.FStar_Syntax_Syntax.ppname).FStar_Ident.idText in - (match uu____5713 with - | FStar_Pervasives_Native.Some (op,uu____5721) -> + (match uu____5786 with + | FStar_Pervasives_Native.Some (op,uu____5794) -> mk1 (FStar_Parser_AST.PatOp (FStar_Ident.mk_ident (op, ((v1.FStar_Syntax_Syntax.ppname).FStar_Ident.idRange)))) | FStar_Pervasives_Native.None -> - let uu____5730 = - let uu____5731 = - let uu____5738 = bv_as_unique_ident v1 in - let uu____5739 = to_arg_qual imp_opt in - (uu____5738, uu____5739) in - FStar_Parser_AST.PatVar uu____5731 in - mk1 uu____5730) - | FStar_Syntax_Syntax.Pat_wild uu____5744 -> + let uu____5803 = + let uu____5804 = + let uu____5811 = bv_as_unique_ident v1 in + let uu____5812 = to_arg_qual imp_opt in + (uu____5811, uu____5812) in + FStar_Parser_AST.PatVar uu____5804 in + mk1 uu____5803) + | FStar_Syntax_Syntax.Pat_wild uu____5817 -> mk1 FStar_Parser_AST.PatWild | FStar_Syntax_Syntax.Pat_dot_term (bv,term) -> let pat = - let uu____5752 = - let uu____5753 = - let uu____5760 = bv_as_unique_ident bv in - (uu____5760, + let uu____5825 = + let uu____5826 = + let uu____5833 = bv_as_unique_ident bv in + (uu____5833, (FStar_Pervasives_Native.Some FStar_Parser_AST.Implicit)) in - FStar_Parser_AST.PatVar uu____5753 in - mk1 uu____5752 in - let uu____5763 = FStar_Options.print_bound_var_types () in - if uu____5763 + FStar_Parser_AST.PatVar uu____5826 in + mk1 uu____5825 in + let uu____5836 = FStar_Options.print_bound_var_types () in + if uu____5836 then - let uu____5764 = - let uu____5765 = - let uu____5770 = resugar_term term in (pat, uu____5770) in - FStar_Parser_AST.PatAscribed uu____5765 in - mk1 uu____5764 + let uu____5837 = + let uu____5838 = + let uu____5843 = resugar_term term in (pat, uu____5843) in + FStar_Parser_AST.PatAscribed uu____5838 in + mk1 uu____5837 else pat in aux p FStar_Pervasives_Native.None let resugar_qualifier: FStar_Syntax_Syntax.qualifier -> FStar_Parser_AST.qualifier FStar_Pervasives_Native.option = - fun uu___74_5776 -> - match uu___74_5776 with + fun uu___74_5849 -> + match uu___74_5849 with | FStar_Syntax_Syntax.Assumption -> FStar_Pervasives_Native.Some FStar_Parser_AST.Assumption | FStar_Syntax_Syntax.New -> @@ -1668,17 +1679,17 @@ let resugar_qualifier: else FStar_Pervasives_Native.Some FStar_Parser_AST.Logic | FStar_Syntax_Syntax.Reifiable -> FStar_Pervasives_Native.Some FStar_Parser_AST.Reifiable - | FStar_Syntax_Syntax.Reflectable uu____5785 -> + | FStar_Syntax_Syntax.Reflectable uu____5858 -> FStar_Pervasives_Native.Some FStar_Parser_AST.Reflectable - | FStar_Syntax_Syntax.Discriminator uu____5786 -> + | FStar_Syntax_Syntax.Discriminator uu____5859 -> FStar_Pervasives_Native.None - | FStar_Syntax_Syntax.Projector uu____5787 -> + | FStar_Syntax_Syntax.Projector uu____5860 -> FStar_Pervasives_Native.None - | FStar_Syntax_Syntax.RecordType uu____5792 -> + | FStar_Syntax_Syntax.RecordType uu____5865 -> FStar_Pervasives_Native.None - | FStar_Syntax_Syntax.RecordConstructor uu____5801 -> + | FStar_Syntax_Syntax.RecordConstructor uu____5874 -> FStar_Pervasives_Native.None - | FStar_Syntax_Syntax.Action uu____5810 -> FStar_Pervasives_Native.None + | FStar_Syntax_Syntax.Action uu____5883 -> FStar_Pervasives_Native.None | FStar_Syntax_Syntax.ExceptionConstructor -> FStar_Pervasives_Native.None | FStar_Syntax_Syntax.HasMaskedEffect -> FStar_Pervasives_Native.None @@ -1686,8 +1697,8 @@ let resugar_qualifier: FStar_Pervasives_Native.Some FStar_Parser_AST.Effect_qual | FStar_Syntax_Syntax.OnlyName -> FStar_Pervasives_Native.None let resugar_pragma: FStar_Syntax_Syntax.pragma -> FStar_Parser_AST.pragma = - fun uu___75_5813 -> - match uu___75_5813 with + fun uu___75_5886 -> + match uu___75_5886 with | FStar_Syntax_Syntax.SetOptions s -> FStar_Parser_AST.SetOptions s | FStar_Syntax_Syntax.ResetOptions s -> FStar_Parser_AST.ResetOptions s | FStar_Syntax_Syntax.LightOff -> FStar_Parser_AST.LightOff @@ -1701,65 +1712,65 @@ let resugar_typ: fun se -> match se.FStar_Syntax_Syntax.sigel with | FStar_Syntax_Syntax.Sig_inductive_typ - (tylid,uvs,bs,t,uu____5840,datacons) -> - let uu____5850 = + (tylid,uvs,bs,t,uu____5913,datacons) -> + let uu____5923 = FStar_All.pipe_right datacon_ses (FStar_List.partition (fun se1 -> match se1.FStar_Syntax_Syntax.sigel with | FStar_Syntax_Syntax.Sig_datacon - (uu____5877,uu____5878,uu____5879,inductive_lid,uu____5881,uu____5882) + (uu____5950,uu____5951,uu____5952,inductive_lid,uu____5954,uu____5955) -> FStar_Ident.lid_equals inductive_lid tylid - | uu____5887 -> failwith "unexpected")) in - (match uu____5850 with + | uu____5960 -> failwith "unexpected")) in + (match uu____5923 with | (current_datacons,other_datacons) -> let bs1 = - let uu____5906 = FStar_Options.print_implicits () in - if uu____5906 then bs else filter_imp bs in + let uu____5979 = FStar_Options.print_implicits () in + if uu____5979 then bs else filter_imp bs in let bs2 = FStar_All.pipe_right bs1 ((map_opt ()) (fun b -> resugar_binder b t.FStar_Syntax_Syntax.pos)) in let tyc = - let uu____5916 = + let uu____5989 = FStar_All.pipe_right se.FStar_Syntax_Syntax.sigquals (FStar_Util.for_some - (fun uu___76_5921 -> - match uu___76_5921 with - | FStar_Syntax_Syntax.RecordType uu____5922 -> + (fun uu___76_5994 -> + match uu___76_5994 with + | FStar_Syntax_Syntax.RecordType uu____5995 -> true - | uu____5931 -> false)) in - if uu____5916 + | uu____6004 -> false)) in + if uu____5989 then let resugar_datacon_as_fields fields se1 = match se1.FStar_Syntax_Syntax.sigel with | FStar_Syntax_Syntax.Sig_datacon - (uu____5979,univs1,term,uu____5982,num,uu____5984) + (uu____6052,univs1,term,uu____6055,num,uu____6057) -> - let uu____5989 = - let uu____5990 = FStar_Syntax_Subst.compress term in - uu____5990.FStar_Syntax_Syntax.n in - (match uu____5989 with - | FStar_Syntax_Syntax.Tm_arrow (bs3,uu____6004) -> + let uu____6062 = + let uu____6063 = FStar_Syntax_Subst.compress term in + uu____6063.FStar_Syntax_Syntax.n in + (match uu____6062 with + | FStar_Syntax_Syntax.Tm_arrow (bs3,uu____6077) -> let mfields = FStar_All.pipe_right bs3 (FStar_List.map - (fun uu____6065 -> - match uu____6065 with + (fun uu____6138 -> + match uu____6138 with | (b,qual) -> - let uu____6080 = - let uu____6081 = + let uu____6153 = + let uu____6154 = bv_as_unique_ident b in FStar_Syntax_Util.unmangle_field_name - uu____6081 in - let uu____6082 = + uu____6154 in + let uu____6155 = resugar_term b.FStar_Syntax_Syntax.sort in - (uu____6080, uu____6082, + (uu____6153, uu____6155, FStar_Pervasives_Native.None))) in FStar_List.append mfields fields - | uu____6093 -> failwith "unexpected") - | uu____6104 -> failwith "unexpected" in + | uu____6166 -> failwith "unexpected") + | uu____6177 -> failwith "unexpected" in let fields = FStar_List.fold_left resugar_datacon_as_fields [] current_datacons in @@ -1770,15 +1781,15 @@ let resugar_typ: (let resugar_datacon constructors se1 = match se1.FStar_Syntax_Syntax.sigel with | FStar_Syntax_Syntax.Sig_datacon - (l,univs1,term,uu____6225,num,uu____6227) -> + (l,univs1,term,uu____6298,num,uu____6300) -> let c = - let uu____6245 = - let uu____6248 = resugar_term term in - FStar_Pervasives_Native.Some uu____6248 in - ((l.FStar_Ident.ident), uu____6245, + let uu____6318 = + let uu____6321 = resugar_term term in + FStar_Pervasives_Native.Some uu____6321 in + ((l.FStar_Ident.ident), uu____6318, FStar_Pervasives_Native.None, false) in c :: constructors - | uu____6265 -> failwith "unexpected" in + | uu____6338 -> failwith "unexpected" in let constructors = FStar_List.fold_left resugar_datacon [] current_datacons in @@ -1786,7 +1797,7 @@ let resugar_typ: ((tylid.FStar_Ident.ident), bs2, FStar_Pervasives_Native.None, constructors)) in (other_datacons, tyc)) - | uu____6341 -> + | uu____6414 -> failwith "Impossible : only Sig_inductive_typ can be resugared as types" let mk_decl: @@ -1797,12 +1808,12 @@ let mk_decl: fun r -> fun q -> fun d' -> - let uu____6359 = FStar_List.choose resugar_qualifier q in + let uu____6432 = FStar_List.choose resugar_qualifier q in { FStar_Parser_AST.d = d'; FStar_Parser_AST.drange = r; FStar_Parser_AST.doc = FStar_Pervasives_Native.None; - FStar_Parser_AST.quals = uu____6359; + FStar_Parser_AST.quals = uu____6432; FStar_Parser_AST.attrs = [] } let decl'_to_decl: @@ -1817,25 +1828,25 @@ let resugar_tscheme': Prims.string -> FStar_Syntax_Syntax.tscheme -> FStar_Parser_AST.decl = fun name -> fun ts -> - let uu____6372 = ts in - match uu____6372 with + let uu____6445 = ts in + match uu____6445 with | (univs1,typ) -> let name1 = FStar_Ident.mk_ident (name, (typ.FStar_Syntax_Syntax.pos)) in - let uu____6380 = - let uu____6381 = - let uu____6394 = - let uu____6403 = - let uu____6410 = - let uu____6411 = - let uu____6424 = resugar_term typ in - (name1, [], FStar_Pervasives_Native.None, uu____6424) in - FStar_Parser_AST.TyconAbbrev uu____6411 in - (uu____6410, FStar_Pervasives_Native.None) in - [uu____6403] in - (false, uu____6394) in - FStar_Parser_AST.Tycon uu____6381 in - mk_decl typ.FStar_Syntax_Syntax.pos [] uu____6380 + let uu____6453 = + let uu____6454 = + let uu____6467 = + let uu____6476 = + let uu____6483 = + let uu____6484 = + let uu____6497 = resugar_term typ in + (name1, [], FStar_Pervasives_Native.None, uu____6497) in + FStar_Parser_AST.TyconAbbrev uu____6484 in + (uu____6483, FStar_Pervasives_Native.None) in + [uu____6476] in + (false, uu____6467) in + FStar_Parser_AST.Tycon uu____6454 in + mk_decl typ.FStar_Syntax_Syntax.pos [] uu____6453 let resugar_tscheme: FStar_Syntax_Syntax.tscheme -> FStar_Parser_AST.decl = fun ts -> resugar_tscheme' "tscheme" ts let resugar_eff_decl: @@ -1852,38 +1863,38 @@ let resugar_eff_decl: let action_params = FStar_Syntax_Subst.open_binders d.FStar_Syntax_Syntax.action_params in - let uu____6478 = + let uu____6551 = FStar_Syntax_Subst.open_term action_params d.FStar_Syntax_Syntax.action_defn in - match uu____6478 with + match uu____6551 with | (bs,action_defn) -> - let uu____6485 = + let uu____6558 = FStar_Syntax_Subst.open_term action_params d.FStar_Syntax_Syntax.action_typ in - (match uu____6485 with + (match uu____6558 with | (bs1,action_typ) -> let action_params1 = - let uu____6493 = FStar_Options.print_implicits () in - if uu____6493 + let uu____6566 = FStar_Options.print_implicits () in + if uu____6566 then action_params else filter_imp action_params in let action_params2 = - let uu____6498 = + let uu____6571 = FStar_All.pipe_right action_params1 ((map_opt ()) (fun b -> resugar_binder b r)) in - FStar_All.pipe_right uu____6498 FStar_List.rev in + FStar_All.pipe_right uu____6571 FStar_List.rev in let action_defn1 = resugar_term action_defn in let action_typ1 = resugar_term action_typ in if for_free1 then let a = - let uu____6512 = - let uu____6523 = + let uu____6585 = + let uu____6596 = FStar_Ident.lid_of_str "construct" in - (uu____6523, + (uu____6596, [(action_defn1, FStar_Parser_AST.Nothing); (action_typ1, FStar_Parser_AST.Nothing)]) in - FStar_Parser_AST.Construct uu____6512 in + FStar_Parser_AST.Construct uu____6585 in let t = FStar_Parser_AST.mk_term a r FStar_Parser_AST.Un in mk_decl r q @@ -1905,19 +1916,19 @@ let resugar_eff_decl: action_defn1)), FStar_Pervasives_Native.None)]))) in let eff_name = (ed.FStar_Syntax_Syntax.mname).FStar_Ident.ident in - let uu____6597 = + let uu____6670 = FStar_Syntax_Subst.open_term ed.FStar_Syntax_Syntax.binders ed.FStar_Syntax_Syntax.signature in - match uu____6597 with + match uu____6670 with | (eff_binders,eff_typ) -> let eff_binders1 = - let uu____6605 = FStar_Options.print_implicits () in - if uu____6605 then eff_binders else filter_imp eff_binders in + let uu____6678 = FStar_Options.print_implicits () in + if uu____6678 then eff_binders else filter_imp eff_binders in let eff_binders2 = - let uu____6610 = + let uu____6683 = FStar_All.pipe_right eff_binders1 ((map_opt ()) (fun b -> resugar_binder b r)) in - FStar_All.pipe_right uu____6610 FStar_List.rev in + FStar_All.pipe_right uu____6683 FStar_List.rev in let eff_typ1 = resugar_term eff_typ in let ret_wp = resugar_tscheme' "ret_wp" ed.FStar_Syntax_Syntax.ret_wp in @@ -1978,70 +1989,70 @@ let resugar_sigelt: = fun se -> match se.FStar_Syntax_Syntax.sigel with - | FStar_Syntax_Syntax.Sig_bundle (ses,uu____6667) -> - let uu____6676 = + | FStar_Syntax_Syntax.Sig_bundle (ses,uu____6740) -> + let uu____6749 = FStar_All.pipe_right ses (FStar_List.partition (fun se1 -> match se1.FStar_Syntax_Syntax.sigel with - | FStar_Syntax_Syntax.Sig_inductive_typ uu____6698 -> true - | FStar_Syntax_Syntax.Sig_declare_typ uu____6715 -> true - | FStar_Syntax_Syntax.Sig_datacon uu____6722 -> false - | uu____6737 -> + | FStar_Syntax_Syntax.Sig_inductive_typ uu____6771 -> true + | FStar_Syntax_Syntax.Sig_declare_typ uu____6788 -> true + | FStar_Syntax_Syntax.Sig_datacon uu____6795 -> false + | uu____6810 -> failwith "Found a sigelt which is neither a type declaration or a data constructor in a sigelt")) in - (match uu____6676 with + (match uu____6749 with | (decl_typ_ses,datacon_ses) -> - let retrieve_datacons_and_resugar uu____6769 se1 = - match uu____6769 with + let retrieve_datacons_and_resugar uu____6842 se1 = + match uu____6842 with | (datacon_ses1,tycons) -> - let uu____6795 = resugar_typ datacon_ses1 se1 in - (match uu____6795 with + let uu____6868 = resugar_typ datacon_ses1 se1 in + (match uu____6868 with | (datacon_ses2,tyc) -> (datacon_ses2, (tyc :: tycons))) in - let uu____6810 = + let uu____6883 = FStar_List.fold_left retrieve_datacons_and_resugar (datacon_ses, []) decl_typ_ses in - (match uu____6810 with + (match uu____6883 with | (leftover_datacons,tycons) -> (match leftover_datacons with | [] -> - let uu____6845 = - let uu____6846 = - let uu____6847 = - let uu____6860 = + let uu____6918 = + let uu____6919 = + let uu____6920 = + let uu____6933 = FStar_List.map (fun tyc -> (tyc, FStar_Pervasives_Native.None)) tycons in - (false, uu____6860) in - FStar_Parser_AST.Tycon uu____6847 in - decl'_to_decl se uu____6846 in - FStar_Pervasives_Native.Some uu____6845 + (false, uu____6933) in + FStar_Parser_AST.Tycon uu____6920 in + decl'_to_decl se uu____6919 in + FStar_Pervasives_Native.Some uu____6918 | se1::[] -> (match se1.FStar_Syntax_Syntax.sigel with | FStar_Syntax_Syntax.Sig_datacon - (l,uu____6891,uu____6892,uu____6893,uu____6894,uu____6895) + (l,uu____6964,uu____6965,uu____6966,uu____6967,uu____6968) -> - let uu____6900 = + let uu____6973 = decl'_to_decl se1 (FStar_Parser_AST.Exception ((l.FStar_Ident.ident), FStar_Pervasives_Native.None)) in - FStar_Pervasives_Native.Some uu____6900 - | uu____6903 -> + FStar_Pervasives_Native.Some uu____6973 + | uu____6976 -> failwith "wrong format for resguar to Exception") - | uu____6906 -> failwith "Should not happen hopefully"))) - | FStar_Syntax_Syntax.Sig_let (lbs,uu____6912) -> - let uu____6917 = + | uu____6979 -> failwith "Should not happen hopefully"))) + | FStar_Syntax_Syntax.Sig_let (lbs,uu____6985) -> + let uu____6990 = FStar_All.pipe_right se.FStar_Syntax_Syntax.sigquals (FStar_Util.for_some - (fun uu___77_6923 -> - match uu___77_6923 with - | FStar_Syntax_Syntax.Projector (uu____6924,uu____6925) -> + (fun uu___77_6996 -> + match uu___77_6996 with + | FStar_Syntax_Syntax.Projector (uu____6997,uu____6998) -> true - | FStar_Syntax_Syntax.Discriminator uu____6926 -> true - | uu____6927 -> false)) in - if uu____6917 + | FStar_Syntax_Syntax.Discriminator uu____6999 -> true + | uu____7000 -> false)) in + if uu____6990 then FStar_Pervasives_Native.None else (let mk1 e = @@ -2051,46 +2062,46 @@ let resugar_sigelt: let desugared_let = mk1 (FStar_Syntax_Syntax.Tm_let (lbs, dummy)) in let t = resugar_term desugared_let in match t.FStar_Parser_AST.tm with - | FStar_Parser_AST.Let (isrec,lets,uu____6950) -> - let uu____6963 = + | FStar_Parser_AST.Let (isrec,lets,uu____7023) -> + let uu____7036 = decl'_to_decl se (FStar_Parser_AST.TopLevelLet (isrec, lets)) in - FStar_Pervasives_Native.Some uu____6963 - | uu____6970 -> failwith "Should not happen hopefully") - | FStar_Syntax_Syntax.Sig_assume (lid,uu____6974,fml) -> - let uu____6976 = - let uu____6977 = - let uu____6978 = - let uu____6983 = resugar_term fml in - ((lid.FStar_Ident.ident), uu____6983) in - FStar_Parser_AST.Assume uu____6978 in - decl'_to_decl se uu____6977 in - FStar_Pervasives_Native.Some uu____6976 + FStar_Pervasives_Native.Some uu____7036 + | uu____7043 -> failwith "Should not happen hopefully") + | FStar_Syntax_Syntax.Sig_assume (lid,uu____7047,fml) -> + let uu____7049 = + let uu____7050 = + let uu____7051 = + let uu____7056 = resugar_term fml in + ((lid.FStar_Ident.ident), uu____7056) in + FStar_Parser_AST.Assume uu____7051 in + decl'_to_decl se uu____7050 in + FStar_Pervasives_Native.Some uu____7049 | FStar_Syntax_Syntax.Sig_new_effect ed -> - let uu____6985 = + let uu____7058 = resugar_eff_decl false se.FStar_Syntax_Syntax.sigrng se.FStar_Syntax_Syntax.sigquals ed in - FStar_Pervasives_Native.Some uu____6985 + FStar_Pervasives_Native.Some uu____7058 | FStar_Syntax_Syntax.Sig_new_effect_for_free ed -> - let uu____6987 = + let uu____7060 = resugar_eff_decl true se.FStar_Syntax_Syntax.sigrng se.FStar_Syntax_Syntax.sigquals ed in - FStar_Pervasives_Native.Some uu____6987 + FStar_Pervasives_Native.Some uu____7060 | FStar_Syntax_Syntax.Sig_sub_effect e -> let src = e.FStar_Syntax_Syntax.source in let dst = e.FStar_Syntax_Syntax.target in let lift_wp = match e.FStar_Syntax_Syntax.lift_wp with - | FStar_Pervasives_Native.Some (uu____6996,t) -> - let uu____7008 = resugar_term t in - FStar_Pervasives_Native.Some uu____7008 - | uu____7009 -> FStar_Pervasives_Native.None in + | FStar_Pervasives_Native.Some (uu____7069,t) -> + let uu____7081 = resugar_term t in + FStar_Pervasives_Native.Some uu____7081 + | uu____7082 -> FStar_Pervasives_Native.None in let lift = match e.FStar_Syntax_Syntax.lift with - | FStar_Pervasives_Native.Some (uu____7017,t) -> - let uu____7029 = resugar_term t in - FStar_Pervasives_Native.Some uu____7029 - | uu____7030 -> FStar_Pervasives_Native.None in + | FStar_Pervasives_Native.Some (uu____7090,t) -> + let uu____7102 = resugar_term t in + FStar_Pervasives_Native.Some uu____7102 + | uu____7103 -> FStar_Pervasives_Native.None in let op = match (lift_wp, lift) with | (FStar_Pervasives_Native.Some t,FStar_Pervasives_Native.None ) -> @@ -2099,8 +2110,8 @@ let resugar_sigelt: -> FStar_Parser_AST.ReifiableLift (wp, t) | (FStar_Pervasives_Native.None ,FStar_Pervasives_Native.Some t) -> FStar_Parser_AST.LiftForFree t - | uu____7054 -> failwith "Should not happen hopefully" in - let uu____7063 = + | uu____7127 -> failwith "Should not happen hopefully" in + let uu____7136 = decl'_to_decl se (FStar_Parser_AST.SubEffect { @@ -2108,71 +2119,71 @@ let resugar_sigelt: FStar_Parser_AST.mdest = dst; FStar_Parser_AST.lift_op = op }) in - FStar_Pervasives_Native.Some uu____7063 + FStar_Pervasives_Native.Some uu____7136 | FStar_Syntax_Syntax.Sig_effect_abbrev (lid,vs,bs,c,flags1) -> - let uu____7073 = FStar_Syntax_Subst.open_comp bs c in - (match uu____7073 with + let uu____7146 = FStar_Syntax_Subst.open_comp bs c in + (match uu____7146 with | (bs1,c1) -> let bs2 = - let uu____7083 = FStar_Options.print_implicits () in - if uu____7083 then bs1 else filter_imp bs1 in + let uu____7156 = FStar_Options.print_implicits () in + if uu____7156 then bs1 else filter_imp bs1 in let bs3 = FStar_All.pipe_right bs2 ((map_opt ()) (fun b -> resugar_binder b se.FStar_Syntax_Syntax.sigrng)) in - let uu____7092 = - let uu____7093 = - let uu____7094 = - let uu____7107 = - let uu____7116 = - let uu____7123 = - let uu____7124 = - let uu____7137 = resugar_comp c1 in + let uu____7165 = + let uu____7166 = + let uu____7167 = + let uu____7180 = + let uu____7189 = + let uu____7196 = + let uu____7197 = + let uu____7210 = resugar_comp c1 in ((lid.FStar_Ident.ident), bs3, - FStar_Pervasives_Native.None, uu____7137) in - FStar_Parser_AST.TyconAbbrev uu____7124 in - (uu____7123, FStar_Pervasives_Native.None) in - [uu____7116] in - (false, uu____7107) in - FStar_Parser_AST.Tycon uu____7094 in - decl'_to_decl se uu____7093 in - FStar_Pervasives_Native.Some uu____7092) + FStar_Pervasives_Native.None, uu____7210) in + FStar_Parser_AST.TyconAbbrev uu____7197 in + (uu____7196, FStar_Pervasives_Native.None) in + [uu____7189] in + (false, uu____7180) in + FStar_Parser_AST.Tycon uu____7167 in + decl'_to_decl se uu____7166 in + FStar_Pervasives_Native.Some uu____7165) | FStar_Syntax_Syntax.Sig_pragma p -> - let uu____7165 = + let uu____7238 = decl'_to_decl se (FStar_Parser_AST.Pragma (resugar_pragma p)) in - FStar_Pervasives_Native.Some uu____7165 + FStar_Pervasives_Native.Some uu____7238 | FStar_Syntax_Syntax.Sig_declare_typ (lid,uvs,t) -> - let uu____7169 = + let uu____7242 = FStar_All.pipe_right se.FStar_Syntax_Syntax.sigquals (FStar_Util.for_some - (fun uu___78_7175 -> - match uu___78_7175 with - | FStar_Syntax_Syntax.Projector (uu____7176,uu____7177) -> + (fun uu___78_7248 -> + match uu___78_7248 with + | FStar_Syntax_Syntax.Projector (uu____7249,uu____7250) -> true - | FStar_Syntax_Syntax.Discriminator uu____7178 -> true - | uu____7179 -> false)) in - if uu____7169 + | FStar_Syntax_Syntax.Discriminator uu____7251 -> true + | uu____7252 -> false)) in + if uu____7242 then FStar_Pervasives_Native.None else (let t' = - let uu____7184 = - (let uu____7187 = FStar_Options.print_universes () in - Prims.op_Negation uu____7187) || (FStar_List.isEmpty uvs) in - if uu____7184 + let uu____7257 = + (let uu____7260 = FStar_Options.print_universes () in + Prims.op_Negation uu____7260) || (FStar_List.isEmpty uvs) in + if uu____7257 then resugar_term t else - (let uu____7189 = FStar_Syntax_Subst.open_univ_vars uvs t in - match uu____7189 with + (let uu____7262 = FStar_Syntax_Subst.open_univ_vars uvs t in + match uu____7262 with | (uvs1,t1) -> let universes = universe_to_string uvs1 in - let uu____7197 = resugar_term t1 in - label universes uu____7197) in - let uu____7198 = + let uu____7270 = resugar_term t1 in + label universes uu____7270) in + let uu____7271 = decl'_to_decl se (FStar_Parser_AST.Val ((lid.FStar_Ident.ident), t')) in - FStar_Pervasives_Native.Some uu____7198) - | FStar_Syntax_Syntax.Sig_inductive_typ uu____7199 -> + FStar_Pervasives_Native.Some uu____7271) + | FStar_Syntax_Syntax.Sig_inductive_typ uu____7272 -> FStar_Pervasives_Native.None - | FStar_Syntax_Syntax.Sig_datacon uu____7216 -> + | FStar_Syntax_Syntax.Sig_datacon uu____7289 -> FStar_Pervasives_Native.None - | FStar_Syntax_Syntax.Sig_main uu____7231 -> FStar_Pervasives_Native.None \ No newline at end of file + | FStar_Syntax_Syntax.Sig_main uu____7304 -> FStar_Pervasives_Native.None \ No newline at end of file diff --git a/src/ocaml-output/FStar_Syntax_Subst.ml b/src/ocaml-output/FStar_Syntax_Subst.ml index 270ed2c668b..d3fd1ad9ce8 100644 --- a/src/ocaml-output/FStar_Syntax_Subst.ml +++ b/src/ocaml-output/FStar_Syntax_Subst.ml @@ -1079,19 +1079,11 @@ let close_lcomp: fun bs -> fun lc -> let s = closing_subst bs in - let uu___65_4545 = lc in - let uu____4546 = subst s lc.FStar_Syntax_Syntax.res_typ in - { - FStar_Syntax_Syntax.eff_name = - (uu___65_4545.FStar_Syntax_Syntax.eff_name); - FStar_Syntax_Syntax.res_typ = uu____4546; - FStar_Syntax_Syntax.cflags = - (uu___65_4545.FStar_Syntax_Syntax.cflags); - FStar_Syntax_Syntax.comp = - (fun uu____4551 -> - let uu____4552 = lc.FStar_Syntax_Syntax.comp () in - subst_comp s uu____4552) - } + FStar_Syntax_Syntax.mk_lcomp lc.FStar_Syntax_Syntax.eff_name + lc.FStar_Syntax_Syntax.res_typ lc.FStar_Syntax_Syntax.cflags + (fun uu____4547 -> + let uu____4548 = FStar_Syntax_Syntax.lcomp_comp lc in + subst_comp s uu____4548) let close_pat: FStar_Syntax_Syntax.pat' FStar_Syntax_Syntax.withinfo_t -> (FStar_Syntax_Syntax.pat' FStar_Syntax_Syntax.withinfo_t,FStar_Syntax_Syntax.subst_elt @@ -1101,102 +1093,102 @@ let close_pat: fun p -> let rec aux sub1 p1 = match p1.FStar_Syntax_Syntax.v with - | FStar_Syntax_Syntax.Pat_constant uu____4599 -> (p1, sub1) + | FStar_Syntax_Syntax.Pat_constant uu____4595 -> (p1, sub1) | FStar_Syntax_Syntax.Pat_cons (fv,pats) -> - let uu____4622 = + let uu____4618 = FStar_All.pipe_right pats (FStar_List.fold_left - (fun uu____4688 -> - fun uu____4689 -> - match (uu____4688, uu____4689) with + (fun uu____4684 -> + fun uu____4685 -> + match (uu____4684, uu____4685) with | ((pats1,sub2),(p2,imp)) -> - let uu____4792 = aux sub2 p2 in - (match uu____4792 with + let uu____4788 = aux sub2 p2 in + (match uu____4788 with | (p3,sub3) -> (((p3, imp) :: pats1), sub3))) ([], sub1)) in - (match uu____4622 with + (match uu____4618 with | (pats1,sub2) -> - ((let uu___66_4894 = p1 in + ((let uu___65_4890 = p1 in { FStar_Syntax_Syntax.v = (FStar_Syntax_Syntax.Pat_cons (fv, (FStar_List.rev pats1))); FStar_Syntax_Syntax.p = - (uu___66_4894.FStar_Syntax_Syntax.p) + (uu___65_4890.FStar_Syntax_Syntax.p) }), sub2)) | FStar_Syntax_Syntax.Pat_var x -> let x1 = - let uu___67_4913 = x in - let uu____4914 = subst sub1 x.FStar_Syntax_Syntax.sort in + let uu___66_4909 = x in + let uu____4910 = subst sub1 x.FStar_Syntax_Syntax.sort in { FStar_Syntax_Syntax.ppname = - (uu___67_4913.FStar_Syntax_Syntax.ppname); + (uu___66_4909.FStar_Syntax_Syntax.ppname); FStar_Syntax_Syntax.index = - (uu___67_4913.FStar_Syntax_Syntax.index); - FStar_Syntax_Syntax.sort = uu____4914 + (uu___66_4909.FStar_Syntax_Syntax.index); + FStar_Syntax_Syntax.sort = uu____4910 } in let sub2 = - let uu____4920 = shift_subst (Prims.parse_int "1") sub1 in + let uu____4916 = shift_subst (Prims.parse_int "1") sub1 in (FStar_Syntax_Syntax.NM (x1, (Prims.parse_int "0"))) :: - uu____4920 in - ((let uu___68_4928 = p1 in + uu____4916 in + ((let uu___67_4924 = p1 in { FStar_Syntax_Syntax.v = (FStar_Syntax_Syntax.Pat_var x1); - FStar_Syntax_Syntax.p = (uu___68_4928.FStar_Syntax_Syntax.p) + FStar_Syntax_Syntax.p = (uu___67_4924.FStar_Syntax_Syntax.p) }), sub2) | FStar_Syntax_Syntax.Pat_wild x -> let x1 = - let uu___69_4933 = x in - let uu____4934 = subst sub1 x.FStar_Syntax_Syntax.sort in + let uu___68_4929 = x in + let uu____4930 = subst sub1 x.FStar_Syntax_Syntax.sort in { FStar_Syntax_Syntax.ppname = - (uu___69_4933.FStar_Syntax_Syntax.ppname); + (uu___68_4929.FStar_Syntax_Syntax.ppname); FStar_Syntax_Syntax.index = - (uu___69_4933.FStar_Syntax_Syntax.index); - FStar_Syntax_Syntax.sort = uu____4934 + (uu___68_4929.FStar_Syntax_Syntax.index); + FStar_Syntax_Syntax.sort = uu____4930 } in let sub2 = - let uu____4940 = shift_subst (Prims.parse_int "1") sub1 in + let uu____4936 = shift_subst (Prims.parse_int "1") sub1 in (FStar_Syntax_Syntax.NM (x1, (Prims.parse_int "0"))) :: - uu____4940 in - ((let uu___70_4948 = p1 in + uu____4936 in + ((let uu___69_4944 = p1 in { FStar_Syntax_Syntax.v = (FStar_Syntax_Syntax.Pat_wild x1); - FStar_Syntax_Syntax.p = (uu___70_4948.FStar_Syntax_Syntax.p) + FStar_Syntax_Syntax.p = (uu___69_4944.FStar_Syntax_Syntax.p) }), sub2) | FStar_Syntax_Syntax.Pat_dot_term (x,t0) -> let x1 = - let uu___71_4958 = x in - let uu____4959 = subst sub1 x.FStar_Syntax_Syntax.sort in + let uu___70_4954 = x in + let uu____4955 = subst sub1 x.FStar_Syntax_Syntax.sort in { FStar_Syntax_Syntax.ppname = - (uu___71_4958.FStar_Syntax_Syntax.ppname); + (uu___70_4954.FStar_Syntax_Syntax.ppname); FStar_Syntax_Syntax.index = - (uu___71_4958.FStar_Syntax_Syntax.index); - FStar_Syntax_Syntax.sort = uu____4959 + (uu___70_4954.FStar_Syntax_Syntax.index); + FStar_Syntax_Syntax.sort = uu____4955 } in let t01 = subst sub1 t0 in - ((let uu___72_4968 = p1 in + ((let uu___71_4964 = p1 in { FStar_Syntax_Syntax.v = (FStar_Syntax_Syntax.Pat_dot_term (x1, t01)); - FStar_Syntax_Syntax.p = (uu___72_4968.FStar_Syntax_Syntax.p) + FStar_Syntax_Syntax.p = (uu___71_4964.FStar_Syntax_Syntax.p) }), sub1) in aux [] p let close_branch: FStar_Syntax_Syntax.branch -> FStar_Syntax_Syntax.branch = - fun uu____4973 -> - match uu____4973 with + fun uu____4969 -> + match uu____4969 with | (p,wopt,e) -> - let uu____4993 = close_pat p in - (match uu____4993 with + let uu____4989 = close_pat p in + (match uu____4989 with | (p1,closing) -> let wopt1 = match wopt with | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None | FStar_Pervasives_Native.Some w -> - let uu____5024 = subst closing w in - FStar_Pervasives_Native.Some uu____5024 in + let uu____5020 = subst closing w in + FStar_Pervasives_Native.Some uu____5020 in let e1 = subst closing e in (p1, wopt1, e1)) let univ_var_opening: FStar_Syntax_Syntax.univ_names -> @@ -1230,8 +1222,8 @@ let open_univ_vars: = fun us -> fun t -> - let uu____5079 = univ_var_opening us in - match uu____5079 with | (s,us') -> let t1 = subst s t in (us', t1) + let uu____5075 = univ_var_opening us in + match uu____5075 with | (s,us') -> let t1 = subst s t in (us', t1) let open_univ_vars_comp: FStar_Syntax_Syntax.univ_names -> FStar_Syntax_Syntax.comp -> @@ -1240,9 +1232,9 @@ let open_univ_vars_comp: = fun us -> fun c -> - let uu____5119 = univ_var_opening us in - match uu____5119 with - | (s,us') -> let uu____5142 = subst_comp s c in (us', uu____5142) + let uu____5115 = univ_var_opening us in + match uu____5115 with + | (s,us') -> let uu____5138 = subst_comp s c in (us', uu____5138) let close_univ_vars: FStar_Syntax_Syntax.univ_names -> FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term @@ -1267,45 +1259,45 @@ let open_let_rec: = fun lbs -> fun t -> - let uu____5186 = - let uu____5197 = FStar_Syntax_Syntax.is_top_level lbs in - if uu____5197 + let uu____5182 = + let uu____5193 = FStar_Syntax_Syntax.is_top_level lbs in + if uu____5193 then ((Prims.parse_int "0"), lbs, []) else FStar_List.fold_right (fun lb -> - fun uu____5230 -> - match uu____5230 with + fun uu____5226 -> + match uu____5226 with | (i,lbs1,out) -> let x = - let uu____5263 = + let uu____5259 = FStar_Util.left lb.FStar_Syntax_Syntax.lbname in - FStar_Syntax_Syntax.freshen_bv uu____5263 in + FStar_Syntax_Syntax.freshen_bv uu____5259 in ((i + (Prims.parse_int "1")), - ((let uu___73_5269 = lb in + ((let uu___72_5265 = lb in { FStar_Syntax_Syntax.lbname = (FStar_Util.Inl x); FStar_Syntax_Syntax.lbunivs = - (uu___73_5269.FStar_Syntax_Syntax.lbunivs); + (uu___72_5265.FStar_Syntax_Syntax.lbunivs); FStar_Syntax_Syntax.lbtyp = - (uu___73_5269.FStar_Syntax_Syntax.lbtyp); + (uu___72_5265.FStar_Syntax_Syntax.lbtyp); FStar_Syntax_Syntax.lbeff = - (uu___73_5269.FStar_Syntax_Syntax.lbeff); + (uu___72_5265.FStar_Syntax_Syntax.lbeff); FStar_Syntax_Syntax.lbdef = - (uu___73_5269.FStar_Syntax_Syntax.lbdef) + (uu___72_5265.FStar_Syntax_Syntax.lbdef) }) :: lbs1), ((FStar_Syntax_Syntax.DB (i, x)) :: out))) lbs ((Prims.parse_int "0"), [], []) in - match uu____5186 with + match uu____5182 with | (n_let_recs,lbs1,let_rec_opening) -> let lbs2 = FStar_All.pipe_right lbs1 (FStar_List.map (fun lb -> - let uu____5307 = + let uu____5303 = FStar_List.fold_right (fun u -> - fun uu____5335 -> - match uu____5335 with + fun uu____5331 -> + match uu____5331 with | (i,us,out) -> let u1 = FStar_Syntax_Syntax.new_univ_name @@ -1315,23 +1307,23 @@ let open_let_rec: (i, (FStar_Syntax_Syntax.U_name u1))) :: out))) lb.FStar_Syntax_Syntax.lbunivs (n_let_recs, [], let_rec_opening) in - match uu____5307 with - | (uu____5376,us,u_let_rec_opening) -> - let uu___74_5387 = lb in - let uu____5388 = + match uu____5303 with + | (uu____5372,us,u_let_rec_opening) -> + let uu___73_5383 = lb in + let uu____5384 = subst u_let_rec_opening lb.FStar_Syntax_Syntax.lbtyp in - let uu____5391 = + let uu____5387 = subst u_let_rec_opening lb.FStar_Syntax_Syntax.lbdef in { FStar_Syntax_Syntax.lbname = - (uu___74_5387.FStar_Syntax_Syntax.lbname); + (uu___73_5383.FStar_Syntax_Syntax.lbname); FStar_Syntax_Syntax.lbunivs = us; - FStar_Syntax_Syntax.lbtyp = uu____5388; + FStar_Syntax_Syntax.lbtyp = uu____5384; FStar_Syntax_Syntax.lbeff = - (uu___74_5387.FStar_Syntax_Syntax.lbeff); - FStar_Syntax_Syntax.lbdef = uu____5391 + (uu___73_5383.FStar_Syntax_Syntax.lbeff); + FStar_Syntax_Syntax.lbdef = uu____5387 })) in let t1 = subst let_rec_opening t in (lbs2, t1) let close_let_rec: @@ -1342,60 +1334,60 @@ let close_let_rec: = fun lbs -> fun t -> - let uu____5413 = - let uu____5420 = FStar_Syntax_Syntax.is_top_level lbs in - if uu____5420 + let uu____5409 = + let uu____5416 = FStar_Syntax_Syntax.is_top_level lbs in + if uu____5416 then ((Prims.parse_int "0"), []) else FStar_List.fold_right (fun lb -> - fun uu____5442 -> - match uu____5442 with + fun uu____5438 -> + match uu____5438 with | (i,out) -> - let uu____5461 = - let uu____5464 = - let uu____5465 = - let uu____5470 = + let uu____5457 = + let uu____5460 = + let uu____5461 = + let uu____5466 = FStar_Util.left lb.FStar_Syntax_Syntax.lbname in - (uu____5470, i) in - FStar_Syntax_Syntax.NM uu____5465 in - uu____5464 :: out in - ((i + (Prims.parse_int "1")), uu____5461)) lbs + (uu____5466, i) in + FStar_Syntax_Syntax.NM uu____5461 in + uu____5460 :: out in + ((i + (Prims.parse_int "1")), uu____5457)) lbs ((Prims.parse_int "0"), []) in - match uu____5413 with + match uu____5409 with | (n_let_recs,let_rec_closing) -> let lbs1 = FStar_All.pipe_right lbs (FStar_List.map (fun lb -> - let uu____5502 = + let uu____5498 = FStar_List.fold_right (fun u -> - fun uu____5520 -> - match uu____5520 with + fun uu____5516 -> + match uu____5516 with | (i,out) -> ((i + (Prims.parse_int "1")), ((FStar_Syntax_Syntax.UD (u, i)) :: out))) lb.FStar_Syntax_Syntax.lbunivs (n_let_recs, let_rec_closing) in - match uu____5502 with - | (uu____5543,u_let_rec_closing) -> - let uu___75_5549 = lb in - let uu____5550 = + match uu____5498 with + | (uu____5539,u_let_rec_closing) -> + let uu___74_5545 = lb in + let uu____5546 = subst u_let_rec_closing lb.FStar_Syntax_Syntax.lbtyp in - let uu____5553 = + let uu____5549 = subst u_let_rec_closing lb.FStar_Syntax_Syntax.lbdef in { FStar_Syntax_Syntax.lbname = - (uu___75_5549.FStar_Syntax_Syntax.lbname); + (uu___74_5545.FStar_Syntax_Syntax.lbname); FStar_Syntax_Syntax.lbunivs = - (uu___75_5549.FStar_Syntax_Syntax.lbunivs); - FStar_Syntax_Syntax.lbtyp = uu____5550; + (uu___74_5545.FStar_Syntax_Syntax.lbunivs); + FStar_Syntax_Syntax.lbtyp = uu____5546; FStar_Syntax_Syntax.lbeff = - (uu___75_5549.FStar_Syntax_Syntax.lbeff); - FStar_Syntax_Syntax.lbdef = uu____5553 + (uu___74_5545.FStar_Syntax_Syntax.lbeff); + FStar_Syntax_Syntax.lbdef = uu____5549 })) in let t1 = subst let_rec_closing t in (lbs1, t1) let close_tscheme: @@ -1403,17 +1395,17 @@ let close_tscheme: FStar_Syntax_Syntax.tscheme -> FStar_Syntax_Syntax.tscheme = fun binders -> - fun uu____5564 -> - match uu____5564 with + fun uu____5560 -> + match uu____5560 with | (us,t) -> let n1 = (FStar_List.length binders) - (Prims.parse_int "1") in let k = FStar_List.length us in let s = FStar_List.mapi (fun i -> - fun uu____5589 -> - match uu____5589 with - | (x,uu____5595) -> + fun uu____5585 -> + match uu____5585 with + | (x,uu____5591) -> FStar_Syntax_Syntax.NM (x, (k + (n1 - i)))) binders in let t1 = subst s t in (us, t1) let close_univ_vars_tscheme: @@ -1421,8 +1413,8 @@ let close_univ_vars_tscheme: FStar_Syntax_Syntax.tscheme -> FStar_Syntax_Syntax.tscheme = fun us -> - fun uu____5610 -> - match uu____5610 with + fun uu____5606 -> + match uu____5606 with | (us',t) -> let n1 = (FStar_List.length us) - (Prims.parse_int "1") in let k = FStar_List.length us' in @@ -1430,17 +1422,17 @@ let close_univ_vars_tscheme: FStar_List.mapi (fun i -> fun x -> FStar_Syntax_Syntax.UD (x, (k + (n1 - i)))) us in - let uu____5632 = subst s t in (us', uu____5632) + let uu____5628 = subst s t in (us', uu____5628) let subst_tscheme: FStar_Syntax_Syntax.subst_elt Prims.list -> FStar_Syntax_Syntax.tscheme -> FStar_Syntax_Syntax.tscheme = fun s -> - fun uu____5642 -> - match uu____5642 with + fun uu____5638 -> + match uu____5638 with | (us,t) -> let s1 = shift_subst (FStar_List.length us) s in - let uu____5652 = subst s1 t in (us, uu____5652) + let uu____5648 = subst s1 t in (us, uu____5648) let opening_of_binders: FStar_Syntax_Syntax.binders -> FStar_Syntax_Syntax.subst_t = fun bs -> @@ -1448,9 +1440,9 @@ let opening_of_binders: FStar_All.pipe_right bs (FStar_List.mapi (fun i -> - fun uu____5674 -> - match uu____5674 with - | (x,uu____5680) -> FStar_Syntax_Syntax.DB ((n1 - i), x))) + fun uu____5670 -> + match uu____5670 with + | (x,uu____5676) -> FStar_Syntax_Syntax.DB ((n1 - i), x))) let closing_of_binders: FStar_Syntax_Syntax.binders -> FStar_Syntax_Syntax.subst_t = fun bs -> closing_subst bs \ No newline at end of file diff --git a/src/ocaml-output/FStar_Syntax_Syntax.ml b/src/ocaml-output/FStar_Syntax_Syntax.ml index d1fe128d43e..f3d2eeb3d70 100644 --- a/src/ocaml-output/FStar_Syntax_Syntax.ml +++ b/src/ocaml-output/FStar_Syntax_Syntax.ml @@ -207,6 +207,8 @@ and cflags = | RETURN | PARTIAL_RETURN | SOMETRIVIAL + | TRIVIAL_POSTCONDITION + | SHOULD_NOT_INLINE | LEMMA | CPS | DECREASES of term' syntax[@@deriving show] @@ -270,7 +272,9 @@ and lcomp = eff_name: FStar_Ident.lident; res_typ: term' syntax; cflags: cflags Prims.list; - comp: Prims.unit -> comp' syntax;}[@@deriving show] + comp_thunk: + (Prims.unit -> comp' syntax,comp' syntax) FStar_Util.either FStar_ST.ref;} +[@@deriving show] and residual_comp = { residual_effect: FStar_Ident.lident; @@ -278,38 +282,38 @@ and residual_comp = residual_flags: cflags Prims.list;}[@@deriving show] let uu___is_Tm_bvar: term' -> Prims.bool = fun projectee -> - match projectee with | Tm_bvar _0 -> true | uu____974 -> false + match projectee with | Tm_bvar _0 -> true | uu____1003 -> false let __proj__Tm_bvar__item___0: term' -> bv = fun projectee -> match projectee with | Tm_bvar _0 -> _0 let uu___is_Tm_name: term' -> Prims.bool = fun projectee -> - match projectee with | Tm_name _0 -> true | uu____986 -> false + match projectee with | Tm_name _0 -> true | uu____1015 -> false let __proj__Tm_name__item___0: term' -> bv = fun projectee -> match projectee with | Tm_name _0 -> _0 let uu___is_Tm_fvar: term' -> Prims.bool = fun projectee -> - match projectee with | Tm_fvar _0 -> true | uu____998 -> false + match projectee with | Tm_fvar _0 -> true | uu____1027 -> false let __proj__Tm_fvar__item___0: term' -> fv = fun projectee -> match projectee with | Tm_fvar _0 -> _0 let uu___is_Tm_uinst: term' -> Prims.bool = fun projectee -> - match projectee with | Tm_uinst _0 -> true | uu____1016 -> false + match projectee with | Tm_uinst _0 -> true | uu____1045 -> false let __proj__Tm_uinst__item___0: term' -> (term' syntax,universes) FStar_Pervasives_Native.tuple2 = fun projectee -> match projectee with | Tm_uinst _0 -> _0 let uu___is_Tm_constant: term' -> Prims.bool = fun projectee -> - match projectee with | Tm_constant _0 -> true | uu____1046 -> false + match projectee with | Tm_constant _0 -> true | uu____1075 -> false let __proj__Tm_constant__item___0: term' -> sconst = fun projectee -> match projectee with | Tm_constant _0 -> _0 let uu___is_Tm_type: term' -> Prims.bool = fun projectee -> - match projectee with | Tm_type _0 -> true | uu____1058 -> false + match projectee with | Tm_type _0 -> true | uu____1087 -> false let __proj__Tm_type__item___0: term' -> universe = fun projectee -> match projectee with | Tm_type _0 -> _0 let uu___is_Tm_abs: term' -> Prims.bool = fun projectee -> - match projectee with | Tm_abs _0 -> true | uu____1086 -> false + match projectee with | Tm_abs _0 -> true | uu____1115 -> false let __proj__Tm_abs__item___0: term' -> ((bv,aqual) FStar_Pervasives_Native.tuple2 Prims.list,term' syntax, @@ -318,7 +322,7 @@ let __proj__Tm_abs__item___0: = fun projectee -> match projectee with | Tm_abs _0 -> _0 let uu___is_Tm_arrow: term' -> Prims.bool = fun projectee -> - match projectee with | Tm_arrow _0 -> true | uu____1158 -> false + match projectee with | Tm_arrow _0 -> true | uu____1187 -> false let __proj__Tm_arrow__item___0: term' -> ((bv,aqual) FStar_Pervasives_Native.tuple2 Prims.list,comp' syntax) @@ -326,13 +330,13 @@ let __proj__Tm_arrow__item___0: = fun projectee -> match projectee with | Tm_arrow _0 -> _0 let uu___is_Tm_refine: term' -> Prims.bool = fun projectee -> - match projectee with | Tm_refine _0 -> true | uu____1212 -> false + match projectee with | Tm_refine _0 -> true | uu____1241 -> false let __proj__Tm_refine__item___0: term' -> (bv,term' syntax) FStar_Pervasives_Native.tuple2 = fun projectee -> match projectee with | Tm_refine _0 -> _0 let uu___is_Tm_app: term' -> Prims.bool = fun projectee -> - match projectee with | Tm_app _0 -> true | uu____1256 -> false + match projectee with | Tm_app _0 -> true | uu____1285 -> false let __proj__Tm_app__item___0: term' -> (term' syntax,(term' syntax,aqual) FStar_Pervasives_Native.tuple2 @@ -341,7 +345,7 @@ let __proj__Tm_app__item___0: = fun projectee -> match projectee with | Tm_app _0 -> _0 let uu___is_Tm_match: term' -> Prims.bool = fun projectee -> - match projectee with | Tm_match _0 -> true | uu____1332 -> false + match projectee with | Tm_match _0 -> true | uu____1361 -> false let __proj__Tm_match__item___0: term' -> (term' syntax,(pat' withinfo_t,term' syntax @@ -352,7 +356,7 @@ let __proj__Tm_match__item___0: = fun projectee -> match projectee with | Tm_match _0 -> _0 let uu___is_Tm_ascribed: term' -> Prims.bool = fun projectee -> - match projectee with | Tm_ascribed _0 -> true | uu____1436 -> false + match projectee with | Tm_ascribed _0 -> true | uu____1465 -> false let __proj__Tm_ascribed__item___0: term' -> (term' syntax,((term' syntax,comp' syntax) FStar_Util.either,term' syntax @@ -363,7 +367,7 @@ let __proj__Tm_ascribed__item___0: = fun projectee -> match projectee with | Tm_ascribed _0 -> _0 let uu___is_Tm_let: term' -> Prims.bool = fun projectee -> - match projectee with | Tm_let _0 -> true | uu____1538 -> false + match projectee with | Tm_let _0 -> true | uu____1567 -> false let __proj__Tm_let__item___0: term' -> ((Prims.bool,letbinding Prims.list) FStar_Pervasives_Native.tuple2, @@ -371,7 +375,7 @@ let __proj__Tm_let__item___0: = fun projectee -> match projectee with | Tm_let _0 -> _0 let uu___is_Tm_uvar: term' -> Prims.bool = fun projectee -> - match projectee with | Tm_uvar _0 -> true | uu____1602 -> false + match projectee with | Tm_uvar _0 -> true | uu____1631 -> false let __proj__Tm_uvar__item___0: term' -> ((term' syntax FStar_Pervasives_Native.option FStar_Unionfind.p_uvar, @@ -380,7 +384,7 @@ let __proj__Tm_uvar__item___0: = fun projectee -> match projectee with | Tm_uvar _0 -> _0 let uu___is_Tm_delayed: term' -> Prims.bool = fun projectee -> - match projectee with | Tm_delayed _0 -> true | uu____1686 -> false + match projectee with | Tm_delayed _0 -> true | uu____1715 -> false let __proj__Tm_delayed__item___0: term' -> ((term' syntax,(subst_elt Prims.list Prims.list,FStar_Range.range @@ -391,21 +395,21 @@ let __proj__Tm_delayed__item___0: = fun projectee -> match projectee with | Tm_delayed _0 -> _0 let uu___is_Tm_meta: term' -> Prims.bool = fun projectee -> - match projectee with | Tm_meta _0 -> true | uu____1776 -> false + match projectee with | Tm_meta _0 -> true | uu____1805 -> false let __proj__Tm_meta__item___0: term' -> (term' syntax,metadata) FStar_Pervasives_Native.tuple2 = fun projectee -> match projectee with | Tm_meta _0 -> _0 let uu___is_Tm_unknown: term' -> Prims.bool = fun projectee -> - match projectee with | Tm_unknown -> true | uu____1805 -> false + match projectee with | Tm_unknown -> true | uu____1834 -> false let uu___is_Pat_constant: pat' -> Prims.bool = fun projectee -> - match projectee with | Pat_constant _0 -> true | uu____1810 -> false + match projectee with | Pat_constant _0 -> true | uu____1839 -> false let __proj__Pat_constant__item___0: pat' -> sconst = fun projectee -> match projectee with | Pat_constant _0 -> _0 let uu___is_Pat_cons: pat' -> Prims.bool = fun projectee -> - match projectee with | Pat_cons _0 -> true | uu____1834 -> false + match projectee with | Pat_cons _0 -> true | uu____1863 -> false let __proj__Pat_cons__item___0: pat' -> (fv,(pat' withinfo_t,Prims.bool) FStar_Pervasives_Native.tuple2 @@ -414,17 +418,17 @@ let __proj__Pat_cons__item___0: = fun projectee -> match projectee with | Pat_cons _0 -> _0 let uu___is_Pat_var: pat' -> Prims.bool = fun projectee -> - match projectee with | Pat_var _0 -> true | uu____1882 -> false + match projectee with | Pat_var _0 -> true | uu____1911 -> false let __proj__Pat_var__item___0: pat' -> bv = fun projectee -> match projectee with | Pat_var _0 -> _0 let uu___is_Pat_wild: pat' -> Prims.bool = fun projectee -> - match projectee with | Pat_wild _0 -> true | uu____1894 -> false + match projectee with | Pat_wild _0 -> true | uu____1923 -> false let __proj__Pat_wild__item___0: pat' -> bv = fun projectee -> match projectee with | Pat_wild _0 -> _0 let uu___is_Pat_dot_term: pat' -> Prims.bool = fun projectee -> - match projectee with | Pat_dot_term _0 -> true | uu____1912 -> false + match projectee with | Pat_dot_term _0 -> true | uu____1941 -> false let __proj__Pat_dot_term__item___0: pat' -> (bv,term' syntax) FStar_Pervasives_Native.tuple2 = fun projectee -> match projectee with | Pat_dot_term _0 -> _0 @@ -493,7 +497,7 @@ let __proj__Mkcomp_typ__item__flags: comp_typ -> cflags Prims.list = flags = __fname__flags;_} -> __fname__flags let uu___is_Total: comp' -> Prims.bool = fun projectee -> - match projectee with | Total _0 -> true | uu____2184 -> false + match projectee with | Total _0 -> true | uu____2213 -> false let __proj__Total__item___0: comp' -> (term' syntax,universe FStar_Pervasives_Native.option) @@ -501,7 +505,7 @@ let __proj__Total__item___0: = fun projectee -> match projectee with | Total _0 -> _0 let uu___is_GTotal: comp' -> Prims.bool = fun projectee -> - match projectee with | GTotal _0 -> true | uu____2228 -> false + match projectee with | GTotal _0 -> true | uu____2257 -> false let __proj__GTotal__item___0: comp' -> (term' syntax,universe FStar_Pervasives_Native.option) @@ -509,49 +513,57 @@ let __proj__GTotal__item___0: = fun projectee -> match projectee with | GTotal _0 -> _0 let uu___is_Comp: comp' -> Prims.bool = fun projectee -> - match projectee with | Comp _0 -> true | uu____2264 -> false + match projectee with | Comp _0 -> true | uu____2293 -> false let __proj__Comp__item___0: comp' -> comp_typ = fun projectee -> match projectee with | Comp _0 -> _0 let uu___is_TOTAL: cflags -> Prims.bool = fun projectee -> - match projectee with | TOTAL -> true | uu____2275 -> false + match projectee with | TOTAL -> true | uu____2304 -> false let uu___is_MLEFFECT: cflags -> Prims.bool = fun projectee -> - match projectee with | MLEFFECT -> true | uu____2279 -> false + match projectee with | MLEFFECT -> true | uu____2308 -> false let uu___is_RETURN: cflags -> Prims.bool = fun projectee -> - match projectee with | RETURN -> true | uu____2283 -> false + match projectee with | RETURN -> true | uu____2312 -> false let uu___is_PARTIAL_RETURN: cflags -> Prims.bool = fun projectee -> - match projectee with | PARTIAL_RETURN -> true | uu____2287 -> false + match projectee with | PARTIAL_RETURN -> true | uu____2316 -> false let uu___is_SOMETRIVIAL: cflags -> Prims.bool = fun projectee -> - match projectee with | SOMETRIVIAL -> true | uu____2291 -> false + match projectee with | SOMETRIVIAL -> true | uu____2320 -> false +let uu___is_TRIVIAL_POSTCONDITION: cflags -> Prims.bool = + fun projectee -> + match projectee with + | TRIVIAL_POSTCONDITION -> true + | uu____2324 -> false +let uu___is_SHOULD_NOT_INLINE: cflags -> Prims.bool = + fun projectee -> + match projectee with | SHOULD_NOT_INLINE -> true | uu____2328 -> false let uu___is_LEMMA: cflags -> Prims.bool = fun projectee -> - match projectee with | LEMMA -> true | uu____2295 -> false + match projectee with | LEMMA -> true | uu____2332 -> false let uu___is_CPS: cflags -> Prims.bool = - fun projectee -> match projectee with | CPS -> true | uu____2299 -> false + fun projectee -> match projectee with | CPS -> true | uu____2336 -> false let uu___is_DECREASES: cflags -> Prims.bool = fun projectee -> - match projectee with | DECREASES _0 -> true | uu____2306 -> false + match projectee with | DECREASES _0 -> true | uu____2343 -> false let __proj__DECREASES__item___0: cflags -> term' syntax = fun projectee -> match projectee with | DECREASES _0 -> _0 let uu___is_Meta_pattern: metadata -> Prims.bool = fun projectee -> - match projectee with | Meta_pattern _0 -> true | uu____2334 -> false + match projectee with | Meta_pattern _0 -> true | uu____2371 -> false let __proj__Meta_pattern__item___0: metadata -> (term' syntax,aqual) FStar_Pervasives_Native.tuple2 Prims.list Prims.list = fun projectee -> match projectee with | Meta_pattern _0 -> _0 let uu___is_Meta_named: metadata -> Prims.bool = fun projectee -> - match projectee with | Meta_named _0 -> true | uu____2376 -> false + match projectee with | Meta_named _0 -> true | uu____2413 -> false let __proj__Meta_named__item___0: metadata -> FStar_Ident.lident = fun projectee -> match projectee with | Meta_named _0 -> _0 let uu___is_Meta_labeled: metadata -> Prims.bool = fun projectee -> - match projectee with | Meta_labeled _0 -> true | uu____2394 -> false + match projectee with | Meta_labeled _0 -> true | uu____2431 -> false let __proj__Meta_labeled__item___0: metadata -> (Prims.string,FStar_Range.range,Prims.bool) @@ -559,63 +571,63 @@ let __proj__Meta_labeled__item___0: = fun projectee -> match projectee with | Meta_labeled _0 -> _0 let uu___is_Meta_desugared: metadata -> Prims.bool = fun projectee -> - match projectee with | Meta_desugared _0 -> true | uu____2424 -> false + match projectee with | Meta_desugared _0 -> true | uu____2461 -> false let __proj__Meta_desugared__item___0: metadata -> meta_source_info = fun projectee -> match projectee with | Meta_desugared _0 -> _0 let uu___is_Meta_monadic: metadata -> Prims.bool = fun projectee -> - match projectee with | Meta_monadic _0 -> true | uu____2442 -> false + match projectee with | Meta_monadic _0 -> true | uu____2479 -> false let __proj__Meta_monadic__item___0: metadata -> (monad_name,term' syntax) FStar_Pervasives_Native.tuple2 = fun projectee -> match projectee with | Meta_monadic _0 -> _0 let uu___is_Meta_monadic_lift: metadata -> Prims.bool = fun projectee -> - match projectee with | Meta_monadic_lift _0 -> true | uu____2480 -> false + match projectee with | Meta_monadic_lift _0 -> true | uu____2517 -> false let __proj__Meta_monadic_lift__item___0: metadata -> (monad_name,monad_name,term' syntax) FStar_Pervasives_Native.tuple3 = fun projectee -> match projectee with | Meta_monadic_lift _0 -> _0 let uu___is_Meta_alien: metadata -> Prims.bool = fun projectee -> - match projectee with | Meta_alien _0 -> true | uu____2524 -> false + match projectee with | Meta_alien _0 -> true | uu____2561 -> false let __proj__Meta_alien__item___0: metadata -> (FStar_Dyn.dyn,Prims.string,term' syntax) FStar_Pervasives_Native.tuple3 = fun projectee -> match projectee with | Meta_alien _0 -> _0 let uu___is_Data_app: meta_source_info -> Prims.bool = fun projectee -> - match projectee with | Data_app -> true | uu____2559 -> false + match projectee with | Data_app -> true | uu____2596 -> false let uu___is_Sequence: meta_source_info -> Prims.bool = fun projectee -> - match projectee with | Sequence -> true | uu____2563 -> false + match projectee with | Sequence -> true | uu____2600 -> false let uu___is_Primop: meta_source_info -> Prims.bool = fun projectee -> - match projectee with | Primop -> true | uu____2567 -> false + match projectee with | Primop -> true | uu____2604 -> false let uu___is_Masked_effect: meta_source_info -> Prims.bool = fun projectee -> - match projectee with | Masked_effect -> true | uu____2571 -> false + match projectee with | Masked_effect -> true | uu____2608 -> false let uu___is_Meta_smt_pat: meta_source_info -> Prims.bool = fun projectee -> - match projectee with | Meta_smt_pat -> true | uu____2575 -> false + match projectee with | Meta_smt_pat -> true | uu____2612 -> false let uu___is_Mutable_alloc: meta_source_info -> Prims.bool = fun projectee -> - match projectee with | Mutable_alloc -> true | uu____2579 -> false + match projectee with | Mutable_alloc -> true | uu____2616 -> false let uu___is_Mutable_rval: meta_source_info -> Prims.bool = fun projectee -> - match projectee with | Mutable_rval -> true | uu____2583 -> false + match projectee with | Mutable_rval -> true | uu____2620 -> false let uu___is_Data_ctor: fv_qual -> Prims.bool = fun projectee -> - match projectee with | Data_ctor -> true | uu____2587 -> false + match projectee with | Data_ctor -> true | uu____2624 -> false let uu___is_Record_projector: fv_qual -> Prims.bool = fun projectee -> - match projectee with | Record_projector _0 -> true | uu____2596 -> false + match projectee with | Record_projector _0 -> true | uu____2633 -> false let __proj__Record_projector__item___0: fv_qual -> (FStar_Ident.lident,FStar_Ident.ident) FStar_Pervasives_Native.tuple2 = fun projectee -> match projectee with | Record_projector _0 -> _0 let uu___is_Record_ctor: fv_qual -> Prims.bool = fun projectee -> - match projectee with | Record_ctor _0 -> true | uu____2626 -> false + match projectee with | Record_ctor _0 -> true | uu____2663 -> false let __proj__Record_ctor__item___0: fv_qual -> (FStar_Ident.lident,FStar_Ident.ident Prims.list) @@ -623,31 +635,31 @@ let __proj__Record_ctor__item___0: = fun projectee -> match projectee with | Record_ctor _0 -> _0 let uu___is_DB: subst_elt -> Prims.bool = fun projectee -> - match projectee with | DB _0 -> true | uu____2660 -> false + match projectee with | DB _0 -> true | uu____2697 -> false let __proj__DB__item___0: subst_elt -> (Prims.int,bv) FStar_Pervasives_Native.tuple2 = fun projectee -> match projectee with | DB _0 -> _0 let uu___is_NM: subst_elt -> Prims.bool = fun projectee -> - match projectee with | NM _0 -> true | uu____2688 -> false + match projectee with | NM _0 -> true | uu____2725 -> false let __proj__NM__item___0: subst_elt -> (bv,Prims.int) FStar_Pervasives_Native.tuple2 = fun projectee -> match projectee with | NM _0 -> _0 let uu___is_NT: subst_elt -> Prims.bool = fun projectee -> - match projectee with | NT _0 -> true | uu____2718 -> false + match projectee with | NT _0 -> true | uu____2755 -> false let __proj__NT__item___0: subst_elt -> (bv,term' syntax) FStar_Pervasives_Native.tuple2 = fun projectee -> match projectee with | NT _0 -> _0 let uu___is_UN: subst_elt -> Prims.bool = fun projectee -> - match projectee with | UN _0 -> true | uu____2752 -> false + match projectee with | UN _0 -> true | uu____2789 -> false let __proj__UN__item___0: subst_elt -> (Prims.int,universe) FStar_Pervasives_Native.tuple2 = fun projectee -> match projectee with | UN _0 -> _0 let uu___is_UD: subst_elt -> Prims.bool = fun projectee -> - match projectee with | UD _0 -> true | uu____2780 -> false + match projectee with | UD _0 -> true | uu____2817 -> false let __proj__UD__item___0: subst_elt -> (univ_name,Prims.int) FStar_Pervasives_Native.tuple2 = fun projectee -> match projectee with | UD _0 -> _0 @@ -733,23 +745,29 @@ let __proj__Mklcomp__item__eff_name: lcomp -> FStar_Ident.lident = fun projectee -> match projectee with | { eff_name = __fname__eff_name; res_typ = __fname__res_typ; - cflags = __fname__cflags; comp = __fname__comp;_} -> + cflags = __fname__cflags; comp_thunk = __fname__comp_thunk;_} -> __fname__eff_name let __proj__Mklcomp__item__res_typ: lcomp -> term' syntax = fun projectee -> match projectee with | { eff_name = __fname__eff_name; res_typ = __fname__res_typ; - cflags = __fname__cflags; comp = __fname__comp;_} -> __fname__res_typ + cflags = __fname__cflags; comp_thunk = __fname__comp_thunk;_} -> + __fname__res_typ let __proj__Mklcomp__item__cflags: lcomp -> cflags Prims.list = fun projectee -> match projectee with | { eff_name = __fname__eff_name; res_typ = __fname__res_typ; - cflags = __fname__cflags; comp = __fname__comp;_} -> __fname__cflags -let __proj__Mklcomp__item__comp: lcomp -> Prims.unit -> comp' syntax = + cflags = __fname__cflags; comp_thunk = __fname__comp_thunk;_} -> + __fname__cflags +let __proj__Mklcomp__item__comp_thunk: + lcomp -> + (Prims.unit -> comp' syntax,comp' syntax) FStar_Util.either FStar_ST.ref + = fun projectee -> match projectee with | { eff_name = __fname__eff_name; res_typ = __fname__res_typ; - cflags = __fname__cflags; comp = __fname__comp;_} -> __fname__comp + cflags = __fname__cflags; comp_thunk = __fname__comp_thunk;_} -> + __fname__comp_thunk let __proj__Mkresidual_comp__item__residual_effect: residual_comp -> FStar_Ident.lident = fun projectee -> @@ -807,6 +825,24 @@ type uvars = ((term' syntax FStar_Pervasives_Native.option FStar_Unionfind.p_uvar, version) FStar_Pervasives_Native.tuple2,term' syntax) FStar_Pervasives_Native.tuple2 FStar_Util.set[@@deriving show] +let mk_lcomp: + FStar_Ident.lident -> + typ -> cflags Prims.list -> (Prims.unit -> comp) -> lcomp + = + fun eff_name -> + fun res_typ -> + fun cflags -> + fun comp_thunk -> + let uu____3486 = FStar_Util.mk_ref (FStar_Util.Inl comp_thunk) in + { eff_name; res_typ; cflags; comp_thunk = uu____3486 } +let lcomp_comp: lcomp -> comp = + fun lc -> + let uu____3536 = FStar_ST.op_Bang lc.comp_thunk in + match uu____3536 with + | FStar_Util.Inl thunk -> + let c = thunk () in + (FStar_ST.op_Colon_Equals lc.comp_thunk (FStar_Util.Inr c); c) + | FStar_Util.Inr c -> c type tscheme = (univ_name Prims.list,typ) FStar_Pervasives_Native.tuple2 [@@deriving show] type freenames_l = bv Prims.list[@@deriving show] @@ -843,69 +879,69 @@ type qualifier = | OnlyName[@@deriving show] let uu___is_Assumption: qualifier -> Prims.bool = fun projectee -> - match projectee with | Assumption -> true | uu____3404 -> false + match projectee with | Assumption -> true | uu____3770 -> false let uu___is_New: qualifier -> Prims.bool = - fun projectee -> match projectee with | New -> true | uu____3408 -> false + fun projectee -> match projectee with | New -> true | uu____3774 -> false let uu___is_Private: qualifier -> Prims.bool = fun projectee -> - match projectee with | Private -> true | uu____3412 -> false + match projectee with | Private -> true | uu____3778 -> false let uu___is_Unfold_for_unification_and_vcgen: qualifier -> Prims.bool = fun projectee -> match projectee with | Unfold_for_unification_and_vcgen -> true - | uu____3416 -> false + | uu____3782 -> false let uu___is_Visible_default: qualifier -> Prims.bool = fun projectee -> - match projectee with | Visible_default -> true | uu____3420 -> false + match projectee with | Visible_default -> true | uu____3786 -> false let uu___is_Irreducible: qualifier -> Prims.bool = fun projectee -> - match projectee with | Irreducible -> true | uu____3424 -> false + match projectee with | Irreducible -> true | uu____3790 -> false let uu___is_Abstract: qualifier -> Prims.bool = fun projectee -> - match projectee with | Abstract -> true | uu____3428 -> false + match projectee with | Abstract -> true | uu____3794 -> false let uu___is_Inline_for_extraction: qualifier -> Prims.bool = fun projectee -> match projectee with | Inline_for_extraction -> true - | uu____3432 -> false + | uu____3798 -> false let uu___is_NoExtract: qualifier -> Prims.bool = fun projectee -> - match projectee with | NoExtract -> true | uu____3436 -> false + match projectee with | NoExtract -> true | uu____3802 -> false let uu___is_Noeq: qualifier -> Prims.bool = fun projectee -> - match projectee with | Noeq -> true | uu____3440 -> false + match projectee with | Noeq -> true | uu____3806 -> false let uu___is_Unopteq: qualifier -> Prims.bool = fun projectee -> - match projectee with | Unopteq -> true | uu____3444 -> false + match projectee with | Unopteq -> true | uu____3810 -> false let uu___is_TotalEffect: qualifier -> Prims.bool = fun projectee -> - match projectee with | TotalEffect -> true | uu____3448 -> false + match projectee with | TotalEffect -> true | uu____3814 -> false let uu___is_Logic: qualifier -> Prims.bool = fun projectee -> - match projectee with | Logic -> true | uu____3452 -> false + match projectee with | Logic -> true | uu____3818 -> false let uu___is_Reifiable: qualifier -> Prims.bool = fun projectee -> - match projectee with | Reifiable -> true | uu____3456 -> false + match projectee with | Reifiable -> true | uu____3822 -> false let uu___is_Reflectable: qualifier -> Prims.bool = fun projectee -> - match projectee with | Reflectable _0 -> true | uu____3461 -> false + match projectee with | Reflectable _0 -> true | uu____3827 -> false let __proj__Reflectable__item___0: qualifier -> FStar_Ident.lident = fun projectee -> match projectee with | Reflectable _0 -> _0 let uu___is_Discriminator: qualifier -> Prims.bool = fun projectee -> - match projectee with | Discriminator _0 -> true | uu____3473 -> false + match projectee with | Discriminator _0 -> true | uu____3839 -> false let __proj__Discriminator__item___0: qualifier -> FStar_Ident.lident = fun projectee -> match projectee with | Discriminator _0 -> _0 let uu___is_Projector: qualifier -> Prims.bool = fun projectee -> - match projectee with | Projector _0 -> true | uu____3489 -> false + match projectee with | Projector _0 -> true | uu____3855 -> false let __proj__Projector__item___0: qualifier -> (FStar_Ident.lident,FStar_Ident.ident) FStar_Pervasives_Native.tuple2 = fun projectee -> match projectee with | Projector _0 -> _0 let uu___is_RecordType: qualifier -> Prims.bool = fun projectee -> - match projectee with | RecordType _0 -> true | uu____3521 -> false + match projectee with | RecordType _0 -> true | uu____3887 -> false let __proj__RecordType__item___0: qualifier -> (FStar_Ident.ident Prims.list,FStar_Ident.ident Prims.list) @@ -913,7 +949,7 @@ let __proj__RecordType__item___0: = fun projectee -> match projectee with | RecordType _0 -> _0 let uu___is_RecordConstructor: qualifier -> Prims.bool = fun projectee -> - match projectee with | RecordConstructor _0 -> true | uu____3565 -> false + match projectee with | RecordConstructor _0 -> true | uu____3931 -> false let __proj__RecordConstructor__item___0: qualifier -> (FStar_Ident.ident Prims.list,FStar_Ident.ident Prims.list) @@ -921,23 +957,23 @@ let __proj__RecordConstructor__item___0: = fun projectee -> match projectee with | RecordConstructor _0 -> _0 let uu___is_Action: qualifier -> Prims.bool = fun projectee -> - match projectee with | Action _0 -> true | uu____3601 -> false + match projectee with | Action _0 -> true | uu____3967 -> false let __proj__Action__item___0: qualifier -> FStar_Ident.lident = fun projectee -> match projectee with | Action _0 -> _0 let uu___is_ExceptionConstructor: qualifier -> Prims.bool = fun projectee -> match projectee with | ExceptionConstructor -> true - | uu____3612 -> false + | uu____3978 -> false let uu___is_HasMaskedEffect: qualifier -> Prims.bool = fun projectee -> - match projectee with | HasMaskedEffect -> true | uu____3616 -> false + match projectee with | HasMaskedEffect -> true | uu____3982 -> false let uu___is_Effect: qualifier -> Prims.bool = fun projectee -> - match projectee with | Effect -> true | uu____3620 -> false + match projectee with | Effect -> true | uu____3986 -> false let uu___is_OnlyName: qualifier -> Prims.bool = fun projectee -> - match projectee with | OnlyName -> true | uu____3624 -> false + match projectee with | OnlyName -> true | uu____3990 -> false type attribute = term[@@deriving show] type tycon = (FStar_Ident.lident,binders,typ) FStar_Pervasives_Native.tuple3 [@@deriving show] @@ -1375,7 +1411,7 @@ and sigelt = sigattrs: attribute Prims.list;}[@@deriving show] let uu___is_Sig_inductive_typ: sigelt' -> Prims.bool = fun projectee -> - match projectee with | Sig_inductive_typ _0 -> true | uu____4581 -> false + match projectee with | Sig_inductive_typ _0 -> true | uu____4947 -> false let __proj__Sig_inductive_typ__item___0: sigelt' -> (FStar_Ident.lident,univ_names,binders,typ,FStar_Ident.lident Prims.list, @@ -1383,7 +1419,7 @@ let __proj__Sig_inductive_typ__item___0: = fun projectee -> match projectee with | Sig_inductive_typ _0 -> _0 let uu___is_Sig_bundle: sigelt' -> Prims.bool = fun projectee -> - match projectee with | Sig_bundle _0 -> true | uu____4649 -> false + match projectee with | Sig_bundle _0 -> true | uu____5015 -> false let __proj__Sig_bundle__item___0: sigelt' -> (sigelt Prims.list,FStar_Ident.lident Prims.list) @@ -1391,7 +1427,7 @@ let __proj__Sig_bundle__item___0: = fun projectee -> match projectee with | Sig_bundle _0 -> _0 let uu___is_Sig_datacon: sigelt' -> Prims.bool = fun projectee -> - match projectee with | Sig_datacon _0 -> true | uu____4699 -> false + match projectee with | Sig_datacon _0 -> true | uu____5065 -> false let __proj__Sig_datacon__item___0: sigelt' -> (FStar_Ident.lident,univ_names,typ,FStar_Ident.lident,Prims.int,FStar_Ident.lident @@ -1400,14 +1436,14 @@ let __proj__Sig_datacon__item___0: = fun projectee -> match projectee with | Sig_datacon _0 -> _0 let uu___is_Sig_declare_typ: sigelt' -> Prims.bool = fun projectee -> - match projectee with | Sig_declare_typ _0 -> true | uu____4759 -> false + match projectee with | Sig_declare_typ _0 -> true | uu____5125 -> false let __proj__Sig_declare_typ__item___0: sigelt' -> (FStar_Ident.lident,univ_names,typ) FStar_Pervasives_Native.tuple3 = fun projectee -> match projectee with | Sig_declare_typ _0 -> _0 let uu___is_Sig_let: sigelt' -> Prims.bool = fun projectee -> - match projectee with | Sig_let _0 -> true | uu____4795 -> false + match projectee with | Sig_let _0 -> true | uu____5161 -> false let __proj__Sig_let__item___0: sigelt' -> (letbindings,FStar_Ident.lident Prims.list) @@ -1415,36 +1451,36 @@ let __proj__Sig_let__item___0: = fun projectee -> match projectee with | Sig_let _0 -> _0 let uu___is_Sig_main: sigelt' -> Prims.bool = fun projectee -> - match projectee with | Sig_main _0 -> true | uu____4825 -> false + match projectee with | Sig_main _0 -> true | uu____5191 -> false let __proj__Sig_main__item___0: sigelt' -> term = fun projectee -> match projectee with | Sig_main _0 -> _0 let uu___is_Sig_assume: sigelt' -> Prims.bool = fun projectee -> - match projectee with | Sig_assume _0 -> true | uu____4843 -> false + match projectee with | Sig_assume _0 -> true | uu____5209 -> false let __proj__Sig_assume__item___0: sigelt' -> (FStar_Ident.lident,univ_names,formula) FStar_Pervasives_Native.tuple3 = fun projectee -> match projectee with | Sig_assume _0 -> _0 let uu___is_Sig_new_effect: sigelt' -> Prims.bool = fun projectee -> - match projectee with | Sig_new_effect _0 -> true | uu____4873 -> false + match projectee with | Sig_new_effect _0 -> true | uu____5239 -> false let __proj__Sig_new_effect__item___0: sigelt' -> eff_decl = fun projectee -> match projectee with | Sig_new_effect _0 -> _0 let uu___is_Sig_new_effect_for_free: sigelt' -> Prims.bool = fun projectee -> match projectee with | Sig_new_effect_for_free _0 -> true - | uu____4885 -> false + | uu____5251 -> false let __proj__Sig_new_effect_for_free__item___0: sigelt' -> eff_decl = fun projectee -> match projectee with | Sig_new_effect_for_free _0 -> _0 let uu___is_Sig_sub_effect: sigelt' -> Prims.bool = fun projectee -> - match projectee with | Sig_sub_effect _0 -> true | uu____4897 -> false + match projectee with | Sig_sub_effect _0 -> true | uu____5263 -> false let __proj__Sig_sub_effect__item___0: sigelt' -> sub_eff = fun projectee -> match projectee with | Sig_sub_effect _0 -> _0 let uu___is_Sig_effect_abbrev: sigelt' -> Prims.bool = fun projectee -> - match projectee with | Sig_effect_abbrev _0 -> true | uu____4921 -> false + match projectee with | Sig_effect_abbrev _0 -> true | uu____5287 -> false let __proj__Sig_effect_abbrev__item___0: sigelt' -> (FStar_Ident.lident,univ_names,binders,comp,cflags Prims.list) @@ -1452,7 +1488,7 @@ let __proj__Sig_effect_abbrev__item___0: = fun projectee -> match projectee with | Sig_effect_abbrev _0 -> _0 let uu___is_Sig_pragma: sigelt' -> Prims.bool = fun projectee -> - match projectee with | Sig_pragma _0 -> true | uu____4969 -> false + match projectee with | Sig_pragma _0 -> true | uu____5335 -> false let __proj__Sig_pragma__item___0: sigelt' -> pragma = fun projectee -> match projectee with | Sig_pragma _0 -> _0 let __proj__Mksigelt__item__sigel: sigelt -> sigelt' = @@ -1526,10 +1562,10 @@ type mk_t = term' mk_t_a[@@deriving show] let contains_reflectable: qualifier Prims.list -> Prims.bool = fun l -> FStar_Util.for_some - (fun uu___29_5121 -> - match uu___29_5121 with - | Reflectable uu____5122 -> true - | uu____5123 -> false) l + (fun uu___29_5487 -> + match uu___29_5487 with + | Reflectable uu____5488 -> true + | uu____5489 -> false) l let withinfo: 'a . 'a -> FStar_Range.range -> 'a withinfo_t = fun v1 -> fun r -> { v = v1; p = r } let withsort: 'a . 'a -> 'a withinfo_t = @@ -1559,37 +1595,37 @@ let range_of_bv: bv -> FStar_Range.range = let set_range_of_bv: bv -> FStar_Range.range -> bv = fun x -> fun r -> - let uu___36_5181 = x in + let uu___36_5547 = x in { ppname = (FStar_Ident.mk_ident (((x.ppname).FStar_Ident.idText), r)); - index = (uu___36_5181.index); - sort = (uu___36_5181.sort) + index = (uu___36_5547.index); + sort = (uu___36_5547.sort) } let syn: - 'Auu____5188 'Auu____5189 'Auu____5190 . - 'Auu____5190 -> - 'Auu____5189 -> - ('Auu____5189 -> 'Auu____5190 -> 'Auu____5188) -> 'Auu____5188 + 'Auu____5554 'Auu____5555 'Auu____5556 . + 'Auu____5556 -> + 'Auu____5555 -> + ('Auu____5555 -> 'Auu____5556 -> 'Auu____5554) -> 'Auu____5554 = fun p -> fun k -> fun f -> f k p let mk_fvs: - 'Auu____5226 . - Prims.unit -> 'Auu____5226 FStar_Pervasives_Native.option FStar_ST.ref - = fun uu____5234 -> FStar_Util.mk_ref FStar_Pervasives_Native.None + 'Auu____5592 . + Prims.unit -> 'Auu____5592 FStar_Pervasives_Native.option FStar_ST.ref + = fun uu____5600 -> FStar_Util.mk_ref FStar_Pervasives_Native.None let mk_uvs: - 'Auu____5250 . - Prims.unit -> 'Auu____5250 FStar_Pervasives_Native.option FStar_ST.ref - = fun uu____5258 -> FStar_Util.mk_ref FStar_Pervasives_Native.None + 'Auu____5616 . + Prims.unit -> 'Auu____5616 FStar_Pervasives_Native.option FStar_ST.ref + = fun uu____5624 -> FStar_Util.mk_ref FStar_Pervasives_Native.None let new_bv_set: Prims.unit -> bv FStar_Util.set = - fun uu____5265 -> FStar_Util.new_set order_bv + fun uu____5631 -> FStar_Util.new_set order_bv let new_fv_set: Prims.unit -> FStar_Ident.lident FStar_Util.set = - fun uu____5272 -> FStar_Util.new_set order_fv + fun uu____5638 -> FStar_Util.new_set order_fv let order_univ_name: univ_name -> univ_name -> Prims.int = fun x -> fun y -> FStar_String.compare (FStar_Ident.text_of_id x) (FStar_Ident.text_of_id y) let new_universe_names_fifo_set: Prims.unit -> univ_name FStar_Util.fifo_set - = fun uu____5285 -> FStar_Util.new_fifo_set order_univ_name + = fun uu____5651 -> FStar_Util.new_fifo_set order_univ_name let no_names: bv FStar_Util.set = new_bv_set () let no_fvars: FStar_Ident.lident FStar_Util.set = new_fv_set () let no_universe_names: univ_name FStar_Util.fifo_set = @@ -1600,18 +1636,18 @@ let list_of_freenames: freenames -> bv Prims.list = fun fvs -> FStar_Util.set_elements fvs let mk: 'a . 'a -> 'a mk_t_a = fun t -> - fun uu____5325 -> + fun uu____5691 -> fun r -> - let uu____5329 = FStar_Util.mk_ref FStar_Pervasives_Native.None in - { n = t; pos = r; vars = uu____5329 } + let uu____5695 = FStar_Util.mk_ref FStar_Pervasives_Native.None in + { n = t; pos = r; vars = uu____5695 } let bv_to_tm: bv -> term = fun bv -> - let uu____5359 = range_of_bv bv in - mk (Tm_bvar bv) FStar_Pervasives_Native.None uu____5359 + let uu____5725 = range_of_bv bv in + mk (Tm_bvar bv) FStar_Pervasives_Native.None uu____5725 let bv_to_name: bv -> term = fun bv -> - let uu____5363 = range_of_bv bv in - mk (Tm_name bv) FStar_Pervasives_Native.None uu____5363 + let uu____5729 = range_of_bv bv in + mk (Tm_name bv) FStar_Pervasives_Native.None uu____5729 let mk_Tm_app: term -> args -> mk_t = fun t1 -> fun args -> @@ -1619,18 +1655,18 @@ let mk_Tm_app: term -> args -> mk_t = fun p -> match args with | [] -> t1 - | uu____5382 -> + | uu____5748 -> mk (Tm_app (t1, args)) FStar_Pervasives_Native.None p let mk_Tm_uinst: term -> universes -> term = fun t -> - fun uu___30_5392 -> - match uu___30_5392 with + fun uu___30_5758 -> + match uu___30_5758 with | [] -> t | us -> (match t.n with - | Tm_fvar uu____5394 -> + | Tm_fvar uu____5760 -> mk (Tm_uinst (t, us)) FStar_Pervasives_Native.None t.pos - | uu____5395 -> failwith "Unexpected universe instantiation") + | uu____5761 -> failwith "Unexpected universe instantiation") let extend_app_n: term -> args -> mk_t = fun t -> fun args' -> @@ -1639,7 +1675,7 @@ let extend_app_n: term -> args -> mk_t = match t.n with | Tm_app (head1,args) -> mk_Tm_app head1 (FStar_List.append args args') kopt r - | uu____5440 -> mk_Tm_app t args' kopt r + | uu____5806 -> mk_Tm_app t args' kopt r let extend_app: term -> arg -> mk_t = fun t -> fun arg -> fun kopt -> fun r -> extend_app_n t [arg] kopt r let mk_Tm_delayed: @@ -1647,14 +1683,14 @@ let mk_Tm_delayed: = fun lr -> fun pos -> - let uu____5469 = - let uu____5472 = - let uu____5473 = - let uu____5498 = FStar_Util.mk_ref FStar_Pervasives_Native.None in - (lr, uu____5498) in - Tm_delayed uu____5473 in - mk uu____5472 in - uu____5469 FStar_Pervasives_Native.None pos + let uu____5835 = + let uu____5838 = + let uu____5839 = + let uu____5864 = FStar_Util.mk_ref FStar_Pervasives_Native.None in + (lr, uu____5864) in + Tm_delayed uu____5839 in + mk uu____5838 in + uu____5835 FStar_Pervasives_Native.None pos let mk_Total': typ -> universe FStar_Pervasives_Native.option -> comp = fun t -> fun u -> mk (Total (t, u)) FStar_Pervasives_Native.None t.pos let mk_GTotal': typ -> universe FStar_Pervasives_Native.option -> comp = @@ -1669,8 +1705,8 @@ let mk_lb: (lbname,univ_name Prims.list,FStar_Ident.lident,typ,term) FStar_Pervasives_Native.tuple5 -> letbinding = - fun uu____5593 -> - match uu____5593 with + fun uu____5959 -> + match uu____5959 with | (x,univs,eff,t,e) -> { lbname = x; lbunivs = univs; lbtyp = t; lbeff = eff; lbdef = e } let default_sigmeta: sig_metadata = @@ -1698,9 +1734,9 @@ let is_teff: term -> Prims.bool = fun t -> match t.n with | Tm_constant (FStar_Const.Const_effect ) -> true - | uu____5643 -> false + | uu____6009 -> false let is_type: term -> Prims.bool = - fun t -> match t.n with | Tm_type uu____5647 -> true | uu____5648 -> false + fun t -> match t.n with | Tm_type uu____6013 -> true | uu____6014 -> false let null_id: FStar_Ident.ident = FStar_Ident.mk_ident ("_", FStar_Range.dummyRange) let null_bv: term -> bv = @@ -1708,7 +1744,7 @@ let null_bv: term -> bv = let mk_binder: bv -> binder = fun a -> (a, FStar_Pervasives_Native.None) let null_binder: term -> binder = fun t -> - let uu____5660 = null_bv t in (uu____5660, FStar_Pervasives_Native.None) + let uu____6026 = null_bv t in (uu____6026, FStar_Pervasives_Native.None) let imp_tag: arg_qualifier = Implicit false let iarg: term -> arg = fun t -> (t, (FStar_Pervasives_Native.Some imp_tag)) let as_arg: term -> arg = fun t -> (t, FStar_Pervasives_Native.None) @@ -1717,18 +1753,18 @@ let is_null_bv: bv -> Prims.bool = let is_null_binder: binder -> Prims.bool = fun b -> is_null_bv (FStar_Pervasives_Native.fst b) let is_top_level: letbinding Prims.list -> Prims.bool = - fun uu___31_5683 -> - match uu___31_5683 with - | { lbname = FStar_Util.Inr uu____5686; lbunivs = uu____5687; - lbtyp = uu____5688; lbeff = uu____5689; lbdef = uu____5690;_}::uu____5691 + fun uu___31_6049 -> + match uu___31_6049 with + | { lbname = FStar_Util.Inr uu____6052; lbunivs = uu____6053; + lbtyp = uu____6054; lbeff = uu____6055; lbdef = uu____6056;_}::uu____6057 -> true - | uu____5700 -> false + | uu____6066 -> false let freenames_of_binders: binders -> freenames = fun bs -> FStar_List.fold_right - (fun uu____5716 -> + (fun uu____6082 -> fun out -> - match uu____5716 with | (x,uu____5727) -> FStar_Util.set_add x out) + match uu____6082 with | (x,uu____6093) -> FStar_Util.set_add x out) bs no_names let binders_of_list: bv Prims.list -> binders = fun fvs -> @@ -1736,48 +1772,48 @@ let binders_of_list: bv Prims.list -> binders = (FStar_List.map (fun t -> (t, FStar_Pervasives_Native.None))) let binders_of_freenames: freenames -> binders = fun fvs -> - let uu____5758 = FStar_Util.set_elements fvs in - FStar_All.pipe_right uu____5758 binders_of_list + let uu____6124 = FStar_Util.set_elements fvs in + FStar_All.pipe_right uu____6124 binders_of_list let is_implicit: aqual -> Prims.bool = - fun uu___32_5765 -> - match uu___32_5765 with - | FStar_Pervasives_Native.Some (Implicit uu____5766) -> true - | uu____5767 -> false + fun uu___32_6131 -> + match uu___32_6131 with + | FStar_Pervasives_Native.Some (Implicit uu____6132) -> true + | uu____6133 -> false let as_implicit: Prims.bool -> aqual = - fun uu___33_5770 -> - if uu___33_5770 + fun uu___33_6136 -> + if uu___33_6136 then FStar_Pervasives_Native.Some imp_tag else FStar_Pervasives_Native.None let pat_bvs: pat -> bv Prims.list = fun p -> let rec aux b p1 = match p1.v with - | Pat_dot_term uu____5798 -> b - | Pat_constant uu____5805 -> b + | Pat_dot_term uu____6164 -> b + | Pat_constant uu____6171 -> b | Pat_wild x -> x :: b | Pat_var x -> x :: b - | Pat_cons (uu____5808,pats) -> + | Pat_cons (uu____6174,pats) -> FStar_List.fold_left (fun b1 -> - fun uu____5839 -> - match uu____5839 with | (p2,uu____5851) -> aux b1 p2) b pats in - let uu____5856 = aux [] p in - FStar_All.pipe_left FStar_List.rev uu____5856 + fun uu____6205 -> + match uu____6205 with | (p2,uu____6217) -> aux b1 p2) b pats in + let uu____6222 = aux [] p in + FStar_All.pipe_left FStar_List.rev uu____6222 let gen_reset: (Prims.unit -> Prims.int,Prims.unit -> Prims.unit) FStar_Pervasives_Native.tuple2 = let x = FStar_Util.mk_ref (Prims.parse_int "0") in - let gen1 uu____5877 = FStar_Util.incr x; FStar_ST.op_Bang x in - let reset uu____5985 = FStar_ST.op_Colon_Equals x (Prims.parse_int "0") in + let gen1 uu____6243 = FStar_Util.incr x; FStar_ST.op_Bang x in + let reset uu____6351 = FStar_ST.op_Colon_Equals x (Prims.parse_int "0") in (gen1, reset) let next_id: Prims.unit -> Prims.int = FStar_Pervasives_Native.fst gen_reset let reset_gensym: Prims.unit -> Prims.unit = FStar_Pervasives_Native.snd gen_reset let range_of_ropt: FStar_Range.range FStar_Pervasives_Native.option -> FStar_Range.range = - fun uu___34_6076 -> - match uu___34_6076 with + fun uu___34_6442 -> + match uu___34_6442 with | FStar_Pervasives_Native.None -> FStar_Range.dummyRange | FStar_Pervasives_Native.Some r -> r let gen_bv: @@ -1788,37 +1824,37 @@ let gen_bv: fun r -> fun t -> let id1 = FStar_Ident.mk_ident (s, (range_of_ropt r)) in - let uu____6102 = next_id () in - { ppname = id1; index = uu____6102; sort = t } + let uu____6468 = next_id () in + { ppname = id1; index = uu____6468; sort = t } let new_bv: FStar_Range.range FStar_Pervasives_Native.option -> typ -> bv = fun ropt -> fun t -> gen_bv FStar_Ident.reserved_prefix ropt t let freshen_bv: bv -> bv = fun bv -> - let uu____6116 = is_null_bv bv in - if uu____6116 + let uu____6482 = is_null_bv bv in + if uu____6482 then - let uu____6117 = - let uu____6120 = range_of_bv bv in - FStar_Pervasives_Native.Some uu____6120 in - new_bv uu____6117 bv.sort + let uu____6483 = + let uu____6486 = range_of_bv bv in + FStar_Pervasives_Native.Some uu____6486 in + new_bv uu____6483 bv.sort else - (let uu___37_6122 = bv in - let uu____6123 = next_id () in + (let uu___37_6488 = bv in + let uu____6489 = next_id () in { - ppname = (uu___37_6122.ppname); - index = uu____6123; - sort = (uu___37_6122.sort) + ppname = (uu___37_6488.ppname); + index = uu____6489; + sort = (uu___37_6488.sort) }) let new_univ_name: FStar_Range.range FStar_Pervasives_Native.option -> univ_name = fun ropt -> let id1 = next_id () in - let uu____6132 = - let uu____6137 = - let uu____6138 = FStar_Util.string_of_int id1 in - Prims.strcat FStar_Ident.reserved_prefix uu____6138 in - (uu____6137, (range_of_ropt ropt)) in - FStar_Ident.mk_ident uu____6132 + let uu____6498 = + let uu____6503 = + let uu____6504 = FStar_Util.string_of_int id1 in + Prims.strcat FStar_Ident.reserved_prefix uu____6504 in + (uu____6503, (range_of_ropt ropt)) in + FStar_Ident.mk_ident uu____6498 let mkbv: FStar_Ident.ident -> Prims.int -> term' syntax -> bv = fun x -> fun y -> fun t -> { ppname = x; index = y; sort = t } let lbname_eq: @@ -1830,7 +1866,7 @@ let lbname_eq: match (l1, l2) with | (FStar_Util.Inl x,FStar_Util.Inl y) -> bv_eq x y | (FStar_Util.Inr l,FStar_Util.Inr m) -> FStar_Ident.lid_equals l m - | uu____6202 -> false + | uu____6568 -> false let fv_eq: fv -> fv -> Prims.bool = fun fv1 -> fun fv2 -> FStar_Ident.lid_equals (fv1.fv_name).v (fv2.fv_name).v @@ -1839,11 +1875,11 @@ let fv_eq_lid: fv -> FStar_Ident.lident -> Prims.bool = let set_bv_range: bv -> FStar_Range.range -> bv = fun bv -> fun r -> - let uu___38_6233 = bv in + let uu___38_6599 = bv in { ppname = (FStar_Ident.mk_ident (((bv.ppname).FStar_Ident.idText), r)); - index = (uu___38_6233.index); - sort = (uu___38_6233.sort) + index = (uu___38_6599.index); + sort = (uu___38_6599.sort) } let lid_as_fv: FStar_Ident.lident -> @@ -1852,8 +1888,8 @@ let lid_as_fv: fun l -> fun dd -> fun dq -> - let uu____6247 = withinfo l (FStar_Ident.range_of_lid l) in - { fv_name = uu____6247; fv_delta = dd; fv_qual = dq } + let uu____6613 = withinfo l (FStar_Ident.range_of_lid l) in + { fv_name = uu____6613; fv_delta = dd; fv_qual = dq } let fv_to_tm: fv -> term = fun fv -> mk (Tm_fvar fv) FStar_Pervasives_Native.None @@ -1864,79 +1900,79 @@ let fvar: = fun l -> fun dd -> - fun dq -> let uu____6264 = lid_as_fv l dd dq in fv_to_tm uu____6264 + fun dq -> let uu____6630 = lid_as_fv l dd dq in fv_to_tm uu____6630 let lid_of_fv: fv -> FStar_Ident.lid = fun fv -> (fv.fv_name).v let range_of_fv: fv -> FStar_Range.range = fun fv -> - let uu____6271 = lid_of_fv fv in FStar_Ident.range_of_lid uu____6271 + let uu____6637 = lid_of_fv fv in FStar_Ident.range_of_lid uu____6637 let set_range_of_fv: fv -> FStar_Range.range -> fv = fun fv -> fun r -> - let uu___39_6278 = fv in - let uu____6279 = - let uu___40_6280 = fv.fv_name in - let uu____6281 = - let uu____6282 = lid_of_fv fv in - FStar_Ident.set_lid_range uu____6282 r in - { v = uu____6281; p = (uu___40_6280.p) } in + let uu___39_6644 = fv in + let uu____6645 = + let uu___40_6646 = fv.fv_name in + let uu____6647 = + let uu____6648 = lid_of_fv fv in + FStar_Ident.set_lid_range uu____6648 r in + { v = uu____6647; p = (uu___40_6646.p) } in { - fv_name = uu____6279; - fv_delta = (uu___39_6278.fv_delta); - fv_qual = (uu___39_6278.fv_qual) + fv_name = uu____6645; + fv_delta = (uu___39_6644.fv_delta); + fv_qual = (uu___39_6644.fv_qual) } let has_simple_attribute: term Prims.list -> Prims.string -> Prims.bool = fun l -> fun s -> FStar_List.existsb - (fun uu___35_6300 -> - match uu___35_6300 with - | { n = Tm_constant (FStar_Const.Const_string (data,uu____6304)); - pos = uu____6305; vars = uu____6306;_} when data = s -> true - | uu____6309 -> false) l + (fun uu___35_6666 -> + match uu___35_6666 with + | { n = Tm_constant (FStar_Const.Const_string (data,uu____6670)); + pos = uu____6671; vars = uu____6672;_} when data = s -> true + | uu____6675 -> false) l let rec eq_pat: pat -> pat -> Prims.bool = fun p1 -> fun p2 -> match ((p1.v), (p2.v)) with | (Pat_constant c1,Pat_constant c2) -> FStar_Const.eq_const c1 c2 | (Pat_cons (fv1,as1),Pat_cons (fv2,as2)) -> - let uu____6356 = fv_eq fv1 fv2 in - if uu____6356 + let uu____6722 = fv_eq fv1 fv2 in + if uu____6722 then - let uu____6360 = FStar_List.zip as1 as2 in - FStar_All.pipe_right uu____6360 + let uu____6726 = FStar_List.zip as1 as2 in + FStar_All.pipe_right uu____6726 (FStar_List.for_all - (fun uu____6426 -> - match uu____6426 with + (fun uu____6792 -> + match uu____6792 with | ((p11,b1),(p21,b2)) -> (b1 = b2) && (eq_pat p11 p21))) else false - | (Pat_var uu____6452,Pat_var uu____6453) -> true - | (Pat_wild uu____6454,Pat_wild uu____6455) -> true + | (Pat_var uu____6818,Pat_var uu____6819) -> true + | (Pat_wild uu____6820,Pat_wild uu____6821) -> true | (Pat_dot_term (bv1,t1),Pat_dot_term (bv2,t2)) -> true - | (uu____6468,uu____6469) -> false + | (uu____6834,uu____6835) -> false let tconst: FStar_Ident.lident -> term = fun l -> - let uu____6473 = - let uu____6476 = - let uu____6477 = + let uu____6839 = + let uu____6842 = + let uu____6843 = lid_as_fv l Delta_constant FStar_Pervasives_Native.None in - Tm_fvar uu____6477 in - mk uu____6476 in - uu____6473 FStar_Pervasives_Native.None FStar_Range.dummyRange + Tm_fvar uu____6843 in + mk uu____6842 in + uu____6839 FStar_Pervasives_Native.None FStar_Range.dummyRange let tabbrev: FStar_Ident.lident -> term = fun l -> - let uu____6484 = - let uu____6487 = - let uu____6488 = + let uu____6850 = + let uu____6853 = + let uu____6854 = lid_as_fv l (Delta_defined_at_level (Prims.parse_int "1")) FStar_Pervasives_Native.None in - Tm_fvar uu____6488 in - mk uu____6487 in - uu____6484 FStar_Pervasives_Native.None FStar_Range.dummyRange + Tm_fvar uu____6854 in + mk uu____6853 in + uu____6850 FStar_Pervasives_Native.None FStar_Range.dummyRange let tdataconstr: FStar_Ident.lident -> term = fun l -> - let uu____6495 = + let uu____6861 = lid_as_fv l Delta_constant (FStar_Pervasives_Native.Some Data_ctor) in - fv_to_tm uu____6495 + fv_to_tm uu____6861 let t_unit: term = tconst FStar_Parser_Const.unit_lid let t_bool: term = tconst FStar_Parser_Const.bool_lid let t_int: term = tconst FStar_Parser_Const.int_lid @@ -1946,39 +1982,39 @@ let t_char: term = tabbrev FStar_Parser_Const.char_lid let t_range: term = tconst FStar_Parser_Const.range_lid let t_term: term = tconst FStar_Parser_Const.term_lid let t_tactic_unit: term' syntax = - let uu____6498 = - let uu____6499 = - let uu____6500 = tabbrev FStar_Parser_Const.tactic_lid in - mk_Tm_uinst uu____6500 [U_zero] in - let uu____6501 = let uu____6502 = as_arg t_unit in [uu____6502] in - mk_Tm_app uu____6499 uu____6501 in - uu____6498 FStar_Pervasives_Native.None FStar_Range.dummyRange + let uu____6864 = + let uu____6865 = + let uu____6866 = tabbrev FStar_Parser_Const.tactic_lid in + mk_Tm_uinst uu____6866 [U_zero] in + let uu____6867 = let uu____6868 = as_arg t_unit in [uu____6868] in + mk_Tm_app uu____6865 uu____6867 in + uu____6864 FStar_Pervasives_Native.None FStar_Range.dummyRange let t_tac_unit: term' syntax = - let uu____6507 = - let uu____6508 = - let uu____6509 = tabbrev FStar_Parser_Const.u_tac_lid in - mk_Tm_uinst uu____6509 [U_zero] in - let uu____6510 = let uu____6511 = as_arg t_unit in [uu____6511] in - mk_Tm_app uu____6508 uu____6510 in - uu____6507 FStar_Pervasives_Native.None FStar_Range.dummyRange + let uu____6873 = + let uu____6874 = + let uu____6875 = tabbrev FStar_Parser_Const.u_tac_lid in + mk_Tm_uinst uu____6875 [U_zero] in + let uu____6876 = let uu____6877 = as_arg t_unit in [uu____6877] in + mk_Tm_app uu____6874 uu____6876 in + uu____6873 FStar_Pervasives_Native.None FStar_Range.dummyRange let t_list_of: term -> term = fun t -> - let uu____6517 = - let uu____6518 = - let uu____6519 = tabbrev FStar_Parser_Const.list_lid in - mk_Tm_uinst uu____6519 [U_zero] in - let uu____6520 = let uu____6521 = as_arg t in [uu____6521] in - mk_Tm_app uu____6518 uu____6520 in - uu____6517 FStar_Pervasives_Native.None FStar_Range.dummyRange + let uu____6883 = + let uu____6884 = + let uu____6885 = tabbrev FStar_Parser_Const.list_lid in + mk_Tm_uinst uu____6885 [U_zero] in + let uu____6886 = let uu____6887 = as_arg t in [uu____6887] in + mk_Tm_app uu____6884 uu____6886 in + uu____6883 FStar_Pervasives_Native.None FStar_Range.dummyRange let t_option_of: term -> term = fun t -> - let uu____6527 = - let uu____6528 = - let uu____6529 = tabbrev FStar_Parser_Const.option_lid in - mk_Tm_uinst uu____6529 [U_zero] in - let uu____6530 = let uu____6531 = as_arg t in [uu____6531] in - mk_Tm_app uu____6528 uu____6530 in - uu____6527 FStar_Pervasives_Native.None FStar_Range.dummyRange + let uu____6893 = + let uu____6894 = + let uu____6895 = tabbrev FStar_Parser_Const.option_lid in + mk_Tm_uinst uu____6895 [U_zero] in + let uu____6896 = let uu____6897 = as_arg t in [uu____6897] in + mk_Tm_app uu____6894 uu____6896 in + uu____6893 FStar_Pervasives_Native.None FStar_Range.dummyRange let unit_const: term' syntax = mk (Tm_constant FStar_Const.Const_unit) FStar_Pervasives_Native.None FStar_Range.dummyRange \ No newline at end of file diff --git a/src/ocaml-output/FStar_Syntax_Util.ml b/src/ocaml-output/FStar_Syntax_Util.ml index 4be37b3b402..62cc898a195 100644 --- a/src/ocaml-output/FStar_Syntax_Util.ml +++ b/src/ocaml-output/FStar_Syntax_Util.ml @@ -378,6 +378,43 @@ let comp_set_flags: FStar_Syntax_Syntax.pos = (uu___46_1084.FStar_Syntax_Syntax.pos); FStar_Syntax_Syntax.vars = (uu___46_1084.FStar_Syntax_Syntax.vars) } +let lcomp_set_flags: + FStar_Syntax_Syntax.lcomp -> + FStar_Syntax_Syntax.cflags Prims.list -> FStar_Syntax_Syntax.lcomp + = + fun lc -> + fun fs -> + let comp_typ_set_flags c = + match c.FStar_Syntax_Syntax.n with + | FStar_Syntax_Syntax.Total uu____1102 -> c + | FStar_Syntax_Syntax.GTotal uu____1111 -> c + | FStar_Syntax_Syntax.Comp ct -> + let ct1 = + let uu___48_1122 = ct in + { + FStar_Syntax_Syntax.comp_univs = + (uu___48_1122.FStar_Syntax_Syntax.comp_univs); + FStar_Syntax_Syntax.effect_name = + (uu___48_1122.FStar_Syntax_Syntax.effect_name); + FStar_Syntax_Syntax.result_typ = + (uu___48_1122.FStar_Syntax_Syntax.result_typ); + FStar_Syntax_Syntax.effect_args = + (uu___48_1122.FStar_Syntax_Syntax.effect_args); + FStar_Syntax_Syntax.flags = fs + } in + let uu___49_1123 = c in + { + FStar_Syntax_Syntax.n = (FStar_Syntax_Syntax.Comp ct1); + FStar_Syntax_Syntax.pos = + (uu___49_1123.FStar_Syntax_Syntax.pos); + FStar_Syntax_Syntax.vars = + (uu___49_1123.FStar_Syntax_Syntax.vars) + } in + FStar_Syntax_Syntax.mk_lcomp lc.FStar_Syntax_Syntax.eff_name + lc.FStar_Syntax_Syntax.res_typ fs + (fun uu____1126 -> + let uu____1127 = FStar_Syntax_Syntax.lcomp_comp lc in + comp_typ_set_flags uu____1127) let comp_to_comp_typ: FStar_Syntax_Syntax.comp -> FStar_Syntax_Syntax.comp_typ = fun c -> @@ -399,7 +436,7 @@ let comp_to_comp_typ: FStar_Syntax_Syntax.effect_args = []; FStar_Syntax_Syntax.flags = (comp_flags c) } - | uu____1120 -> + | uu____1160 -> failwith "Assertion failed: Computation type without universe" let is_named_tot: FStar_Syntax_Syntax.comp' FStar_Syntax_Syntax.syntax -> Prims.bool = @@ -408,8 +445,8 @@ let is_named_tot: | FStar_Syntax_Syntax.Comp c1 -> FStar_Ident.lid_equals c1.FStar_Syntax_Syntax.effect_name FStar_Parser_Const.effect_Tot_lid - | FStar_Syntax_Syntax.Total uu____1129 -> true - | FStar_Syntax_Syntax.GTotal uu____1138 -> false + | FStar_Syntax_Syntax.Total uu____1169 -> true + | FStar_Syntax_Syntax.GTotal uu____1178 -> false let is_total_comp: FStar_Syntax_Syntax.comp' FStar_Syntax_Syntax.syntax -> Prims.bool = fun c -> @@ -418,11 +455,11 @@ let is_total_comp: || (FStar_All.pipe_right (comp_flags c) (FStar_Util.for_some - (fun uu___34_1157 -> - match uu___34_1157 with + (fun uu___34_1197 -> + match uu___34_1197 with | FStar_Syntax_Syntax.TOTAL -> true | FStar_Syntax_Syntax.RETURN -> true - | uu____1158 -> false))) + | uu____1198 -> false))) let is_total_lcomp: FStar_Syntax_Syntax.lcomp -> Prims.bool = fun c -> (FStar_Ident.lid_equals c.FStar_Syntax_Syntax.eff_name @@ -430,11 +467,11 @@ let is_total_lcomp: FStar_Syntax_Syntax.lcomp -> Prims.bool = || (FStar_All.pipe_right c.FStar_Syntax_Syntax.cflags (FStar_Util.for_some - (fun uu___35_1165 -> - match uu___35_1165 with + (fun uu___35_1205 -> + match uu___35_1205 with | FStar_Syntax_Syntax.TOTAL -> true | FStar_Syntax_Syntax.RETURN -> true - | uu____1166 -> false))) + | uu____1206 -> false))) let is_tot_or_gtot_lcomp: FStar_Syntax_Syntax.lcomp -> Prims.bool = fun c -> ((FStar_Ident.lid_equals c.FStar_Syntax_Syntax.eff_name @@ -445,30 +482,30 @@ let is_tot_or_gtot_lcomp: FStar_Syntax_Syntax.lcomp -> Prims.bool = || (FStar_All.pipe_right c.FStar_Syntax_Syntax.cflags (FStar_Util.for_some - (fun uu___36_1173 -> - match uu___36_1173 with + (fun uu___36_1213 -> + match uu___36_1213 with | FStar_Syntax_Syntax.TOTAL -> true | FStar_Syntax_Syntax.RETURN -> true - | uu____1174 -> false))) + | uu____1214 -> false))) let is_partial_return: FStar_Syntax_Syntax.comp' FStar_Syntax_Syntax.syntax -> Prims.bool = fun c -> FStar_All.pipe_right (comp_flags c) (FStar_Util.for_some - (fun uu___37_1185 -> - match uu___37_1185 with + (fun uu___37_1225 -> + match uu___37_1225 with | FStar_Syntax_Syntax.RETURN -> true | FStar_Syntax_Syntax.PARTIAL_RETURN -> true - | uu____1186 -> false)) + | uu____1226 -> false)) let is_lcomp_partial_return: FStar_Syntax_Syntax.lcomp -> Prims.bool = fun c -> FStar_All.pipe_right c.FStar_Syntax_Syntax.cflags (FStar_Util.for_some - (fun uu___38_1193 -> - match uu___38_1193 with + (fun uu___38_1233 -> + match uu___38_1233 with | FStar_Syntax_Syntax.RETURN -> true | FStar_Syntax_Syntax.PARTIAL_RETURN -> true - | uu____1194 -> false)) + | uu____1234 -> false)) let is_tot_or_gtot_comp: FStar_Syntax_Syntax.comp' FStar_Syntax_Syntax.syntax -> Prims.bool = fun c -> @@ -484,18 +521,18 @@ let is_pure_comp: FStar_Syntax_Syntax.comp' FStar_Syntax_Syntax.syntax -> Prims.bool = fun c -> match c.FStar_Syntax_Syntax.n with - | FStar_Syntax_Syntax.Total uu____1212 -> true - | FStar_Syntax_Syntax.GTotal uu____1221 -> false + | FStar_Syntax_Syntax.Total uu____1252 -> true + | FStar_Syntax_Syntax.GTotal uu____1261 -> false | FStar_Syntax_Syntax.Comp ct -> ((is_total_comp c) || (is_pure_effect ct.FStar_Syntax_Syntax.effect_name)) || (FStar_All.pipe_right ct.FStar_Syntax_Syntax.flags (FStar_Util.for_some - (fun uu___39_1234 -> - match uu___39_1234 with + (fun uu___39_1274 -> + match uu___39_1274 with | FStar_Syntax_Syntax.LEMMA -> true - | uu____1235 -> false))) + | uu____1275 -> false))) let is_ghost_effect: FStar_Ident.lident -> Prims.bool = fun l -> ((FStar_Ident.lid_equals FStar_Parser_Const.effect_GTot_lid l) || @@ -510,21 +547,21 @@ let is_pure_lcomp: FStar_Syntax_Syntax.lcomp -> Prims.bool = || (FStar_All.pipe_right lc.FStar_Syntax_Syntax.cflags (FStar_Util.for_some - (fun uu___40_1252 -> - match uu___40_1252 with + (fun uu___40_1292 -> + match uu___40_1292 with | FStar_Syntax_Syntax.LEMMA -> true - | uu____1253 -> false))) + | uu____1293 -> false))) let is_pure_or_ghost_lcomp: FStar_Syntax_Syntax.lcomp -> Prims.bool = fun lc -> (is_pure_lcomp lc) || (is_ghost_effect lc.FStar_Syntax_Syntax.eff_name) let is_pure_or_ghost_function: FStar_Syntax_Syntax.term -> Prims.bool = fun t -> - let uu____1260 = - let uu____1261 = FStar_Syntax_Subst.compress t in - uu____1261.FStar_Syntax_Syntax.n in - match uu____1260 with - | FStar_Syntax_Syntax.Tm_arrow (uu____1264,c) -> is_pure_or_ghost_comp c - | uu____1282 -> true + let uu____1300 = + let uu____1301 = FStar_Syntax_Subst.compress t in + uu____1301.FStar_Syntax_Syntax.n in + match uu____1300 with + | FStar_Syntax_Syntax.Tm_arrow (uu____1304,c) -> is_pure_or_ghost_comp c + | uu____1322 -> true let is_lemma_comp: FStar_Syntax_Syntax.comp' FStar_Syntax_Syntax.syntax -> Prims.bool = fun c -> @@ -532,15 +569,15 @@ let is_lemma_comp: | FStar_Syntax_Syntax.Comp ct -> FStar_Ident.lid_equals ct.FStar_Syntax_Syntax.effect_name FStar_Parser_Const.effect_Lemma_lid - | uu____1291 -> false + | uu____1331 -> false let is_lemma: FStar_Syntax_Syntax.term -> Prims.bool = fun t -> - let uu____1295 = - let uu____1296 = FStar_Syntax_Subst.compress t in - uu____1296.FStar_Syntax_Syntax.n in - match uu____1295 with - | FStar_Syntax_Syntax.Tm_arrow (uu____1299,c) -> is_lemma_comp c - | uu____1317 -> false + let uu____1335 = + let uu____1336 = FStar_Syntax_Subst.compress t in + uu____1336.FStar_Syntax_Syntax.n in + match uu____1335 with + | FStar_Syntax_Syntax.Tm_arrow (uu____1339,c) -> is_lemma_comp c + | uu____1357 -> false let head_and_args: FStar_Syntax_Syntax.term -> (FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax,(FStar_Syntax_Syntax.term' @@ -554,7 +591,7 @@ let head_and_args: let t1 = FStar_Syntax_Subst.compress t in match t1.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Tm_app (head1,args) -> (head1, args) - | uu____1382 -> (t1, []) + | uu____1422 -> (t1, []) let rec head_and_args': FStar_Syntax_Syntax.term -> (FStar_Syntax_Syntax.term,(FStar_Syntax_Syntax.term' @@ -566,46 +603,46 @@ let rec head_and_args': let t1 = FStar_Syntax_Subst.compress t in match t1.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Tm_app (head1,args) -> - let uu____1447 = head_and_args' head1 in - (match uu____1447 with + let uu____1487 = head_and_args' head1 in + (match uu____1487 with | (head2,args') -> (head2, (FStar_List.append args' args))) - | uu____1504 -> (t1, []) + | uu____1544 -> (t1, []) let un_uinst: FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term = fun t -> let t1 = FStar_Syntax_Subst.compress t in match t1.FStar_Syntax_Syntax.n with - | FStar_Syntax_Syntax.Tm_uinst (t2,uu____1524) -> + | FStar_Syntax_Syntax.Tm_uinst (t2,uu____1564) -> FStar_Syntax_Subst.compress t2 - | uu____1529 -> t1 + | uu____1569 -> t1 let is_smt_lemma: FStar_Syntax_Syntax.term -> Prims.bool = fun t -> - let uu____1533 = - let uu____1534 = FStar_Syntax_Subst.compress t in - uu____1534.FStar_Syntax_Syntax.n in - match uu____1533 with - | FStar_Syntax_Syntax.Tm_arrow (uu____1537,c) -> + let uu____1573 = + let uu____1574 = FStar_Syntax_Subst.compress t in + uu____1574.FStar_Syntax_Syntax.n in + match uu____1573 with + | FStar_Syntax_Syntax.Tm_arrow (uu____1577,c) -> (match c.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Comp ct when FStar_Ident.lid_equals ct.FStar_Syntax_Syntax.effect_name FStar_Parser_Const.effect_Lemma_lid -> (match ct.FStar_Syntax_Syntax.effect_args with - | _req::_ens::(pats,uu____1559)::uu____1560 -> + | _req::_ens::(pats,uu____1599)::uu____1600 -> let pats' = unmeta pats in - let uu____1604 = head_and_args pats' in - (match uu____1604 with - | (head1,uu____1620) -> - let uu____1641 = - let uu____1642 = un_uinst head1 in - uu____1642.FStar_Syntax_Syntax.n in - (match uu____1641 with + let uu____1644 = head_and_args pats' in + (match uu____1644 with + | (head1,uu____1660) -> + let uu____1681 = + let uu____1682 = un_uinst head1 in + uu____1682.FStar_Syntax_Syntax.n in + (match uu____1681 with | FStar_Syntax_Syntax.Tm_fvar fv -> FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.cons_lid - | uu____1646 -> false)) - | uu____1647 -> false) - | uu____1656 -> false) - | uu____1657 -> false + | uu____1686 -> false)) + | uu____1687 -> false) + | uu____1696 -> false) + | uu____1697 -> false let is_ml_comp: FStar_Syntax_Syntax.comp' FStar_Syntax_Syntax.syntax -> Prims.bool = fun c -> @@ -616,19 +653,19 @@ let is_ml_comp: || (FStar_All.pipe_right c1.FStar_Syntax_Syntax.flags (FStar_Util.for_some - (fun uu___41_1669 -> - match uu___41_1669 with + (fun uu___41_1709 -> + match uu___41_1709 with | FStar_Syntax_Syntax.MLEFFECT -> true - | uu____1670 -> false))) - | uu____1671 -> false + | uu____1710 -> false))) + | uu____1711 -> false let comp_result: FStar_Syntax_Syntax.comp' FStar_Syntax_Syntax.syntax -> FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax = fun c -> match c.FStar_Syntax_Syntax.n with - | FStar_Syntax_Syntax.Total (t,uu____1684) -> t - | FStar_Syntax_Syntax.GTotal (t,uu____1694) -> t + | FStar_Syntax_Syntax.Total (t,uu____1724) -> t + | FStar_Syntax_Syntax.GTotal (t,uu____1734) -> t | FStar_Syntax_Syntax.Comp ct -> ct.FStar_Syntax_Syntax.result_typ let set_result_typ: FStar_Syntax_Syntax.comp' FStar_Syntax_Syntax.syntax -> @@ -637,34 +674,34 @@ let set_result_typ: fun c -> fun t -> match c.FStar_Syntax_Syntax.n with - | FStar_Syntax_Syntax.Total uu____1714 -> + | FStar_Syntax_Syntax.Total uu____1754 -> FStar_Syntax_Syntax.mk_Total t - | FStar_Syntax_Syntax.GTotal uu____1723 -> + | FStar_Syntax_Syntax.GTotal uu____1763 -> FStar_Syntax_Syntax.mk_GTotal t | FStar_Syntax_Syntax.Comp ct -> FStar_Syntax_Syntax.mk_Comp - (let uu___48_1735 = ct in + (let uu___50_1775 = ct in { FStar_Syntax_Syntax.comp_univs = - (uu___48_1735.FStar_Syntax_Syntax.comp_univs); + (uu___50_1775.FStar_Syntax_Syntax.comp_univs); FStar_Syntax_Syntax.effect_name = - (uu___48_1735.FStar_Syntax_Syntax.effect_name); + (uu___50_1775.FStar_Syntax_Syntax.effect_name); FStar_Syntax_Syntax.result_typ = t; FStar_Syntax_Syntax.effect_args = - (uu___48_1735.FStar_Syntax_Syntax.effect_args); + (uu___50_1775.FStar_Syntax_Syntax.effect_args); FStar_Syntax_Syntax.flags = - (uu___48_1735.FStar_Syntax_Syntax.flags) + (uu___50_1775.FStar_Syntax_Syntax.flags) }) let is_trivial_wp: FStar_Syntax_Syntax.comp' FStar_Syntax_Syntax.syntax -> Prims.bool = fun c -> FStar_All.pipe_right (comp_flags c) (FStar_Util.for_some - (fun uu___42_1746 -> - match uu___42_1746 with + (fun uu___42_1786 -> + match uu___42_1786 with | FStar_Syntax_Syntax.TOTAL -> true | FStar_Syntax_Syntax.RETURN -> true - | uu____1747 -> false)) + | uu____1787 -> false)) let primops: FStar_Ident.lident Prims.list = [FStar_Parser_Const.op_Eq; FStar_Parser_Const.op_notEq; @@ -691,14 +728,14 @@ let is_primop: match f.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Tm_fvar fv -> is_primop_lid (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v - | uu____1763 -> false + | uu____1803 -> false let rec unascribe: FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term = fun e -> let e1 = FStar_Syntax_Subst.compress e in match e1.FStar_Syntax_Syntax.n with - | FStar_Syntax_Syntax.Tm_ascribed (e2,uu____1769,uu____1770) -> + | FStar_Syntax_Syntax.Tm_ascribed (e2,uu____1809,uu____1810) -> unascribe e2 - | uu____1811 -> e1 + | uu____1851 -> e1 let rec ascribe: FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax -> ((FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax,FStar_Syntax_Syntax.comp' @@ -711,9 +748,9 @@ let rec ascribe: fun t -> fun k -> match t.FStar_Syntax_Syntax.n with - | FStar_Syntax_Syntax.Tm_ascribed (t',uu____1859,uu____1860) -> + | FStar_Syntax_Syntax.Tm_ascribed (t',uu____1899,uu____1900) -> ascribe t' k - | uu____1901 -> + | uu____1941 -> FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_ascribed (t, k, FStar_Pervasives_Native.None)) @@ -724,13 +761,13 @@ type eq_result = | Unknown[@@deriving show] let uu___is_Equal: eq_result -> Prims.bool = fun projectee -> - match projectee with | Equal -> true | uu____1925 -> false + match projectee with | Equal -> true | uu____1965 -> false let uu___is_NotEqual: eq_result -> Prims.bool = fun projectee -> - match projectee with | NotEqual -> true | uu____1929 -> false + match projectee with | NotEqual -> true | uu____1969 -> false let uu___is_Unknown: eq_result -> Prims.bool = fun projectee -> - match projectee with | Unknown -> true | uu____1933 -> false + match projectee with | Unknown -> true | uu____1973 -> false let injectives: Prims.string Prims.list = ["FStar.Int8.int_to_t"; "FStar.Int16.int_to_t"; @@ -753,37 +790,37 @@ let rec eq_tm: fun t1 -> fun t2 -> let canon_app t = - let uu____1956 = - let uu____1969 = unascribe t in head_and_args' uu____1969 in - match uu____1956 with + let uu____1996 = + let uu____2009 = unascribe t in head_and_args' uu____2009 in + match uu____1996 with | (hd1,args) -> FStar_Syntax_Syntax.mk_Tm_app hd1 args FStar_Pervasives_Native.None t.FStar_Syntax_Syntax.pos in let t11 = canon_app t1 in let t21 = canon_app t2 in - let equal_if uu___43_1999 = if uu___43_1999 then Equal else Unknown in - let equal_iff uu___44_2004 = if uu___44_2004 then Equal else NotEqual in - let eq_and f g = match f with | Equal -> g () | uu____2018 -> Unknown in + let equal_if uu___43_2039 = if uu___43_2039 then Equal else Unknown in + let equal_iff uu___44_2044 = if uu___44_2044 then Equal else NotEqual in + let eq_and f g = match f with | Equal -> g () | uu____2058 -> Unknown in let eq_inj f g = match (f, g) with | (Equal ,Equal ) -> Equal - | (NotEqual ,uu____2026) -> NotEqual - | (uu____2027,NotEqual ) -> NotEqual - | (Unknown ,uu____2028) -> Unknown - | (uu____2029,Unknown ) -> Unknown in + | (NotEqual ,uu____2066) -> NotEqual + | (uu____2067,NotEqual ) -> NotEqual + | (Unknown ,uu____2068) -> Unknown + | (uu____2069,Unknown ) -> Unknown in let equal_data f1 args1 f2 args2 = - let uu____2067 = FStar_Syntax_Syntax.fv_eq f1 f2 in - if uu____2067 + let uu____2107 = FStar_Syntax_Syntax.fv_eq f1 f2 in + if uu____2107 then - let uu____2071 = FStar_List.zip args1 args2 in + let uu____2111 = FStar_List.zip args1 args2 in FStar_All.pipe_left (FStar_List.fold_left (fun acc -> - fun uu____2129 -> - match uu____2129 with + fun uu____2169 -> + match uu____2169 with | ((a1,q1),(a2,q2)) -> - let uu____2157 = eq_tm a1 a2 in eq_inj acc uu____2157) - Equal) uu____2071 + let uu____2197 = eq_tm a1 a2 in eq_inj acc uu____2197) + Equal) uu____2111 else NotEqual in match ((t11.FStar_Syntax_Syntax.n), (t21.FStar_Syntax_Syntax.n)) with | (FStar_Syntax_Syntax.Tm_bvar bv1,FStar_Syntax_Syntax.Tm_bvar bv2) -> @@ -800,36 +837,36 @@ let rec eq_tm: (FStar_Pervasives_Native.Some FStar_Syntax_Syntax.Data_ctor)) then equal_data f [] g [] else - (let uu____2178 = FStar_Syntax_Syntax.fv_eq f g in - equal_if uu____2178) + (let uu____2218 = FStar_Syntax_Syntax.fv_eq f g in + equal_if uu____2218) | (FStar_Syntax_Syntax.Tm_uinst (f,us),FStar_Syntax_Syntax.Tm_uinst (g,vs)) -> - let uu____2191 = eq_tm f g in - eq_and uu____2191 - (fun uu____2194 -> - let uu____2195 = eq_univs_list us vs in equal_if uu____2195) + let uu____2231 = eq_tm f g in + eq_and uu____2231 + (fun uu____2234 -> + let uu____2235 = eq_univs_list us vs in equal_if uu____2235) | (FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_range - uu____2196),uu____2197) -> Unknown - | (uu____2198,FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_range - uu____2199)) -> Unknown + uu____2236),uu____2237) -> Unknown + | (uu____2238,FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_range + uu____2239)) -> Unknown | (FStar_Syntax_Syntax.Tm_constant c,FStar_Syntax_Syntax.Tm_constant d) -> - let uu____2202 = FStar_Const.eq_const c d in equal_iff uu____2202 + let uu____2242 = FStar_Const.eq_const c d in equal_iff uu____2242 | (FStar_Syntax_Syntax.Tm_uvar - (u1,uu____2204),FStar_Syntax_Syntax.Tm_uvar (u2,uu____2206)) -> - let uu____2255 = FStar_Syntax_Unionfind.equiv u1 u2 in - equal_if uu____2255 + (u1,uu____2244),FStar_Syntax_Syntax.Tm_uvar (u2,uu____2246)) -> + let uu____2295 = FStar_Syntax_Unionfind.equiv u1 u2 in + equal_if uu____2295 | (FStar_Syntax_Syntax.Tm_app (h1,args1),FStar_Syntax_Syntax.Tm_app (h2,args2)) -> - let uu____2300 = - let uu____2305 = - let uu____2306 = un_uinst h1 in - uu____2306.FStar_Syntax_Syntax.n in - let uu____2309 = - let uu____2310 = un_uinst h2 in - uu____2310.FStar_Syntax_Syntax.n in - (uu____2305, uu____2309) in - (match uu____2300 with + let uu____2340 = + let uu____2345 = + let uu____2346 = un_uinst h1 in + uu____2346.FStar_Syntax_Syntax.n in + let uu____2349 = + let uu____2350 = un_uinst h2 in + uu____2350.FStar_Syntax_Syntax.n in + (uu____2345, uu____2349) in + (match uu____2340 with | (FStar_Syntax_Syntax.Tm_fvar f1,FStar_Syntax_Syntax.Tm_fvar f2) when (f1.FStar_Syntax_Syntax.fv_qual = @@ -842,33 +879,33 @@ let rec eq_tm: | (FStar_Syntax_Syntax.Tm_fvar f1,FStar_Syntax_Syntax.Tm_fvar f2) when (FStar_Syntax_Syntax.fv_eq f1 f2) && - (let uu____2322 = - let uu____2323 = FStar_Syntax_Syntax.lid_of_fv f1 in - FStar_Ident.string_of_lid uu____2323 in - FStar_List.mem uu____2322 injectives) + (let uu____2362 = + let uu____2363 = FStar_Syntax_Syntax.lid_of_fv f1 in + FStar_Ident.string_of_lid uu____2363 in + FStar_List.mem uu____2362 injectives) -> equal_data f1 args1 f2 args2 - | uu____2324 -> - let uu____2329 = eq_tm h1 h2 in - eq_and uu____2329 (fun uu____2331 -> eq_args args1 args2)) + | uu____2364 -> + let uu____2369 = eq_tm h1 h2 in + eq_and uu____2369 (fun uu____2371 -> eq_args args1 args2)) | (FStar_Syntax_Syntax.Tm_type u,FStar_Syntax_Syntax.Tm_type v1) -> - let uu____2334 = eq_univs u v1 in equal_if uu____2334 - | (FStar_Syntax_Syntax.Tm_meta (t12,uu____2336),uu____2337) -> + let uu____2374 = eq_univs u v1 in equal_if uu____2374 + | (FStar_Syntax_Syntax.Tm_meta (t12,uu____2376),uu____2377) -> eq_tm t12 t21 - | (uu____2342,FStar_Syntax_Syntax.Tm_meta (t22,uu____2344)) -> + | (uu____2382,FStar_Syntax_Syntax.Tm_meta (t22,uu____2384)) -> eq_tm t11 t22 - | uu____2349 -> Unknown + | uu____2389 -> Unknown and eq_args: FStar_Syntax_Syntax.args -> FStar_Syntax_Syntax.args -> eq_result = fun a1 -> fun a2 -> match (a1, a2) with | ([],[]) -> Equal - | ((a,uu____2385)::a11,(b,uu____2388)::b1) -> - let uu____2442 = eq_tm a b in - (match uu____2442 with + | ((a,uu____2425)::a11,(b,uu____2428)::b1) -> + let uu____2482 = eq_tm a b in + (match uu____2482 with | Equal -> eq_args a11 b1 - | uu____2443 -> Unknown) - | uu____2444 -> Unknown + | uu____2483 -> Unknown) + | uu____2484 -> Unknown and eq_univs_list: FStar_Syntax_Syntax.universes -> FStar_Syntax_Syntax.universes -> Prims.bool @@ -881,61 +918,64 @@ let rec unrefine: FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term = fun t -> let t1 = FStar_Syntax_Subst.compress t in match t1.FStar_Syntax_Syntax.n with - | FStar_Syntax_Syntax.Tm_refine (x,uu____2456) -> + | FStar_Syntax_Syntax.Tm_refine (x,uu____2496) -> unrefine x.FStar_Syntax_Syntax.sort - | FStar_Syntax_Syntax.Tm_ascribed (t2,uu____2462,uu____2463) -> + | FStar_Syntax_Syntax.Tm_ascribed (t2,uu____2502,uu____2503) -> unrefine t2 - | uu____2504 -> t1 + | uu____2544 -> t1 let rec is_unit: FStar_Syntax_Syntax.term -> Prims.bool = fun t -> - let uu____2508 = - let uu____2509 = unrefine t in uu____2509.FStar_Syntax_Syntax.n in - match uu____2508 with + let uu____2548 = + let uu____2549 = unrefine t in uu____2549.FStar_Syntax_Syntax.n in + match uu____2548 with | FStar_Syntax_Syntax.Tm_fvar fv -> - (FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.unit_lid) || - (FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.squash_lid) - | FStar_Syntax_Syntax.Tm_uinst (t1,uu____2514) -> is_unit t1 - | uu____2519 -> false + ((FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.unit_lid) || + (FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.squash_lid)) + || + (FStar_Syntax_Syntax.fv_eq_lid fv + FStar_Parser_Const.auto_squash_lid) + | FStar_Syntax_Syntax.Tm_uinst (t1,uu____2554) -> is_unit t1 + | uu____2559 -> false let rec non_informative: FStar_Syntax_Syntax.term -> Prims.bool = fun t -> - let uu____2523 = - let uu____2524 = unrefine t in uu____2524.FStar_Syntax_Syntax.n in - match uu____2523 with - | FStar_Syntax_Syntax.Tm_type uu____2527 -> true + let uu____2563 = + let uu____2564 = unrefine t in uu____2564.FStar_Syntax_Syntax.n in + match uu____2563 with + | FStar_Syntax_Syntax.Tm_type uu____2567 -> true | FStar_Syntax_Syntax.Tm_fvar fv -> ((FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.unit_lid) || (FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.squash_lid)) || (FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.erased_lid) - | FStar_Syntax_Syntax.Tm_app (head1,uu____2530) -> non_informative head1 - | FStar_Syntax_Syntax.Tm_uinst (t1,uu____2552) -> non_informative t1 - | FStar_Syntax_Syntax.Tm_arrow (uu____2557,c) -> + | FStar_Syntax_Syntax.Tm_app (head1,uu____2570) -> non_informative head1 + | FStar_Syntax_Syntax.Tm_uinst (t1,uu____2592) -> non_informative t1 + | FStar_Syntax_Syntax.Tm_arrow (uu____2597,c) -> (is_tot_or_gtot_comp c) && (non_informative (comp_result c)) - | uu____2575 -> false + | uu____2615 -> false let is_fun: FStar_Syntax_Syntax.term -> Prims.bool = fun e -> - let uu____2579 = - let uu____2580 = FStar_Syntax_Subst.compress e in - uu____2580.FStar_Syntax_Syntax.n in - match uu____2579 with - | FStar_Syntax_Syntax.Tm_abs uu____2583 -> true - | uu____2600 -> false + let uu____2619 = + let uu____2620 = FStar_Syntax_Subst.compress e in + uu____2620.FStar_Syntax_Syntax.n in + match uu____2619 with + | FStar_Syntax_Syntax.Tm_abs uu____2623 -> true + | uu____2640 -> false let is_function_typ: FStar_Syntax_Syntax.term -> Prims.bool = fun t -> - let uu____2604 = - let uu____2605 = FStar_Syntax_Subst.compress t in - uu____2605.FStar_Syntax_Syntax.n in - match uu____2604 with - | FStar_Syntax_Syntax.Tm_arrow uu____2608 -> true - | uu____2621 -> false + let uu____2644 = + let uu____2645 = FStar_Syntax_Subst.compress t in + uu____2645.FStar_Syntax_Syntax.n in + match uu____2644 with + | FStar_Syntax_Syntax.Tm_arrow uu____2648 -> true + | uu____2661 -> false let rec pre_typ: FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term = fun t -> let t1 = FStar_Syntax_Subst.compress t in match t1.FStar_Syntax_Syntax.n with - | FStar_Syntax_Syntax.Tm_refine (x,uu____2627) -> + | FStar_Syntax_Syntax.Tm_refine (x,uu____2667) -> pre_typ x.FStar_Syntax_Syntax.sort - | FStar_Syntax_Syntax.Tm_ascribed (t2,uu____2633,uu____2634) -> + | FStar_Syntax_Syntax.Tm_ascribed (t2,uu____2673,uu____2674) -> pre_typ t2 - | uu____2675 -> t1 + | uu____2715 -> t1 let destruct: FStar_Syntax_Syntax.term -> FStar_Ident.lident -> @@ -946,43 +986,43 @@ let destruct: fun typ -> fun lid -> let typ1 = FStar_Syntax_Subst.compress typ in - let uu____2693 = - let uu____2694 = un_uinst typ1 in uu____2694.FStar_Syntax_Syntax.n in - match uu____2693 with + let uu____2733 = + let uu____2734 = un_uinst typ1 in uu____2734.FStar_Syntax_Syntax.n in + match uu____2733 with | FStar_Syntax_Syntax.Tm_app (head1,args) -> let head2 = un_uinst head1 in (match head2.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Tm_fvar tc when FStar_Syntax_Syntax.fv_eq_lid tc lid -> FStar_Pervasives_Native.Some args - | uu____2749 -> FStar_Pervasives_Native.None) + | uu____2789 -> FStar_Pervasives_Native.None) | FStar_Syntax_Syntax.Tm_fvar tc when FStar_Syntax_Syntax.fv_eq_lid tc lid -> FStar_Pervasives_Native.Some [] - | uu____2773 -> FStar_Pervasives_Native.None + | uu____2813 -> FStar_Pervasives_Native.None let lids_of_sigelt: FStar_Syntax_Syntax.sigelt -> FStar_Ident.lident Prims.list = fun se -> match se.FStar_Syntax_Syntax.sigel with - | FStar_Syntax_Syntax.Sig_let (uu____2789,lids) -> lids - | FStar_Syntax_Syntax.Sig_bundle (uu____2795,lids) -> lids + | FStar_Syntax_Syntax.Sig_let (uu____2829,lids) -> lids + | FStar_Syntax_Syntax.Sig_bundle (uu____2835,lids) -> lids | FStar_Syntax_Syntax.Sig_inductive_typ - (lid,uu____2806,uu____2807,uu____2808,uu____2809,uu____2810) -> + (lid,uu____2846,uu____2847,uu____2848,uu____2849,uu____2850) -> [lid] | FStar_Syntax_Syntax.Sig_effect_abbrev - (lid,uu____2820,uu____2821,uu____2822,uu____2823) -> [lid] + (lid,uu____2860,uu____2861,uu____2862,uu____2863) -> [lid] | FStar_Syntax_Syntax.Sig_datacon - (lid,uu____2829,uu____2830,uu____2831,uu____2832,uu____2833) -> + (lid,uu____2869,uu____2870,uu____2871,uu____2872,uu____2873) -> [lid] - | FStar_Syntax_Syntax.Sig_declare_typ (lid,uu____2839,uu____2840) -> + | FStar_Syntax_Syntax.Sig_declare_typ (lid,uu____2879,uu____2880) -> [lid] - | FStar_Syntax_Syntax.Sig_assume (lid,uu____2842,uu____2843) -> [lid] + | FStar_Syntax_Syntax.Sig_assume (lid,uu____2882,uu____2883) -> [lid] | FStar_Syntax_Syntax.Sig_new_effect_for_free n1 -> [n1.FStar_Syntax_Syntax.mname] | FStar_Syntax_Syntax.Sig_new_effect n1 -> [n1.FStar_Syntax_Syntax.mname] - | FStar_Syntax_Syntax.Sig_sub_effect uu____2846 -> [] - | FStar_Syntax_Syntax.Sig_pragma uu____2847 -> [] - | FStar_Syntax_Syntax.Sig_main uu____2848 -> [] + | FStar_Syntax_Syntax.Sig_sub_effect uu____2886 -> [] + | FStar_Syntax_Syntax.Sig_pragma uu____2887 -> [] + | FStar_Syntax_Syntax.Sig_main uu____2888 -> [] let lid_of_sigelt: FStar_Syntax_Syntax.sigelt -> FStar_Ident.lident FStar_Pervasives_Native.option @@ -990,32 +1030,32 @@ let lid_of_sigelt: fun se -> match lids_of_sigelt se with | l::[] -> FStar_Pervasives_Native.Some l - | uu____2859 -> FStar_Pervasives_Native.None + | uu____2899 -> FStar_Pervasives_Native.None let quals_of_sigelt: FStar_Syntax_Syntax.sigelt -> FStar_Syntax_Syntax.qualifier Prims.list = fun x -> x.FStar_Syntax_Syntax.sigquals let range_of_sigelt: FStar_Syntax_Syntax.sigelt -> FStar_Range.range = fun x -> x.FStar_Syntax_Syntax.sigrng let range_of_lb: - 'Auu____2873 'Auu____2874 . - ((FStar_Syntax_Syntax.bv,FStar_Ident.lid) FStar_Util.either,'Auu____2874, - 'Auu____2873) FStar_Pervasives_Native.tuple3 -> FStar_Range.range + 'Auu____2913 'Auu____2914 . + ((FStar_Syntax_Syntax.bv,FStar_Ident.lid) FStar_Util.either,'Auu____2914, + 'Auu____2913) FStar_Pervasives_Native.tuple3 -> FStar_Range.range = - fun uu___45_2888 -> - match uu___45_2888 with - | (FStar_Util.Inl x,uu____2900,uu____2901) -> + fun uu___45_2928 -> + match uu___45_2928 with + | (FStar_Util.Inl x,uu____2940,uu____2941) -> FStar_Syntax_Syntax.range_of_bv x - | (FStar_Util.Inr l,uu____2907,uu____2908) -> FStar_Ident.range_of_lid l + | (FStar_Util.Inr l,uu____2947,uu____2948) -> FStar_Ident.range_of_lid l let range_of_arg: - 'Auu____2916 'Auu____2917 . - ('Auu____2917 FStar_Syntax_Syntax.syntax,'Auu____2916) + 'Auu____2956 'Auu____2957 . + ('Auu____2957 FStar_Syntax_Syntax.syntax,'Auu____2956) FStar_Pervasives_Native.tuple2 -> FStar_Range.range = - fun uu____2927 -> - match uu____2927 with | (hd1,uu____2935) -> hd1.FStar_Syntax_Syntax.pos + fun uu____2967 -> + match uu____2967 with | (hd1,uu____2975) -> hd1.FStar_Syntax_Syntax.pos let range_of_args: - 'Auu____2944 'Auu____2945 . - ('Auu____2945 FStar_Syntax_Syntax.syntax,'Auu____2944) + 'Auu____2984 'Auu____2985 . + ('Auu____2985 FStar_Syntax_Syntax.syntax,'Auu____2984) FStar_Pervasives_Native.tuple2 Prims.list -> FStar_Range.range -> FStar_Range.range = @@ -1046,27 +1086,27 @@ let mk_data: fun args -> match args with | [] -> - let uu____3065 = - let uu____3068 = - let uu____3069 = - let uu____3076 = + let uu____3105 = + let uu____3108 = + let uu____3109 = + let uu____3116 = FStar_Syntax_Syntax.fvar l FStar_Syntax_Syntax.Delta_constant (FStar_Pervasives_Native.Some FStar_Syntax_Syntax.Data_ctor) in - (uu____3076, + (uu____3116, (FStar_Syntax_Syntax.Meta_desugared FStar_Syntax_Syntax.Data_app)) in - FStar_Syntax_Syntax.Tm_meta uu____3069 in - FStar_Syntax_Syntax.mk uu____3068 in - uu____3065 FStar_Pervasives_Native.None + FStar_Syntax_Syntax.Tm_meta uu____3109 in + FStar_Syntax_Syntax.mk uu____3108 in + uu____3105 FStar_Pervasives_Native.None (FStar_Ident.range_of_lid l) - | uu____3080 -> + | uu____3120 -> let e = - let uu____3092 = + let uu____3132 = FStar_Syntax_Syntax.fvar l FStar_Syntax_Syntax.Delta_constant (FStar_Pervasives_Native.Some FStar_Syntax_Syntax.Data_ctor) in - mk_app uu____3092 args in + mk_app uu____3132 args in FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_meta (e, @@ -1082,12 +1122,12 @@ let unmangle_field_name: FStar_Ident.ident -> FStar_Ident.ident = fun x -> if FStar_Util.starts_with x.FStar_Ident.idText "__fname__" then - let uu____3103 = - let uu____3108 = + let uu____3143 = + let uu____3148 = FStar_Util.substring_from x.FStar_Ident.idText (Prims.parse_int "9") in - (uu____3108, (x.FStar_Ident.idRange)) in - FStar_Ident.mk_ident uu____3103 + (uu____3148, (x.FStar_Ident.idRange)) in + FStar_Ident.mk_ident uu____3143 else x let field_projector_prefix: Prims.string = "__proj__" let field_projector_sep: Prims.string = "__item__" @@ -1125,42 +1165,42 @@ let mk_field_projector_name: fun x -> fun i -> let nm = - let uu____3143 = FStar_Syntax_Syntax.is_null_bv x in - if uu____3143 + let uu____3183 = FStar_Syntax_Syntax.is_null_bv x in + if uu____3183 then - let uu____3144 = - let uu____3149 = - let uu____3150 = FStar_Util.string_of_int i in - Prims.strcat "_" uu____3150 in - let uu____3151 = FStar_Syntax_Syntax.range_of_bv x in - (uu____3149, uu____3151) in - FStar_Ident.mk_ident uu____3144 + let uu____3184 = + let uu____3189 = + let uu____3190 = FStar_Util.string_of_int i in + Prims.strcat "_" uu____3190 in + let uu____3191 = FStar_Syntax_Syntax.range_of_bv x in + (uu____3189, uu____3191) in + FStar_Ident.mk_ident uu____3184 else x.FStar_Syntax_Syntax.ppname in let y = - let uu___49_3154 = x in + let uu___51_3194 = x in { FStar_Syntax_Syntax.ppname = nm; FStar_Syntax_Syntax.index = - (uu___49_3154.FStar_Syntax_Syntax.index); + (uu___51_3194.FStar_Syntax_Syntax.index); FStar_Syntax_Syntax.sort = - (uu___49_3154.FStar_Syntax_Syntax.sort) + (uu___51_3194.FStar_Syntax_Syntax.sort) } in - let uu____3155 = mk_field_projector_name_from_ident lid nm in - (uu____3155, y) + let uu____3195 = mk_field_projector_name_from_ident lid nm in + (uu____3195, y) let set_uvar: FStar_Syntax_Syntax.uvar -> FStar_Syntax_Syntax.term -> Prims.unit = fun uv -> fun t -> - let uu____3162 = FStar_Syntax_Unionfind.find uv in - match uu____3162 with - | FStar_Pervasives_Native.Some uu____3165 -> - let uu____3166 = - let uu____3167 = - let uu____3168 = FStar_Syntax_Unionfind.uvar_id uv in - FStar_All.pipe_left FStar_Util.string_of_int uu____3168 in - FStar_Util.format1 "Changing a fixed uvar! ?%s\n" uu____3167 in - failwith uu____3166 - | uu____3169 -> FStar_Syntax_Unionfind.change uv t + let uu____3202 = FStar_Syntax_Unionfind.find uv in + match uu____3202 with + | FStar_Pervasives_Native.Some uu____3205 -> + let uu____3206 = + let uu____3207 = + let uu____3208 = FStar_Syntax_Unionfind.uvar_id uv in + FStar_All.pipe_left FStar_Util.string_of_int uu____3208 in + FStar_Util.format1 "Changing a fixed uvar! ?%s\n" uu____3207 in + failwith uu____3206 + | uu____3209 -> FStar_Syntax_Unionfind.change uv t let qualifier_equal: FStar_Syntax_Syntax.qualifier -> FStar_Syntax_Syntax.qualifier -> Prims.bool @@ -1201,7 +1241,7 @@ let qualifier_equal: (fun x1 -> fun x2 -> x1.FStar_Ident.idText = x2.FStar_Ident.idText) f1 f2) - | uu____3240 -> q1 = q2 + | uu____3280 -> q1 = q2 let abs: FStar_Syntax_Syntax.binders -> FStar_Syntax_Syntax.term -> @@ -1215,50 +1255,50 @@ let abs: match lopt1 with | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None | FStar_Pervasives_Native.Some rc -> - let uu____3271 = - let uu___50_3272 = rc in - let uu____3273 = + let uu____3311 = + let uu___52_3312 = rc in + let uu____3313 = FStar_Util.map_opt rc.FStar_Syntax_Syntax.residual_typ (FStar_Syntax_Subst.close bs) in { FStar_Syntax_Syntax.residual_effect = - (uu___50_3272.FStar_Syntax_Syntax.residual_effect); - FStar_Syntax_Syntax.residual_typ = uu____3273; + (uu___52_3312.FStar_Syntax_Syntax.residual_effect); + FStar_Syntax_Syntax.residual_typ = uu____3313; FStar_Syntax_Syntax.residual_flags = - (uu___50_3272.FStar_Syntax_Syntax.residual_flags) + (uu___52_3312.FStar_Syntax_Syntax.residual_flags) } in - FStar_Pervasives_Native.Some uu____3271 in + FStar_Pervasives_Native.Some uu____3311 in match bs with | [] -> t - | uu____3284 -> + | uu____3324 -> let body = - let uu____3286 = FStar_Syntax_Subst.close bs t in - FStar_Syntax_Subst.compress uu____3286 in + let uu____3326 = FStar_Syntax_Subst.close bs t in + FStar_Syntax_Subst.compress uu____3326 in (match ((body.FStar_Syntax_Syntax.n), lopt) with | (FStar_Syntax_Syntax.Tm_abs (bs',t1,lopt'),FStar_Pervasives_Native.None ) -> - let uu____3314 = - let uu____3317 = - let uu____3318 = - let uu____3335 = - let uu____3342 = FStar_Syntax_Subst.close_binders bs in - FStar_List.append uu____3342 bs' in - let uu____3353 = close_lopt lopt' in - (uu____3335, t1, uu____3353) in - FStar_Syntax_Syntax.Tm_abs uu____3318 in - FStar_Syntax_Syntax.mk uu____3317 in - uu____3314 FStar_Pervasives_Native.None + let uu____3354 = + let uu____3357 = + let uu____3358 = + let uu____3375 = + let uu____3382 = FStar_Syntax_Subst.close_binders bs in + FStar_List.append uu____3382 bs' in + let uu____3393 = close_lopt lopt' in + (uu____3375, t1, uu____3393) in + FStar_Syntax_Syntax.Tm_abs uu____3358 in + FStar_Syntax_Syntax.mk uu____3357 in + uu____3354 FStar_Pervasives_Native.None t1.FStar_Syntax_Syntax.pos - | uu____3369 -> - let uu____3376 = - let uu____3379 = - let uu____3380 = - let uu____3397 = FStar_Syntax_Subst.close_binders bs in - let uu____3398 = close_lopt lopt in - (uu____3397, body, uu____3398) in - FStar_Syntax_Syntax.Tm_abs uu____3380 in - FStar_Syntax_Syntax.mk uu____3379 in - uu____3376 FStar_Pervasives_Native.None + | uu____3409 -> + let uu____3416 = + let uu____3419 = + let uu____3420 = + let uu____3437 = FStar_Syntax_Subst.close_binders bs in + let uu____3438 = close_lopt lopt in + (uu____3437, body, uu____3438) in + FStar_Syntax_Syntax.Tm_abs uu____3420 in + FStar_Syntax_Syntax.mk uu____3419 in + uu____3416 FStar_Pervasives_Native.None t.FStar_Syntax_Syntax.pos) let arrow: (FStar_Syntax_Syntax.bv,FStar_Syntax_Syntax.aqual) @@ -1270,16 +1310,16 @@ let arrow: fun c -> match bs with | [] -> comp_result c - | uu____3436 -> - let uu____3443 = - let uu____3446 = - let uu____3447 = - let uu____3460 = FStar_Syntax_Subst.close_binders bs in - let uu____3461 = FStar_Syntax_Subst.close_comp bs c in - (uu____3460, uu____3461) in - FStar_Syntax_Syntax.Tm_arrow uu____3447 in - FStar_Syntax_Syntax.mk uu____3446 in - uu____3443 FStar_Pervasives_Native.None c.FStar_Syntax_Syntax.pos + | uu____3476 -> + let uu____3483 = + let uu____3486 = + let uu____3487 = + let uu____3500 = FStar_Syntax_Subst.close_binders bs in + let uu____3501 = FStar_Syntax_Subst.close_comp bs c in + (uu____3500, uu____3501) in + FStar_Syntax_Syntax.Tm_arrow uu____3487 in + FStar_Syntax_Syntax.mk uu____3486 in + uu____3483 FStar_Pervasives_Native.None c.FStar_Syntax_Syntax.pos let flat_arrow: (FStar_Syntax_Syntax.bv,FStar_Syntax_Syntax.aqual) FStar_Pervasives_Native.tuple2 Prims.list -> @@ -1289,25 +1329,25 @@ let flat_arrow: fun bs -> fun c -> let t = arrow bs c in - let uu____3492 = - let uu____3493 = FStar_Syntax_Subst.compress t in - uu____3493.FStar_Syntax_Syntax.n in - match uu____3492 with + let uu____3532 = + let uu____3533 = FStar_Syntax_Subst.compress t in + uu____3533.FStar_Syntax_Syntax.n in + match uu____3532 with | FStar_Syntax_Syntax.Tm_arrow (bs1,c1) -> (match c1.FStar_Syntax_Syntax.n with - | FStar_Syntax_Syntax.Total (tres,uu____3519) -> - let uu____3528 = - let uu____3529 = FStar_Syntax_Subst.compress tres in - uu____3529.FStar_Syntax_Syntax.n in - (match uu____3528 with + | FStar_Syntax_Syntax.Total (tres,uu____3559) -> + let uu____3568 = + let uu____3569 = FStar_Syntax_Subst.compress tres in + uu____3569.FStar_Syntax_Syntax.n in + (match uu____3568 with | FStar_Syntax_Syntax.Tm_arrow (bs',c') -> FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_arrow ((FStar_List.append bs1 bs'), c')) FStar_Pervasives_Native.None t.FStar_Syntax_Syntax.pos - | uu____3564 -> t) - | uu____3565 -> t) - | uu____3566 -> t + | uu____3604 -> t) + | uu____3605 -> t) + | uu____3606 -> t let refine: FStar_Syntax_Syntax.bv -> FStar_Syntax_Syntax.term -> @@ -1315,21 +1355,21 @@ let refine: = fun b -> fun t -> - let uu____3575 = - let uu____3576 = FStar_Syntax_Syntax.range_of_bv b in - FStar_Range.union_ranges uu____3576 t.FStar_Syntax_Syntax.pos in - let uu____3577 = - let uu____3580 = - let uu____3581 = - let uu____3588 = - let uu____3589 = - let uu____3590 = FStar_Syntax_Syntax.mk_binder b in - [uu____3590] in - FStar_Syntax_Subst.close uu____3589 t in - (b, uu____3588) in - FStar_Syntax_Syntax.Tm_refine uu____3581 in - FStar_Syntax_Syntax.mk uu____3580 in - uu____3577 FStar_Pervasives_Native.None uu____3575 + let uu____3615 = + let uu____3616 = FStar_Syntax_Syntax.range_of_bv b in + FStar_Range.union_ranges uu____3616 t.FStar_Syntax_Syntax.pos in + let uu____3617 = + let uu____3620 = + let uu____3621 = + let uu____3628 = + let uu____3629 = + let uu____3630 = FStar_Syntax_Syntax.mk_binder b in + [uu____3630] in + FStar_Syntax_Subst.close uu____3629 t in + (b, uu____3628) in + FStar_Syntax_Syntax.Tm_refine uu____3621 in + FStar_Syntax_Syntax.mk uu____3620 in + uu____3617 FStar_Pervasives_Native.None uu____3615 let branch: FStar_Syntax_Syntax.branch -> FStar_Syntax_Syntax.branch = fun b -> FStar_Syntax_Subst.close_branch b let rec arrow_formals_comp: @@ -1342,23 +1382,23 @@ let rec arrow_formals_comp: let k1 = FStar_Syntax_Subst.compress k in match k1.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Tm_arrow (bs,c) -> - let uu____3639 = FStar_Syntax_Subst.open_comp bs c in - (match uu____3639 with + let uu____3679 = FStar_Syntax_Subst.open_comp bs c in + (match uu____3679 with | (bs1,c1) -> - let uu____3656 = is_tot_or_gtot_comp c1 in - if uu____3656 + let uu____3696 = is_tot_or_gtot_comp c1 in + if uu____3696 then - let uu____3667 = arrow_formals_comp (comp_result c1) in - (match uu____3667 with + let uu____3707 = arrow_formals_comp (comp_result c1) in + (match uu____3707 with | (bs',k2) -> ((FStar_List.append bs1 bs'), k2)) else (bs1, c1)) | FStar_Syntax_Syntax.Tm_refine - ({ FStar_Syntax_Syntax.ppname = uu____3713; - FStar_Syntax_Syntax.index = uu____3714; - FStar_Syntax_Syntax.sort = k2;_},uu____3716) + ({ FStar_Syntax_Syntax.ppname = uu____3753; + FStar_Syntax_Syntax.index = uu____3754; + FStar_Syntax_Syntax.sort = k2;_},uu____3756) -> arrow_formals_comp k2 - | uu____3723 -> - let uu____3724 = FStar_Syntax_Syntax.mk_Total k1 in ([], uu____3724) + | uu____3763 -> + let uu____3764 = FStar_Syntax_Syntax.mk_Total k1 in ([], uu____3764) let rec arrow_formals: FStar_Syntax_Syntax.term -> ((FStar_Syntax_Syntax.bv,FStar_Syntax_Syntax.aqual) @@ -1367,8 +1407,8 @@ let rec arrow_formals: FStar_Pervasives_Native.tuple2 = fun k -> - let uu____3750 = arrow_formals_comp k in - match uu____3750 with | (bs,c) -> (bs, (comp_result c)) + let uu____3790 = arrow_formals_comp k in + match uu____3790 with | (bs,c) -> (bs, (comp_result c)) let abs_formals: FStar_Syntax_Syntax.term -> (FStar_Syntax_Syntax.binders,FStar_Syntax_Syntax.term,FStar_Syntax_Syntax.residual_comp @@ -1379,37 +1419,37 @@ let abs_formals: let subst_lcomp_opt s l = match l with | FStar_Pervasives_Native.Some rc -> - let uu____3826 = - let uu___51_3827 = rc in - let uu____3828 = + let uu____3866 = + let uu___53_3867 = rc in + let uu____3868 = FStar_Util.map_opt rc.FStar_Syntax_Syntax.residual_typ (FStar_Syntax_Subst.subst s) in { FStar_Syntax_Syntax.residual_effect = - (uu___51_3827.FStar_Syntax_Syntax.residual_effect); - FStar_Syntax_Syntax.residual_typ = uu____3828; + (uu___53_3867.FStar_Syntax_Syntax.residual_effect); + FStar_Syntax_Syntax.residual_typ = uu____3868; FStar_Syntax_Syntax.residual_flags = - (uu___51_3827.FStar_Syntax_Syntax.residual_flags) + (uu___53_3867.FStar_Syntax_Syntax.residual_flags) } in - FStar_Pervasives_Native.Some uu____3826 - | uu____3835 -> l in + FStar_Pervasives_Native.Some uu____3866 + | uu____3875 -> l in let rec aux t1 abs_body_lcomp = - let uu____3863 = - let uu____3864 = - let uu____3867 = FStar_Syntax_Subst.compress t1 in - FStar_All.pipe_left unascribe uu____3867 in - uu____3864.FStar_Syntax_Syntax.n in - match uu____3863 with + let uu____3903 = + let uu____3904 = + let uu____3907 = FStar_Syntax_Subst.compress t1 in + FStar_All.pipe_left unascribe uu____3907 in + uu____3904.FStar_Syntax_Syntax.n in + match uu____3903 with | FStar_Syntax_Syntax.Tm_abs (bs,t2,what) -> - let uu____3905 = aux t2 what in - (match uu____3905 with + let uu____3945 = aux t2 what in + (match uu____3945 with | (bs',t3,what1) -> ((FStar_List.append bs bs'), t3, what1)) - | uu____3965 -> ([], t1, abs_body_lcomp) in - let uu____3978 = aux t FStar_Pervasives_Native.None in - match uu____3978 with + | uu____4005 -> ([], t1, abs_body_lcomp) in + let uu____4018 = aux t FStar_Pervasives_Native.None in + match uu____4018 with | (bs,t1,abs_body_lcomp) -> - let uu____4020 = FStar_Syntax_Subst.open_term' bs t1 in - (match uu____4020 with + let uu____4060 = FStar_Syntax_Subst.open_term' bs t1 in + (match uu____4060 with | (bs1,t2,opening) -> let abs_body_lcomp1 = subst_lcomp_opt opening abs_body_lcomp in (bs1, t2, abs_body_lcomp1)) @@ -1449,9 +1489,9 @@ let close_univs_and_mk_letbinding: fun def -> let def1 = match (recs, univ_vars) with - | (FStar_Pervasives_Native.None ,uu____4123) -> def - | (uu____4134,[]) -> def - | (FStar_Pervasives_Native.Some fvs,uu____4146) -> + | (FStar_Pervasives_Native.None ,uu____4163) -> def + | (uu____4174,[]) -> def + | (FStar_Pervasives_Native.Some fvs,uu____4186) -> let universes = FStar_All.pipe_right univ_vars (FStar_List.map @@ -1481,34 +1521,34 @@ let open_univ_vars_binders_and_comp: fun c -> match binders with | [] -> - let uu____4246 = FStar_Syntax_Subst.open_univ_vars_comp uvs c in - (match uu____4246 with | (uvs1,c1) -> (uvs1, [], c1)) - | uu____4275 -> + let uu____4286 = FStar_Syntax_Subst.open_univ_vars_comp uvs c in + (match uu____4286 with | (uvs1,c1) -> (uvs1, [], c1)) + | uu____4315 -> let t' = arrow binders c in - let uu____4285 = FStar_Syntax_Subst.open_univ_vars uvs t' in - (match uu____4285 with + let uu____4325 = FStar_Syntax_Subst.open_univ_vars uvs t' in + (match uu____4325 with | (uvs1,t'1) -> - let uu____4304 = - let uu____4305 = FStar_Syntax_Subst.compress t'1 in - uu____4305.FStar_Syntax_Syntax.n in - (match uu____4304 with + let uu____4344 = + let uu____4345 = FStar_Syntax_Subst.compress t'1 in + uu____4345.FStar_Syntax_Syntax.n in + (match uu____4344 with | FStar_Syntax_Syntax.Tm_arrow (binders1,c1) -> (uvs1, binders1, c1) - | uu____4346 -> failwith "Impossible")) + | uu____4386 -> failwith "Impossible")) let is_tuple_constructor: FStar_Syntax_Syntax.typ -> Prims.bool = fun t -> match t.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Tm_fvar fv -> FStar_Parser_Const.is_tuple_constructor_string ((fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v).FStar_Ident.str - | uu____4363 -> false + | uu____4403 -> false let is_dtuple_constructor: FStar_Syntax_Syntax.typ -> Prims.bool = fun t -> match t.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Tm_fvar fv -> FStar_Parser_Const.is_dtuple_constructor_lid (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v - | uu____4368 -> false + | uu____4408 -> false let is_lid_equality: FStar_Ident.lident -> Prims.bool = fun x -> FStar_Ident.lid_equals x FStar_Parser_Const.eq2_lid let is_forall: FStar_Ident.lident -> Prims.bool = @@ -1532,26 +1572,26 @@ let is_constructor: FStar_Syntax_Syntax.term -> FStar_Ident.lident -> Prims.bool = fun t -> fun lid -> - let uu____4400 = - let uu____4401 = pre_typ t in uu____4401.FStar_Syntax_Syntax.n in - match uu____4400 with + let uu____4440 = + let uu____4441 = pre_typ t in uu____4441.FStar_Syntax_Syntax.n in + match uu____4440 with | FStar_Syntax_Syntax.Tm_fvar tc -> FStar_Ident.lid_equals (tc.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v lid - | uu____4405 -> false + | uu____4445 -> false let rec is_constructed_typ: FStar_Syntax_Syntax.term -> FStar_Ident.lident -> Prims.bool = fun t -> fun lid -> - let uu____4412 = - let uu____4413 = pre_typ t in uu____4413.FStar_Syntax_Syntax.n in - match uu____4412 with - | FStar_Syntax_Syntax.Tm_fvar uu____4416 -> is_constructor t lid - | FStar_Syntax_Syntax.Tm_app (t1,uu____4418) -> + let uu____4452 = + let uu____4453 = pre_typ t in uu____4453.FStar_Syntax_Syntax.n in + match uu____4452 with + | FStar_Syntax_Syntax.Tm_fvar uu____4456 -> is_constructor t lid + | FStar_Syntax_Syntax.Tm_app (t1,uu____4458) -> is_constructed_typ t1 lid - | FStar_Syntax_Syntax.Tm_uinst (t1,uu____4440) -> + | FStar_Syntax_Syntax.Tm_uinst (t1,uu____4480) -> is_constructed_typ t1 lid - | uu____4445 -> false + | uu____4485 -> false let rec get_tycon: FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term FStar_Pervasives_Native.option @@ -1559,14 +1599,14 @@ let rec get_tycon: fun t -> let t1 = pre_typ t in match t1.FStar_Syntax_Syntax.n with - | FStar_Syntax_Syntax.Tm_bvar uu____4454 -> + | FStar_Syntax_Syntax.Tm_bvar uu____4494 -> FStar_Pervasives_Native.Some t1 - | FStar_Syntax_Syntax.Tm_name uu____4455 -> + | FStar_Syntax_Syntax.Tm_name uu____4495 -> FStar_Pervasives_Native.Some t1 - | FStar_Syntax_Syntax.Tm_fvar uu____4456 -> + | FStar_Syntax_Syntax.Tm_fvar uu____4496 -> FStar_Pervasives_Native.Some t1 - | FStar_Syntax_Syntax.Tm_app (t2,uu____4458) -> get_tycon t2 - | uu____4479 -> FStar_Pervasives_Native.None + | FStar_Syntax_Syntax.Tm_app (t2,uu____4498) -> get_tycon t2 + | uu____4519 -> FStar_Pervasives_Native.None let is_interpreted: FStar_Ident.lident -> Prims.bool = fun l -> let theory_syms = @@ -1588,29 +1628,29 @@ let is_interpreted: FStar_Ident.lident -> Prims.bool = FStar_Util.for_some (FStar_Ident.lid_equals l) theory_syms let is_fstar_tactics_embed: FStar_Syntax_Syntax.term -> Prims.bool = fun t -> - let uu____4489 = - let uu____4490 = un_uinst t in uu____4490.FStar_Syntax_Syntax.n in - match uu____4489 with + let uu____4529 = + let uu____4530 = un_uinst t in uu____4530.FStar_Syntax_Syntax.n in + match uu____4529 with | FStar_Syntax_Syntax.Tm_fvar fv -> FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.fstar_refl_embed_lid - | uu____4494 -> false + | uu____4534 -> false let is_fstar_tactics_quote: FStar_Syntax_Syntax.term -> Prims.bool = fun t -> - let uu____4498 = - let uu____4499 = un_uinst t in uu____4499.FStar_Syntax_Syntax.n in - match uu____4498 with + let uu____4538 = + let uu____4539 = un_uinst t in uu____4539.FStar_Syntax_Syntax.n in + match uu____4538 with | FStar_Syntax_Syntax.Tm_fvar fv -> FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.quote_lid - | uu____4503 -> false + | uu____4543 -> false let is_fstar_tactics_by_tactic: FStar_Syntax_Syntax.term -> Prims.bool = fun t -> - let uu____4507 = - let uu____4508 = un_uinst t in uu____4508.FStar_Syntax_Syntax.n in - match uu____4507 with + let uu____4547 = + let uu____4548 = un_uinst t in uu____4548.FStar_Syntax_Syntax.n in + match uu____4547 with | FStar_Syntax_Syntax.Tm_fvar fv -> FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.by_tactic_lid - | uu____4512 -> false + | uu____4552 -> false let ktype: FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax = FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_type FStar_Syntax_Syntax.U_unknown) @@ -1624,27 +1664,27 @@ let type_u: (FStar_Syntax_Syntax.typ,FStar_Syntax_Syntax.universe) FStar_Pervasives_Native.tuple2 = - fun uu____4523 -> + fun uu____4563 -> let u = - let uu____4529 = FStar_Syntax_Unionfind.univ_fresh () in + let uu____4569 = FStar_Syntax_Unionfind.univ_fresh () in FStar_All.pipe_left (fun _0_28 -> FStar_Syntax_Syntax.U_unif _0_28) - uu____4529 in - let uu____4546 = + uu____4569 in + let uu____4586 = FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_type u) FStar_Pervasives_Native.None FStar_Range.dummyRange in - (uu____4546, u) + (uu____4586, u) let attr_substitute: FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax = - let uu____4553 = - let uu____4556 = - let uu____4557 = - let uu____4558 = + let uu____4593 = + let uu____4596 = + let uu____4597 = + let uu____4598 = FStar_Ident.lid_of_path ["FStar"; "Pervasives"; "Substitute"] FStar_Range.dummyRange in - FStar_Syntax_Syntax.lid_as_fv uu____4558 + FStar_Syntax_Syntax.lid_as_fv uu____4598 FStar_Syntax_Syntax.Delta_constant FStar_Pervasives_Native.None in - FStar_Syntax_Syntax.Tm_fvar uu____4557 in - FStar_Syntax_Syntax.mk uu____4556 in - uu____4553 FStar_Pervasives_Native.None FStar_Range.dummyRange + FStar_Syntax_Syntax.Tm_fvar uu____4597 in + FStar_Syntax_Syntax.mk uu____4596 in + uu____4593 FStar_Pervasives_Native.None FStar_Range.dummyRange let exp_true_bool: FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax = FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_bool true)) @@ -1704,24 +1744,24 @@ let mk_conj_opt: match phi1 with | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.Some phi2 | FStar_Pervasives_Native.Some phi11 -> - let uu____4605 = - let uu____4608 = + let uu____4645 = + let uu____4648 = FStar_Range.union_ranges phi11.FStar_Syntax_Syntax.pos phi2.FStar_Syntax_Syntax.pos in - let uu____4609 = - let uu____4612 = - let uu____4613 = - let uu____4628 = - let uu____4631 = FStar_Syntax_Syntax.as_arg phi11 in - let uu____4632 = - let uu____4635 = FStar_Syntax_Syntax.as_arg phi2 in - [uu____4635] in - uu____4631 :: uu____4632 in - (tand, uu____4628) in - FStar_Syntax_Syntax.Tm_app uu____4613 in - FStar_Syntax_Syntax.mk uu____4612 in - uu____4609 FStar_Pervasives_Native.None uu____4608 in - FStar_Pervasives_Native.Some uu____4605 + let uu____4649 = + let uu____4652 = + let uu____4653 = + let uu____4668 = + let uu____4671 = FStar_Syntax_Syntax.as_arg phi11 in + let uu____4672 = + let uu____4675 = FStar_Syntax_Syntax.as_arg phi2 in + [uu____4675] in + uu____4671 :: uu____4672 in + (tand, uu____4668) in + FStar_Syntax_Syntax.Tm_app uu____4653 in + FStar_Syntax_Syntax.mk uu____4652 in + uu____4649 FStar_Pervasives_Native.None uu____4648 in + FStar_Pervasives_Native.Some uu____4645 let mk_binop: FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax -> FStar_Syntax_Syntax.term -> @@ -1731,36 +1771,36 @@ let mk_binop: fun op_t -> fun phi1 -> fun phi2 -> - let uu____4658 = + let uu____4698 = FStar_Range.union_ranges phi1.FStar_Syntax_Syntax.pos phi2.FStar_Syntax_Syntax.pos in - let uu____4659 = - let uu____4662 = - let uu____4663 = - let uu____4678 = - let uu____4681 = FStar_Syntax_Syntax.as_arg phi1 in - let uu____4682 = - let uu____4685 = FStar_Syntax_Syntax.as_arg phi2 in - [uu____4685] in - uu____4681 :: uu____4682 in - (op_t, uu____4678) in - FStar_Syntax_Syntax.Tm_app uu____4663 in - FStar_Syntax_Syntax.mk uu____4662 in - uu____4659 FStar_Pervasives_Native.None uu____4658 + let uu____4699 = + let uu____4702 = + let uu____4703 = + let uu____4718 = + let uu____4721 = FStar_Syntax_Syntax.as_arg phi1 in + let uu____4722 = + let uu____4725 = FStar_Syntax_Syntax.as_arg phi2 in + [uu____4725] in + uu____4721 :: uu____4722 in + (op_t, uu____4718) in + FStar_Syntax_Syntax.Tm_app uu____4703 in + FStar_Syntax_Syntax.mk uu____4702 in + uu____4699 FStar_Pervasives_Native.None uu____4698 let mk_neg: FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax = fun phi -> - let uu____4698 = - let uu____4701 = - let uu____4702 = - let uu____4717 = - let uu____4720 = FStar_Syntax_Syntax.as_arg phi in [uu____4720] in - (t_not, uu____4717) in - FStar_Syntax_Syntax.Tm_app uu____4702 in - FStar_Syntax_Syntax.mk uu____4701 in - uu____4698 FStar_Pervasives_Native.None phi.FStar_Syntax_Syntax.pos + let uu____4738 = + let uu____4741 = + let uu____4742 = + let uu____4757 = + let uu____4760 = FStar_Syntax_Syntax.as_arg phi in [uu____4760] in + (t_not, uu____4757) in + FStar_Syntax_Syntax.Tm_app uu____4742 in + FStar_Syntax_Syntax.mk uu____4741 in + uu____4738 FStar_Pervasives_Native.None phi.FStar_Syntax_Syntax.pos let mk_conj: FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term -> @@ -1798,15 +1838,15 @@ let b2t: FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax = fun e -> - let uu____4781 = - let uu____4784 = - let uu____4785 = - let uu____4800 = - let uu____4803 = FStar_Syntax_Syntax.as_arg e in [uu____4803] in - (b2t_v, uu____4800) in - FStar_Syntax_Syntax.Tm_app uu____4785 in - FStar_Syntax_Syntax.mk uu____4784 in - uu____4781 FStar_Pervasives_Native.None e.FStar_Syntax_Syntax.pos + let uu____4821 = + let uu____4824 = + let uu____4825 = + let uu____4840 = + let uu____4843 = FStar_Syntax_Syntax.as_arg e in [uu____4843] in + (b2t_v, uu____4840) in + FStar_Syntax_Syntax.Tm_app uu____4825 in + FStar_Syntax_Syntax.mk uu____4824 in + uu____4821 FStar_Pervasives_Native.None e.FStar_Syntax_Syntax.pos let teq: FStar_Syntax_Syntax.term = fvar_const FStar_Parser_Const.eq2_lid let mk_untyped_eq2: FStar_Syntax_Syntax.term -> @@ -1815,22 +1855,22 @@ let mk_untyped_eq2: = fun e1 -> fun e2 -> - let uu____4817 = + let uu____4857 = FStar_Range.union_ranges e1.FStar_Syntax_Syntax.pos e2.FStar_Syntax_Syntax.pos in - let uu____4818 = - let uu____4821 = - let uu____4822 = - let uu____4837 = - let uu____4840 = FStar_Syntax_Syntax.as_arg e1 in - let uu____4841 = - let uu____4844 = FStar_Syntax_Syntax.as_arg e2 in - [uu____4844] in - uu____4840 :: uu____4841 in - (teq, uu____4837) in - FStar_Syntax_Syntax.Tm_app uu____4822 in - FStar_Syntax_Syntax.mk uu____4821 in - uu____4818 FStar_Pervasives_Native.None uu____4817 + let uu____4858 = + let uu____4861 = + let uu____4862 = + let uu____4877 = + let uu____4880 = FStar_Syntax_Syntax.as_arg e1 in + let uu____4881 = + let uu____4884 = FStar_Syntax_Syntax.as_arg e2 in + [uu____4884] in + uu____4880 :: uu____4881 in + (teq, uu____4877) in + FStar_Syntax_Syntax.Tm_app uu____4862 in + FStar_Syntax_Syntax.mk uu____4861 in + uu____4858 FStar_Pervasives_Native.None uu____4857 let mk_eq2: FStar_Syntax_Syntax.universe -> FStar_Syntax_Syntax.typ -> @@ -1842,25 +1882,25 @@ let mk_eq2: fun e1 -> fun e2 -> let eq_inst = FStar_Syntax_Syntax.mk_Tm_uinst teq [u] in - let uu____4863 = + let uu____4903 = FStar_Range.union_ranges e1.FStar_Syntax_Syntax.pos e2.FStar_Syntax_Syntax.pos in - let uu____4864 = - let uu____4867 = - let uu____4868 = - let uu____4883 = - let uu____4886 = FStar_Syntax_Syntax.iarg t in - let uu____4887 = - let uu____4890 = FStar_Syntax_Syntax.as_arg e1 in - let uu____4891 = - let uu____4894 = FStar_Syntax_Syntax.as_arg e2 in - [uu____4894] in - uu____4890 :: uu____4891 in - uu____4886 :: uu____4887 in - (eq_inst, uu____4883) in - FStar_Syntax_Syntax.Tm_app uu____4868 in - FStar_Syntax_Syntax.mk uu____4867 in - uu____4864 FStar_Pervasives_Native.None uu____4863 + let uu____4904 = + let uu____4907 = + let uu____4908 = + let uu____4923 = + let uu____4926 = FStar_Syntax_Syntax.iarg t in + let uu____4927 = + let uu____4930 = FStar_Syntax_Syntax.as_arg e1 in + let uu____4931 = + let uu____4934 = FStar_Syntax_Syntax.as_arg e2 in + [uu____4934] in + uu____4930 :: uu____4931 in + uu____4926 :: uu____4927 in + (eq_inst, uu____4923) in + FStar_Syntax_Syntax.Tm_app uu____4908 in + FStar_Syntax_Syntax.mk uu____4907 in + uu____4904 FStar_Pervasives_Native.None uu____4903 let mk_has_type: FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term -> @@ -1877,35 +1917,64 @@ let mk_has_type: (t_has_type, [FStar_Syntax_Syntax.U_zero; FStar_Syntax_Syntax.U_zero])) FStar_Pervasives_Native.None FStar_Range.dummyRange in - let uu____4917 = - let uu____4920 = - let uu____4921 = - let uu____4936 = - let uu____4939 = FStar_Syntax_Syntax.iarg t in - let uu____4940 = - let uu____4943 = FStar_Syntax_Syntax.as_arg x in - let uu____4944 = - let uu____4947 = FStar_Syntax_Syntax.as_arg t' in - [uu____4947] in - uu____4943 :: uu____4944 in - uu____4939 :: uu____4940 in - (t_has_type1, uu____4936) in - FStar_Syntax_Syntax.Tm_app uu____4921 in - FStar_Syntax_Syntax.mk uu____4920 in - uu____4917 FStar_Pervasives_Native.None FStar_Range.dummyRange + let uu____4957 = + let uu____4960 = + let uu____4961 = + let uu____4976 = + let uu____4979 = FStar_Syntax_Syntax.iarg t in + let uu____4980 = + let uu____4983 = FStar_Syntax_Syntax.as_arg x in + let uu____4984 = + let uu____4987 = FStar_Syntax_Syntax.as_arg t' in + [uu____4987] in + uu____4983 :: uu____4984 in + uu____4979 :: uu____4980 in + (t_has_type1, uu____4976) in + FStar_Syntax_Syntax.Tm_app uu____4961 in + FStar_Syntax_Syntax.mk uu____4960 in + uu____4957 FStar_Pervasives_Native.None FStar_Range.dummyRange +let mk_with_type: + FStar_Syntax_Syntax.universe -> + FStar_Syntax_Syntax.term -> + FStar_Syntax_Syntax.term -> + FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax + = + fun u -> + fun t -> + fun e -> + let t_with_type = + FStar_Syntax_Syntax.fvar FStar_Parser_Const.with_type_lid + FStar_Syntax_Syntax.Delta_equational FStar_Pervasives_Native.None in + let t_with_type1 = + FStar_Syntax_Syntax.mk + (FStar_Syntax_Syntax.Tm_uinst (t_with_type, [u])) + FStar_Pervasives_Native.None FStar_Range.dummyRange in + let uu____5012 = + let uu____5015 = + let uu____5016 = + let uu____5031 = + let uu____5034 = FStar_Syntax_Syntax.iarg t in + let uu____5035 = + let uu____5038 = FStar_Syntax_Syntax.as_arg e in + [uu____5038] in + uu____5034 :: uu____5035 in + (t_with_type1, uu____5031) in + FStar_Syntax_Syntax.Tm_app uu____5016 in + FStar_Syntax_Syntax.mk uu____5015 in + uu____5012 FStar_Pervasives_Native.None FStar_Range.dummyRange let lex_t: FStar_Syntax_Syntax.term = fvar_const FStar_Parser_Const.lex_t_lid let lex_top: FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax = - let uu____4957 = - let uu____4960 = - let uu____4961 = - let uu____4968 = + let uu____5048 = + let uu____5051 = + let uu____5052 = + let uu____5059 = FStar_Syntax_Syntax.fvar FStar_Parser_Const.lextop_lid FStar_Syntax_Syntax.Delta_constant (FStar_Pervasives_Native.Some FStar_Syntax_Syntax.Data_ctor) in - (uu____4968, [FStar_Syntax_Syntax.U_zero]) in - FStar_Syntax_Syntax.Tm_uinst uu____4961 in - FStar_Syntax_Syntax.mk uu____4960 in - uu____4957 FStar_Pervasives_Native.None FStar_Range.dummyRange + (uu____5059, [FStar_Syntax_Syntax.U_zero]) in + FStar_Syntax_Syntax.Tm_uinst uu____5052 in + FStar_Syntax_Syntax.mk uu____5051 in + uu____5048 FStar_Pervasives_Native.None FStar_Range.dummyRange let lex_pair: FStar_Syntax_Syntax.term = FStar_Syntax_Syntax.fvar FStar_Parser_Const.lexcons_lid FStar_Syntax_Syntax.Delta_constant @@ -1922,24 +1991,20 @@ let lcomp_of_comp: FStar_Syntax_Syntax.lcomp = fun c0 -> - let uu____4981 = + let uu____5072 = match c0.FStar_Syntax_Syntax.n with - | FStar_Syntax_Syntax.Total uu____4994 -> + | FStar_Syntax_Syntax.Total uu____5085 -> (FStar_Parser_Const.effect_Tot_lid, [FStar_Syntax_Syntax.TOTAL]) - | FStar_Syntax_Syntax.GTotal uu____5005 -> + | FStar_Syntax_Syntax.GTotal uu____5096 -> (FStar_Parser_Const.effect_GTot_lid, [FStar_Syntax_Syntax.SOMETRIVIAL]) | FStar_Syntax_Syntax.Comp c -> ((c.FStar_Syntax_Syntax.effect_name), (c.FStar_Syntax_Syntax.flags)) in - match uu____4981 with + match uu____5072 with | (eff_name,flags) -> - { - FStar_Syntax_Syntax.eff_name = eff_name; - FStar_Syntax_Syntax.res_typ = (comp_result c0); - FStar_Syntax_Syntax.cflags = flags; - FStar_Syntax_Syntax.comp = ((fun uu____5026 -> c0)) - } + FStar_Syntax_Syntax.mk_lcomp eff_name (comp_result c0) flags + (fun uu____5117 -> c0) let mk_residual_comp: FStar_Ident.lident -> FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax @@ -1992,27 +2057,27 @@ let mk_forall_aux: fun fa -> fun x -> fun body -> - let uu____5082 = - let uu____5085 = - let uu____5086 = - let uu____5101 = - let uu____5104 = + let uu____5173 = + let uu____5176 = + let uu____5177 = + let uu____5192 = + let uu____5195 = FStar_Syntax_Syntax.iarg x.FStar_Syntax_Syntax.sort in - let uu____5105 = - let uu____5108 = - let uu____5109 = - let uu____5110 = - let uu____5111 = FStar_Syntax_Syntax.mk_binder x in - [uu____5111] in - abs uu____5110 body + let uu____5196 = + let uu____5199 = + let uu____5200 = + let uu____5201 = + let uu____5202 = FStar_Syntax_Syntax.mk_binder x in + [uu____5202] in + abs uu____5201 body (FStar_Pervasives_Native.Some (residual_tot ktype0)) in - FStar_Syntax_Syntax.as_arg uu____5109 in - [uu____5108] in - uu____5104 :: uu____5105 in - (fa, uu____5101) in - FStar_Syntax_Syntax.Tm_app uu____5086 in - FStar_Syntax_Syntax.mk uu____5085 in - uu____5082 FStar_Pervasives_Native.None FStar_Range.dummyRange + FStar_Syntax_Syntax.as_arg uu____5200 in + [uu____5199] in + uu____5195 :: uu____5196 in + (fa, uu____5192) in + FStar_Syntax_Syntax.Tm_app uu____5177 in + FStar_Syntax_Syntax.mk uu____5176 in + uu____5173 FStar_Pervasives_Native.None FStar_Range.dummyRange let mk_forall_no_univ: FStar_Syntax_Syntax.bv -> FStar_Syntax_Syntax.typ -> FStar_Syntax_Syntax.typ @@ -2036,16 +2101,16 @@ let close_forall_no_univs: FStar_List.fold_right (fun b -> fun f1 -> - let uu____5150 = FStar_Syntax_Syntax.is_null_binder b in - if uu____5150 + let uu____5241 = FStar_Syntax_Syntax.is_null_binder b in + if uu____5241 then f1 else mk_forall_no_univ (FStar_Pervasives_Native.fst b) f1) bs f let rec is_wild_pat: FStar_Syntax_Syntax.pat' FStar_Syntax_Syntax.withinfo_t -> Prims.bool = fun p -> match p.FStar_Syntax_Syntax.v with - | FStar_Syntax_Syntax.Pat_wild uu____5159 -> true - | uu____5160 -> false + | FStar_Syntax_Syntax.Pat_wild uu____5250 -> true + | uu____5251 -> false let if_then_else: FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax -> FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax -> @@ -2056,25 +2121,25 @@ let if_then_else: fun t1 -> fun t2 -> let then_branch = - let uu____5199 = + let uu____5290 = FStar_Syntax_Syntax.withinfo (FStar_Syntax_Syntax.Pat_constant (FStar_Const.Const_bool true)) t1.FStar_Syntax_Syntax.pos in - (uu____5199, FStar_Pervasives_Native.None, t1) in + (uu____5290, FStar_Pervasives_Native.None, t1) in let else_branch = - let uu____5227 = + let uu____5318 = FStar_Syntax_Syntax.withinfo (FStar_Syntax_Syntax.Pat_constant (FStar_Const.Const_bool false)) t2.FStar_Syntax_Syntax.pos in - (uu____5227, FStar_Pervasives_Native.None, t2) in - let uu____5240 = - let uu____5241 = + (uu____5318, FStar_Pervasives_Native.None, t2) in + let uu____5331 = + let uu____5332 = FStar_Range.union_ranges t1.FStar_Syntax_Syntax.pos t2.FStar_Syntax_Syntax.pos in - FStar_Range.union_ranges b.FStar_Syntax_Syntax.pos uu____5241 in + FStar_Range.union_ranges b.FStar_Syntax_Syntax.pos uu____5332 in FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_match (b, [then_branch; else_branch])) - FStar_Pervasives_Native.None uu____5240 + FStar_Pervasives_Native.None uu____5331 let mk_squash: FStar_Syntax_Syntax.universe -> FStar_Syntax_Syntax.term -> @@ -2086,10 +2151,10 @@ let mk_squash: FStar_Syntax_Syntax.fvar FStar_Parser_Const.squash_lid (FStar_Syntax_Syntax.Delta_defined_at_level (Prims.parse_int "1")) FStar_Pervasives_Native.None in - let uu____5311 = FStar_Syntax_Syntax.mk_Tm_uinst sq [u] in - let uu____5314 = - let uu____5323 = FStar_Syntax_Syntax.as_arg p in [uu____5323] in - mk_app uu____5311 uu____5314 + let uu____5402 = FStar_Syntax_Syntax.mk_Tm_uinst sq [u] in + let uu____5405 = + let uu____5414 = FStar_Syntax_Syntax.as_arg p in [uu____5414] in + mk_app uu____5402 uu____5405 let mk_auto_squash: FStar_Syntax_Syntax.universe -> FStar_Syntax_Syntax.term -> @@ -2101,26 +2166,26 @@ let mk_auto_squash: FStar_Syntax_Syntax.fvar FStar_Parser_Const.auto_squash_lid (FStar_Syntax_Syntax.Delta_defined_at_level (Prims.parse_int "2")) FStar_Pervasives_Native.None in - let uu____5333 = FStar_Syntax_Syntax.mk_Tm_uinst sq [u] in - let uu____5336 = - let uu____5345 = FStar_Syntax_Syntax.as_arg p in [uu____5345] in - mk_app uu____5333 uu____5336 + let uu____5424 = FStar_Syntax_Syntax.mk_Tm_uinst sq [u] in + let uu____5427 = + let uu____5436 = FStar_Syntax_Syntax.as_arg p in [uu____5436] in + mk_app uu____5424 uu____5427 let un_squash: FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax FStar_Pervasives_Native.option = fun t -> - let uu____5353 = head_and_args t in - match uu____5353 with + let uu____5444 = head_and_args t in + match uu____5444 with | (head1,args) -> - let uu____5394 = - let uu____5407 = - let uu____5408 = un_uinst head1 in - uu____5408.FStar_Syntax_Syntax.n in - (uu____5407, args) in - (match uu____5394 with - | (FStar_Syntax_Syntax.Tm_fvar fv,(p,uu____5425)::[]) when + let uu____5485 = + let uu____5498 = + let uu____5499 = un_uinst head1 in + uu____5499.FStar_Syntax_Syntax.n in + (uu____5498, args) in + (match uu____5485 with + | (FStar_Syntax_Syntax.Tm_fvar fv,(p,uu____5516)::[]) when FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.squash_lid -> FStar_Pervasives_Native.Some p | (FStar_Syntax_Syntax.Tm_refine (b,p),[]) -> @@ -2129,26 +2194,26 @@ let un_squash: FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.unit_lid -> - let uu____5477 = - let uu____5482 = - let uu____5483 = FStar_Syntax_Syntax.mk_binder b in - [uu____5483] in - FStar_Syntax_Subst.open_term uu____5482 p in - (match uu____5477 with + let uu____5568 = + let uu____5573 = + let uu____5574 = FStar_Syntax_Syntax.mk_binder b in + [uu____5574] in + FStar_Syntax_Subst.open_term uu____5573 p in + (match uu____5568 with | (bs,p1) -> let b1 = match bs with | b1::[] -> b1 - | uu____5512 -> failwith "impossible" in - let uu____5517 = - let uu____5518 = FStar_Syntax_Free.names p1 in + | uu____5603 -> failwith "impossible" in + let uu____5608 = + let uu____5609 = FStar_Syntax_Free.names p1 in FStar_Util.set_mem (FStar_Pervasives_Native.fst b1) - uu____5518 in - if uu____5517 + uu____5609 in + if uu____5608 then FStar_Pervasives_Native.None else FStar_Pervasives_Native.Some p1) - | uu____5528 -> FStar_Pervasives_Native.None) - | uu____5531 -> FStar_Pervasives_Native.None) + | uu____5619 -> FStar_Pervasives_Native.None) + | uu____5622 -> FStar_Pervasives_Native.None) let is_squash: FStar_Syntax_Syntax.term -> (FStar_Syntax_Syntax.universe,FStar_Syntax_Syntax.term' @@ -2156,23 +2221,23 @@ let is_squash: FStar_Pervasives_Native.tuple2 FStar_Pervasives_Native.option = fun t -> - let uu____5557 = head_and_args t in - match uu____5557 with + let uu____5648 = head_and_args t in + match uu____5648 with | (head1,args) -> - let uu____5602 = - let uu____5615 = - let uu____5616 = FStar_Syntax_Subst.compress head1 in - uu____5616.FStar_Syntax_Syntax.n in - (uu____5615, args) in - (match uu____5602 with + let uu____5693 = + let uu____5706 = + let uu____5707 = FStar_Syntax_Subst.compress head1 in + uu____5707.FStar_Syntax_Syntax.n in + (uu____5706, args) in + (match uu____5693 with | (FStar_Syntax_Syntax.Tm_uinst ({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_fvar fv; - FStar_Syntax_Syntax.pos = uu____5636; - FStar_Syntax_Syntax.vars = uu____5637;_},u::[]),(t1,uu____5640)::[]) + FStar_Syntax_Syntax.pos = uu____5727; + FStar_Syntax_Syntax.vars = uu____5728;_},u::[]),(t1,uu____5731)::[]) when FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.squash_lid -> FStar_Pervasives_Native.Some (u, t1) - | uu____5679 -> FStar_Pervasives_Native.None) + | uu____5770 -> FStar_Pervasives_Native.None) let is_auto_squash: FStar_Syntax_Syntax.term -> (FStar_Syntax_Syntax.universe,FStar_Syntax_Syntax.term' @@ -2180,32 +2245,32 @@ let is_auto_squash: FStar_Pervasives_Native.tuple2 FStar_Pervasives_Native.option = fun t -> - let uu____5709 = head_and_args t in - match uu____5709 with + let uu____5800 = head_and_args t in + match uu____5800 with | (head1,args) -> - let uu____5754 = - let uu____5767 = - let uu____5768 = FStar_Syntax_Subst.compress head1 in - uu____5768.FStar_Syntax_Syntax.n in - (uu____5767, args) in - (match uu____5754 with + let uu____5845 = + let uu____5858 = + let uu____5859 = FStar_Syntax_Subst.compress head1 in + uu____5859.FStar_Syntax_Syntax.n in + (uu____5858, args) in + (match uu____5845 with | (FStar_Syntax_Syntax.Tm_uinst ({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_fvar fv; - FStar_Syntax_Syntax.pos = uu____5788; - FStar_Syntax_Syntax.vars = uu____5789;_},u::[]),(t1,uu____5792)::[]) + FStar_Syntax_Syntax.pos = uu____5879; + FStar_Syntax_Syntax.vars = uu____5880;_},u::[]),(t1,uu____5883)::[]) when FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.auto_squash_lid -> FStar_Pervasives_Native.Some (u, t1) - | uu____5831 -> FStar_Pervasives_Native.None) + | uu____5922 -> FStar_Pervasives_Native.None) let is_sub_singleton: FStar_Syntax_Syntax.term -> Prims.bool = fun t -> - let uu____5853 = let uu____5868 = unmeta t in head_and_args uu____5868 in - match uu____5853 with - | (head1,uu____5870) -> - let uu____5891 = - let uu____5892 = un_uinst head1 in uu____5892.FStar_Syntax_Syntax.n in - (match uu____5891 with + let uu____5944 = let uu____5959 = unmeta t in head_and_args uu____5959 in + match uu____5944 with + | (head1,uu____5961) -> + let uu____5982 = + let uu____5983 = un_uinst head1 in uu____5983.FStar_Syntax_Syntax.n in + (match uu____5982 with | FStar_Syntax_Syntax.Tm_fvar fv -> (((((((((((((((((FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.squash_lid) @@ -2260,41 +2325,41 @@ let is_sub_singleton: FStar_Syntax_Syntax.term -> Prims.bool = || (FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.precedes_lid) - | uu____5896 -> false) + | uu____5987 -> false) let arrow_one: FStar_Syntax_Syntax.typ -> (FStar_Syntax_Syntax.binder,FStar_Syntax_Syntax.comp) FStar_Pervasives_Native.tuple2 FStar_Pervasives_Native.option = fun t -> - let uu____5912 = - let uu____5925 = - let uu____5926 = FStar_Syntax_Subst.compress t in - uu____5926.FStar_Syntax_Syntax.n in - match uu____5925 with + let uu____6003 = + let uu____6016 = + let uu____6017 = FStar_Syntax_Subst.compress t in + uu____6017.FStar_Syntax_Syntax.n in + match uu____6016 with | FStar_Syntax_Syntax.Tm_arrow ([],c) -> failwith "fatal: empty binders on arrow?" | FStar_Syntax_Syntax.Tm_arrow (b::[],c) -> FStar_Pervasives_Native.Some (b, c) | FStar_Syntax_Syntax.Tm_arrow (b::bs,c) -> - let uu____6035 = - let uu____6044 = - let uu____6045 = arrow bs c in - FStar_Syntax_Syntax.mk_Total uu____6045 in - (b, uu____6044) in - FStar_Pervasives_Native.Some uu____6035 - | uu____6058 -> FStar_Pervasives_Native.None in - FStar_Util.bind_opt uu____5912 - (fun uu____6094 -> - match uu____6094 with + let uu____6126 = + let uu____6135 = + let uu____6136 = arrow bs c in + FStar_Syntax_Syntax.mk_Total uu____6136 in + (b, uu____6135) in + FStar_Pervasives_Native.Some uu____6126 + | uu____6149 -> FStar_Pervasives_Native.None in + FStar_Util.bind_opt uu____6003 + (fun uu____6185 -> + match uu____6185 with | (b,c) -> - let uu____6129 = FStar_Syntax_Subst.open_comp [b] c in - (match uu____6129 with + let uu____6220 = FStar_Syntax_Subst.open_comp [b] c in + (match uu____6220 with | (bs,c1) -> let b1 = match bs with | b1::[] -> b1 - | uu____6176 -> + | uu____6267 -> failwith "impossible: open_comp returned different amount of binders" in FStar_Pervasives_Native.Some (b1, c1))) @@ -2302,8 +2367,8 @@ let is_free_in: FStar_Syntax_Syntax.bv -> FStar_Syntax_Syntax.term -> Prims.bool = fun bv -> fun t -> - let uu____6199 = FStar_Syntax_Free.names t in - FStar_Util.set_mem bv uu____6199 + let uu____6290 = FStar_Syntax_Free.names t in + FStar_Util.set_mem bv uu____6290 type qpats = FStar_Syntax_Syntax.args Prims.list[@@deriving show] type connective = | QAll of (FStar_Syntax_Syntax.binders,qpats,FStar_Syntax_Syntax.typ) @@ -2314,7 +2379,7 @@ type connective = FStar_Pervasives_Native.tuple2[@@deriving show] let uu___is_QAll: connective -> Prims.bool = fun projectee -> - match projectee with | QAll _0 -> true | uu____6242 -> false + match projectee with | QAll _0 -> true | uu____6333 -> false let __proj__QAll__item___0: connective -> (FStar_Syntax_Syntax.binders,qpats,FStar_Syntax_Syntax.typ) @@ -2322,7 +2387,7 @@ let __proj__QAll__item___0: = fun projectee -> match projectee with | QAll _0 -> _0 let uu___is_QEx: connective -> Prims.bool = fun projectee -> - match projectee with | QEx _0 -> true | uu____6278 -> false + match projectee with | QEx _0 -> true | uu____6369 -> false let __proj__QEx__item___0: connective -> (FStar_Syntax_Syntax.binders,qpats,FStar_Syntax_Syntax.typ) @@ -2330,7 +2395,7 @@ let __proj__QEx__item___0: = fun projectee -> match projectee with | QEx _0 -> _0 let uu___is_BaseConn: connective -> Prims.bool = fun projectee -> - match projectee with | BaseConn _0 -> true | uu____6312 -> false + match projectee with | BaseConn _0 -> true | uu____6403 -> false let __proj__BaseConn__item___0: connective -> (FStar_Ident.lident,FStar_Syntax_Syntax.args) @@ -2343,11 +2408,11 @@ let destruct_typ_as_formula: let f2 = FStar_Syntax_Subst.compress f1 in match f2.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Tm_meta - (t,FStar_Syntax_Syntax.Meta_monadic uu____6345) -> unmeta_monadic t + (t,FStar_Syntax_Syntax.Meta_monadic uu____6436) -> unmeta_monadic t | FStar_Syntax_Syntax.Tm_meta - (t,FStar_Syntax_Syntax.Meta_monadic_lift uu____6357) -> + (t,FStar_Syntax_Syntax.Meta_monadic_lift uu____6448) -> unmeta_monadic t - | uu____6370 -> f2 in + | uu____6461 -> f2 in let destruct_base_conn f1 = let connectives = [(FStar_Parser_Const.true_lid, (Prims.parse_int "0")); @@ -2362,18 +2427,18 @@ let destruct_typ_as_formula: (FStar_Parser_Const.eq2_lid, (Prims.parse_int "2")); (FStar_Parser_Const.eq3_lid, (Prims.parse_int "4")); (FStar_Parser_Const.eq3_lid, (Prims.parse_int "2"))] in - let aux f2 uu____6448 = - match uu____6448 with + let aux f2 uu____6539 = + match uu____6539 with | (lid,arity) -> - let uu____6457 = - let uu____6472 = unmeta_monadic f2 in head_and_args uu____6472 in - (match uu____6457 with + let uu____6548 = + let uu____6563 = unmeta_monadic f2 in head_and_args uu____6563 in + (match uu____6548 with | (t,args) -> let t1 = un_uinst t in - let uu____6498 = + let uu____6589 = (is_constructor t1 lid) && ((FStar_List.length args) = arity) in - if uu____6498 + if uu____6589 then FStar_Pervasives_Native.Some (BaseConn (lid, args)) else FStar_Pervasives_Native.None) in FStar_Util.find_map connectives (aux f1) in @@ -2382,65 +2447,65 @@ let destruct_typ_as_formula: match t1.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Tm_meta (t2,FStar_Syntax_Syntax.Meta_pattern pats) -> - let uu____6573 = FStar_Syntax_Subst.compress t2 in - (pats, uu____6573) - | uu____6584 -> ([], t1) in + let uu____6664 = FStar_Syntax_Subst.compress t2 in + (pats, uu____6664) + | uu____6675 -> ([], t1) in let destruct_q_conn t = let is_q fa fv = if fa then is_forall (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v else is_exists (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in let flat t1 = - let uu____6631 = head_and_args t1 in - match uu____6631 with + let uu____6722 = head_and_args t1 in + match uu____6722 with | (t2,args) -> - let uu____6678 = un_uinst t2 in - let uu____6679 = + let uu____6769 = un_uinst t2 in + let uu____6770 = FStar_All.pipe_right args (FStar_List.map - (fun uu____6712 -> - match uu____6712 with + (fun uu____6803 -> + match uu____6803 with | (t3,imp) -> - let uu____6723 = unascribe t3 in (uu____6723, imp))) in - (uu____6678, uu____6679) in + let uu____6814 = unascribe t3 in (uu____6814, imp))) in + (uu____6769, uu____6770) in let rec aux qopt out t1 = - let uu____6758 = let uu____6775 = flat t1 in (qopt, uu____6775) in - match uu____6758 with + let uu____6849 = let uu____6866 = flat t1 in (qopt, uu____6866) in + match uu____6849 with | (FStar_Pervasives_Native.Some fa,({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_fvar tc; - FStar_Syntax_Syntax.pos = uu____6802; - FStar_Syntax_Syntax.vars = uu____6803;_},({ + FStar_Syntax_Syntax.pos = uu____6893; + FStar_Syntax_Syntax.vars = uu____6894;_},({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_abs - (b::[],t2,uu____6806); + (b::[],t2,uu____6897); FStar_Syntax_Syntax.pos - = uu____6807; + = uu____6898; FStar_Syntax_Syntax.vars - = uu____6808;_},uu____6809)::[])) + = uu____6899;_},uu____6900)::[])) when is_q fa tc -> aux qopt (b :: out) t2 | (FStar_Pervasives_Native.Some fa,({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_fvar tc; - FStar_Syntax_Syntax.pos = uu____6886; - FStar_Syntax_Syntax.vars = uu____6887;_},uu____6888:: + FStar_Syntax_Syntax.pos = uu____6977; + FStar_Syntax_Syntax.vars = uu____6978;_},uu____6979:: ({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_abs - (b::[],t2,uu____6891); - FStar_Syntax_Syntax.pos = uu____6892; - FStar_Syntax_Syntax.vars = uu____6893;_},uu____6894)::[])) + (b::[],t2,uu____6982); + FStar_Syntax_Syntax.pos = uu____6983; + FStar_Syntax_Syntax.vars = uu____6984;_},uu____6985)::[])) when is_q fa tc -> aux qopt (b :: out) t2 | (FStar_Pervasives_Native.None ,({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_fvar tc; - FStar_Syntax_Syntax.pos = uu____6982; - FStar_Syntax_Syntax.vars = uu____6983;_},({ + FStar_Syntax_Syntax.pos = uu____7073; + FStar_Syntax_Syntax.vars = uu____7074;_},({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_abs - (b::[],t2,uu____6986); + (b::[],t2,uu____7077); FStar_Syntax_Syntax.pos - = uu____6987; + = uu____7078; FStar_Syntax_Syntax.vars - = uu____6988;_},uu____6989)::[])) + = uu____7079;_},uu____7080)::[])) when is_qlid (tc.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v -> aux @@ -2450,18 +2515,18 @@ let destruct_typ_as_formula: (b :: out) t2 | (FStar_Pervasives_Native.None ,({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_fvar tc; - FStar_Syntax_Syntax.pos = uu____7065; - FStar_Syntax_Syntax.vars = uu____7066;_},uu____7067::({ + FStar_Syntax_Syntax.pos = uu____7156; + FStar_Syntax_Syntax.vars = uu____7157;_},uu____7158::({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_abs - (b::[],t2,uu____7070); + (b::[],t2,uu____7161); FStar_Syntax_Syntax.pos = - uu____7071; + uu____7162; FStar_Syntax_Syntax.vars = - uu____7072;_},uu____7073)::[])) + uu____7163;_},uu____7164)::[])) when is_qlid (tc.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v -> aux @@ -2469,20 +2534,20 @@ let destruct_typ_as_formula: (is_forall (tc.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v)) (b :: out) t2 - | (FStar_Pervasives_Native.Some b,uu____7161) -> + | (FStar_Pervasives_Native.Some b,uu____7252) -> let bs = FStar_List.rev out in - let uu____7195 = FStar_Syntax_Subst.open_term bs t1 in - (match uu____7195 with + let uu____7286 = FStar_Syntax_Subst.open_term bs t1 in + (match uu____7286 with | (bs1,t2) -> - let uu____7204 = patterns t2 in - (match uu____7204 with + let uu____7295 = patterns t2 in + (match uu____7295 with | (pats,body) -> if b then FStar_Pervasives_Native.Some (QAll (bs1, pats, body)) else FStar_Pervasives_Native.Some (QEx (bs1, pats, body)))) - | uu____7266 -> FStar_Pervasives_Native.None in + | uu____7357 -> FStar_Pervasives_Native.None in aux FStar_Pervasives_Native.None [] t in let u_connectives = [(FStar_Parser_Const.true_lid, FStar_Parser_Const.c_true_lid, @@ -2494,18 +2559,18 @@ let destruct_typ_as_formula: (FStar_Parser_Const.or_lid, FStar_Parser_Const.c_or_lid, (Prims.parse_int "2"))] in let destruct_sq_base_conn t = - let uu____7332 = un_squash t in - FStar_Util.bind_opt uu____7332 + let uu____7423 = un_squash t in + FStar_Util.bind_opt uu____7423 (fun t1 -> - let uu____7348 = head_and_args' t1 in - match uu____7348 with + let uu____7439 = head_and_args' t1 in + match uu____7439 with | (hd1,args) -> - let uu____7381 = - let uu____7386 = - let uu____7387 = un_uinst hd1 in - uu____7387.FStar_Syntax_Syntax.n in - (uu____7386, (FStar_List.length args)) in - (match uu____7381 with + let uu____7472 = + let uu____7477 = + let uu____7478 = un_uinst hd1 in + uu____7478.FStar_Syntax_Syntax.n in + (uu____7477, (FStar_List.length args)) in + (match uu____7472 with | (FStar_Syntax_Syntax.Tm_fvar fv,_0_29) when (_0_29 = (Prims.parse_int "2")) && (FStar_Syntax_Syntax.fv_eq_lid fv @@ -2562,152 +2627,152 @@ let destruct_typ_as_formula: -> FStar_Pervasives_Native.Some (BaseConn (FStar_Parser_Const.false_lid, args)) - | uu____7470 -> FStar_Pervasives_Native.None)) in + | uu____7561 -> FStar_Pervasives_Native.None)) in let rec destruct_sq_forall t = - let uu____7493 = un_squash t in - FStar_Util.bind_opt uu____7493 + let uu____7584 = un_squash t in + FStar_Util.bind_opt uu____7584 (fun t1 -> - let uu____7508 = arrow_one t1 in - match uu____7508 with + let uu____7599 = arrow_one t1 in + match uu____7599 with | FStar_Pervasives_Native.Some (b,c) -> - let uu____7523 = - let uu____7524 = is_tot_or_gtot_comp c in - Prims.op_Negation uu____7524 in - if uu____7523 + let uu____7614 = + let uu____7615 = is_tot_or_gtot_comp c in + Prims.op_Negation uu____7615 in + if uu____7614 then FStar_Pervasives_Native.None else (let q = - let uu____7531 = comp_to_comp_typ c in - uu____7531.FStar_Syntax_Syntax.result_typ in - let uu____7532 = + let uu____7622 = comp_to_comp_typ c in + uu____7622.FStar_Syntax_Syntax.result_typ in + let uu____7623 = is_free_in (FStar_Pervasives_Native.fst b) q in - if uu____7532 + if uu____7623 then - let uu____7535 = patterns q in - match uu____7535 with + let uu____7626 = patterns q in + match uu____7626 with | (pats,q1) -> FStar_All.pipe_left maybe_collect (FStar_Pervasives_Native.Some (QAll ([b], pats, q1))) else - (let uu____7591 = - let uu____7592 = - let uu____7597 = - let uu____7600 = + (let uu____7682 = + let uu____7683 = + let uu____7688 = + let uu____7691 = FStar_Syntax_Syntax.as_arg (FStar_Pervasives_Native.fst b).FStar_Syntax_Syntax.sort in - let uu____7601 = - let uu____7604 = FStar_Syntax_Syntax.as_arg q in - [uu____7604] in - uu____7600 :: uu____7601 in - (FStar_Parser_Const.imp_lid, uu____7597) in - BaseConn uu____7592 in - FStar_Pervasives_Native.Some uu____7591)) - | uu____7607 -> FStar_Pervasives_Native.None) + let uu____7692 = + let uu____7695 = FStar_Syntax_Syntax.as_arg q in + [uu____7695] in + uu____7691 :: uu____7692 in + (FStar_Parser_Const.imp_lid, uu____7688) in + BaseConn uu____7683 in + FStar_Pervasives_Native.Some uu____7682)) + | uu____7698 -> FStar_Pervasives_Native.None) and destruct_sq_exists t = - let uu____7615 = un_squash t in - FStar_Util.bind_opt uu____7615 + let uu____7706 = un_squash t in + FStar_Util.bind_opt uu____7706 (fun t1 -> - let uu____7646 = head_and_args' t1 in - match uu____7646 with + let uu____7737 = head_and_args' t1 in + match uu____7737 with | (hd1,args) -> - let uu____7679 = - let uu____7692 = - let uu____7693 = un_uinst hd1 in - uu____7693.FStar_Syntax_Syntax.n in - (uu____7692, args) in - (match uu____7679 with + let uu____7770 = + let uu____7783 = + let uu____7784 = un_uinst hd1 in + uu____7784.FStar_Syntax_Syntax.n in + (uu____7783, args) in + (match uu____7770 with | (FStar_Syntax_Syntax.Tm_fvar - fv,(a1,uu____7708)::(a2,uu____7710)::[]) when + fv,(a1,uu____7799)::(a2,uu____7801)::[]) when FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.dtuple2_lid -> - let uu____7745 = - let uu____7746 = FStar_Syntax_Subst.compress a2 in - uu____7746.FStar_Syntax_Syntax.n in - (match uu____7745 with - | FStar_Syntax_Syntax.Tm_abs (b::[],q,uu____7753) -> - let uu____7780 = FStar_Syntax_Subst.open_term [b] q in - (match uu____7780 with + let uu____7836 = + let uu____7837 = FStar_Syntax_Subst.compress a2 in + uu____7837.FStar_Syntax_Syntax.n in + (match uu____7836 with + | FStar_Syntax_Syntax.Tm_abs (b::[],q,uu____7844) -> + let uu____7871 = FStar_Syntax_Subst.open_term [b] q in + (match uu____7871 with | (bs,q1) -> let b1 = match bs with | b1::[] -> b1 - | uu____7819 -> failwith "impossible" in - let uu____7824 = patterns q1 in - (match uu____7824 with + | uu____7910 -> failwith "impossible" in + let uu____7915 = patterns q1 in + (match uu____7915 with | (pats,q2) -> FStar_All.pipe_left maybe_collect (FStar_Pervasives_Native.Some (QEx ([b1], pats, q2))))) - | uu____7891 -> FStar_Pervasives_Native.None) - | uu____7892 -> FStar_Pervasives_Native.None)) + | uu____7982 -> FStar_Pervasives_Native.None) + | uu____7983 -> FStar_Pervasives_Native.None)) and maybe_collect f1 = match f1 with | FStar_Pervasives_Native.Some (QAll (bs,pats,phi)) -> - let uu____7913 = destruct_sq_forall phi in - (match uu____7913 with + let uu____8004 = destruct_sq_forall phi in + (match uu____8004 with | FStar_Pervasives_Native.Some (QAll (bs',pats',psi)) -> FStar_All.pipe_left (fun _0_37 -> FStar_Pervasives_Native.Some _0_37) (QAll ((FStar_List.append bs bs'), (FStar_List.append pats pats'), psi)) - | uu____7935 -> f1) + | uu____8026 -> f1) | FStar_Pervasives_Native.Some (QEx (bs,pats,phi)) -> - let uu____7941 = destruct_sq_exists phi in - (match uu____7941 with + let uu____8032 = destruct_sq_exists phi in + (match uu____8032 with | FStar_Pervasives_Native.Some (QEx (bs',pats',psi)) -> FStar_All.pipe_left (fun _0_38 -> FStar_Pervasives_Native.Some _0_38) (QEx ((FStar_List.append bs bs'), (FStar_List.append pats pats'), psi)) - | uu____7963 -> f1) - | uu____7966 -> f1 in + | uu____8054 -> f1) + | uu____8057 -> f1 in let phi = unmeta_monadic f in - let uu____7970 = destruct_base_conn phi in - FStar_Util.catch_opt uu____7970 - (fun uu____7975 -> - let uu____7976 = destruct_q_conn phi in - FStar_Util.catch_opt uu____7976 - (fun uu____7981 -> - let uu____7982 = destruct_sq_base_conn phi in - FStar_Util.catch_opt uu____7982 - (fun uu____7987 -> - let uu____7988 = destruct_sq_forall phi in - FStar_Util.catch_opt uu____7988 - (fun uu____7993 -> - let uu____7994 = destruct_sq_exists phi in - FStar_Util.catch_opt uu____7994 - (fun uu____7998 -> FStar_Pervasives_Native.None))))) + let uu____8061 = destruct_base_conn phi in + FStar_Util.catch_opt uu____8061 + (fun uu____8066 -> + let uu____8067 = destruct_q_conn phi in + FStar_Util.catch_opt uu____8067 + (fun uu____8072 -> + let uu____8073 = destruct_sq_base_conn phi in + FStar_Util.catch_opt uu____8073 + (fun uu____8078 -> + let uu____8079 = destruct_sq_forall phi in + FStar_Util.catch_opt uu____8079 + (fun uu____8084 -> + let uu____8085 = destruct_sq_exists phi in + FStar_Util.catch_opt uu____8085 + (fun uu____8089 -> FStar_Pervasives_Native.None))))) let unthunk_lemma_post: FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax = fun t -> - let uu____8004 = - let uu____8005 = FStar_Syntax_Subst.compress t in - uu____8005.FStar_Syntax_Syntax.n in - match uu____8004 with - | FStar_Syntax_Syntax.Tm_abs (b::[],e,uu____8012) -> - let uu____8039 = FStar_Syntax_Subst.open_term [b] e in - (match uu____8039 with + let uu____8095 = + let uu____8096 = FStar_Syntax_Subst.compress t in + uu____8096.FStar_Syntax_Syntax.n in + match uu____8095 with + | FStar_Syntax_Syntax.Tm_abs (b::[],e,uu____8103) -> + let uu____8130 = FStar_Syntax_Subst.open_term [b] e in + (match uu____8130 with | (bs,e1) -> let b1 = FStar_List.hd bs in - let uu____8065 = is_free_in (FStar_Pervasives_Native.fst b1) e1 in - if uu____8065 + let uu____8156 = is_free_in (FStar_Pervasives_Native.fst b1) e1 in + if uu____8156 then - let uu____8068 = - let uu____8077 = FStar_Syntax_Syntax.as_arg exp_unit in - [uu____8077] in - mk_app t uu____8068 + let uu____8159 = + let uu____8168 = FStar_Syntax_Syntax.as_arg exp_unit in + [uu____8168] in + mk_app t uu____8159 else e1) - | uu____8079 -> - let uu____8080 = - let uu____8089 = FStar_Syntax_Syntax.as_arg exp_unit in - [uu____8089] in - mk_app t uu____8080 + | uu____8170 -> + let uu____8171 = + let uu____8180 = FStar_Syntax_Syntax.as_arg exp_unit in + [uu____8180] in + mk_app t uu____8171 let action_as_lb: FStar_Ident.lident -> FStar_Syntax_Syntax.action -> FStar_Syntax_Syntax.sigelt @@ -2715,22 +2780,22 @@ let action_as_lb: fun eff_lid -> fun a -> let lb = - let uu____8097 = - let uu____8102 = + let uu____8188 = + let uu____8193 = FStar_Syntax_Syntax.lid_as_fv a.FStar_Syntax_Syntax.action_name FStar_Syntax_Syntax.Delta_equational FStar_Pervasives_Native.None in - FStar_Util.Inr uu____8102 in - let uu____8103 = - let uu____8104 = + FStar_Util.Inr uu____8193 in + let uu____8194 = + let uu____8195 = FStar_Syntax_Syntax.mk_Total a.FStar_Syntax_Syntax.action_typ in - arrow a.FStar_Syntax_Syntax.action_params uu____8104 in - let uu____8107 = + arrow a.FStar_Syntax_Syntax.action_params uu____8195 in + let uu____8198 = abs a.FStar_Syntax_Syntax.action_params a.FStar_Syntax_Syntax.action_defn FStar_Pervasives_Native.None in - close_univs_and_mk_letbinding FStar_Pervasives_Native.None uu____8097 - a.FStar_Syntax_Syntax.action_univs uu____8103 - FStar_Parser_Const.effect_Tot_lid uu____8107 in + close_univs_and_mk_letbinding FStar_Pervasives_Native.None uu____8188 + a.FStar_Syntax_Syntax.action_univs uu____8194 + FStar_Parser_Const.effect_Tot_lid uu____8198 in { FStar_Syntax_Syntax.sigel = (FStar_Syntax_Syntax.Sig_let @@ -2752,50 +2817,50 @@ let mk_reify: FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_constant FStar_Const.Const_reify) FStar_Pervasives_Native.None t.FStar_Syntax_Syntax.pos in - let uu____8132 = - let uu____8135 = - let uu____8136 = - let uu____8151 = - let uu____8154 = FStar_Syntax_Syntax.as_arg t in [uu____8154] in - (reify_, uu____8151) in - FStar_Syntax_Syntax.Tm_app uu____8136 in - FStar_Syntax_Syntax.mk uu____8135 in - uu____8132 FStar_Pervasives_Native.None t.FStar_Syntax_Syntax.pos + let uu____8223 = + let uu____8226 = + let uu____8227 = + let uu____8242 = + let uu____8245 = FStar_Syntax_Syntax.as_arg t in [uu____8245] in + (reify_, uu____8242) in + FStar_Syntax_Syntax.Tm_app uu____8227 in + FStar_Syntax_Syntax.mk uu____8226 in + uu____8223 FStar_Pervasives_Native.None t.FStar_Syntax_Syntax.pos let rec delta_qualifier: FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.delta_depth = fun t -> let t1 = FStar_Syntax_Subst.compress t in match t1.FStar_Syntax_Syntax.n with - | FStar_Syntax_Syntax.Tm_delayed uu____8166 -> failwith "Impossible" + | FStar_Syntax_Syntax.Tm_delayed uu____8257 -> failwith "Impossible" | FStar_Syntax_Syntax.Tm_fvar fv -> fv.FStar_Syntax_Syntax.fv_delta - | FStar_Syntax_Syntax.Tm_bvar uu____8192 -> + | FStar_Syntax_Syntax.Tm_bvar uu____8283 -> FStar_Syntax_Syntax.Delta_equational - | FStar_Syntax_Syntax.Tm_name uu____8193 -> + | FStar_Syntax_Syntax.Tm_name uu____8284 -> FStar_Syntax_Syntax.Delta_equational - | FStar_Syntax_Syntax.Tm_match uu____8194 -> + | FStar_Syntax_Syntax.Tm_match uu____8285 -> FStar_Syntax_Syntax.Delta_equational - | FStar_Syntax_Syntax.Tm_uvar uu____8217 -> + | FStar_Syntax_Syntax.Tm_uvar uu____8308 -> FStar_Syntax_Syntax.Delta_equational | FStar_Syntax_Syntax.Tm_unknown -> FStar_Syntax_Syntax.Delta_equational - | FStar_Syntax_Syntax.Tm_type uu____8234 -> + | FStar_Syntax_Syntax.Tm_type uu____8325 -> FStar_Syntax_Syntax.Delta_constant - | FStar_Syntax_Syntax.Tm_constant uu____8235 -> + | FStar_Syntax_Syntax.Tm_constant uu____8326 -> FStar_Syntax_Syntax.Delta_constant - | FStar_Syntax_Syntax.Tm_arrow uu____8236 -> + | FStar_Syntax_Syntax.Tm_arrow uu____8327 -> FStar_Syntax_Syntax.Delta_constant - | FStar_Syntax_Syntax.Tm_uinst (t2,uu____8250) -> delta_qualifier t2 + | FStar_Syntax_Syntax.Tm_uinst (t2,uu____8341) -> delta_qualifier t2 | FStar_Syntax_Syntax.Tm_refine - ({ FStar_Syntax_Syntax.ppname = uu____8255; - FStar_Syntax_Syntax.index = uu____8256; - FStar_Syntax_Syntax.sort = t2;_},uu____8258) + ({ FStar_Syntax_Syntax.ppname = uu____8346; + FStar_Syntax_Syntax.index = uu____8347; + FStar_Syntax_Syntax.sort = t2;_},uu____8349) -> delta_qualifier t2 - | FStar_Syntax_Syntax.Tm_meta (t2,uu____8266) -> delta_qualifier t2 - | FStar_Syntax_Syntax.Tm_ascribed (t2,uu____8272,uu____8273) -> + | FStar_Syntax_Syntax.Tm_meta (t2,uu____8357) -> delta_qualifier t2 + | FStar_Syntax_Syntax.Tm_ascribed (t2,uu____8363,uu____8364) -> delta_qualifier t2 - | FStar_Syntax_Syntax.Tm_app (t2,uu____8315) -> delta_qualifier t2 - | FStar_Syntax_Syntax.Tm_abs (uu____8336,t2,uu____8338) -> + | FStar_Syntax_Syntax.Tm_app (t2,uu____8406) -> delta_qualifier t2 + | FStar_Syntax_Syntax.Tm_abs (uu____8427,t2,uu____8429) -> delta_qualifier t2 - | FStar_Syntax_Syntax.Tm_let (uu____8359,t2) -> delta_qualifier t2 + | FStar_Syntax_Syntax.Tm_let (uu____8450,t2) -> delta_qualifier t2 let rec incr_delta_depth: FStar_Syntax_Syntax.delta_depth -> FStar_Syntax_Syntax.delta_depth = fun d -> @@ -2809,53 +2874,53 @@ let rec incr_delta_depth: | FStar_Syntax_Syntax.Delta_abstract d1 -> incr_delta_depth d1 let incr_delta_qualifier: FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.delta_depth = - fun t -> let uu____8385 = delta_qualifier t in incr_delta_depth uu____8385 + fun t -> let uu____8476 = delta_qualifier t in incr_delta_depth uu____8476 let is_unknown: FStar_Syntax_Syntax.term -> Prims.bool = fun t -> - let uu____8389 = - let uu____8390 = FStar_Syntax_Subst.compress t in - uu____8390.FStar_Syntax_Syntax.n in - match uu____8389 with + let uu____8480 = + let uu____8481 = FStar_Syntax_Subst.compress t in + uu____8481.FStar_Syntax_Syntax.n in + match uu____8480 with | FStar_Syntax_Syntax.Tm_unknown -> true - | uu____8393 -> false + | uu____8484 -> false let rec list_elements: FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term Prims.list FStar_Pervasives_Native.option = fun e -> - let uu____8405 = let uu____8420 = unmeta e in head_and_args uu____8420 in - match uu____8405 with + let uu____8496 = let uu____8511 = unmeta e in head_and_args uu____8511 in + match uu____8496 with | (head1,args) -> - let uu____8447 = - let uu____8460 = - let uu____8461 = un_uinst head1 in - uu____8461.FStar_Syntax_Syntax.n in - (uu____8460, args) in - (match uu____8447 with - | (FStar_Syntax_Syntax.Tm_fvar fv,uu____8477) when + let uu____8538 = + let uu____8551 = + let uu____8552 = un_uinst head1 in + uu____8552.FStar_Syntax_Syntax.n in + (uu____8551, args) in + (match uu____8538 with + | (FStar_Syntax_Syntax.Tm_fvar fv,uu____8568) when FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.nil_lid -> FStar_Pervasives_Native.Some [] | (FStar_Syntax_Syntax.Tm_fvar - fv,uu____8497::(hd1,uu____8499)::(tl1,uu____8501)::[]) when + fv,uu____8588::(hd1,uu____8590)::(tl1,uu____8592)::[]) when FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.cons_lid -> - let uu____8548 = - let uu____8553 = - let uu____8558 = list_elements tl1 in - FStar_Util.must uu____8558 in - hd1 :: uu____8553 in - FStar_Pervasives_Native.Some uu____8548 - | uu____8571 -> FStar_Pervasives_Native.None) + let uu____8639 = + let uu____8644 = + let uu____8649 = list_elements tl1 in + FStar_Util.must uu____8649 in + hd1 :: uu____8644 in + FStar_Pervasives_Native.Some uu____8639 + | uu____8662 -> FStar_Pervasives_Native.None) let rec apply_last: - 'Auu____8589 . - ('Auu____8589 -> 'Auu____8589) -> - 'Auu____8589 Prims.list -> 'Auu____8589 Prims.list + 'Auu____8680 . + ('Auu____8680 -> 'Auu____8680) -> + 'Auu____8680 Prims.list -> 'Auu____8680 Prims.list = fun f -> fun l -> match l with | [] -> failwith "apply_last: got empty list" - | a::[] -> let uu____8612 = f a in [uu____8612] - | x::xs -> let uu____8617 = apply_last f xs in x :: uu____8617 + | a::[] -> let uu____8703 = f a in [uu____8703] + | x::xs -> let uu____8708 = apply_last f xs in x :: uu____8708 let dm4f_lid: FStar_Syntax_Syntax.eff_decl -> Prims.string -> FStar_Ident.lident = fun ed -> @@ -2876,48 +2941,48 @@ let rec mk_list: fun rng -> fun l -> let ctor l1 = - let uu____8653 = - let uu____8656 = - let uu____8657 = + let uu____8744 = + let uu____8747 = + let uu____8748 = FStar_Syntax_Syntax.lid_as_fv l1 FStar_Syntax_Syntax.Delta_constant (FStar_Pervasives_Native.Some FStar_Syntax_Syntax.Data_ctor) in - FStar_Syntax_Syntax.Tm_fvar uu____8657 in - FStar_Syntax_Syntax.mk uu____8656 in - uu____8653 FStar_Pervasives_Native.None rng in + FStar_Syntax_Syntax.Tm_fvar uu____8748 in + FStar_Syntax_Syntax.mk uu____8747 in + uu____8744 FStar_Pervasives_Native.None rng in let cons1 args pos = - let uu____8670 = - let uu____8671 = - let uu____8672 = ctor FStar_Parser_Const.cons_lid in - FStar_Syntax_Syntax.mk_Tm_uinst uu____8672 + let uu____8761 = + let uu____8762 = + let uu____8763 = ctor FStar_Parser_Const.cons_lid in + FStar_Syntax_Syntax.mk_Tm_uinst uu____8763 [FStar_Syntax_Syntax.U_zero] in - FStar_Syntax_Syntax.mk_Tm_app uu____8671 args in - uu____8670 FStar_Pervasives_Native.None pos in + FStar_Syntax_Syntax.mk_Tm_app uu____8762 args in + uu____8761 FStar_Pervasives_Native.None pos in let nil args pos = - let uu____8684 = - let uu____8685 = - let uu____8686 = ctor FStar_Parser_Const.nil_lid in - FStar_Syntax_Syntax.mk_Tm_uinst uu____8686 + let uu____8775 = + let uu____8776 = + let uu____8777 = ctor FStar_Parser_Const.nil_lid in + FStar_Syntax_Syntax.mk_Tm_uinst uu____8777 [FStar_Syntax_Syntax.U_zero] in - FStar_Syntax_Syntax.mk_Tm_app uu____8685 args in - uu____8684 FStar_Pervasives_Native.None pos in - let uu____8689 = - let uu____8690 = - let uu____8691 = FStar_Syntax_Syntax.iarg typ in [uu____8691] in - nil uu____8690 rng in + FStar_Syntax_Syntax.mk_Tm_app uu____8776 args in + uu____8775 FStar_Pervasives_Native.None pos in + let uu____8780 = + let uu____8781 = + let uu____8782 = FStar_Syntax_Syntax.iarg typ in [uu____8782] in + nil uu____8781 rng in FStar_List.fold_right (fun t -> fun a -> - let uu____8697 = - let uu____8698 = FStar_Syntax_Syntax.iarg typ in - let uu____8699 = - let uu____8702 = FStar_Syntax_Syntax.as_arg t in - let uu____8703 = - let uu____8706 = FStar_Syntax_Syntax.as_arg a in - [uu____8706] in - uu____8702 :: uu____8703 in - uu____8698 :: uu____8699 in - cons1 uu____8697 t.FStar_Syntax_Syntax.pos) l uu____8689 + let uu____8788 = + let uu____8789 = FStar_Syntax_Syntax.iarg typ in + let uu____8790 = + let uu____8793 = FStar_Syntax_Syntax.as_arg t in + let uu____8794 = + let uu____8797 = FStar_Syntax_Syntax.as_arg a in + [uu____8797] in + uu____8793 :: uu____8794 in + uu____8789 :: uu____8790 in + cons1 uu____8788 t.FStar_Syntax_Syntax.pos) l uu____8780 let uvar_from_id: Prims.int -> FStar_Syntax_Syntax.typ -> @@ -2925,14 +2990,14 @@ let uvar_from_id: = fun id1 -> fun t -> - let uu____8715 = - let uu____8718 = - let uu____8719 = - let uu____8736 = FStar_Syntax_Unionfind.from_id id1 in - (uu____8736, t) in - FStar_Syntax_Syntax.Tm_uvar uu____8719 in - FStar_Syntax_Syntax.mk uu____8718 in - uu____8715 FStar_Pervasives_Native.None FStar_Range.dummyRange + let uu____8806 = + let uu____8809 = + let uu____8810 = + let uu____8827 = FStar_Syntax_Unionfind.from_id id1 in + (uu____8827, t) in + FStar_Syntax_Syntax.Tm_uvar uu____8810 in + FStar_Syntax_Syntax.mk uu____8809 in + uu____8806 FStar_Pervasives_Native.None FStar_Range.dummyRange let rec eqlist: 'a . ('a -> 'a -> Prims.bool) -> 'a Prims.list -> 'a Prims.list -> Prims.bool @@ -2943,7 +3008,7 @@ let rec eqlist: match (xs, ys) with | ([],[]) -> true | (x::xs1,y::ys1) -> (eq1 x y) && (eqlist eq1 xs1 ys1) - | uu____8796 -> false + | uu____8887 -> false let eqsum: 'a 'b . ('a -> 'a -> Prims.bool) -> @@ -2957,7 +3022,7 @@ let eqsum: match (x, y) with | (FStar_Util.Inl x1,FStar_Util.Inl y1) -> e1 x1 y1 | (FStar_Util.Inr x1,FStar_Util.Inr y1) -> e2 x1 y1 - | uu____8893 -> false + | uu____8984 -> false let eqprod: 'a 'b . ('a -> 'a -> Prims.bool) -> @@ -2982,29 +3047,29 @@ let eqopt: match (x, y) with | (FStar_Pervasives_Native.Some x1,FStar_Pervasives_Native.Some y1) -> e x1 y1 - | uu____9031 -> false + | uu____9122 -> false let rec term_eq: FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term -> Prims.bool = fun t1 -> fun t2 -> let canon_app t = match t.FStar_Syntax_Syntax.n with - | FStar_Syntax_Syntax.Tm_app uu____9142 -> - let uu____9157 = head_and_args' t in - (match uu____9157 with + | FStar_Syntax_Syntax.Tm_app uu____9233 -> + let uu____9248 = head_and_args' t in + (match uu____9248 with | (hd1,args) -> - let uu___52_9190 = t in + let uu___54_9281 = t in { FStar_Syntax_Syntax.n = (FStar_Syntax_Syntax.Tm_app (hd1, args)); FStar_Syntax_Syntax.pos = - (uu___52_9190.FStar_Syntax_Syntax.pos); + (uu___54_9281.FStar_Syntax_Syntax.pos); FStar_Syntax_Syntax.vars = - (uu___52_9190.FStar_Syntax_Syntax.vars) + (uu___54_9281.FStar_Syntax_Syntax.vars) }) - | uu____9201 -> t in - let t11 = let uu____9205 = unmeta_safe t1 in canon_app uu____9205 in - let t21 = let uu____9211 = unmeta_safe t2 in canon_app uu____9211 in + | uu____9292 -> t in + let t11 = let uu____9296 = unmeta_safe t1 in canon_app uu____9296 in + let t21 = let uu____9302 = unmeta_safe t2 in canon_app uu____9302 in match ((t11.FStar_Syntax_Syntax.n), (t21.FStar_Syntax_Syntax.n)) with | (FStar_Syntax_Syntax.Tm_bvar x,FStar_Syntax_Syntax.Tm_bvar y) -> x.FStar_Syntax_Syntax.index = y.FStar_Syntax_Syntax.index @@ -3028,7 +3093,7 @@ let rec term_eq: (b2,t22)) -> (FStar_Syntax_Syntax.bv_eq b1 b2) && (term_eq t12 t22) | (FStar_Syntax_Syntax.Tm_match (t12,bs1),FStar_Syntax_Syntax.Tm_match (t22,bs2)) -> (term_eq t12 t22) && (eqlist branch_eq bs1 bs2) - | (uu____9478,uu____9479) -> false + | (uu____9569,uu____9570) -> false and arg_eq: (FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax,FStar_Syntax_Syntax.aqual) FStar_Pervasives_Native.tuple2 -> @@ -3083,7 +3148,7 @@ and comp_eq: && (eq_flags c11.FStar_Syntax_Syntax.flags c21.FStar_Syntax_Syntax.flags) - | (uu____9574,uu____9575) -> false + | (uu____9665,uu____9666) -> false and eq_flags: FStar_Syntax_Syntax.cflags Prims.list -> FStar_Syntax_Syntax.cflags Prims.list -> Prims.bool @@ -3100,9 +3165,9 @@ and branch_eq: FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax) FStar_Pervasives_Native.tuple3 -> Prims.bool = - fun uu____9582 -> - fun uu____9583 -> - match (uu____9582, uu____9583) with | ((p1,w1,t1),(p2,w2,t2)) -> false + fun uu____9673 -> + fun uu____9674 -> + match (uu____9673, uu____9674) with | ((p1,w1,t1),(p2,w2,t2)) -> false let rec bottom_fold: (FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term) -> FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term @@ -3111,89 +3176,90 @@ let rec bottom_fold: fun t -> let ff = bottom_fold f in let tn = - let uu____9721 = FStar_Syntax_Subst.compress t in - uu____9721.FStar_Syntax_Syntax.n in + let uu____9812 = FStar_Syntax_Subst.compress t in + uu____9812.FStar_Syntax_Syntax.n in let tn1 = match tn with | FStar_Syntax_Syntax.Tm_app (f1,args) -> - let uu____9747 = - let uu____9762 = ff f1 in - let uu____9763 = + let uu____9838 = + let uu____9853 = ff f1 in + let uu____9854 = FStar_List.map - (fun uu____9782 -> - match uu____9782 with - | (a,q) -> let uu____9793 = ff a in (uu____9793, q)) + (fun uu____9873 -> + match uu____9873 with + | (a,q) -> let uu____9884 = ff a in (uu____9884, q)) args in - (uu____9762, uu____9763) in - FStar_Syntax_Syntax.Tm_app uu____9747 + (uu____9853, uu____9854) in + FStar_Syntax_Syntax.Tm_app uu____9838 | FStar_Syntax_Syntax.Tm_abs (bs,t1,k) -> - let uu____9823 = FStar_Syntax_Subst.open_term bs t1 in - (match uu____9823 with + let uu____9914 = FStar_Syntax_Subst.open_term bs t1 in + (match uu____9914 with | (bs1,t') -> let t'' = ff t' in - let uu____9831 = - let uu____9848 = FStar_Syntax_Subst.close bs1 t'' in - (bs1, uu____9848, k) in - FStar_Syntax_Syntax.Tm_abs uu____9831) + let uu____9922 = + let uu____9939 = FStar_Syntax_Subst.close bs1 t'' in + (bs1, uu____9939, k) in + FStar_Syntax_Syntax.Tm_abs uu____9922) | FStar_Syntax_Syntax.Tm_arrow (bs,k) -> tn | FStar_Syntax_Syntax.Tm_uinst (t1,us) -> - let uu____9875 = let uu____9882 = ff t1 in (uu____9882, us) in - FStar_Syntax_Syntax.Tm_uinst uu____9875 - | uu____9883 -> tn in + let uu____9966 = let uu____9973 = ff t1 in (uu____9973, us) in + FStar_Syntax_Syntax.Tm_uinst uu____9966 + | uu____9974 -> tn in f - (let uu___53_9886 = t in + (let uu___55_9977 = t in { FStar_Syntax_Syntax.n = tn1; - FStar_Syntax_Syntax.pos = (uu___53_9886.FStar_Syntax_Syntax.pos); - FStar_Syntax_Syntax.vars = (uu___53_9886.FStar_Syntax_Syntax.vars) + FStar_Syntax_Syntax.pos = (uu___55_9977.FStar_Syntax_Syntax.pos); + FStar_Syntax_Syntax.vars = (uu___55_9977.FStar_Syntax_Syntax.vars) }) let rec sizeof: FStar_Syntax_Syntax.term -> Prims.int = fun t -> match t.FStar_Syntax_Syntax.n with - | FStar_Syntax_Syntax.Tm_delayed uu____9890 -> - let uu____9915 = - let uu____9916 = FStar_Syntax_Subst.compress t in sizeof uu____9916 in - (Prims.parse_int "1") + uu____9915 + | FStar_Syntax_Syntax.Tm_delayed uu____9981 -> + let uu____10006 = + let uu____10007 = FStar_Syntax_Subst.compress t in + sizeof uu____10007 in + (Prims.parse_int "1") + uu____10006 | FStar_Syntax_Syntax.Tm_bvar bv -> - let uu____9918 = sizeof bv.FStar_Syntax_Syntax.sort in - (Prims.parse_int "1") + uu____9918 + let uu____10009 = sizeof bv.FStar_Syntax_Syntax.sort in + (Prims.parse_int "1") + uu____10009 | FStar_Syntax_Syntax.Tm_name bv -> - let uu____9920 = sizeof bv.FStar_Syntax_Syntax.sort in - (Prims.parse_int "1") + uu____9920 + let uu____10011 = sizeof bv.FStar_Syntax_Syntax.sort in + (Prims.parse_int "1") + uu____10011 | FStar_Syntax_Syntax.Tm_uinst (t1,us) -> - let uu____9927 = sizeof t1 in (FStar_List.length us) + uu____9927 - | FStar_Syntax_Syntax.Tm_abs (bs,t1,uu____9930) -> - let uu____9951 = sizeof t1 in - let uu____9952 = + let uu____10018 = sizeof t1 in (FStar_List.length us) + uu____10018 + | FStar_Syntax_Syntax.Tm_abs (bs,t1,uu____10021) -> + let uu____10042 = sizeof t1 in + let uu____10043 = FStar_List.fold_left (fun acc -> - fun uu____9963 -> - match uu____9963 with - | (bv,uu____9969) -> - let uu____9970 = sizeof bv.FStar_Syntax_Syntax.sort in - acc + uu____9970) (Prims.parse_int "0") bs in - uu____9951 + uu____9952 + fun uu____10054 -> + match uu____10054 with + | (bv,uu____10060) -> + let uu____10061 = sizeof bv.FStar_Syntax_Syntax.sort in + acc + uu____10061) (Prims.parse_int "0") bs in + uu____10042 + uu____10043 | FStar_Syntax_Syntax.Tm_app (hd1,args) -> - let uu____9993 = sizeof hd1 in - let uu____9994 = + let uu____10084 = sizeof hd1 in + let uu____10085 = FStar_List.fold_left (fun acc -> - fun uu____10005 -> - match uu____10005 with - | (arg,uu____10011) -> - let uu____10012 = sizeof arg in acc + uu____10012) + fun uu____10096 -> + match uu____10096 with + | (arg,uu____10102) -> + let uu____10103 = sizeof arg in acc + uu____10103) (Prims.parse_int "0") args in - uu____9993 + uu____9994 - | uu____10013 -> Prims.parse_int "1" + uu____10084 + uu____10085 + | uu____10104 -> Prims.parse_int "1" let is_fvar: FStar_Ident.lident -> FStar_Syntax_Syntax.term -> Prims.bool = fun lid -> fun t -> - let uu____10020 = - let uu____10021 = un_uinst t in uu____10021.FStar_Syntax_Syntax.n in - match uu____10020 with + let uu____10111 = + let uu____10112 = un_uinst t in uu____10112.FStar_Syntax_Syntax.n in + match uu____10111 with | FStar_Syntax_Syntax.Tm_fvar fv -> FStar_Syntax_Syntax.fv_eq_lid fv lid - | uu____10025 -> false + | uu____10116 -> false let is_synth_by_tactic: FStar_Syntax_Syntax.term -> Prims.bool = fun t -> is_fvar FStar_Parser_Const.synth_lid t let mk_alien: @@ -3208,18 +3274,18 @@ let mk_alien: fun b -> fun s -> fun r -> - let uu____10055 = - let uu____10058 = - let uu____10059 = - let uu____10066 = - let uu____10067 = - let uu____10076 = FStar_Dyn.mkdyn b in - (uu____10076, s, ty) in - FStar_Syntax_Syntax.Meta_alien uu____10067 in - (FStar_Syntax_Syntax.tun, uu____10066) in - FStar_Syntax_Syntax.Tm_meta uu____10059 in - FStar_Syntax_Syntax.mk uu____10058 in - uu____10055 FStar_Pervasives_Native.None + let uu____10146 = + let uu____10149 = + let uu____10150 = + let uu____10157 = + let uu____10158 = + let uu____10167 = FStar_Dyn.mkdyn b in + (uu____10167, s, ty) in + FStar_Syntax_Syntax.Meta_alien uu____10158 in + (FStar_Syntax_Syntax.tun, uu____10157) in + FStar_Syntax_Syntax.Tm_meta uu____10150 in + FStar_Syntax_Syntax.mk uu____10149 in + uu____10146 FStar_Pervasives_Native.None (match r with | FStar_Pervasives_Native.Some r1 -> r1 | FStar_Pervasives_Native.None -> FStar_Range.dummyRange) @@ -3228,7 +3294,7 @@ let un_alien: FStar_Syntax_Syntax.term -> FStar_Dyn.dyn = let t1 = FStar_Syntax_Subst.compress t in match t1.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Tm_meta - (uu____10086,FStar_Syntax_Syntax.Meta_alien - (blob,uu____10088,uu____10089)) + (uu____10177,FStar_Syntax_Syntax.Meta_alien + (blob,uu____10179,uu____10180)) -> blob - | uu____10098 -> failwith "unexpected: term was not an alien embedding" \ No newline at end of file + | uu____10189 -> failwith "unexpected: term was not an alien embedding" \ No newline at end of file diff --git a/src/ocaml-output/FStar_TypeChecker_DMFF.ml b/src/ocaml-output/FStar_TypeChecker_DMFF.ml index 01fda8e4d9a..1592d74f1b3 100644 --- a/src/ocaml-output/FStar_TypeChecker_DMFF.ml +++ b/src/ocaml-output/FStar_TypeChecker_DMFF.ml @@ -1752,139 +1752,141 @@ and star_type': (uu____3904, uu____3905, something) in FStar_Syntax_Syntax.Tm_ascribed uu____3877 in mk1 uu____3876 - | FStar_Syntax_Syntax.Tm_ascribed (e,uu____3959,uu____3960) -> - let uu____4001 = - let uu____4006 = - let uu____4007 = FStar_Syntax_Print.term_to_string t1 in + | FStar_Syntax_Syntax.Tm_ascribed + (uu____3958,(uu____3959,FStar_Pervasives_Native.Some uu____3960),uu____3961) + -> + let uu____4010 = + let uu____4015 = + let uu____4016 = FStar_Syntax_Print.term_to_string t1 in FStar_Util.format1 - "Tm_ascribed (with tactics) is outside of the definition language: %s" - uu____4007 in - (FStar_Errors.Fatal_TermOutsideOfDefLanguage, uu____4006) in - FStar_Errors.raise_err uu____4001 - | FStar_Syntax_Syntax.Tm_refine uu____4008 -> - let uu____4015 = - let uu____4020 = - let uu____4021 = FStar_Syntax_Print.term_to_string t1 in + "Ascriptions with tactics are outside of the definition language: %s" + uu____4016 in + (FStar_Errors.Fatal_TermOutsideOfDefLanguage, uu____4015) in + FStar_Errors.raise_err uu____4010 + | FStar_Syntax_Syntax.Tm_refine uu____4017 -> + let uu____4024 = + let uu____4029 = + let uu____4030 = FStar_Syntax_Print.term_to_string t1 in FStar_Util.format1 "Tm_refine is outside of the definition language: %s" - uu____4021 in - (FStar_Errors.Fatal_TermOutsideOfDefLanguage, uu____4020) in - FStar_Errors.raise_err uu____4015 - | FStar_Syntax_Syntax.Tm_uinst uu____4022 -> - let uu____4029 = - let uu____4034 = - let uu____4035 = FStar_Syntax_Print.term_to_string t1 in + uu____4030 in + (FStar_Errors.Fatal_TermOutsideOfDefLanguage, uu____4029) in + FStar_Errors.raise_err uu____4024 + | FStar_Syntax_Syntax.Tm_uinst uu____4031 -> + let uu____4038 = + let uu____4043 = + let uu____4044 = FStar_Syntax_Print.term_to_string t1 in FStar_Util.format1 "Tm_uinst is outside of the definition language: %s" - uu____4035 in - (FStar_Errors.Fatal_TermOutsideOfDefLanguage, uu____4034) in - FStar_Errors.raise_err uu____4029 - | FStar_Syntax_Syntax.Tm_constant uu____4036 -> - let uu____4037 = - let uu____4042 = - let uu____4043 = FStar_Syntax_Print.term_to_string t1 in + uu____4044 in + (FStar_Errors.Fatal_TermOutsideOfDefLanguage, uu____4043) in + FStar_Errors.raise_err uu____4038 + | FStar_Syntax_Syntax.Tm_constant uu____4045 -> + let uu____4046 = + let uu____4051 = + let uu____4052 = FStar_Syntax_Print.term_to_string t1 in FStar_Util.format1 "Tm_constant is outside of the definition language: %s" - uu____4043 in - (FStar_Errors.Fatal_TermOutsideOfDefLanguage, uu____4042) in - FStar_Errors.raise_err uu____4037 - | FStar_Syntax_Syntax.Tm_match uu____4044 -> - let uu____4067 = - let uu____4072 = - let uu____4073 = FStar_Syntax_Print.term_to_string t1 in + uu____4052 in + (FStar_Errors.Fatal_TermOutsideOfDefLanguage, uu____4051) in + FStar_Errors.raise_err uu____4046 + | FStar_Syntax_Syntax.Tm_match uu____4053 -> + let uu____4076 = + let uu____4081 = + let uu____4082 = FStar_Syntax_Print.term_to_string t1 in FStar_Util.format1 "Tm_match is outside of the definition language: %s" - uu____4073 in - (FStar_Errors.Fatal_TermOutsideOfDefLanguage, uu____4072) in - FStar_Errors.raise_err uu____4067 - | FStar_Syntax_Syntax.Tm_let uu____4074 -> - let uu____4087 = - let uu____4092 = - let uu____4093 = FStar_Syntax_Print.term_to_string t1 in + uu____4082 in + (FStar_Errors.Fatal_TermOutsideOfDefLanguage, uu____4081) in + FStar_Errors.raise_err uu____4076 + | FStar_Syntax_Syntax.Tm_let uu____4083 -> + let uu____4096 = + let uu____4101 = + let uu____4102 = FStar_Syntax_Print.term_to_string t1 in FStar_Util.format1 - "Tm_let is outside of the definition language: %s" uu____4093 in - (FStar_Errors.Fatal_TermOutsideOfDefLanguage, uu____4092) in - FStar_Errors.raise_err uu____4087 - | FStar_Syntax_Syntax.Tm_uvar uu____4094 -> - let uu____4111 = - let uu____4116 = - let uu____4117 = FStar_Syntax_Print.term_to_string t1 in + "Tm_let is outside of the definition language: %s" uu____4102 in + (FStar_Errors.Fatal_TermOutsideOfDefLanguage, uu____4101) in + FStar_Errors.raise_err uu____4096 + | FStar_Syntax_Syntax.Tm_uvar uu____4103 -> + let uu____4120 = + let uu____4125 = + let uu____4126 = FStar_Syntax_Print.term_to_string t1 in FStar_Util.format1 "Tm_uvar is outside of the definition language: %s" - uu____4117 in - (FStar_Errors.Fatal_TermOutsideOfDefLanguage, uu____4116) in - FStar_Errors.raise_err uu____4111 + uu____4126 in + (FStar_Errors.Fatal_TermOutsideOfDefLanguage, uu____4125) in + FStar_Errors.raise_err uu____4120 | FStar_Syntax_Syntax.Tm_unknown -> - let uu____4118 = - let uu____4123 = - let uu____4124 = FStar_Syntax_Print.term_to_string t1 in + let uu____4127 = + let uu____4132 = + let uu____4133 = FStar_Syntax_Print.term_to_string t1 in FStar_Util.format1 "Tm_unknown is outside of the definition language: %s" - uu____4124 in - (FStar_Errors.Fatal_TermOutsideOfDefLanguage, uu____4123) in - FStar_Errors.raise_err uu____4118 - | FStar_Syntax_Syntax.Tm_delayed uu____4125 -> failwith "impossible" + uu____4133 in + (FStar_Errors.Fatal_TermOutsideOfDefLanguage, uu____4132) in + FStar_Errors.raise_err uu____4127 + | FStar_Syntax_Syntax.Tm_delayed uu____4134 -> failwith "impossible" let is_monadic: FStar_Syntax_Syntax.residual_comp FStar_Pervasives_Native.option -> Prims.bool = - fun uu___65_4154 -> - match uu___65_4154 with + fun uu___65_4163 -> + match uu___65_4163 with | FStar_Pervasives_Native.None -> failwith "un-annotated lambda?!" | FStar_Pervasives_Native.Some rc -> FStar_All.pipe_right rc.FStar_Syntax_Syntax.residual_flags (FStar_Util.for_some - (fun uu___64_4161 -> - match uu___64_4161 with + (fun uu___64_4170 -> + match uu___64_4170 with | FStar_Syntax_Syntax.CPS -> true - | uu____4162 -> false)) + | uu____4171 -> false)) let rec is_C: FStar_Syntax_Syntax.typ -> Prims.bool = fun t -> - let uu____4166 = - let uu____4167 = FStar_Syntax_Subst.compress t in - uu____4167.FStar_Syntax_Syntax.n in - match uu____4166 with + let uu____4175 = + let uu____4176 = FStar_Syntax_Subst.compress t in + uu____4176.FStar_Syntax_Syntax.n in + match uu____4175 with | FStar_Syntax_Syntax.Tm_app (head1,args) when FStar_Syntax_Util.is_tuple_constructor head1 -> let r = - let uu____4193 = - let uu____4194 = FStar_List.hd args in - FStar_Pervasives_Native.fst uu____4194 in - is_C uu____4193 in + let uu____4202 = + let uu____4203 = FStar_List.hd args in + FStar_Pervasives_Native.fst uu____4203 in + is_C uu____4202 in if r then - ((let uu____4210 = - let uu____4211 = + ((let uu____4219 = + let uu____4220 = FStar_List.for_all - (fun uu____4219 -> - match uu____4219 with | (h,uu____4225) -> is_C h) args in - Prims.op_Negation uu____4211 in - if uu____4210 then failwith "not a C (A * C)" else ()); + (fun uu____4228 -> + match uu____4228 with | (h,uu____4234) -> is_C h) args in + Prims.op_Negation uu____4220 in + if uu____4219 then failwith "not a C (A * C)" else ()); true) else - ((let uu____4229 = - let uu____4230 = + ((let uu____4238 = + let uu____4239 = FStar_List.for_all - (fun uu____4239 -> - match uu____4239 with - | (h,uu____4245) -> - let uu____4246 = is_C h in - Prims.op_Negation uu____4246) args in - Prims.op_Negation uu____4230 in - if uu____4229 then failwith "not a C (C * A)" else ()); + (fun uu____4248 -> + match uu____4248 with + | (h,uu____4254) -> + let uu____4255 = is_C h in + Prims.op_Negation uu____4255) args in + Prims.op_Negation uu____4239 in + if uu____4238 then failwith "not a C (C * A)" else ()); false) | FStar_Syntax_Syntax.Tm_arrow (binders,comp) -> - let uu____4266 = nm_of_comp comp.FStar_Syntax_Syntax.n in - (match uu____4266 with + let uu____4275 = nm_of_comp comp.FStar_Syntax_Syntax.n in + (match uu____4275 with | M t1 -> - ((let uu____4269 = is_C t1 in - if uu____4269 then failwith "not a C (C -> C)" else ()); + ((let uu____4278 = is_C t1 in + if uu____4278 then failwith "not a C (C -> C)" else ()); true) | N t1 -> is_C t1) - | FStar_Syntax_Syntax.Tm_meta (t1,uu____4273) -> is_C t1 - | FStar_Syntax_Syntax.Tm_uinst (t1,uu____4279) -> is_C t1 - | FStar_Syntax_Syntax.Tm_ascribed (t1,uu____4285,uu____4286) -> is_C t1 - | uu____4327 -> false + | FStar_Syntax_Syntax.Tm_meta (t1,uu____4282) -> is_C t1 + | FStar_Syntax_Syntax.Tm_uinst (t1,uu____4288) -> is_C t1 + | FStar_Syntax_Syntax.Tm_ascribed (t1,uu____4294,uu____4295) -> is_C t1 + | uu____4336 -> false let mk_return: env -> FStar_Syntax_Syntax.typ -> @@ -1900,27 +1902,27 @@ let mk_return: let p = FStar_Syntax_Syntax.gen_bv "p'" FStar_Pervasives_Native.None p_type in let body = - let uu____4350 = - let uu____4351 = - let uu____4366 = FStar_Syntax_Syntax.bv_to_name p in - let uu____4367 = - let uu____4374 = - let uu____4379 = FStar_Syntax_Syntax.as_implicit false in - (e, uu____4379) in - [uu____4374] in - (uu____4366, uu____4367) in - FStar_Syntax_Syntax.Tm_app uu____4351 in - mk1 uu____4350 in - let uu____4394 = - let uu____4395 = FStar_Syntax_Syntax.mk_binder p in [uu____4395] in - FStar_Syntax_Util.abs uu____4394 body + let uu____4359 = + let uu____4360 = + let uu____4375 = FStar_Syntax_Syntax.bv_to_name p in + let uu____4376 = + let uu____4383 = + let uu____4388 = FStar_Syntax_Syntax.as_implicit false in + (e, uu____4388) in + [uu____4383] in + (uu____4375, uu____4376) in + FStar_Syntax_Syntax.Tm_app uu____4360 in + mk1 uu____4359 in + let uu____4403 = + let uu____4404 = FStar_Syntax_Syntax.mk_binder p in [uu____4404] in + FStar_Syntax_Util.abs uu____4403 body (FStar_Pervasives_Native.Some (FStar_Syntax_Util.residual_tot FStar_Syntax_Util.ktype0)) let is_unknown: FStar_Syntax_Syntax.term' -> Prims.bool = - fun uu___66_4398 -> - match uu___66_4398 with + fun uu___66_4407 -> + match uu___66_4407 with | FStar_Syntax_Syntax.Tm_unknown -> true - | uu____4399 -> false + | uu____4408 -> false let rec check: env -> FStar_Syntax_Syntax.term -> @@ -1931,121 +1933,121 @@ let rec check: fun env -> fun e -> fun context_nm -> - let return_if uu____4574 = - match uu____4574 with + let return_if uu____4583 = + match uu____4583 with | (rec_nm,s_e,u_e) -> let check1 t1 t2 = - let uu____4601 = + let uu____4610 = (Prims.op_Negation (is_unknown t2.FStar_Syntax_Syntax.n)) && - (let uu____4603 = - let uu____4604 = + (let uu____4612 = + let uu____4613 = FStar_TypeChecker_Rel.teq env.env t1 t2 in - FStar_TypeChecker_Rel.is_trivial uu____4604 in - Prims.op_Negation uu____4603) in - if uu____4601 + FStar_TypeChecker_Rel.is_trivial uu____4613 in + Prims.op_Negation uu____4612) in + if uu____4610 then - let uu____4605 = - let uu____4610 = - let uu____4611 = FStar_Syntax_Print.term_to_string e in - let uu____4612 = FStar_Syntax_Print.term_to_string t1 in - let uu____4613 = FStar_Syntax_Print.term_to_string t2 in + let uu____4614 = + let uu____4619 = + let uu____4620 = FStar_Syntax_Print.term_to_string e in + let uu____4621 = FStar_Syntax_Print.term_to_string t1 in + let uu____4622 = FStar_Syntax_Print.term_to_string t2 in FStar_Util.format3 "[check]: the expression [%s] has type [%s] but should have type [%s]" - uu____4611 uu____4612 uu____4613 in - (FStar_Errors.Fatal_TypeMismatch, uu____4610) in - FStar_Errors.raise_err uu____4605 + uu____4620 uu____4621 uu____4622 in + (FStar_Errors.Fatal_TypeMismatch, uu____4619) in + FStar_Errors.raise_err uu____4614 else () in (match (rec_nm, context_nm) with | (N t1,N t2) -> (check1 t1 t2; (rec_nm, s_e, u_e)) | (M t1,M t2) -> (check1 t1 t2; (rec_nm, s_e, u_e)) | (N t1,M t2) -> (check1 t1 t2; - (let uu____4630 = mk_return env t1 s_e in - ((M t1), uu____4630, u_e))) + (let uu____4639 = mk_return env t1 s_e in + ((M t1), uu____4639, u_e))) | (M t1,N t2) -> - let uu____4633 = - let uu____4638 = - let uu____4639 = FStar_Syntax_Print.term_to_string e in - let uu____4640 = FStar_Syntax_Print.term_to_string t1 in - let uu____4641 = FStar_Syntax_Print.term_to_string t2 in + let uu____4642 = + let uu____4647 = + let uu____4648 = FStar_Syntax_Print.term_to_string e in + let uu____4649 = FStar_Syntax_Print.term_to_string t1 in + let uu____4650 = FStar_Syntax_Print.term_to_string t2 in FStar_Util.format3 "[check %s]: got an effectful computation [%s] in lieu of a pure computation [%s]" - uu____4639 uu____4640 uu____4641 in + uu____4648 uu____4649 uu____4650 in (FStar_Errors.Fatal_EffectfulAndPureComputationMismatch, - uu____4638) in - FStar_Errors.raise_err uu____4633) in + uu____4647) in + FStar_Errors.raise_err uu____4642) in let ensure_m env1 e2 = - let strip_m uu___67_4682 = - match uu___67_4682 with + let strip_m uu___67_4691 = + match uu___67_4691 with | (M t,s_e,u_e) -> (t, s_e, u_e) - | uu____4698 -> failwith "impossible" in + | uu____4707 -> failwith "impossible" in match context_nm with | N t -> - let uu____4718 = - let uu____4723 = - let uu____4724 = FStar_Syntax_Print.term_to_string t in + let uu____4727 = + let uu____4732 = + let uu____4733 = FStar_Syntax_Print.term_to_string t in Prims.strcat "let-bound monadic body has a non-monadic continuation or a branch of a match is monadic and the others aren't : " - uu____4724 in - (FStar_Errors.Fatal_LetBoundMonadicMismatch, uu____4723) in - FStar_Errors.raise_error uu____4718 e2.FStar_Syntax_Syntax.pos - | M uu____4731 -> - let uu____4732 = check env1 e2 context_nm in strip_m uu____4732 in - let uu____4739 = - let uu____4740 = FStar_Syntax_Subst.compress e in - uu____4740.FStar_Syntax_Syntax.n in - match uu____4739 with - | FStar_Syntax_Syntax.Tm_bvar uu____4749 -> - let uu____4750 = infer env e in return_if uu____4750 - | FStar_Syntax_Syntax.Tm_name uu____4757 -> - let uu____4758 = infer env e in return_if uu____4758 - | FStar_Syntax_Syntax.Tm_fvar uu____4765 -> - let uu____4766 = infer env e in return_if uu____4766 - | FStar_Syntax_Syntax.Tm_abs uu____4773 -> - let uu____4790 = infer env e in return_if uu____4790 - | FStar_Syntax_Syntax.Tm_constant uu____4797 -> - let uu____4798 = infer env e in return_if uu____4798 - | FStar_Syntax_Syntax.Tm_app uu____4805 -> - let uu____4820 = infer env e in return_if uu____4820 + uu____4733 in + (FStar_Errors.Fatal_LetBoundMonadicMismatch, uu____4732) in + FStar_Errors.raise_error uu____4727 e2.FStar_Syntax_Syntax.pos + | M uu____4740 -> + let uu____4741 = check env1 e2 context_nm in strip_m uu____4741 in + let uu____4748 = + let uu____4749 = FStar_Syntax_Subst.compress e in + uu____4749.FStar_Syntax_Syntax.n in + match uu____4748 with + | FStar_Syntax_Syntax.Tm_bvar uu____4758 -> + let uu____4759 = infer env e in return_if uu____4759 + | FStar_Syntax_Syntax.Tm_name uu____4766 -> + let uu____4767 = infer env e in return_if uu____4767 + | FStar_Syntax_Syntax.Tm_fvar uu____4774 -> + let uu____4775 = infer env e in return_if uu____4775 + | FStar_Syntax_Syntax.Tm_abs uu____4782 -> + let uu____4799 = infer env e in return_if uu____4799 + | FStar_Syntax_Syntax.Tm_constant uu____4806 -> + let uu____4807 = infer env e in return_if uu____4807 + | FStar_Syntax_Syntax.Tm_app uu____4814 -> + let uu____4829 = infer env e in return_if uu____4829 | FStar_Syntax_Syntax.Tm_let ((false ,binding::[]),e2) -> mk_let env binding e2 (fun env1 -> fun e21 -> check env1 e21 context_nm) ensure_m | FStar_Syntax_Syntax.Tm_match (e0,branches) -> mk_match env e0 branches (fun env1 -> fun body -> check env1 body context_nm) - | FStar_Syntax_Syntax.Tm_meta (e1,uu____4888) -> + | FStar_Syntax_Syntax.Tm_meta (e1,uu____4897) -> check env e1 context_nm - | FStar_Syntax_Syntax.Tm_uinst (e1,uu____4894) -> + | FStar_Syntax_Syntax.Tm_uinst (e1,uu____4903) -> check env e1 context_nm - | FStar_Syntax_Syntax.Tm_ascribed (e1,uu____4900,uu____4901) -> + | FStar_Syntax_Syntax.Tm_ascribed (e1,uu____4909,uu____4910) -> check env e1 context_nm - | FStar_Syntax_Syntax.Tm_let uu____4942 -> - let uu____4955 = - let uu____4956 = FStar_Syntax_Print.term_to_string e in - FStar_Util.format1 "[check]: Tm_let %s" uu____4956 in - failwith uu____4955 - | FStar_Syntax_Syntax.Tm_type uu____4963 -> + | FStar_Syntax_Syntax.Tm_let uu____4951 -> + let uu____4964 = + let uu____4965 = FStar_Syntax_Print.term_to_string e in + FStar_Util.format1 "[check]: Tm_let %s" uu____4965 in + failwith uu____4964 + | FStar_Syntax_Syntax.Tm_type uu____4972 -> failwith "impossible (DM stratification)" - | FStar_Syntax_Syntax.Tm_arrow uu____4970 -> + | FStar_Syntax_Syntax.Tm_arrow uu____4979 -> failwith "impossible (DM stratification)" - | FStar_Syntax_Syntax.Tm_refine uu____4989 -> - let uu____4996 = - let uu____4997 = FStar_Syntax_Print.term_to_string e in - FStar_Util.format1 "[check]: Tm_refine %s" uu____4997 in - failwith uu____4996 - | FStar_Syntax_Syntax.Tm_uvar uu____5004 -> - let uu____5021 = - let uu____5022 = FStar_Syntax_Print.term_to_string e in - FStar_Util.format1 "[check]: Tm_uvar %s" uu____5022 in - failwith uu____5021 - | FStar_Syntax_Syntax.Tm_delayed uu____5029 -> + | FStar_Syntax_Syntax.Tm_refine uu____4998 -> + let uu____5005 = + let uu____5006 = FStar_Syntax_Print.term_to_string e in + FStar_Util.format1 "[check]: Tm_refine %s" uu____5006 in + failwith uu____5005 + | FStar_Syntax_Syntax.Tm_uvar uu____5013 -> + let uu____5030 = + let uu____5031 = FStar_Syntax_Print.term_to_string e in + FStar_Util.format1 "[check]: Tm_uvar %s" uu____5031 in + failwith uu____5030 + | FStar_Syntax_Syntax.Tm_delayed uu____5038 -> failwith "impossible (compressed)" | FStar_Syntax_Syntax.Tm_unknown -> - let uu____5060 = - let uu____5061 = FStar_Syntax_Print.term_to_string e in - FStar_Util.format1 "[check]: Tm_unknown %s" uu____5061 in - failwith uu____5060 + let uu____5069 = + let uu____5070 = FStar_Syntax_Print.term_to_string e in + FStar_Util.format1 "[check]: Tm_unknown %s" uu____5070 in + failwith uu____5069 and infer: env -> FStar_Syntax_Syntax.term -> @@ -2064,10 +2066,10 @@ and infer: FStar_TypeChecker_Normalize.UnfoldUntil FStar_Syntax_Syntax.Delta_constant; FStar_TypeChecker_Normalize.EraseUniverses] env.env in - let uu____5085 = - let uu____5086 = FStar_Syntax_Subst.compress e in - uu____5086.FStar_Syntax_Syntax.n in - match uu____5085 with + let uu____5094 = + let uu____5095 = FStar_Syntax_Subst.compress e in + uu____5095.FStar_Syntax_Syntax.n in + match uu____5094 with | FStar_Syntax_Syntax.Tm_bvar bv -> failwith "I failed to open a binder... boo" | FStar_Syntax_Syntax.Tm_name bv -> @@ -2076,142 +2078,142 @@ and infer: let subst_rc_opt subst1 rc_opt1 = match rc_opt1 with | FStar_Pervasives_Native.Some - { FStar_Syntax_Syntax.residual_effect = uu____5145; + { FStar_Syntax_Syntax.residual_effect = uu____5154; FStar_Syntax_Syntax.residual_typ = FStar_Pervasives_Native.None ; - FStar_Syntax_Syntax.residual_flags = uu____5146;_} + FStar_Syntax_Syntax.residual_flags = uu____5155;_} -> rc_opt1 | FStar_Pervasives_Native.None -> rc_opt1 | FStar_Pervasives_Native.Some rc -> - let uu____5152 = - let uu___82_5153 = rc in - let uu____5154 = - let uu____5159 = - let uu____5160 = + let uu____5161 = + let uu___82_5162 = rc in + let uu____5163 = + let uu____5168 = + let uu____5169 = FStar_Util.must rc.FStar_Syntax_Syntax.residual_typ in - FStar_Syntax_Subst.subst subst1 uu____5160 in - FStar_Pervasives_Native.Some uu____5159 in + FStar_Syntax_Subst.subst subst1 uu____5169 in + FStar_Pervasives_Native.Some uu____5168 in { FStar_Syntax_Syntax.residual_effect = - (uu___82_5153.FStar_Syntax_Syntax.residual_effect); - FStar_Syntax_Syntax.residual_typ = uu____5154; + (uu___82_5162.FStar_Syntax_Syntax.residual_effect); + FStar_Syntax_Syntax.residual_typ = uu____5163; FStar_Syntax_Syntax.residual_flags = - (uu___82_5153.FStar_Syntax_Syntax.residual_flags) + (uu___82_5162.FStar_Syntax_Syntax.residual_flags) } in - FStar_Pervasives_Native.Some uu____5152 in + FStar_Pervasives_Native.Some uu____5161 in let binders1 = FStar_Syntax_Subst.open_binders binders in let subst1 = FStar_Syntax_Subst.opening_of_binders binders1 in let body1 = FStar_Syntax_Subst.subst subst1 body in let rc_opt1 = subst_rc_opt subst1 rc_opt in let env1 = - let uu___83_5170 = env in - let uu____5171 = + let uu___83_5179 = env in + let uu____5180 = FStar_TypeChecker_Env.push_binders env.env binders1 in { - env = uu____5171; - subst = (uu___83_5170.subst); - tc_const = (uu___83_5170.tc_const) + env = uu____5180; + subst = (uu___83_5179.subst); + tc_const = (uu___83_5179.tc_const) } in let s_binders = FStar_List.map - (fun uu____5191 -> - match uu____5191 with + (fun uu____5200 -> + match uu____5200 with | (bv,qual) -> let sort = star_type' env1 bv.FStar_Syntax_Syntax.sort in - ((let uu___84_5204 = bv in + ((let uu___84_5213 = bv in { FStar_Syntax_Syntax.ppname = - (uu___84_5204.FStar_Syntax_Syntax.ppname); + (uu___84_5213.FStar_Syntax_Syntax.ppname); FStar_Syntax_Syntax.index = - (uu___84_5204.FStar_Syntax_Syntax.index); + (uu___84_5213.FStar_Syntax_Syntax.index); FStar_Syntax_Syntax.sort = sort }), qual)) binders1 in - let uu____5205 = + let uu____5214 = FStar_List.fold_left - (fun uu____5234 -> - fun uu____5235 -> - match (uu____5234, uu____5235) with + (fun uu____5243 -> + fun uu____5244 -> + match (uu____5243, uu____5244) with | ((env2,acc),(bv,qual)) -> let c = bv.FStar_Syntax_Syntax.sort in - let uu____5283 = is_C c in - if uu____5283 + let uu____5292 = is_C c in + if uu____5292 then let xw = - let uu____5291 = star_type' env2 c in + let uu____5300 = star_type' env2 c in FStar_Syntax_Syntax.gen_bv (Prims.strcat (bv.FStar_Syntax_Syntax.ppname).FStar_Ident.idText "__w") FStar_Pervasives_Native.None - uu____5291 in + uu____5300 in let x = - let uu___85_5293 = bv in - let uu____5294 = - let uu____5297 = + let uu___85_5302 = bv in + let uu____5303 = + let uu____5306 = FStar_Syntax_Syntax.bv_to_name xw in - trans_F_ env2 c uu____5297 in + trans_F_ env2 c uu____5306 in { FStar_Syntax_Syntax.ppname = - (uu___85_5293.FStar_Syntax_Syntax.ppname); + (uu___85_5302.FStar_Syntax_Syntax.ppname); FStar_Syntax_Syntax.index = - (uu___85_5293.FStar_Syntax_Syntax.index); - FStar_Syntax_Syntax.sort = uu____5294 + (uu___85_5302.FStar_Syntax_Syntax.index); + FStar_Syntax_Syntax.sort = uu____5303 } in let env3 = - let uu___86_5299 = env2 in - let uu____5300 = - let uu____5303 = - let uu____5304 = - let uu____5311 = + let uu___86_5308 = env2 in + let uu____5309 = + let uu____5312 = + let uu____5313 = + let uu____5320 = FStar_Syntax_Syntax.bv_to_name xw in - (bv, uu____5311) in - FStar_Syntax_Syntax.NT uu____5304 in - uu____5303 :: (env2.subst) in + (bv, uu____5320) in + FStar_Syntax_Syntax.NT uu____5313 in + uu____5312 :: (env2.subst) in { - env = (uu___86_5299.env); - subst = uu____5300; - tc_const = (uu___86_5299.tc_const) + env = (uu___86_5308.env); + subst = uu____5309; + tc_const = (uu___86_5308.tc_const) } in - let uu____5312 = - let uu____5315 = FStar_Syntax_Syntax.mk_binder x in - let uu____5316 = - let uu____5319 = + let uu____5321 = + let uu____5324 = FStar_Syntax_Syntax.mk_binder x in + let uu____5325 = + let uu____5328 = FStar_Syntax_Syntax.mk_binder xw in - uu____5319 :: acc in - uu____5315 :: uu____5316 in - (env3, uu____5312) + uu____5328 :: acc in + uu____5324 :: uu____5325 in + (env3, uu____5321) else (let x = - let uu___87_5324 = bv in - let uu____5325 = + let uu___87_5333 = bv in + let uu____5334 = star_type' env2 bv.FStar_Syntax_Syntax.sort in { FStar_Syntax_Syntax.ppname = - (uu___87_5324.FStar_Syntax_Syntax.ppname); + (uu___87_5333.FStar_Syntax_Syntax.ppname); FStar_Syntax_Syntax.index = - (uu___87_5324.FStar_Syntax_Syntax.index); - FStar_Syntax_Syntax.sort = uu____5325 + (uu___87_5333.FStar_Syntax_Syntax.index); + FStar_Syntax_Syntax.sort = uu____5334 } in - let uu____5328 = - let uu____5331 = FStar_Syntax_Syntax.mk_binder x in - uu____5331 :: acc in - (env2, uu____5328))) (env1, []) binders1 in - (match uu____5205 with + let uu____5337 = + let uu____5340 = FStar_Syntax_Syntax.mk_binder x in + uu____5340 :: acc in + (env2, uu____5337))) (env1, []) binders1 in + (match uu____5214 with | (env2,u_binders) -> let u_binders1 = FStar_List.rev u_binders in - let uu____5351 = + let uu____5360 = let check_what = - let uu____5369 = is_monadic rc_opt1 in - if uu____5369 then check_m else check_n in - let uu____5381 = check_what env2 body1 in - match uu____5381 with + let uu____5378 = is_monadic rc_opt1 in + if uu____5378 then check_m else check_n in + let uu____5390 = check_what env2 body1 in + match uu____5390 with | (t,s_body,u_body) -> - let uu____5397 = - let uu____5398 = - let uu____5399 = is_monadic rc_opt1 in - if uu____5399 then M t else N t in - comp_of_nm uu____5398 in - (uu____5397, s_body, u_body) in - (match uu____5351 with + let uu____5406 = + let uu____5407 = + let uu____5408 = is_monadic rc_opt1 in + if uu____5408 then M t else N t in + comp_of_nm uu____5407 in + (uu____5406, s_body, u_body) in + (match uu____5360 with | (comp,s_body,u_body) -> let t = FStar_Syntax_Util.arrow binders1 comp in let s_rc_opt = @@ -2222,142 +2224,142 @@ and infer: (match rc.FStar_Syntax_Syntax.residual_typ with | FStar_Pervasives_Native.None -> let rc1 = - let uu____5424 = + let uu____5433 = FStar_All.pipe_right rc.FStar_Syntax_Syntax.residual_flags (FStar_Util.for_some - (fun uu___68_5428 -> - match uu___68_5428 with + (fun uu___68_5437 -> + match uu___68_5437 with | FStar_Syntax_Syntax.CPS -> true - | uu____5429 -> false)) in - if uu____5424 + | uu____5438 -> false)) in + if uu____5433 then - let uu____5430 = + let uu____5439 = FStar_List.filter - (fun uu___69_5434 -> - match uu___69_5434 with + (fun uu___69_5443 -> + match uu___69_5443 with | FStar_Syntax_Syntax.CPS -> false - | uu____5435 -> true) + | uu____5444 -> true) rc.FStar_Syntax_Syntax.residual_flags in FStar_Syntax_Util.mk_residual_comp FStar_Parser_Const.effect_Tot_lid - FStar_Pervasives_Native.None uu____5430 + FStar_Pervasives_Native.None uu____5439 else rc in FStar_Pervasives_Native.Some rc1 | FStar_Pervasives_Native.Some rt -> - let uu____5444 = + let uu____5453 = FStar_All.pipe_right rc.FStar_Syntax_Syntax.residual_flags (FStar_Util.for_some - (fun uu___70_5448 -> - match uu___70_5448 with + (fun uu___70_5457 -> + match uu___70_5457 with | FStar_Syntax_Syntax.CPS -> true - | uu____5449 -> false)) in - if uu____5444 + | uu____5458 -> false)) in + if uu____5453 then let flags1 = FStar_List.filter - (fun uu___71_5456 -> - match uu___71_5456 with + (fun uu___71_5465 -> + match uu___71_5465 with | FStar_Syntax_Syntax.CPS -> false - | uu____5457 -> true) + | uu____5466 -> true) rc.FStar_Syntax_Syntax.residual_flags in - let uu____5458 = - let uu____5459 = - let uu____5464 = double_star rt in - FStar_Pervasives_Native.Some uu____5464 in + let uu____5467 = + let uu____5468 = + let uu____5473 = double_star rt in + FStar_Pervasives_Native.Some uu____5473 in FStar_Syntax_Util.mk_residual_comp FStar_Parser_Const.effect_Tot_lid - uu____5459 flags1 in - FStar_Pervasives_Native.Some uu____5458 + uu____5468 flags1 in + FStar_Pervasives_Native.Some uu____5467 else - (let uu____5466 = - let uu___88_5467 = rc in - let uu____5468 = - let uu____5473 = star_type' env2 rt in - FStar_Pervasives_Native.Some uu____5473 in + (let uu____5475 = + let uu___88_5476 = rc in + let uu____5477 = + let uu____5482 = star_type' env2 rt in + FStar_Pervasives_Native.Some uu____5482 in { FStar_Syntax_Syntax.residual_effect = - (uu___88_5467.FStar_Syntax_Syntax.residual_effect); + (uu___88_5476.FStar_Syntax_Syntax.residual_effect); FStar_Syntax_Syntax.residual_typ = - uu____5468; + uu____5477; FStar_Syntax_Syntax.residual_flags = - (uu___88_5467.FStar_Syntax_Syntax.residual_flags) + (uu___88_5476.FStar_Syntax_Syntax.residual_flags) } in - FStar_Pervasives_Native.Some uu____5466)) in - let uu____5474 = + FStar_Pervasives_Native.Some uu____5475)) in + let uu____5483 = let comp1 = - let uu____5484 = is_monadic rc_opt1 in - let uu____5485 = + let uu____5493 = is_monadic rc_opt1 in + let uu____5494 = FStar_Syntax_Subst.subst env2.subst s_body in trans_G env2 (FStar_Syntax_Util.comp_result comp) - uu____5484 uu____5485 in - let uu____5486 = + uu____5493 uu____5494 in + let uu____5495 = FStar_Syntax_Util.ascribe u_body ((FStar_Util.Inr comp1), FStar_Pervasives_Native.None) in - (uu____5486, + (uu____5495, (FStar_Pervasives_Native.Some (FStar_Syntax_Util.residual_comp_of_comp comp1))) in - (match uu____5474 with + (match uu____5483 with | (u_body1,u_rc_opt) -> let s_body1 = FStar_Syntax_Subst.close s_binders s_body in let s_binders1 = FStar_Syntax_Subst.close_binders s_binders in let s_term = - let uu____5528 = - let uu____5529 = - let uu____5546 = - let uu____5549 = + let uu____5537 = + let uu____5538 = + let uu____5555 = + let uu____5558 = FStar_Syntax_Subst.closing_of_binders s_binders1 in - subst_rc_opt uu____5549 s_rc_opt in - (s_binders1, s_body1, uu____5546) in - FStar_Syntax_Syntax.Tm_abs uu____5529 in - mk1 uu____5528 in + subst_rc_opt uu____5558 s_rc_opt in + (s_binders1, s_body1, uu____5555) in + FStar_Syntax_Syntax.Tm_abs uu____5538 in + mk1 uu____5537 in let u_body2 = FStar_Syntax_Subst.close u_binders1 u_body1 in let u_binders2 = FStar_Syntax_Subst.close_binders u_binders1 in let u_term = - let uu____5559 = - let uu____5560 = - let uu____5577 = - let uu____5580 = + let uu____5568 = + let uu____5569 = + let uu____5586 = + let uu____5589 = FStar_Syntax_Subst.closing_of_binders u_binders2 in - subst_rc_opt uu____5580 u_rc_opt in - (u_binders2, u_body2, uu____5577) in - FStar_Syntax_Syntax.Tm_abs uu____5560 in - mk1 uu____5559 in + subst_rc_opt uu____5589 u_rc_opt in + (u_binders2, u_body2, uu____5586) in + FStar_Syntax_Syntax.Tm_abs uu____5569 in + mk1 uu____5568 in ((N t), s_term, u_term)))) | FStar_Syntax_Syntax.Tm_fvar { FStar_Syntax_Syntax.fv_name = { FStar_Syntax_Syntax.v = lid; - FStar_Syntax_Syntax.p = uu____5590;_}; - FStar_Syntax_Syntax.fv_delta = uu____5591; - FStar_Syntax_Syntax.fv_qual = uu____5592;_} + FStar_Syntax_Syntax.p = uu____5599;_}; + FStar_Syntax_Syntax.fv_delta = uu____5600; + FStar_Syntax_Syntax.fv_qual = uu____5601;_} -> - let uu____5595 = - let uu____5600 = FStar_TypeChecker_Env.lookup_lid env.env lid in - FStar_All.pipe_left FStar_Pervasives_Native.fst uu____5600 in - (match uu____5595 with - | (uu____5631,t) -> - let uu____5633 = let uu____5634 = normalize1 t in N uu____5634 in - (uu____5633, e, e)) + let uu____5604 = + let uu____5609 = FStar_TypeChecker_Env.lookup_lid env.env lid in + FStar_All.pipe_left FStar_Pervasives_Native.fst uu____5609 in + (match uu____5604 with + | (uu____5640,t) -> + let uu____5642 = let uu____5643 = normalize1 t in N uu____5643 in + (uu____5642, e, e)) | FStar_Syntax_Syntax.Tm_app ({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_range_of ); - FStar_Syntax_Syntax.pos = uu____5635; - FStar_Syntax_Syntax.vars = uu____5636;_},a::hd1::rest) + FStar_Syntax_Syntax.pos = uu____5644; + FStar_Syntax_Syntax.vars = uu____5645;_},a::hd1::rest) -> let rest1 = hd1 :: rest in - let uu____5699 = FStar_Syntax_Util.head_and_args e in - (match uu____5699 with - | (unary_op,uu____5721) -> + let uu____5708 = FStar_Syntax_Util.head_and_args e in + (match uu____5708 with + | (unary_op,uu____5730) -> let head1 = mk1 (FStar_Syntax_Syntax.Tm_app (unary_op, [a])) in let t = mk1 (FStar_Syntax_Syntax.Tm_app (head1, rest1)) in infer env t) @@ -2365,13 +2367,13 @@ and infer: ({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_set_range_of ); - FStar_Syntax_Syntax.pos = uu____5780; - FStar_Syntax_Syntax.vars = uu____5781;_},a1::a2::hd1::rest) + FStar_Syntax_Syntax.pos = uu____5789; + FStar_Syntax_Syntax.vars = uu____5790;_},a1::a2::hd1::rest) -> let rest1 = hd1 :: rest in - let uu____5857 = FStar_Syntax_Util.head_and_args e in - (match uu____5857 with - | (unary_op,uu____5879) -> + let uu____5866 = FStar_Syntax_Util.head_and_args e in + (match uu____5866 with + | (unary_op,uu____5888) -> let head1 = mk1 (FStar_Syntax_Syntax.Tm_app (unary_op, [a1; a2])) in let t = mk1 (FStar_Syntax_Syntax.Tm_app (head1, rest1)) in @@ -2380,309 +2382,309 @@ and infer: ({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_range_of ); - FStar_Syntax_Syntax.pos = uu____5944; - FStar_Syntax_Syntax.vars = uu____5945;_},(a,FStar_Pervasives_Native.None + FStar_Syntax_Syntax.pos = uu____5953; + FStar_Syntax_Syntax.vars = uu____5954;_},(a,FStar_Pervasives_Native.None )::[]) -> - let uu____5983 = infer env a in - (match uu____5983 with + let uu____5992 = infer env a in + (match uu____5992 with | (t,s,u) -> - let uu____5999 = FStar_Syntax_Util.head_and_args e in - (match uu____5999 with - | (head1,uu____6021) -> - let uu____6042 = - let uu____6043 = + let uu____6008 = FStar_Syntax_Util.head_and_args e in + (match uu____6008 with + | (head1,uu____6030) -> + let uu____6051 = + let uu____6052 = FStar_Syntax_Syntax.tabbrev FStar_Parser_Const.range_lid in - N uu____6043 in - let uu____6044 = - let uu____6047 = - let uu____6048 = - let uu____6063 = - let uu____6066 = FStar_Syntax_Syntax.as_arg s in - [uu____6066] in - (head1, uu____6063) in - FStar_Syntax_Syntax.Tm_app uu____6048 in - mk1 uu____6047 in - let uu____6071 = - let uu____6074 = - let uu____6075 = - let uu____6090 = - let uu____6093 = FStar_Syntax_Syntax.as_arg u in - [uu____6093] in - (head1, uu____6090) in - FStar_Syntax_Syntax.Tm_app uu____6075 in - mk1 uu____6074 in - (uu____6042, uu____6044, uu____6071))) + N uu____6052 in + let uu____6053 = + let uu____6056 = + let uu____6057 = + let uu____6072 = + let uu____6075 = FStar_Syntax_Syntax.as_arg s in + [uu____6075] in + (head1, uu____6072) in + FStar_Syntax_Syntax.Tm_app uu____6057 in + mk1 uu____6056 in + let uu____6080 = + let uu____6083 = + let uu____6084 = + let uu____6099 = + let uu____6102 = FStar_Syntax_Syntax.as_arg u in + [uu____6102] in + (head1, uu____6099) in + FStar_Syntax_Syntax.Tm_app uu____6084 in + mk1 uu____6083 in + (uu____6051, uu____6053, uu____6080))) | FStar_Syntax_Syntax.Tm_app ({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_set_range_of ); - FStar_Syntax_Syntax.pos = uu____6102; - FStar_Syntax_Syntax.vars = uu____6103;_},(a1,uu____6105)::a2::[]) + FStar_Syntax_Syntax.pos = uu____6111; + FStar_Syntax_Syntax.vars = uu____6112;_},(a1,uu____6114)::a2::[]) -> - let uu____6147 = infer env a1 in - (match uu____6147 with + let uu____6156 = infer env a1 in + (match uu____6156 with | (t,s,u) -> - let uu____6163 = FStar_Syntax_Util.head_and_args e in - (match uu____6163 with - | (head1,uu____6185) -> - let uu____6206 = - let uu____6209 = - let uu____6210 = - let uu____6225 = - let uu____6228 = FStar_Syntax_Syntax.as_arg s in - [uu____6228; a2] in - (head1, uu____6225) in - FStar_Syntax_Syntax.Tm_app uu____6210 in - mk1 uu____6209 in - let uu____6245 = - let uu____6248 = - let uu____6249 = - let uu____6264 = - let uu____6267 = FStar_Syntax_Syntax.as_arg u in - [uu____6267; a2] in - (head1, uu____6264) in - FStar_Syntax_Syntax.Tm_app uu____6249 in - mk1 uu____6248 in - (t, uu____6206, uu____6245))) + let uu____6172 = FStar_Syntax_Util.head_and_args e in + (match uu____6172 with + | (head1,uu____6194) -> + let uu____6215 = + let uu____6218 = + let uu____6219 = + let uu____6234 = + let uu____6237 = FStar_Syntax_Syntax.as_arg s in + [uu____6237; a2] in + (head1, uu____6234) in + FStar_Syntax_Syntax.Tm_app uu____6219 in + mk1 uu____6218 in + let uu____6254 = + let uu____6257 = + let uu____6258 = + let uu____6273 = + let uu____6276 = FStar_Syntax_Syntax.as_arg u in + [uu____6276; a2] in + (head1, uu____6273) in + FStar_Syntax_Syntax.Tm_app uu____6258 in + mk1 uu____6257 in + (t, uu____6215, uu____6254))) | FStar_Syntax_Syntax.Tm_app ({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_range_of ); - FStar_Syntax_Syntax.pos = uu____6288; - FStar_Syntax_Syntax.vars = uu____6289;_},uu____6290) + FStar_Syntax_Syntax.pos = uu____6297; + FStar_Syntax_Syntax.vars = uu____6298;_},uu____6299) -> - let uu____6311 = - let uu____6316 = - let uu____6317 = FStar_Syntax_Print.term_to_string e in - FStar_Util.format1 "DMFF: Ill-applied constant %s" uu____6317 in - (FStar_Errors.Fatal_IllAppliedConstant, uu____6316) in - FStar_Errors.raise_error uu____6311 e.FStar_Syntax_Syntax.pos + let uu____6320 = + let uu____6325 = + let uu____6326 = FStar_Syntax_Print.term_to_string e in + FStar_Util.format1 "DMFF: Ill-applied constant %s" uu____6326 in + (FStar_Errors.Fatal_IllAppliedConstant, uu____6325) in + FStar_Errors.raise_error uu____6320 e.FStar_Syntax_Syntax.pos | FStar_Syntax_Syntax.Tm_app ({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_set_range_of ); - FStar_Syntax_Syntax.pos = uu____6324; - FStar_Syntax_Syntax.vars = uu____6325;_},uu____6326) + FStar_Syntax_Syntax.pos = uu____6333; + FStar_Syntax_Syntax.vars = uu____6334;_},uu____6335) -> - let uu____6347 = - let uu____6352 = - let uu____6353 = FStar_Syntax_Print.term_to_string e in - FStar_Util.format1 "DMFF: Ill-applied constant %s" uu____6353 in - (FStar_Errors.Fatal_IllAppliedConstant, uu____6352) in - FStar_Errors.raise_error uu____6347 e.FStar_Syntax_Syntax.pos + let uu____6356 = + let uu____6361 = + let uu____6362 = FStar_Syntax_Print.term_to_string e in + FStar_Util.format1 "DMFF: Ill-applied constant %s" uu____6362 in + (FStar_Errors.Fatal_IllAppliedConstant, uu____6361) in + FStar_Errors.raise_error uu____6356 e.FStar_Syntax_Syntax.pos | FStar_Syntax_Syntax.Tm_app (head1,args) -> - let uu____6382 = check_n env head1 in - (match uu____6382 with + let uu____6391 = check_n env head1 in + (match uu____6391 with | (t_head,s_head,u_head) -> let is_arrow t = - let uu____6402 = - let uu____6403 = FStar_Syntax_Subst.compress t in - uu____6403.FStar_Syntax_Syntax.n in - match uu____6402 with - | FStar_Syntax_Syntax.Tm_arrow uu____6406 -> true - | uu____6419 -> false in + let uu____6411 = + let uu____6412 = FStar_Syntax_Subst.compress t in + uu____6412.FStar_Syntax_Syntax.n in + match uu____6411 with + | FStar_Syntax_Syntax.Tm_arrow uu____6415 -> true + | uu____6428 -> false in let rec flatten1 t = - let uu____6436 = - let uu____6437 = FStar_Syntax_Subst.compress t in - uu____6437.FStar_Syntax_Syntax.n in - match uu____6436 with + let uu____6445 = + let uu____6446 = FStar_Syntax_Subst.compress t in + uu____6446.FStar_Syntax_Syntax.n in + match uu____6445 with | FStar_Syntax_Syntax.Tm_arrow (binders,{ FStar_Syntax_Syntax.n = - FStar_Syntax_Syntax.Total (t1,uu____6454); - FStar_Syntax_Syntax.pos = uu____6455; - FStar_Syntax_Syntax.vars = uu____6456;_}) + FStar_Syntax_Syntax.Total (t1,uu____6463); + FStar_Syntax_Syntax.pos = uu____6464; + FStar_Syntax_Syntax.vars = uu____6465;_}) when is_arrow t1 -> - let uu____6481 = flatten1 t1 in - (match uu____6481 with + let uu____6490 = flatten1 t1 in + (match uu____6490 with | (binders',comp) -> ((FStar_List.append binders binders'), comp)) | FStar_Syntax_Syntax.Tm_arrow (binders,comp) -> (binders, comp) - | FStar_Syntax_Syntax.Tm_ascribed (e1,uu____6563,uu____6564) + | FStar_Syntax_Syntax.Tm_ascribed (e1,uu____6572,uu____6573) -> flatten1 e1 - | uu____6605 -> - let uu____6606 = - let uu____6611 = - let uu____6612 = + | uu____6614 -> + let uu____6615 = + let uu____6620 = + let uu____6621 = FStar_Syntax_Print.term_to_string t_head in FStar_Util.format1 "%s: not a function type" - uu____6612 in - (FStar_Errors.Fatal_NotFunctionType, uu____6611) in - FStar_Errors.raise_err uu____6606 in - let uu____6625 = flatten1 t_head in - (match uu____6625 with + uu____6621 in + (FStar_Errors.Fatal_NotFunctionType, uu____6620) in + FStar_Errors.raise_err uu____6615 in + let uu____6634 = flatten1 t_head in + (match uu____6634 with | (binders,comp) -> let n1 = FStar_List.length binders in let n' = FStar_List.length args in (if (FStar_List.length binders) < (FStar_List.length args) then - (let uu____6685 = - let uu____6690 = - let uu____6691 = FStar_Util.string_of_int n1 in - let uu____6698 = + (let uu____6694 = + let uu____6699 = + let uu____6700 = FStar_Util.string_of_int n1 in + let uu____6707 = FStar_Util.string_of_int (n' - n1) in - let uu____6709 = FStar_Util.string_of_int n1 in + let uu____6718 = FStar_Util.string_of_int n1 in FStar_Util.format3 "The head of this application, after being applied to %s arguments, is an effectful computation (leaving %s arguments to be applied). Please let-bind the head applied to the %s first arguments." - uu____6691 uu____6698 uu____6709 in + uu____6700 uu____6707 uu____6718 in (FStar_Errors.Fatal_BinderAndArgsLengthMismatch, - uu____6690) in - FStar_Errors.raise_err uu____6685) + uu____6699) in + FStar_Errors.raise_err uu____6694) else (); - (let uu____6717 = + (let uu____6726 = FStar_Syntax_Subst.open_comp binders comp in - match uu____6717 with + match uu____6726 with | (binders1,comp1) -> - let rec final_type subst1 uu____6758 args1 = - match uu____6758 with + let rec final_type subst1 uu____6767 args1 = + match uu____6767 with | (binders2,comp2) -> (match (binders2, args1) with | ([],[]) -> - let uu____6832 = - let uu____6833 = + let uu____6841 = + let uu____6842 = FStar_Syntax_Subst.subst_comp subst1 comp2 in - uu____6833.FStar_Syntax_Syntax.n in - nm_of_comp uu____6832 + uu____6842.FStar_Syntax_Syntax.n in + nm_of_comp uu____6841 | (binders3,[]) -> - let uu____6863 = - let uu____6864 = - let uu____6867 = - let uu____6868 = + let uu____6872 = + let uu____6873 = + let uu____6876 = + let uu____6877 = mk1 (FStar_Syntax_Syntax.Tm_arrow (binders3, comp2)) in FStar_Syntax_Subst.subst subst1 - uu____6868 in + uu____6877 in FStar_Syntax_Subst.compress - uu____6867 in - uu____6864.FStar_Syntax_Syntax.n in - (match uu____6863 with + uu____6876 in + uu____6873.FStar_Syntax_Syntax.n in + (match uu____6872 with | FStar_Syntax_Syntax.Tm_arrow (binders4,comp3) -> - let uu____6893 = - let uu____6894 = - let uu____6895 = - let uu____6908 = + let uu____6902 = + let uu____6903 = + let uu____6904 = + let uu____6917 = FStar_Syntax_Subst.close_comp binders4 comp3 in - (binders4, uu____6908) in + (binders4, uu____6917) in FStar_Syntax_Syntax.Tm_arrow - uu____6895 in - mk1 uu____6894 in - N uu____6893 - | uu____6915 -> failwith "wat?") - | ([],uu____6916::uu____6917) -> + uu____6904 in + mk1 uu____6903 in + N uu____6902 + | uu____6924 -> failwith "wat?") + | ([],uu____6925::uu____6926) -> failwith "just checked that?!" - | ((bv,uu____6957)::binders3,(arg,uu____6960)::args2) + | ((bv,uu____6966)::binders3,(arg,uu____6969)::args2) -> final_type ((FStar_Syntax_Syntax.NT (bv, arg)) :: subst1) (binders3, comp2) args2) in let final_type1 = final_type [] (binders1, comp1) args in - let uu____7013 = FStar_List.splitAt n' binders1 in - (match uu____7013 with - | (binders2,uu____7045) -> - let uu____7070 = - let uu____7091 = + let uu____7022 = FStar_List.splitAt n' binders1 in + (match uu____7022 with + | (binders2,uu____7054) -> + let uu____7079 = + let uu____7100 = FStar_List.map2 - (fun uu____7145 -> - fun uu____7146 -> - match (uu____7145, uu____7146) with - | ((bv,uu____7184),(arg,q)) -> - let uu____7201 = - let uu____7202 = + (fun uu____7154 -> + fun uu____7155 -> + match (uu____7154, uu____7155) with + | ((bv,uu____7193),(arg,q)) -> + let uu____7210 = + let uu____7211 = FStar_Syntax_Subst.compress bv.FStar_Syntax_Syntax.sort in - uu____7202.FStar_Syntax_Syntax.n in - (match uu____7201 with + uu____7211.FStar_Syntax_Syntax.n in + (match uu____7210 with | FStar_Syntax_Syntax.Tm_type - uu____7221 -> - let uu____7222 = - let uu____7227 = + uu____7230 -> + let uu____7231 = + let uu____7236 = star_type' env arg in - (uu____7227, q) in - (uu____7222, [(arg, q)]) - | uu____7254 -> - let uu____7255 = + (uu____7236, q) in + (uu____7231, [(arg, q)]) + | uu____7263 -> + let uu____7264 = check_n env arg in - (match uu____7255 with - | (uu____7278,s_arg,u_arg) + (match uu____7264 with + | (uu____7287,s_arg,u_arg) -> - let uu____7281 = - let uu____7288 = + let uu____7290 = + let uu____7297 = is_C bv.FStar_Syntax_Syntax.sort in - if uu____7288 + if uu____7297 then - let uu____7295 = - let uu____7300 + let uu____7304 = + let uu____7309 = FStar_Syntax_Subst.subst env.subst s_arg in - (uu____7300, q) in - [uu____7295; + (uu____7309, q) in + [uu____7304; (u_arg, q)] else [(u_arg, q)] in ((s_arg, q), - uu____7281)))) + uu____7290)))) binders2 args in - FStar_List.split uu____7091 in - (match uu____7070 with + FStar_List.split uu____7100 in + (match uu____7079 with | (s_args,u_args) -> let u_args1 = FStar_List.flatten u_args in - let uu____7399 = + let uu____7408 = mk1 (FStar_Syntax_Syntax.Tm_app (s_head, s_args)) in - let uu____7408 = + let uu____7417 = mk1 (FStar_Syntax_Syntax.Tm_app (u_head, u_args1)) in - (final_type1, uu____7399, uu____7408))))))) + (final_type1, uu____7408, uu____7417))))))) | FStar_Syntax_Syntax.Tm_let ((false ,binding::[]),e2) -> mk_let env binding e2 infer check_m | FStar_Syntax_Syntax.Tm_match (e0,branches) -> mk_match env e0 branches infer - | FStar_Syntax_Syntax.Tm_uinst (e1,uu____7476) -> infer env e1 - | FStar_Syntax_Syntax.Tm_meta (e1,uu____7482) -> infer env e1 - | FStar_Syntax_Syntax.Tm_ascribed (e1,uu____7488,uu____7489) -> + | FStar_Syntax_Syntax.Tm_uinst (e1,uu____7485) -> infer env e1 + | FStar_Syntax_Syntax.Tm_meta (e1,uu____7491) -> infer env e1 + | FStar_Syntax_Syntax.Tm_ascribed (e1,uu____7497,uu____7498) -> infer env e1 | FStar_Syntax_Syntax.Tm_constant c -> - let uu____7531 = let uu____7532 = env.tc_const c in N uu____7532 in - (uu____7531, e, e) - | FStar_Syntax_Syntax.Tm_let uu____7533 -> - let uu____7546 = - let uu____7547 = FStar_Syntax_Print.term_to_string e in - FStar_Util.format1 "[infer]: Tm_let %s" uu____7547 in - failwith uu____7546 - | FStar_Syntax_Syntax.Tm_type uu____7554 -> + let uu____7540 = let uu____7541 = env.tc_const c in N uu____7541 in + (uu____7540, e, e) + | FStar_Syntax_Syntax.Tm_let uu____7542 -> + let uu____7555 = + let uu____7556 = FStar_Syntax_Print.term_to_string e in + FStar_Util.format1 "[infer]: Tm_let %s" uu____7556 in + failwith uu____7555 + | FStar_Syntax_Syntax.Tm_type uu____7563 -> failwith "impossible (DM stratification)" - | FStar_Syntax_Syntax.Tm_arrow uu____7561 -> + | FStar_Syntax_Syntax.Tm_arrow uu____7570 -> failwith "impossible (DM stratification)" - | FStar_Syntax_Syntax.Tm_refine uu____7580 -> - let uu____7587 = - let uu____7588 = FStar_Syntax_Print.term_to_string e in - FStar_Util.format1 "[infer]: Tm_refine %s" uu____7588 in - failwith uu____7587 - | FStar_Syntax_Syntax.Tm_uvar uu____7595 -> - let uu____7612 = - let uu____7613 = FStar_Syntax_Print.term_to_string e in - FStar_Util.format1 "[infer]: Tm_uvar %s" uu____7613 in - failwith uu____7612 - | FStar_Syntax_Syntax.Tm_delayed uu____7620 -> + | FStar_Syntax_Syntax.Tm_refine uu____7589 -> + let uu____7596 = + let uu____7597 = FStar_Syntax_Print.term_to_string e in + FStar_Util.format1 "[infer]: Tm_refine %s" uu____7597 in + failwith uu____7596 + | FStar_Syntax_Syntax.Tm_uvar uu____7604 -> + let uu____7621 = + let uu____7622 = FStar_Syntax_Print.term_to_string e in + FStar_Util.format1 "[infer]: Tm_uvar %s" uu____7622 in + failwith uu____7621 + | FStar_Syntax_Syntax.Tm_delayed uu____7629 -> failwith "impossible (compressed)" | FStar_Syntax_Syntax.Tm_unknown -> - let uu____7651 = - let uu____7652 = FStar_Syntax_Print.term_to_string e in - FStar_Util.format1 "[infer]: Tm_unknown %s" uu____7652 in - failwith uu____7651 + let uu____7660 = + let uu____7661 = FStar_Syntax_Print.term_to_string e in + FStar_Util.format1 "[infer]: Tm_unknown %s" uu____7661 in + failwith uu____7660 and mk_match: env -> FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax -> @@ -2706,58 +2708,58 @@ and mk_match: let mk1 x = FStar_Syntax_Syntax.mk x FStar_Pervasives_Native.None e0.FStar_Syntax_Syntax.pos in - let uu____7697 = check_n env e0 in - match uu____7697 with - | (uu____7710,s_e0,u_e0) -> - let uu____7713 = - let uu____7742 = + let uu____7706 = check_n env e0 in + match uu____7706 with + | (uu____7719,s_e0,u_e0) -> + let uu____7722 = + let uu____7751 = FStar_List.map (fun b -> - let uu____7803 = FStar_Syntax_Subst.open_branch b in - match uu____7803 with + let uu____7812 = FStar_Syntax_Subst.open_branch b in + match uu____7812 with | (pat,FStar_Pervasives_Native.None ,body) -> let env1 = - let uu___89_7845 = env in - let uu____7846 = - let uu____7847 = + let uu___89_7854 = env in + let uu____7855 = + let uu____7856 = FStar_Syntax_Syntax.pat_bvs pat in FStar_List.fold_left FStar_TypeChecker_Env.push_bv env.env - uu____7847 in + uu____7856 in { - env = uu____7846; - subst = (uu___89_7845.subst); - tc_const = (uu___89_7845.tc_const) + env = uu____7855; + subst = (uu___89_7854.subst); + tc_const = (uu___89_7854.tc_const) } in - let uu____7850 = f env1 body in - (match uu____7850 with + let uu____7859 = f env1 body in + (match uu____7859 with | (nm,s_body,u_body) -> (nm, (pat, FStar_Pervasives_Native.None, (s_body, u_body, body)))) - | uu____7922 -> + | uu____7931 -> FStar_Errors.raise_err (FStar_Errors.Fatal_WhenClauseNotSupported, "No when clauses in the definition language")) branches in - FStar_List.split uu____7742 in - (match uu____7713 with + FStar_List.split uu____7751 in + (match uu____7722 with | (nms,branches1) -> let t1 = - let uu____8024 = FStar_List.hd nms in - match uu____8024 with | M t1 -> t1 | N t1 -> t1 in + let uu____8033 = FStar_List.hd nms in + match uu____8033 with | M t1 -> t1 | N t1 -> t1 in let has_m = FStar_List.existsb - (fun uu___72_8030 -> - match uu___72_8030 with - | M uu____8031 -> true - | uu____8032 -> false) nms in - let uu____8033 = - let uu____8070 = + (fun uu___72_8039 -> + match uu___72_8039 with + | M uu____8040 -> true + | uu____8041 -> false) nms in + let uu____8042 = + let uu____8079 = FStar_List.map2 (fun nm -> - fun uu____8160 -> - match uu____8160 with + fun uu____8169 -> + match uu____8169 with | (pat,guard,(s_body,u_body,original_body)) -> (match (nm, has_m) with | (N t2,false ) -> @@ -2767,16 +2769,16 @@ and mk_match: (nm, (pat, guard, s_body), (pat, guard, u_body)) | (N t2,true ) -> - let uu____8337 = + let uu____8346 = check env original_body (M t2) in - (match uu____8337 with - | (uu____8374,s_body1,u_body1) -> + (match uu____8346 with + | (uu____8383,s_body1,u_body1) -> ((M t2), (pat, guard, s_body1), (pat, guard, u_body1))) - | (M uu____8413,false ) -> + | (M uu____8422,false ) -> failwith "impossible")) nms branches1 in - FStar_List.unzip3 uu____8070 in - (match uu____8033 with + FStar_List.unzip3 uu____8079 in + (match uu____8042 with | (nms1,s_branches,u_branches) -> if has_m then @@ -2786,26 +2788,26 @@ and mk_match: FStar_Pervasives_Native.None p_type in let s_branches1 = FStar_List.map - (fun uu____8597 -> - match uu____8597 with + (fun uu____8606 -> + match uu____8606 with | (pat,guard,s_body) -> let s_body1 = - let uu____8648 = - let uu____8649 = - let uu____8664 = - let uu____8671 = - let uu____8676 = + let uu____8657 = + let uu____8658 = + let uu____8673 = + let uu____8680 = + let uu____8685 = FStar_Syntax_Syntax.bv_to_name p in - let uu____8677 = + let uu____8686 = FStar_Syntax_Syntax.as_implicit false in - (uu____8676, uu____8677) in - [uu____8671] in - (s_body, uu____8664) in + (uu____8685, uu____8686) in + [uu____8680] in + (s_body, uu____8673) in FStar_Syntax_Syntax.Tm_app - uu____8649 in - mk1 uu____8648 in + uu____8658 in + mk1 uu____8657 in (pat, guard, s_body1)) s_branches in let s_branches2 = FStar_List.map FStar_Syntax_Subst.close_branch @@ -2814,43 +2816,43 @@ and mk_match: FStar_List.map FStar_Syntax_Subst.close_branch u_branches in let s_e = - let uu____8709 = - let uu____8710 = + let uu____8718 = + let uu____8719 = FStar_Syntax_Syntax.mk_binder p in - [uu____8710] in - let uu____8711 = + [uu____8719] in + let uu____8720 = mk1 (FStar_Syntax_Syntax.Tm_match (s_e0, s_branches2)) in - FStar_Syntax_Util.abs uu____8709 uu____8711 + FStar_Syntax_Util.abs uu____8718 uu____8720 (FStar_Pervasives_Native.Some (FStar_Syntax_Util.residual_tot FStar_Syntax_Util.ktype0)) in let t1_star = - let uu____8717 = - let uu____8724 = - let uu____8725 = + let uu____8726 = + let uu____8733 = + let uu____8734 = FStar_Syntax_Syntax.new_bv FStar_Pervasives_Native.None p_type in FStar_All.pipe_left - FStar_Syntax_Syntax.mk_binder uu____8725 in - [uu____8724] in - let uu____8726 = + FStar_Syntax_Syntax.mk_binder uu____8734 in + [uu____8733] in + let uu____8735 = FStar_Syntax_Syntax.mk_Total FStar_Syntax_Util.ktype0 in - FStar_Syntax_Util.arrow uu____8717 uu____8726 in - let uu____8729 = + FStar_Syntax_Util.arrow uu____8726 uu____8735 in + let uu____8738 = mk1 (FStar_Syntax_Syntax.Tm_ascribed (s_e, ((FStar_Util.Inl t1_star), FStar_Pervasives_Native.None), FStar_Pervasives_Native.None)) in - let uu____8768 = + let uu____8777 = mk1 (FStar_Syntax_Syntax.Tm_match (u_e0, u_branches1)) in - ((M t1), uu____8729, uu____8768) + ((M t1), uu____8738, uu____8777) else (let s_branches1 = FStar_List.map FStar_Syntax_Subst.close_branch @@ -2859,24 +2861,24 @@ and mk_match: FStar_List.map FStar_Syntax_Subst.close_branch u_branches in let t1_star = t1 in - let uu____8785 = - let uu____8788 = - let uu____8789 = - let uu____8816 = + let uu____8794 = + let uu____8797 = + let uu____8798 = + let uu____8825 = mk1 (FStar_Syntax_Syntax.Tm_match (s_e0, s_branches1)) in - (uu____8816, + (uu____8825, ((FStar_Util.Inl t1_star), FStar_Pervasives_Native.None), FStar_Pervasives_Native.None) in - FStar_Syntax_Syntax.Tm_ascribed uu____8789 in - mk1 uu____8788 in - let uu____8853 = + FStar_Syntax_Syntax.Tm_ascribed uu____8798 in + mk1 uu____8797 in + let uu____8862 = mk1 (FStar_Syntax_Syntax.Tm_match (u_e0, u_branches1)) in - ((N t1), uu____8785, uu____8853)))) + ((N t1), uu____8794, uu____8862)))) and mk_let: env_ -> FStar_Syntax_Syntax.letbinding -> @@ -2905,211 +2907,211 @@ and mk_let: let e1 = binding.FStar_Syntax_Syntax.lbdef in let x = FStar_Util.left binding.FStar_Syntax_Syntax.lbname in let x_binders = - let uu____8900 = FStar_Syntax_Syntax.mk_binder x in - [uu____8900] in - let uu____8901 = FStar_Syntax_Subst.open_term x_binders e2 in - match uu____8901 with + let uu____8909 = FStar_Syntax_Syntax.mk_binder x in + [uu____8909] in + let uu____8910 = FStar_Syntax_Subst.open_term x_binders e2 in + match uu____8910 with | (x_binders1,e21) -> - let uu____8914 = infer env e1 in - (match uu____8914 with + let uu____8923 = infer env e1 in + (match uu____8923 with | (N t1,s_e1,u_e1) -> let u_binding = - let uu____8931 = is_C t1 in - if uu____8931 + let uu____8940 = is_C t1 in + if uu____8940 then - let uu___90_8932 = binding in - let uu____8933 = - let uu____8936 = + let uu___90_8941 = binding in + let uu____8942 = + let uu____8945 = FStar_Syntax_Subst.subst env.subst s_e1 in - trans_F_ env t1 uu____8936 in + trans_F_ env t1 uu____8945 in { FStar_Syntax_Syntax.lbname = - (uu___90_8932.FStar_Syntax_Syntax.lbname); + (uu___90_8941.FStar_Syntax_Syntax.lbname); FStar_Syntax_Syntax.lbunivs = - (uu___90_8932.FStar_Syntax_Syntax.lbunivs); - FStar_Syntax_Syntax.lbtyp = uu____8933; + (uu___90_8941.FStar_Syntax_Syntax.lbunivs); + FStar_Syntax_Syntax.lbtyp = uu____8942; FStar_Syntax_Syntax.lbeff = - (uu___90_8932.FStar_Syntax_Syntax.lbeff); + (uu___90_8941.FStar_Syntax_Syntax.lbeff); FStar_Syntax_Syntax.lbdef = - (uu___90_8932.FStar_Syntax_Syntax.lbdef) + (uu___90_8941.FStar_Syntax_Syntax.lbdef) } else binding in let env1 = - let uu___91_8939 = env in - let uu____8940 = + let uu___91_8948 = env in + let uu____8949 = FStar_TypeChecker_Env.push_bv env.env - (let uu___92_8942 = x in + (let uu___92_8951 = x in { FStar_Syntax_Syntax.ppname = - (uu___92_8942.FStar_Syntax_Syntax.ppname); + (uu___92_8951.FStar_Syntax_Syntax.ppname); FStar_Syntax_Syntax.index = - (uu___92_8942.FStar_Syntax_Syntax.index); + (uu___92_8951.FStar_Syntax_Syntax.index); FStar_Syntax_Syntax.sort = t1 }) in { - env = uu____8940; - subst = (uu___91_8939.subst); - tc_const = (uu___91_8939.tc_const) + env = uu____8949; + subst = (uu___91_8948.subst); + tc_const = (uu___91_8948.tc_const) } in - let uu____8943 = proceed env1 e21 in - (match uu____8943 with + let uu____8952 = proceed env1 e21 in + (match uu____8952 with | (nm_rec,s_e2,u_e2) -> let s_binding = - let uu___93_8960 = binding in - let uu____8961 = + let uu___93_8969 = binding in + let uu____8970 = star_type' env1 binding.FStar_Syntax_Syntax.lbtyp in { FStar_Syntax_Syntax.lbname = - (uu___93_8960.FStar_Syntax_Syntax.lbname); + (uu___93_8969.FStar_Syntax_Syntax.lbname); FStar_Syntax_Syntax.lbunivs = - (uu___93_8960.FStar_Syntax_Syntax.lbunivs); - FStar_Syntax_Syntax.lbtyp = uu____8961; + (uu___93_8969.FStar_Syntax_Syntax.lbunivs); + FStar_Syntax_Syntax.lbtyp = uu____8970; FStar_Syntax_Syntax.lbeff = - (uu___93_8960.FStar_Syntax_Syntax.lbeff); + (uu___93_8969.FStar_Syntax_Syntax.lbeff); FStar_Syntax_Syntax.lbdef = - (uu___93_8960.FStar_Syntax_Syntax.lbdef) + (uu___93_8969.FStar_Syntax_Syntax.lbdef) } in - let uu____8964 = - let uu____8967 = - let uu____8968 = - let uu____8981 = + let uu____8973 = + let uu____8976 = + let uu____8977 = + let uu____8990 = FStar_Syntax_Subst.close x_binders1 s_e2 in ((false, - [(let uu___94_8991 = s_binding in + [(let uu___94_9000 = s_binding in { FStar_Syntax_Syntax.lbname = - (uu___94_8991.FStar_Syntax_Syntax.lbname); + (uu___94_9000.FStar_Syntax_Syntax.lbname); FStar_Syntax_Syntax.lbunivs = - (uu___94_8991.FStar_Syntax_Syntax.lbunivs); + (uu___94_9000.FStar_Syntax_Syntax.lbunivs); FStar_Syntax_Syntax.lbtyp = - (uu___94_8991.FStar_Syntax_Syntax.lbtyp); + (uu___94_9000.FStar_Syntax_Syntax.lbtyp); FStar_Syntax_Syntax.lbeff = - (uu___94_8991.FStar_Syntax_Syntax.lbeff); + (uu___94_9000.FStar_Syntax_Syntax.lbeff); FStar_Syntax_Syntax.lbdef = s_e1 - })]), uu____8981) in - FStar_Syntax_Syntax.Tm_let uu____8968 in - mk1 uu____8967 in - let uu____8992 = - let uu____8995 = - let uu____8996 = - let uu____9009 = + })]), uu____8990) in + FStar_Syntax_Syntax.Tm_let uu____8977 in + mk1 uu____8976 in + let uu____9001 = + let uu____9004 = + let uu____9005 = + let uu____9018 = FStar_Syntax_Subst.close x_binders1 u_e2 in ((false, - [(let uu___95_9019 = u_binding in + [(let uu___95_9028 = u_binding in { FStar_Syntax_Syntax.lbname = - (uu___95_9019.FStar_Syntax_Syntax.lbname); + (uu___95_9028.FStar_Syntax_Syntax.lbname); FStar_Syntax_Syntax.lbunivs = - (uu___95_9019.FStar_Syntax_Syntax.lbunivs); + (uu___95_9028.FStar_Syntax_Syntax.lbunivs); FStar_Syntax_Syntax.lbtyp = - (uu___95_9019.FStar_Syntax_Syntax.lbtyp); + (uu___95_9028.FStar_Syntax_Syntax.lbtyp); FStar_Syntax_Syntax.lbeff = - (uu___95_9019.FStar_Syntax_Syntax.lbeff); + (uu___95_9028.FStar_Syntax_Syntax.lbeff); FStar_Syntax_Syntax.lbdef = u_e1 - })]), uu____9009) in - FStar_Syntax_Syntax.Tm_let uu____8996 in - mk1 uu____8995 in - (nm_rec, uu____8964, uu____8992)) + })]), uu____9018) in + FStar_Syntax_Syntax.Tm_let uu____9005 in + mk1 uu____9004 in + (nm_rec, uu____8973, uu____9001)) | (M t1,s_e1,u_e1) -> let u_binding = - let uu___96_9028 = binding in + let uu___96_9037 = binding in { FStar_Syntax_Syntax.lbname = - (uu___96_9028.FStar_Syntax_Syntax.lbname); + (uu___96_9037.FStar_Syntax_Syntax.lbname); FStar_Syntax_Syntax.lbunivs = - (uu___96_9028.FStar_Syntax_Syntax.lbunivs); + (uu___96_9037.FStar_Syntax_Syntax.lbunivs); FStar_Syntax_Syntax.lbtyp = t1; FStar_Syntax_Syntax.lbeff = FStar_Parser_Const.effect_PURE_lid; FStar_Syntax_Syntax.lbdef = - (uu___96_9028.FStar_Syntax_Syntax.lbdef) + (uu___96_9037.FStar_Syntax_Syntax.lbdef) } in let env1 = - let uu___97_9030 = env in - let uu____9031 = + let uu___97_9039 = env in + let uu____9040 = FStar_TypeChecker_Env.push_bv env.env - (let uu___98_9033 = x in + (let uu___98_9042 = x in { FStar_Syntax_Syntax.ppname = - (uu___98_9033.FStar_Syntax_Syntax.ppname); + (uu___98_9042.FStar_Syntax_Syntax.ppname); FStar_Syntax_Syntax.index = - (uu___98_9033.FStar_Syntax_Syntax.index); + (uu___98_9042.FStar_Syntax_Syntax.index); FStar_Syntax_Syntax.sort = t1 }) in { - env = uu____9031; - subst = (uu___97_9030.subst); - tc_const = (uu___97_9030.tc_const) + env = uu____9040; + subst = (uu___97_9039.subst); + tc_const = (uu___97_9039.tc_const) } in - let uu____9034 = ensure_m env1 e21 in - (match uu____9034 with + let uu____9043 = ensure_m env1 e21 in + (match uu____9043 with | (t2,s_e2,u_e2) -> let p_type = mk_star_to_type mk1 env1 t2 in let p = FStar_Syntax_Syntax.gen_bv "p''" FStar_Pervasives_Native.None p_type in let s_e21 = - let uu____9057 = - let uu____9058 = - let uu____9073 = - let uu____9080 = - let uu____9085 = + let uu____9066 = + let uu____9067 = + let uu____9082 = + let uu____9089 = + let uu____9094 = FStar_Syntax_Syntax.bv_to_name p in - let uu____9086 = + let uu____9095 = FStar_Syntax_Syntax.as_implicit false in - (uu____9085, uu____9086) in - [uu____9080] in - (s_e2, uu____9073) in - FStar_Syntax_Syntax.Tm_app uu____9058 in - mk1 uu____9057 in + (uu____9094, uu____9095) in + [uu____9089] in + (s_e2, uu____9082) in + FStar_Syntax_Syntax.Tm_app uu____9067 in + mk1 uu____9066 in let s_e22 = FStar_Syntax_Util.abs x_binders1 s_e21 (FStar_Pervasives_Native.Some (FStar_Syntax_Util.residual_tot FStar_Syntax_Util.ktype0)) in let body = - let uu____9105 = - let uu____9106 = - let uu____9121 = - let uu____9128 = - let uu____9133 = + let uu____9114 = + let uu____9115 = + let uu____9130 = + let uu____9137 = + let uu____9142 = FStar_Syntax_Syntax.as_implicit false in - (s_e22, uu____9133) in - [uu____9128] in - (s_e1, uu____9121) in - FStar_Syntax_Syntax.Tm_app uu____9106 in - mk1 uu____9105 in - let uu____9148 = - let uu____9149 = - let uu____9150 = + (s_e22, uu____9142) in + [uu____9137] in + (s_e1, uu____9130) in + FStar_Syntax_Syntax.Tm_app uu____9115 in + mk1 uu____9114 in + let uu____9157 = + let uu____9158 = + let uu____9159 = FStar_Syntax_Syntax.mk_binder p in - [uu____9150] in - FStar_Syntax_Util.abs uu____9149 body + [uu____9159] in + FStar_Syntax_Util.abs uu____9158 body (FStar_Pervasives_Native.Some (FStar_Syntax_Util.residual_tot FStar_Syntax_Util.ktype0)) in - let uu____9151 = - let uu____9154 = - let uu____9155 = - let uu____9168 = + let uu____9160 = + let uu____9163 = + let uu____9164 = + let uu____9177 = FStar_Syntax_Subst.close x_binders1 u_e2 in ((false, - [(let uu___99_9178 = u_binding in + [(let uu___99_9187 = u_binding in { FStar_Syntax_Syntax.lbname = - (uu___99_9178.FStar_Syntax_Syntax.lbname); + (uu___99_9187.FStar_Syntax_Syntax.lbname); FStar_Syntax_Syntax.lbunivs = - (uu___99_9178.FStar_Syntax_Syntax.lbunivs); + (uu___99_9187.FStar_Syntax_Syntax.lbunivs); FStar_Syntax_Syntax.lbtyp = - (uu___99_9178.FStar_Syntax_Syntax.lbtyp); + (uu___99_9187.FStar_Syntax_Syntax.lbtyp); FStar_Syntax_Syntax.lbeff = - (uu___99_9178.FStar_Syntax_Syntax.lbeff); + (uu___99_9187.FStar_Syntax_Syntax.lbeff); FStar_Syntax_Syntax.lbdef = u_e1 - })]), uu____9168) in - FStar_Syntax_Syntax.Tm_let uu____9155 in - mk1 uu____9154 in - ((M t2), uu____9148, uu____9151))) + })]), uu____9177) in + FStar_Syntax_Syntax.Tm_let uu____9164 in + mk1 uu____9163 in + ((M t2), uu____9157, uu____9160))) and check_n: env_ -> FStar_Syntax_Syntax.term -> @@ -3119,14 +3121,14 @@ and check_n: fun env -> fun e -> let mn = - let uu____9190 = + let uu____9199 = FStar_Syntax_Syntax.mk FStar_Syntax_Syntax.Tm_unknown FStar_Pervasives_Native.None e.FStar_Syntax_Syntax.pos in - N uu____9190 in - let uu____9191 = check env e mn in - match uu____9191 with + N uu____9199 in + let uu____9200 = check env e mn in + match uu____9200 with | (N t,s_e,u_e) -> (t, s_e, u_e) - | uu____9207 -> failwith "[check_n]: impossible" + | uu____9216 -> failwith "[check_n]: impossible" and check_m: env_ -> FStar_Syntax_Syntax.term -> @@ -3136,14 +3138,14 @@ and check_m: fun env -> fun e -> let mn = - let uu____9229 = + let uu____9238 = FStar_Syntax_Syntax.mk FStar_Syntax_Syntax.Tm_unknown FStar_Pervasives_Native.None e.FStar_Syntax_Syntax.pos in - M uu____9229 in - let uu____9230 = check env e mn in - match uu____9230 with + M uu____9238 in + let uu____9239 = check env e mn in + match uu____9239 with | (M t,s_e,u_e) -> (t, s_e, u_e) - | uu____9246 -> failwith "[check_m]: impossible" + | uu____9255 -> failwith "[check_m]: impossible" and comp_of_nm: nm_ -> FStar_Syntax_Syntax.comp = fun nm -> match nm with | N t -> FStar_Syntax_Syntax.mk_Total t | M t -> mk_M t @@ -3170,150 +3172,150 @@ and trans_F_: fun env -> fun c -> fun wp -> - (let uu____9276 = - let uu____9277 = is_C c in Prims.op_Negation uu____9277 in - if uu____9276 then failwith "not a C" else ()); + (let uu____9285 = + let uu____9286 = is_C c in Prims.op_Negation uu____9286 in + if uu____9285 then failwith "not a C" else ()); (let mk1 x = FStar_Syntax_Syntax.mk x FStar_Pervasives_Native.None c.FStar_Syntax_Syntax.pos in - let uu____9285 = - let uu____9286 = FStar_Syntax_Subst.compress c in - uu____9286.FStar_Syntax_Syntax.n in - match uu____9285 with + let uu____9294 = + let uu____9295 = FStar_Syntax_Subst.compress c in + uu____9295.FStar_Syntax_Syntax.n in + match uu____9294 with | FStar_Syntax_Syntax.Tm_app (head1,args) -> - let uu____9311 = FStar_Syntax_Util.head_and_args wp in - (match uu____9311 with + let uu____9320 = FStar_Syntax_Util.head_and_args wp in + (match uu____9320 with | (wp_head,wp_args) -> - ((let uu____9349 = + ((let uu____9358 = (Prims.op_Negation ((FStar_List.length wp_args) = (FStar_List.length args))) || - (let uu____9363 = - let uu____9364 = + (let uu____9372 = + let uu____9373 = FStar_Parser_Const.mk_tuple_data_lid (FStar_List.length wp_args) FStar_Range.dummyRange in FStar_Syntax_Util.is_constructor wp_head - uu____9364 in - Prims.op_Negation uu____9363) in - if uu____9349 then failwith "mismatch" else ()); - (let uu____9372 = - let uu____9373 = - let uu____9388 = + uu____9373 in + Prims.op_Negation uu____9372) in + if uu____9358 then failwith "mismatch" else ()); + (let uu____9381 = + let uu____9382 = + let uu____9397 = FStar_List.map2 - (fun uu____9416 -> - fun uu____9417 -> - match (uu____9416, uu____9417) with + (fun uu____9425 -> + fun uu____9426 -> + match (uu____9425, uu____9426) with | ((arg,q),(wp_arg,q')) -> let print_implicit q1 = - let uu____9454 = + let uu____9463 = FStar_Syntax_Syntax.is_implicit q1 in - if uu____9454 + if uu____9463 then "implicit" else "explicit" in (if q <> q' then - (let uu____9457 = - let uu____9462 = - let uu____9463 = + (let uu____9466 = + let uu____9471 = + let uu____9472 = print_implicit q in - let uu____9464 = + let uu____9473 = print_implicit q' in FStar_Util.format2 "Incoherent implicit qualifiers %b %b\n" - uu____9463 uu____9464 in + uu____9472 uu____9473 in (FStar_Errors.Warning_IncoherentImplicitQualifier, - uu____9462) in + uu____9471) in FStar_Errors.log_issue head1.FStar_Syntax_Syntax.pos - uu____9457) + uu____9466) else (); - (let uu____9466 = + (let uu____9475 = trans_F_ env arg wp_arg in - (uu____9466, q)))) args wp_args in - (head1, uu____9388) in - FStar_Syntax_Syntax.Tm_app uu____9373 in - mk1 uu____9372))) + (uu____9475, q)))) args wp_args in + (head1, uu____9397) in + FStar_Syntax_Syntax.Tm_app uu____9382 in + mk1 uu____9381))) | FStar_Syntax_Syntax.Tm_arrow (binders,comp) -> let binders1 = FStar_Syntax_Util.name_binders binders in - let uu____9500 = FStar_Syntax_Subst.open_comp binders1 comp in - (match uu____9500 with + let uu____9509 = FStar_Syntax_Subst.open_comp binders1 comp in + (match uu____9509 with | (binders_orig,comp1) -> - let uu____9507 = - let uu____9522 = + let uu____9516 = + let uu____9531 = FStar_List.map - (fun uu____9556 -> - match uu____9556 with + (fun uu____9565 -> + match uu____9565 with | (bv,q) -> let h = bv.FStar_Syntax_Syntax.sort in - let uu____9576 = is_C h in - if uu____9576 + let uu____9585 = is_C h in + if uu____9585 then let w' = - let uu____9588 = star_type' env h in + let uu____9597 = star_type' env h in FStar_Syntax_Syntax.gen_bv (Prims.strcat (bv.FStar_Syntax_Syntax.ppname).FStar_Ident.idText "__w'") FStar_Pervasives_Native.None - uu____9588 in - let uu____9589 = - let uu____9596 = - let uu____9603 = - let uu____9608 = - let uu____9609 = - let uu____9610 = + uu____9597 in + let uu____9598 = + let uu____9605 = + let uu____9612 = + let uu____9617 = + let uu____9618 = + let uu____9619 = FStar_Syntax_Syntax.bv_to_name w' in - trans_F_ env h uu____9610 in + trans_F_ env h uu____9619 in FStar_Syntax_Syntax.null_bv - uu____9609 in - (uu____9608, q) in - [uu____9603] in - (w', q) :: uu____9596 in - (w', uu____9589) + uu____9618 in + (uu____9617, q) in + [uu____9612] in + (w', q) :: uu____9605 in + (w', uu____9598) else (let x = - let uu____9631 = star_type' env h in + let uu____9640 = star_type' env h in FStar_Syntax_Syntax.gen_bv (Prims.strcat (bv.FStar_Syntax_Syntax.ppname).FStar_Ident.idText "__x") FStar_Pervasives_Native.None - uu____9631 in + uu____9640 in (x, [(x, q)]))) binders_orig in - FStar_List.split uu____9522 in - (match uu____9507 with + FStar_List.split uu____9531 in + (match uu____9516 with | (bvs,binders2) -> let binders3 = FStar_List.flatten binders2 in let comp2 = - let uu____9686 = - let uu____9689 = + let uu____9695 = + let uu____9698 = FStar_Syntax_Syntax.binders_of_list bvs in FStar_Syntax_Util.rename_binders binders_orig - uu____9689 in - FStar_Syntax_Subst.subst_comp uu____9686 comp1 in + uu____9698 in + FStar_Syntax_Subst.subst_comp uu____9695 comp1 in let app = - let uu____9693 = - let uu____9694 = - let uu____9709 = + let uu____9702 = + let uu____9703 = + let uu____9718 = FStar_List.map (fun bv -> - let uu____9724 = + let uu____9733 = FStar_Syntax_Syntax.bv_to_name bv in - let uu____9725 = + let uu____9734 = FStar_Syntax_Syntax.as_implicit false in - (uu____9724, uu____9725)) bvs in - (wp, uu____9709) in - FStar_Syntax_Syntax.Tm_app uu____9694 in - mk1 uu____9693 in + (uu____9733, uu____9734)) bvs in + (wp, uu____9718) in + FStar_Syntax_Syntax.Tm_app uu____9703 in + mk1 uu____9702 in let comp3 = - let uu____9733 = type_of_comp comp2 in - let uu____9734 = is_monadic_comp comp2 in - trans_G env uu____9733 uu____9734 app in + let uu____9742 = type_of_comp comp2 in + let uu____9743 = is_monadic_comp comp2 in + trans_G env uu____9742 uu____9743 app in FStar_Syntax_Util.arrow binders3 comp3)) - | FStar_Syntax_Syntax.Tm_ascribed (e,uu____9736,uu____9737) -> + | FStar_Syntax_Syntax.Tm_ascribed (e,uu____9745,uu____9746) -> trans_F_ env e wp - | uu____9778 -> failwith "impossible trans_F_") + | uu____9787 -> failwith "impossible trans_F_") and trans_G: env_ -> FStar_Syntax_Syntax.typ -> @@ -3325,26 +3327,26 @@ and trans_G: fun wp -> if is_monadic1 then - let uu____9783 = - let uu____9784 = star_type' env h in - let uu____9787 = - let uu____9796 = - let uu____9801 = FStar_Syntax_Syntax.as_implicit false in - (wp, uu____9801) in - [uu____9796] in + let uu____9792 = + let uu____9793 = star_type' env h in + let uu____9796 = + let uu____9805 = + let uu____9810 = FStar_Syntax_Syntax.as_implicit false in + (wp, uu____9810) in + [uu____9805] in { FStar_Syntax_Syntax.comp_univs = [FStar_Syntax_Syntax.U_unknown]; FStar_Syntax_Syntax.effect_name = FStar_Parser_Const.effect_PURE_lid; - FStar_Syntax_Syntax.result_typ = uu____9784; - FStar_Syntax_Syntax.effect_args = uu____9787; + FStar_Syntax_Syntax.result_typ = uu____9793; + FStar_Syntax_Syntax.effect_args = uu____9796; FStar_Syntax_Syntax.flags = [] } in - FStar_Syntax_Syntax.mk_Comp uu____9783 + FStar_Syntax_Syntax.mk_Comp uu____9792 else - (let uu____9811 = trans_F_ env h wp in - FStar_Syntax_Syntax.mk_Total uu____9811) + (let uu____9820 = trans_F_ env h wp in + FStar_Syntax_Syntax.mk_Total uu____9820) let n: FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term @@ -3358,7 +3360,7 @@ let n: FStar_TypeChecker_Normalize.EraseUniverses] let star_type: env -> FStar_Syntax_Syntax.typ -> FStar_Syntax_Syntax.typ = fun env -> - fun t -> let uu____9822 = n env.env t in star_type' env uu____9822 + fun t -> let uu____9831 = n env.env t in star_type' env uu____9831 let star_expr: env -> FStar_Syntax_Syntax.term -> @@ -3366,7 +3368,7 @@ let star_expr: FStar_Pervasives_Native.tuple3 = fun env -> - fun t -> let uu____9837 = n env.env t in check_n env uu____9837 + fun t -> let uu____9846 = n env.env t in check_n env uu____9846 let trans_F: env -> FStar_Syntax_Syntax.typ -> @@ -3375,5 +3377,5 @@ let trans_F: fun env -> fun c -> fun wp -> - let uu____9847 = n env.env c in - let uu____9848 = n env.env wp in trans_F_ env uu____9847 uu____9848 \ No newline at end of file + let uu____9856 = n env.env c in + let uu____9857 = n env.env wp in trans_F_ env uu____9856 uu____9857 \ No newline at end of file diff --git a/src/ocaml-output/FStar_TypeChecker_Env.ml b/src/ocaml-output/FStar_TypeChecker_Env.ml index 1c9eecd5a0c..291eb1e689a 100644 --- a/src/ocaml-output/FStar_TypeChecker_Env.ml +++ b/src/ocaml-output/FStar_TypeChecker_Env.ml @@ -1232,8 +1232,8 @@ let rename_gamma: fun gamma -> FStar_All.pipe_right gamma (FStar_List.map - (fun uu___68_5079 -> - match uu___68_5079 with + (fun uu___69_5079 -> + match uu___69_5079 with | Binding_var x -> let y = let uu____5082 = FStar_Syntax_Syntax.bv_to_name x in @@ -1244,15 +1244,15 @@ let rename_gamma: (match uu____5083 with | FStar_Syntax_Syntax.Tm_name y1 -> let uu____5088 = - let uu___82_5089 = y1 in + let uu___84_5089 = y1 in let uu____5090 = FStar_Syntax_Subst.subst subst1 x.FStar_Syntax_Syntax.sort in { FStar_Syntax_Syntax.ppname = - (uu___82_5089.FStar_Syntax_Syntax.ppname); + (uu___84_5089.FStar_Syntax_Syntax.ppname); FStar_Syntax_Syntax.index = - (uu___82_5089.FStar_Syntax_Syntax.index); + (uu___84_5089.FStar_Syntax_Syntax.index); FStar_Syntax_Syntax.sort = uu____5090 } in Binding_var uu____5088 @@ -1261,43 +1261,43 @@ let rename_gamma: let rename_env: FStar_Syntax_Syntax.subst_t -> env -> env = fun subst1 -> fun env -> - let uu___83_5101 = env in + let uu___85_5101 = env in let uu____5102 = rename_gamma subst1 env.gamma in { - solver = (uu___83_5101.solver); - range = (uu___83_5101.range); - curmodule = (uu___83_5101.curmodule); + solver = (uu___85_5101.solver); + range = (uu___85_5101.range); + curmodule = (uu___85_5101.curmodule); gamma = uu____5102; - gamma_cache = (uu___83_5101.gamma_cache); - modules = (uu___83_5101.modules); - expected_typ = (uu___83_5101.expected_typ); - sigtab = (uu___83_5101.sigtab); - is_pattern = (uu___83_5101.is_pattern); - instantiate_imp = (uu___83_5101.instantiate_imp); - effects = (uu___83_5101.effects); - generalize = (uu___83_5101.generalize); - letrecs = (uu___83_5101.letrecs); - top_level = (uu___83_5101.top_level); - check_uvars = (uu___83_5101.check_uvars); - use_eq = (uu___83_5101.use_eq); - is_iface = (uu___83_5101.is_iface); - admit = (uu___83_5101.admit); - lax = (uu___83_5101.lax); - lax_universes = (uu___83_5101.lax_universes); - failhard = (uu___83_5101.failhard); - nosynth = (uu___83_5101.nosynth); - tc_term = (uu___83_5101.tc_term); - type_of = (uu___83_5101.type_of); - universe_of = (uu___83_5101.universe_of); - use_bv_sorts = (uu___83_5101.use_bv_sorts); - qname_and_index = (uu___83_5101.qname_and_index); - proof_ns = (uu___83_5101.proof_ns); - synth = (uu___83_5101.synth); - is_native_tactic = (uu___83_5101.is_native_tactic); - identifier_info = (uu___83_5101.identifier_info); - tc_hooks = (uu___83_5101.tc_hooks); - dsenv = (uu___83_5101.dsenv); - dep_graph = (uu___83_5101.dep_graph) + gamma_cache = (uu___85_5101.gamma_cache); + modules = (uu___85_5101.modules); + expected_typ = (uu___85_5101.expected_typ); + sigtab = (uu___85_5101.sigtab); + is_pattern = (uu___85_5101.is_pattern); + instantiate_imp = (uu___85_5101.instantiate_imp); + effects = (uu___85_5101.effects); + generalize = (uu___85_5101.generalize); + letrecs = (uu___85_5101.letrecs); + top_level = (uu___85_5101.top_level); + check_uvars = (uu___85_5101.check_uvars); + use_eq = (uu___85_5101.use_eq); + is_iface = (uu___85_5101.is_iface); + admit = (uu___85_5101.admit); + lax = (uu___85_5101.lax); + lax_universes = (uu___85_5101.lax_universes); + failhard = (uu___85_5101.failhard); + nosynth = (uu___85_5101.nosynth); + tc_term = (uu___85_5101.tc_term); + type_of = (uu___85_5101.type_of); + universe_of = (uu___85_5101.universe_of); + use_bv_sorts = (uu___85_5101.use_bv_sorts); + qname_and_index = (uu___85_5101.qname_and_index); + proof_ns = (uu___85_5101.proof_ns); + synth = (uu___85_5101.synth); + is_native_tactic = (uu___85_5101.is_native_tactic); + identifier_info = (uu___85_5101.identifier_info); + tc_hooks = (uu___85_5101.tc_hooks); + dsenv = (uu___85_5101.dsenv); + dep_graph = (uu___85_5101.dep_graph) } let default_tc_hooks: tcenv_hooks = { tc_push_in_gamma_hook = (fun uu____5109 -> fun uu____5110 -> ()) } @@ -1305,81 +1305,81 @@ let tc_hooks: env -> tcenv_hooks = fun env -> env.tc_hooks let set_tc_hooks: env -> tcenv_hooks -> env = fun env -> fun hooks -> - let uu___84_5120 = env in + let uu___86_5120 = env in { - solver = (uu___84_5120.solver); - range = (uu___84_5120.range); - curmodule = (uu___84_5120.curmodule); - gamma = (uu___84_5120.gamma); - gamma_cache = (uu___84_5120.gamma_cache); - modules = (uu___84_5120.modules); - expected_typ = (uu___84_5120.expected_typ); - sigtab = (uu___84_5120.sigtab); - is_pattern = (uu___84_5120.is_pattern); - instantiate_imp = (uu___84_5120.instantiate_imp); - effects = (uu___84_5120.effects); - generalize = (uu___84_5120.generalize); - letrecs = (uu___84_5120.letrecs); - top_level = (uu___84_5120.top_level); - check_uvars = (uu___84_5120.check_uvars); - use_eq = (uu___84_5120.use_eq); - is_iface = (uu___84_5120.is_iface); - admit = (uu___84_5120.admit); - lax = (uu___84_5120.lax); - lax_universes = (uu___84_5120.lax_universes); - failhard = (uu___84_5120.failhard); - nosynth = (uu___84_5120.nosynth); - tc_term = (uu___84_5120.tc_term); - type_of = (uu___84_5120.type_of); - universe_of = (uu___84_5120.universe_of); - use_bv_sorts = (uu___84_5120.use_bv_sorts); - qname_and_index = (uu___84_5120.qname_and_index); - proof_ns = (uu___84_5120.proof_ns); - synth = (uu___84_5120.synth); - is_native_tactic = (uu___84_5120.is_native_tactic); - identifier_info = (uu___84_5120.identifier_info); + solver = (uu___86_5120.solver); + range = (uu___86_5120.range); + curmodule = (uu___86_5120.curmodule); + gamma = (uu___86_5120.gamma); + gamma_cache = (uu___86_5120.gamma_cache); + modules = (uu___86_5120.modules); + expected_typ = (uu___86_5120.expected_typ); + sigtab = (uu___86_5120.sigtab); + is_pattern = (uu___86_5120.is_pattern); + instantiate_imp = (uu___86_5120.instantiate_imp); + effects = (uu___86_5120.effects); + generalize = (uu___86_5120.generalize); + letrecs = (uu___86_5120.letrecs); + top_level = (uu___86_5120.top_level); + check_uvars = (uu___86_5120.check_uvars); + use_eq = (uu___86_5120.use_eq); + is_iface = (uu___86_5120.is_iface); + admit = (uu___86_5120.admit); + lax = (uu___86_5120.lax); + lax_universes = (uu___86_5120.lax_universes); + failhard = (uu___86_5120.failhard); + nosynth = (uu___86_5120.nosynth); + tc_term = (uu___86_5120.tc_term); + type_of = (uu___86_5120.type_of); + universe_of = (uu___86_5120.universe_of); + use_bv_sorts = (uu___86_5120.use_bv_sorts); + qname_and_index = (uu___86_5120.qname_and_index); + proof_ns = (uu___86_5120.proof_ns); + synth = (uu___86_5120.synth); + is_native_tactic = (uu___86_5120.is_native_tactic); + identifier_info = (uu___86_5120.identifier_info); tc_hooks = hooks; - dsenv = (uu___84_5120.dsenv); - dep_graph = (uu___84_5120.dep_graph) + dsenv = (uu___86_5120.dsenv); + dep_graph = (uu___86_5120.dep_graph) } let set_dep_graph: env -> FStar_Parser_Dep.deps -> env = fun e -> fun g -> - let uu___85_5127 = e in + let uu___87_5127 = e in { - solver = (uu___85_5127.solver); - range = (uu___85_5127.range); - curmodule = (uu___85_5127.curmodule); - gamma = (uu___85_5127.gamma); - gamma_cache = (uu___85_5127.gamma_cache); - modules = (uu___85_5127.modules); - expected_typ = (uu___85_5127.expected_typ); - sigtab = (uu___85_5127.sigtab); - is_pattern = (uu___85_5127.is_pattern); - instantiate_imp = (uu___85_5127.instantiate_imp); - effects = (uu___85_5127.effects); - generalize = (uu___85_5127.generalize); - letrecs = (uu___85_5127.letrecs); - top_level = (uu___85_5127.top_level); - check_uvars = (uu___85_5127.check_uvars); - use_eq = (uu___85_5127.use_eq); - is_iface = (uu___85_5127.is_iface); - admit = (uu___85_5127.admit); - lax = (uu___85_5127.lax); - lax_universes = (uu___85_5127.lax_universes); - failhard = (uu___85_5127.failhard); - nosynth = (uu___85_5127.nosynth); - tc_term = (uu___85_5127.tc_term); - type_of = (uu___85_5127.type_of); - universe_of = (uu___85_5127.universe_of); - use_bv_sorts = (uu___85_5127.use_bv_sorts); - qname_and_index = (uu___85_5127.qname_and_index); - proof_ns = (uu___85_5127.proof_ns); - synth = (uu___85_5127.synth); - is_native_tactic = (uu___85_5127.is_native_tactic); - identifier_info = (uu___85_5127.identifier_info); - tc_hooks = (uu___85_5127.tc_hooks); - dsenv = (uu___85_5127.dsenv); + solver = (uu___87_5127.solver); + range = (uu___87_5127.range); + curmodule = (uu___87_5127.curmodule); + gamma = (uu___87_5127.gamma); + gamma_cache = (uu___87_5127.gamma_cache); + modules = (uu___87_5127.modules); + expected_typ = (uu___87_5127.expected_typ); + sigtab = (uu___87_5127.sigtab); + is_pattern = (uu___87_5127.is_pattern); + instantiate_imp = (uu___87_5127.instantiate_imp); + effects = (uu___87_5127.effects); + generalize = (uu___87_5127.generalize); + letrecs = (uu___87_5127.letrecs); + top_level = (uu___87_5127.top_level); + check_uvars = (uu___87_5127.check_uvars); + use_eq = (uu___87_5127.use_eq); + is_iface = (uu___87_5127.is_iface); + admit = (uu___87_5127.admit); + lax = (uu___87_5127.lax); + lax_universes = (uu___87_5127.lax_universes); + failhard = (uu___87_5127.failhard); + nosynth = (uu___87_5127.nosynth); + tc_term = (uu___87_5127.tc_term); + type_of = (uu___87_5127.type_of); + universe_of = (uu___87_5127.universe_of); + use_bv_sorts = (uu___87_5127.use_bv_sorts); + qname_and_index = (uu___87_5127.qname_and_index); + proof_ns = (uu___87_5127.proof_ns); + synth = (uu___87_5127.synth); + is_native_tactic = (uu___87_5127.is_native_tactic); + identifier_info = (uu___87_5127.identifier_info); + tc_hooks = (uu___87_5127.tc_hooks); + dsenv = (uu___87_5127.dsenv); dep_graph = g } let dep_graph: env -> FStar_Parser_Dep.deps = fun e -> e.dep_graph @@ -1526,47 +1526,47 @@ let push_stack: env -> env = (let uu____6159 = let uu____6162 = FStar_ST.op_Bang stack in env :: uu____6162 in FStar_ST.op_Colon_Equals stack uu____6159); - (let uu___86_6269 = env in + (let uu___88_6269 = env in let uu____6270 = FStar_Util.smap_copy (gamma_cache env) in let uu____6273 = FStar_Util.smap_copy (sigtab env) in let uu____6276 = let uu____6279 = FStar_ST.op_Bang env.identifier_info in FStar_Util.mk_ref uu____6279 in { - solver = (uu___86_6269.solver); - range = (uu___86_6269.range); - curmodule = (uu___86_6269.curmodule); - gamma = (uu___86_6269.gamma); + solver = (uu___88_6269.solver); + range = (uu___88_6269.range); + curmodule = (uu___88_6269.curmodule); + gamma = (uu___88_6269.gamma); gamma_cache = uu____6270; - modules = (uu___86_6269.modules); - expected_typ = (uu___86_6269.expected_typ); + modules = (uu___88_6269.modules); + expected_typ = (uu___88_6269.expected_typ); sigtab = uu____6273; - is_pattern = (uu___86_6269.is_pattern); - instantiate_imp = (uu___86_6269.instantiate_imp); - effects = (uu___86_6269.effects); - generalize = (uu___86_6269.generalize); - letrecs = (uu___86_6269.letrecs); - top_level = (uu___86_6269.top_level); - check_uvars = (uu___86_6269.check_uvars); - use_eq = (uu___86_6269.use_eq); - is_iface = (uu___86_6269.is_iface); - admit = (uu___86_6269.admit); - lax = (uu___86_6269.lax); - lax_universes = (uu___86_6269.lax_universes); - failhard = (uu___86_6269.failhard); - nosynth = (uu___86_6269.nosynth); - tc_term = (uu___86_6269.tc_term); - type_of = (uu___86_6269.type_of); - universe_of = (uu___86_6269.universe_of); - use_bv_sorts = (uu___86_6269.use_bv_sorts); - qname_and_index = (uu___86_6269.qname_and_index); - proof_ns = (uu___86_6269.proof_ns); - synth = (uu___86_6269.synth); - is_native_tactic = (uu___86_6269.is_native_tactic); + is_pattern = (uu___88_6269.is_pattern); + instantiate_imp = (uu___88_6269.instantiate_imp); + effects = (uu___88_6269.effects); + generalize = (uu___88_6269.generalize); + letrecs = (uu___88_6269.letrecs); + top_level = (uu___88_6269.top_level); + check_uvars = (uu___88_6269.check_uvars); + use_eq = (uu___88_6269.use_eq); + is_iface = (uu___88_6269.is_iface); + admit = (uu___88_6269.admit); + lax = (uu___88_6269.lax); + lax_universes = (uu___88_6269.lax_universes); + failhard = (uu___88_6269.failhard); + nosynth = (uu___88_6269.nosynth); + tc_term = (uu___88_6269.tc_term); + type_of = (uu___88_6269.type_of); + universe_of = (uu___88_6269.universe_of); + use_bv_sorts = (uu___88_6269.use_bv_sorts); + qname_and_index = (uu___88_6269.qname_and_index); + proof_ns = (uu___88_6269.proof_ns); + synth = (uu___88_6269.synth); + is_native_tactic = (uu___88_6269.is_native_tactic); identifier_info = uu____6276; - tc_hooks = (uu___86_6269.tc_hooks); - dsenv = (uu___86_6269.dsenv); - dep_graph = (uu___86_6269.dep_graph) + tc_hooks = (uu___88_6269.tc_hooks); + dsenv = (uu___88_6269.dsenv); + dep_graph = (uu___88_6269.dep_graph) }) let pop_stack: Prims.unit -> env = fun uu____6352 -> @@ -1596,82 +1596,82 @@ let incr_query_index: env -> env = | FStar_Pervasives_Native.None -> let next = n1 + (Prims.parse_int "1") in (add_query_index (l, next); - (let uu___87_6543 = env in + (let uu___89_6543 = env in { - solver = (uu___87_6543.solver); - range = (uu___87_6543.range); - curmodule = (uu___87_6543.curmodule); - gamma = (uu___87_6543.gamma); - gamma_cache = (uu___87_6543.gamma_cache); - modules = (uu___87_6543.modules); - expected_typ = (uu___87_6543.expected_typ); - sigtab = (uu___87_6543.sigtab); - is_pattern = (uu___87_6543.is_pattern); - instantiate_imp = (uu___87_6543.instantiate_imp); - effects = (uu___87_6543.effects); - generalize = (uu___87_6543.generalize); - letrecs = (uu___87_6543.letrecs); - top_level = (uu___87_6543.top_level); - check_uvars = (uu___87_6543.check_uvars); - use_eq = (uu___87_6543.use_eq); - is_iface = (uu___87_6543.is_iface); - admit = (uu___87_6543.admit); - lax = (uu___87_6543.lax); - lax_universes = (uu___87_6543.lax_universes); - failhard = (uu___87_6543.failhard); - nosynth = (uu___87_6543.nosynth); - tc_term = (uu___87_6543.tc_term); - type_of = (uu___87_6543.type_of); - universe_of = (uu___87_6543.universe_of); - use_bv_sorts = (uu___87_6543.use_bv_sorts); + solver = (uu___89_6543.solver); + range = (uu___89_6543.range); + curmodule = (uu___89_6543.curmodule); + gamma = (uu___89_6543.gamma); + gamma_cache = (uu___89_6543.gamma_cache); + modules = (uu___89_6543.modules); + expected_typ = (uu___89_6543.expected_typ); + sigtab = (uu___89_6543.sigtab); + is_pattern = (uu___89_6543.is_pattern); + instantiate_imp = (uu___89_6543.instantiate_imp); + effects = (uu___89_6543.effects); + generalize = (uu___89_6543.generalize); + letrecs = (uu___89_6543.letrecs); + top_level = (uu___89_6543.top_level); + check_uvars = (uu___89_6543.check_uvars); + use_eq = (uu___89_6543.use_eq); + is_iface = (uu___89_6543.is_iface); + admit = (uu___89_6543.admit); + lax = (uu___89_6543.lax); + lax_universes = (uu___89_6543.lax_universes); + failhard = (uu___89_6543.failhard); + nosynth = (uu___89_6543.nosynth); + tc_term = (uu___89_6543.tc_term); + type_of = (uu___89_6543.type_of); + universe_of = (uu___89_6543.universe_of); + use_bv_sorts = (uu___89_6543.use_bv_sorts); qname_and_index = (FStar_Pervasives_Native.Some (l, next)); - proof_ns = (uu___87_6543.proof_ns); - synth = (uu___87_6543.synth); - is_native_tactic = (uu___87_6543.is_native_tactic); - identifier_info = (uu___87_6543.identifier_info); - tc_hooks = (uu___87_6543.tc_hooks); - dsenv = (uu___87_6543.dsenv); - dep_graph = (uu___87_6543.dep_graph) + proof_ns = (uu___89_6543.proof_ns); + synth = (uu___89_6543.synth); + is_native_tactic = (uu___89_6543.is_native_tactic); + identifier_info = (uu___89_6543.identifier_info); + tc_hooks = (uu___89_6543.tc_hooks); + dsenv = (uu___89_6543.dsenv); + dep_graph = (uu___89_6543.dep_graph) })) | FStar_Pervasives_Native.Some (uu____6548,m) -> let next = m + (Prims.parse_int "1") in (add_query_index (l, next); - (let uu___88_6556 = env in + (let uu___90_6556 = env in { - solver = (uu___88_6556.solver); - range = (uu___88_6556.range); - curmodule = (uu___88_6556.curmodule); - gamma = (uu___88_6556.gamma); - gamma_cache = (uu___88_6556.gamma_cache); - modules = (uu___88_6556.modules); - expected_typ = (uu___88_6556.expected_typ); - sigtab = (uu___88_6556.sigtab); - is_pattern = (uu___88_6556.is_pattern); - instantiate_imp = (uu___88_6556.instantiate_imp); - effects = (uu___88_6556.effects); - generalize = (uu___88_6556.generalize); - letrecs = (uu___88_6556.letrecs); - top_level = (uu___88_6556.top_level); - check_uvars = (uu___88_6556.check_uvars); - use_eq = (uu___88_6556.use_eq); - is_iface = (uu___88_6556.is_iface); - admit = (uu___88_6556.admit); - lax = (uu___88_6556.lax); - lax_universes = (uu___88_6556.lax_universes); - failhard = (uu___88_6556.failhard); - nosynth = (uu___88_6556.nosynth); - tc_term = (uu___88_6556.tc_term); - type_of = (uu___88_6556.type_of); - universe_of = (uu___88_6556.universe_of); - use_bv_sorts = (uu___88_6556.use_bv_sorts); + solver = (uu___90_6556.solver); + range = (uu___90_6556.range); + curmodule = (uu___90_6556.curmodule); + gamma = (uu___90_6556.gamma); + gamma_cache = (uu___90_6556.gamma_cache); + modules = (uu___90_6556.modules); + expected_typ = (uu___90_6556.expected_typ); + sigtab = (uu___90_6556.sigtab); + is_pattern = (uu___90_6556.is_pattern); + instantiate_imp = (uu___90_6556.instantiate_imp); + effects = (uu___90_6556.effects); + generalize = (uu___90_6556.generalize); + letrecs = (uu___90_6556.letrecs); + top_level = (uu___90_6556.top_level); + check_uvars = (uu___90_6556.check_uvars); + use_eq = (uu___90_6556.use_eq); + is_iface = (uu___90_6556.is_iface); + admit = (uu___90_6556.admit); + lax = (uu___90_6556.lax); + lax_universes = (uu___90_6556.lax_universes); + failhard = (uu___90_6556.failhard); + nosynth = (uu___90_6556.nosynth); + tc_term = (uu___90_6556.tc_term); + type_of = (uu___90_6556.type_of); + universe_of = (uu___90_6556.universe_of); + use_bv_sorts = (uu___90_6556.use_bv_sorts); qname_and_index = (FStar_Pervasives_Native.Some (l, next)); - proof_ns = (uu___88_6556.proof_ns); - synth = (uu___88_6556.synth); - is_native_tactic = (uu___88_6556.is_native_tactic); - identifier_info = (uu___88_6556.identifier_info); - tc_hooks = (uu___88_6556.tc_hooks); - dsenv = (uu___88_6556.dsenv); - dep_graph = (uu___88_6556.dep_graph) + proof_ns = (uu___90_6556.proof_ns); + synth = (uu___90_6556.synth); + is_native_tactic = (uu___90_6556.is_native_tactic); + identifier_info = (uu___90_6556.identifier_info); + tc_hooks = (uu___90_6556.tc_hooks); + dsenv = (uu___90_6556.dsenv); + dep_graph = (uu___90_6556.dep_graph) }))) let debug: env -> FStar_Options.debug_level_t -> Prims.bool = fun env -> @@ -1682,42 +1682,42 @@ let set_range: env -> FStar_Range.range -> env = if r = FStar_Range.dummyRange then e else - (let uu___89_6574 = e in + (let uu___91_6574 = e in { - solver = (uu___89_6574.solver); + solver = (uu___91_6574.solver); range = r; - curmodule = (uu___89_6574.curmodule); - gamma = (uu___89_6574.gamma); - gamma_cache = (uu___89_6574.gamma_cache); - modules = (uu___89_6574.modules); - expected_typ = (uu___89_6574.expected_typ); - sigtab = (uu___89_6574.sigtab); - is_pattern = (uu___89_6574.is_pattern); - instantiate_imp = (uu___89_6574.instantiate_imp); - effects = (uu___89_6574.effects); - generalize = (uu___89_6574.generalize); - letrecs = (uu___89_6574.letrecs); - top_level = (uu___89_6574.top_level); - check_uvars = (uu___89_6574.check_uvars); - use_eq = (uu___89_6574.use_eq); - is_iface = (uu___89_6574.is_iface); - admit = (uu___89_6574.admit); - lax = (uu___89_6574.lax); - lax_universes = (uu___89_6574.lax_universes); - failhard = (uu___89_6574.failhard); - nosynth = (uu___89_6574.nosynth); - tc_term = (uu___89_6574.tc_term); - type_of = (uu___89_6574.type_of); - universe_of = (uu___89_6574.universe_of); - use_bv_sorts = (uu___89_6574.use_bv_sorts); - qname_and_index = (uu___89_6574.qname_and_index); - proof_ns = (uu___89_6574.proof_ns); - synth = (uu___89_6574.synth); - is_native_tactic = (uu___89_6574.is_native_tactic); - identifier_info = (uu___89_6574.identifier_info); - tc_hooks = (uu___89_6574.tc_hooks); - dsenv = (uu___89_6574.dsenv); - dep_graph = (uu___89_6574.dep_graph) + curmodule = (uu___91_6574.curmodule); + gamma = (uu___91_6574.gamma); + gamma_cache = (uu___91_6574.gamma_cache); + modules = (uu___91_6574.modules); + expected_typ = (uu___91_6574.expected_typ); + sigtab = (uu___91_6574.sigtab); + is_pattern = (uu___91_6574.is_pattern); + instantiate_imp = (uu___91_6574.instantiate_imp); + effects = (uu___91_6574.effects); + generalize = (uu___91_6574.generalize); + letrecs = (uu___91_6574.letrecs); + top_level = (uu___91_6574.top_level); + check_uvars = (uu___91_6574.check_uvars); + use_eq = (uu___91_6574.use_eq); + is_iface = (uu___91_6574.is_iface); + admit = (uu___91_6574.admit); + lax = (uu___91_6574.lax); + lax_universes = (uu___91_6574.lax_universes); + failhard = (uu___91_6574.failhard); + nosynth = (uu___91_6574.nosynth); + tc_term = (uu___91_6574.tc_term); + type_of = (uu___91_6574.type_of); + universe_of = (uu___91_6574.universe_of); + use_bv_sorts = (uu___91_6574.use_bv_sorts); + qname_and_index = (uu___91_6574.qname_and_index); + proof_ns = (uu___91_6574.proof_ns); + synth = (uu___91_6574.synth); + is_native_tactic = (uu___91_6574.is_native_tactic); + identifier_info = (uu___91_6574.identifier_info); + tc_hooks = (uu___91_6574.tc_hooks); + dsenv = (uu___91_6574.dsenv); + dep_graph = (uu___91_6574.dep_graph) }) let get_range: env -> FStar_Range.range = fun e -> e.range let toggle_id_info: env -> Prims.bool -> Prims.unit = @@ -1759,42 +1759,42 @@ let current_module: env -> FStar_Ident.lident = fun env -> env.curmodule let set_current_module: env -> FStar_Ident.lident -> env = fun env -> fun lid -> - let uu___90_7019 = env in + let uu___92_7019 = env in { - solver = (uu___90_7019.solver); - range = (uu___90_7019.range); + solver = (uu___92_7019.solver); + range = (uu___92_7019.range); curmodule = lid; - gamma = (uu___90_7019.gamma); - gamma_cache = (uu___90_7019.gamma_cache); - modules = (uu___90_7019.modules); - expected_typ = (uu___90_7019.expected_typ); - sigtab = (uu___90_7019.sigtab); - is_pattern = (uu___90_7019.is_pattern); - instantiate_imp = (uu___90_7019.instantiate_imp); - effects = (uu___90_7019.effects); - generalize = (uu___90_7019.generalize); - letrecs = (uu___90_7019.letrecs); - top_level = (uu___90_7019.top_level); - check_uvars = (uu___90_7019.check_uvars); - use_eq = (uu___90_7019.use_eq); - is_iface = (uu___90_7019.is_iface); - admit = (uu___90_7019.admit); - lax = (uu___90_7019.lax); - lax_universes = (uu___90_7019.lax_universes); - failhard = (uu___90_7019.failhard); - nosynth = (uu___90_7019.nosynth); - tc_term = (uu___90_7019.tc_term); - type_of = (uu___90_7019.type_of); - universe_of = (uu___90_7019.universe_of); - use_bv_sorts = (uu___90_7019.use_bv_sorts); - qname_and_index = (uu___90_7019.qname_and_index); - proof_ns = (uu___90_7019.proof_ns); - synth = (uu___90_7019.synth); - is_native_tactic = (uu___90_7019.is_native_tactic); - identifier_info = (uu___90_7019.identifier_info); - tc_hooks = (uu___90_7019.tc_hooks); - dsenv = (uu___90_7019.dsenv); - dep_graph = (uu___90_7019.dep_graph) + gamma = (uu___92_7019.gamma); + gamma_cache = (uu___92_7019.gamma_cache); + modules = (uu___92_7019.modules); + expected_typ = (uu___92_7019.expected_typ); + sigtab = (uu___92_7019.sigtab); + is_pattern = (uu___92_7019.is_pattern); + instantiate_imp = (uu___92_7019.instantiate_imp); + effects = (uu___92_7019.effects); + generalize = (uu___92_7019.generalize); + letrecs = (uu___92_7019.letrecs); + top_level = (uu___92_7019.top_level); + check_uvars = (uu___92_7019.check_uvars); + use_eq = (uu___92_7019.use_eq); + is_iface = (uu___92_7019.is_iface); + admit = (uu___92_7019.admit); + lax = (uu___92_7019.lax); + lax_universes = (uu___92_7019.lax_universes); + failhard = (uu___92_7019.failhard); + nosynth = (uu___92_7019.nosynth); + tc_term = (uu___92_7019.tc_term); + type_of = (uu___92_7019.type_of); + universe_of = (uu___92_7019.universe_of); + use_bv_sorts = (uu___92_7019.use_bv_sorts); + qname_and_index = (uu___92_7019.qname_and_index); + proof_ns = (uu___92_7019.proof_ns); + synth = (uu___92_7019.synth); + is_native_tactic = (uu___92_7019.is_native_tactic); + identifier_info = (uu___92_7019.identifier_info); + tc_hooks = (uu___92_7019.tc_hooks); + dsenv = (uu___92_7019.dsenv); + dep_graph = (uu___92_7019.dep_graph) } let has_interface: env -> FStar_Ident.lident -> Prims.bool = fun env -> @@ -1855,8 +1855,8 @@ let inst_tscheme: (FStar_Syntax_Syntax.universes,FStar_Syntax_Syntax.term) FStar_Pervasives_Native.tuple2 = - fun uu___69_7133 -> - match uu___69_7133 with + fun uu___70_7133 -> + match uu___70_7133 with | ([],t) -> ([], t) | (us,t) -> let us' = @@ -1983,8 +1983,8 @@ let lookup_qname: match uu____7400 with | FStar_Pervasives_Native.None -> FStar_Util.find_map env.gamma - (fun uu___70_7445 -> - match uu___70_7445 with + (fun uu___71_7445 -> + match uu___71_7445 with | Binding_lid (l,t) -> if FStar_Ident.lid_equals lid l then @@ -2096,8 +2096,8 @@ let try_lookup_bv: fun env -> fun bv -> FStar_Util.find_map env.gamma - (fun uu___71_8058 -> - match uu___71_8058 with + (fun uu___72_8058 -> + match uu___72_8058 with | Binding_var id1 when FStar_Syntax_Syntax.bv_eq id1 bv -> FStar_Pervasives_Native.Some ((id1.FStar_Syntax_Syntax.sort), @@ -2321,13 +2321,13 @@ let try_lookup_lid_aux: | FStar_Pervasives_Native.Some ((us,t),r) -> FStar_Pervasives_Native.Some ((us, - (let uu___91_9149 = t in + (let uu___93_9149 = t in { FStar_Syntax_Syntax.n = - (uu___91_9149.FStar_Syntax_Syntax.n); + (uu___93_9149.FStar_Syntax_Syntax.n); FStar_Syntax_Syntax.pos = (FStar_Ident.range_of_lid lid); FStar_Syntax_Syntax.vars = - (uu___91_9149.FStar_Syntax_Syntax.vars) + (uu___93_9149.FStar_Syntax_Syntax.vars) })), r) | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None let lid_exists: env -> FStar_Ident.lident -> Prims.bool = @@ -2400,8 +2400,8 @@ let lookup_univ: env -> FStar_Syntax_Syntax.univ_name -> Prims.bool = fun x -> FStar_All.pipe_right (FStar_List.find - (fun uu___72_9485 -> - match uu___72_9485 with + (fun uu___73_9485 -> + match uu___73_9485 with | Binding_univ y -> x.FStar_Ident.idText = y.FStar_Ident.idText | uu____9487 -> false) env.gamma) FStar_Option.isSome let try_lookup_val_decl: @@ -2624,8 +2624,8 @@ let lookup_effect_abbrev: let uu____10609 = FStar_All.pipe_right quals (FStar_Util.for_some - (fun uu___73_10613 -> - match uu___73_10613 with + (fun uu___74_10613 -> + match uu___74_10613 with | FStar_Syntax_Syntax.Irreducible -> true | uu____10614 -> false)) in if uu____10609 @@ -2777,8 +2777,8 @@ let is_projector: env -> FStar_Ident.lident -> Prims.bool = FStar_Syntax_Syntax.sigattrs = uu____11041;_},uu____11042),uu____11043) -> FStar_Util.for_some - (fun uu___74_11096 -> - match uu___74_11096 with + (fun uu___75_11096 -> + match uu___75_11096 with | FStar_Syntax_Syntax.Projector uu____11097 -> true | uu____11102 -> false) quals | uu____11103 -> false @@ -2815,8 +2815,8 @@ let is_record: env -> FStar_Ident.lident -> Prims.bool = FStar_Syntax_Syntax.sigattrs = uu____11274;_},uu____11275),uu____11276) -> FStar_Util.for_some - (fun uu___75_11337 -> - match uu___75_11337 with + (fun uu___76_11337 -> + match uu___76_11337 with | FStar_Syntax_Syntax.RecordType uu____11338 -> true | FStar_Syntax_Syntax.RecordConstructor uu____11347 -> true | uu____11356 -> false) quals @@ -2837,8 +2837,8 @@ let is_action: env -> FStar_Ident.lident -> Prims.bool = FStar_Syntax_Syntax.sigattrs = uu____11410;_},uu____11411),uu____11412) -> FStar_Util.for_some - (fun uu___76_11469 -> - match uu___76_11469 with + (fun uu___77_11469 -> + match uu___77_11469 with | FStar_Syntax_Syntax.Action uu____11470 -> true | uu____11471 -> false) quals | uu____11472 -> false @@ -2869,46 +2869,59 @@ let is_interpreted: env -> FStar_Syntax_Syntax.term -> Prims.bool = fv.FStar_Syntax_Syntax.fv_delta = FStar_Syntax_Syntax.Delta_equational | uu____11507 -> false +let is_irreducible: env -> FStar_Ident.lident -> Prims.bool = + fun env -> + fun l -> + let uu____11514 = lookup_qname env l in + match uu____11514 with + | FStar_Pervasives_Native.Some + (FStar_Util.Inr (se,uu____11536),uu____11537) -> + FStar_Util.for_some + (fun uu___78_11585 -> + match uu___78_11585 with + | FStar_Syntax_Syntax.Irreducible -> true + | uu____11586 -> false) se.FStar_Syntax_Syntax.sigquals + | uu____11587 -> false let is_type_constructor: env -> FStar_Ident.lident -> Prims.bool = fun env -> fun lid -> let mapper x = match FStar_Pervasives_Native.fst x with - | FStar_Util.Inl uu____11572 -> FStar_Pervasives_Native.Some false - | FStar_Util.Inr (se,uu____11588) -> + | FStar_Util.Inl uu____11672 -> FStar_Pervasives_Native.Some false + | FStar_Util.Inr (se,uu____11688) -> (match se.FStar_Syntax_Syntax.sigel with - | FStar_Syntax_Syntax.Sig_declare_typ uu____11605 -> + | FStar_Syntax_Syntax.Sig_declare_typ uu____11705 -> FStar_Pervasives_Native.Some (FStar_List.contains FStar_Syntax_Syntax.New se.FStar_Syntax_Syntax.sigquals) - | FStar_Syntax_Syntax.Sig_inductive_typ uu____11612 -> + | FStar_Syntax_Syntax.Sig_inductive_typ uu____11712 -> FStar_Pervasives_Native.Some true - | uu____11629 -> FStar_Pervasives_Native.Some false) in - let uu____11630 = - let uu____11633 = lookup_qname env lid in - FStar_Util.bind_opt uu____11633 mapper in - match uu____11630 with + | uu____11729 -> FStar_Pervasives_Native.Some false) in + let uu____11730 = + let uu____11733 = lookup_qname env lid in + FStar_Util.bind_opt uu____11733 mapper in + match uu____11730 with | FStar_Pervasives_Native.Some b -> b | FStar_Pervasives_Native.None -> false let num_inductive_ty_params: env -> FStar_Ident.lident -> Prims.int = fun env -> fun lid -> - let uu____11679 = lookup_qname env lid in - match uu____11679 with + let uu____11779 = lookup_qname env lid in + match uu____11779 with | FStar_Pervasives_Native.Some (FStar_Util.Inr ({ FStar_Syntax_Syntax.sigel = FStar_Syntax_Syntax.Sig_inductive_typ - (uu____11700,uu____11701,tps,uu____11703,uu____11704,uu____11705); - FStar_Syntax_Syntax.sigrng = uu____11706; - FStar_Syntax_Syntax.sigquals = uu____11707; - FStar_Syntax_Syntax.sigmeta = uu____11708; - FStar_Syntax_Syntax.sigattrs = uu____11709;_},uu____11710),uu____11711) + (uu____11800,uu____11801,tps,uu____11803,uu____11804,uu____11805); + FStar_Syntax_Syntax.sigrng = uu____11806; + FStar_Syntax_Syntax.sigquals = uu____11807; + FStar_Syntax_Syntax.sigmeta = uu____11808; + FStar_Syntax_Syntax.sigattrs = uu____11809;_},uu____11810),uu____11811) -> FStar_List.length tps - | uu____11774 -> - let uu____11795 = name_not_found lid in - FStar_Errors.raise_error uu____11795 (FStar_Ident.range_of_lid lid) + | uu____11874 -> + let uu____11895 = name_not_found lid in + FStar_Errors.raise_error uu____11895 (FStar_Ident.range_of_lid lid) let effect_decl_opt: env -> FStar_Ident.lident -> @@ -2919,26 +2932,26 @@ let effect_decl_opt: fun l -> FStar_All.pipe_right (env.effects).decls (FStar_Util.find_opt - (fun uu____11839 -> - match uu____11839 with - | (d,uu____11847) -> + (fun uu____11939 -> + match uu____11939 with + | (d,uu____11947) -> FStar_Ident.lid_equals d.FStar_Syntax_Syntax.mname l)) let get_effect_decl: env -> FStar_Ident.lident -> FStar_Syntax_Syntax.eff_decl = fun env -> fun l -> - let uu____11858 = effect_decl_opt env l in - match uu____11858 with + let uu____11958 = effect_decl_opt env l in + match uu____11958 with | FStar_Pervasives_Native.None -> - let uu____11873 = name_not_found l in - FStar_Errors.raise_error uu____11873 (FStar_Ident.range_of_lid l) + let uu____11973 = name_not_found l in + FStar_Errors.raise_error uu____11973 (FStar_Ident.range_of_lid l) | FStar_Pervasives_Native.Some md -> FStar_Pervasives_Native.fst md let identity_mlift: mlift = { - mlift_wp = (fun uu____11899 -> fun t -> fun wp -> wp); + mlift_wp = (fun uu____11999 -> fun t -> fun wp -> wp); mlift_term = (FStar_Pervasives_Native.Some - (fun uu____11914 -> + (fun uu____12014 -> fun t -> fun wp -> fun e -> FStar_Util.return_all e)) } let join: @@ -2965,27 +2978,27 @@ let join: (FStar_Parser_Const.effect_GTot_lid, identity_mlift, identity_mlift) else - (let uu____11947 = + (let uu____12047 = FStar_All.pipe_right (env.effects).joins (FStar_Util.find_opt - (fun uu____12000 -> - match uu____12000 with - | (m1,m2,uu____12013,uu____12014,uu____12015) -> + (fun uu____12100 -> + match uu____12100 with + | (m1,m2,uu____12113,uu____12114,uu____12115) -> (FStar_Ident.lid_equals l1 m1) && (FStar_Ident.lid_equals l2 m2))) in - match uu____11947 with + match uu____12047 with | FStar_Pervasives_Native.None -> - let uu____12032 = - let uu____12037 = - let uu____12038 = FStar_Syntax_Print.lid_to_string l1 in - let uu____12039 = FStar_Syntax_Print.lid_to_string l2 in + let uu____12132 = + let uu____12137 = + let uu____12138 = FStar_Syntax_Print.lid_to_string l1 in + let uu____12139 = FStar_Syntax_Print.lid_to_string l2 in FStar_Util.format2 - "Effects %s and %s cannot be composed" uu____12038 - uu____12039 in - (FStar_Errors.Fatal_EffectsCannotBeComposed, uu____12037) in - FStar_Errors.raise_error uu____12032 env.range + "Effects %s and %s cannot be composed" uu____12138 + uu____12139 in + (FStar_Errors.Fatal_EffectsCannotBeComposed, uu____12137) in + FStar_Errors.raise_error uu____12132 env.range | FStar_Pervasives_Native.Some - (uu____12046,uu____12047,m3,j1,j2) -> (m3, j1, j2)) + (uu____12146,uu____12147,m3,j1,j2) -> (m3, j1, j2)) let monad_leq: env -> FStar_Ident.lident -> @@ -3008,8 +3021,8 @@ let monad_leq: (FStar_Ident.lid_equals l1 e.msource) && (FStar_Ident.lid_equals l2 e.mtarget))) let wp_sig_aux: - 'Auu____12084 . - (FStar_Syntax_Syntax.eff_decl,'Auu____12084) + 'Auu____12184 . + (FStar_Syntax_Syntax.eff_decl,'Auu____12184) FStar_Pervasives_Native.tuple2 Prims.list -> FStar_Ident.lident -> (FStar_Syntax_Syntax.bv,FStar_Syntax_Syntax.term' @@ -3018,37 +3031,37 @@ let wp_sig_aux: = fun decls -> fun m -> - let uu____12111 = + let uu____12211 = FStar_All.pipe_right decls (FStar_Util.find_opt - (fun uu____12137 -> - match uu____12137 with - | (d,uu____12143) -> + (fun uu____12237 -> + match uu____12237 with + | (d,uu____12243) -> FStar_Ident.lid_equals d.FStar_Syntax_Syntax.mname m)) in - match uu____12111 with + match uu____12211 with | FStar_Pervasives_Native.None -> - let uu____12154 = + let uu____12254 = FStar_Util.format1 "Impossible: declaration for monad %s not found" m.FStar_Ident.str in - failwith uu____12154 + failwith uu____12254 | FStar_Pervasives_Native.Some (md,_q) -> - let uu____12167 = + let uu____12267 = inst_tscheme ((md.FStar_Syntax_Syntax.univs), (md.FStar_Syntax_Syntax.signature)) in - (match uu____12167 with - | (uu____12178,s) -> + (match uu____12267 with + | (uu____12278,s) -> let s1 = FStar_Syntax_Subst.compress s in (match ((md.FStar_Syntax_Syntax.binders), (s1.FStar_Syntax_Syntax.n)) with | ([],FStar_Syntax_Syntax.Tm_arrow - ((a,uu____12188)::(wp,uu____12190)::[],c)) when + ((a,uu____12288)::(wp,uu____12290)::[],c)) when FStar_Syntax_Syntax.is_teff (FStar_Syntax_Util.comp_result c) -> (a, (wp.FStar_Syntax_Syntax.sort)) - | uu____12226 -> failwith "Impossible")) + | uu____12326 -> failwith "Impossible")) let wp_signature: env -> FStar_Ident.lident -> @@ -3084,85 +3097,85 @@ let null_wp_for_eff: inst_effect_fun_with [res_u] env ed ed.FStar_Syntax_Syntax.null_wp in let null_wp_res = - let uu____12269 = get_range env in - let uu____12270 = - let uu____12273 = - let uu____12274 = - let uu____12289 = - let uu____12292 = FStar_Syntax_Syntax.as_arg res_t in - [uu____12292] in - (null_wp, uu____12289) in - FStar_Syntax_Syntax.Tm_app uu____12274 in - FStar_Syntax_Syntax.mk uu____12273 in - uu____12270 FStar_Pervasives_Native.None uu____12269 in - let uu____12298 = - let uu____12299 = - let uu____12308 = FStar_Syntax_Syntax.as_arg null_wp_res in - [uu____12308] in + let uu____12369 = get_range env in + let uu____12370 = + let uu____12373 = + let uu____12374 = + let uu____12389 = + let uu____12392 = FStar_Syntax_Syntax.as_arg res_t in + [uu____12392] in + (null_wp, uu____12389) in + FStar_Syntax_Syntax.Tm_app uu____12374 in + FStar_Syntax_Syntax.mk uu____12373 in + uu____12370 FStar_Pervasives_Native.None uu____12369 in + let uu____12398 = + let uu____12399 = + let uu____12408 = FStar_Syntax_Syntax.as_arg null_wp_res in + [uu____12408] in { FStar_Syntax_Syntax.comp_univs = [res_u]; FStar_Syntax_Syntax.effect_name = eff_name1; FStar_Syntax_Syntax.result_typ = res_t; - FStar_Syntax_Syntax.effect_args = uu____12299; + FStar_Syntax_Syntax.effect_args = uu____12399; FStar_Syntax_Syntax.flags = [] } in - FStar_Syntax_Syntax.mk_Comp uu____12298) + FStar_Syntax_Syntax.mk_Comp uu____12398) let build_lattice: env -> FStar_Syntax_Syntax.sigelt -> env = fun env -> fun se -> match se.FStar_Syntax_Syntax.sigel with | FStar_Syntax_Syntax.Sig_new_effect ne -> let effects = - let uu___92_12317 = env.effects in + let uu___94_12417 = env.effects in { decls = ((ne, (se.FStar_Syntax_Syntax.sigquals)) :: ((env.effects).decls)); - order = (uu___92_12317.order); - joins = (uu___92_12317.joins) + order = (uu___94_12417.order); + joins = (uu___94_12417.joins) } in - let uu___93_12326 = env in + let uu___95_12426 = env in { - solver = (uu___93_12326.solver); - range = (uu___93_12326.range); - curmodule = (uu___93_12326.curmodule); - gamma = (uu___93_12326.gamma); - gamma_cache = (uu___93_12326.gamma_cache); - modules = (uu___93_12326.modules); - expected_typ = (uu___93_12326.expected_typ); - sigtab = (uu___93_12326.sigtab); - is_pattern = (uu___93_12326.is_pattern); - instantiate_imp = (uu___93_12326.instantiate_imp); + solver = (uu___95_12426.solver); + range = (uu___95_12426.range); + curmodule = (uu___95_12426.curmodule); + gamma = (uu___95_12426.gamma); + gamma_cache = (uu___95_12426.gamma_cache); + modules = (uu___95_12426.modules); + expected_typ = (uu___95_12426.expected_typ); + sigtab = (uu___95_12426.sigtab); + is_pattern = (uu___95_12426.is_pattern); + instantiate_imp = (uu___95_12426.instantiate_imp); effects; - generalize = (uu___93_12326.generalize); - letrecs = (uu___93_12326.letrecs); - top_level = (uu___93_12326.top_level); - check_uvars = (uu___93_12326.check_uvars); - use_eq = (uu___93_12326.use_eq); - is_iface = (uu___93_12326.is_iface); - admit = (uu___93_12326.admit); - lax = (uu___93_12326.lax); - lax_universes = (uu___93_12326.lax_universes); - failhard = (uu___93_12326.failhard); - nosynth = (uu___93_12326.nosynth); - tc_term = (uu___93_12326.tc_term); - type_of = (uu___93_12326.type_of); - universe_of = (uu___93_12326.universe_of); - use_bv_sorts = (uu___93_12326.use_bv_sorts); - qname_and_index = (uu___93_12326.qname_and_index); - proof_ns = (uu___93_12326.proof_ns); - synth = (uu___93_12326.synth); - is_native_tactic = (uu___93_12326.is_native_tactic); - identifier_info = (uu___93_12326.identifier_info); - tc_hooks = (uu___93_12326.tc_hooks); - dsenv = (uu___93_12326.dsenv); - dep_graph = (uu___93_12326.dep_graph) + generalize = (uu___95_12426.generalize); + letrecs = (uu___95_12426.letrecs); + top_level = (uu___95_12426.top_level); + check_uvars = (uu___95_12426.check_uvars); + use_eq = (uu___95_12426.use_eq); + is_iface = (uu___95_12426.is_iface); + admit = (uu___95_12426.admit); + lax = (uu___95_12426.lax); + lax_universes = (uu___95_12426.lax_universes); + failhard = (uu___95_12426.failhard); + nosynth = (uu___95_12426.nosynth); + tc_term = (uu___95_12426.tc_term); + type_of = (uu___95_12426.type_of); + universe_of = (uu___95_12426.universe_of); + use_bv_sorts = (uu___95_12426.use_bv_sorts); + qname_and_index = (uu___95_12426.qname_and_index); + proof_ns = (uu___95_12426.proof_ns); + synth = (uu___95_12426.synth); + is_native_tactic = (uu___95_12426.is_native_tactic); + identifier_info = (uu___95_12426.identifier_info); + tc_hooks = (uu___95_12426.tc_hooks); + dsenv = (uu___95_12426.dsenv); + dep_graph = (uu___95_12426.dep_graph) } | FStar_Syntax_Syntax.Sig_sub_effect sub1 -> let compose_edges e1 e2 = let composed_lift = let mlift_wp u r wp1 = - let uu____12346 = (e1.mlift).mlift_wp u r wp1 in - (e2.mlift).mlift_wp u r uu____12346 in + let uu____12446 = (e1.mlift).mlift_wp u r wp1 in + (e2.mlift).mlift_wp u r uu____12446 in let mlift_term = match (((e1.mlift).mlift_term), ((e2.mlift).mlift_term)) with | (FStar_Pervasives_Native.Some @@ -3172,10 +3185,10 @@ let build_lattice: env -> FStar_Syntax_Syntax.sigelt -> env = fun t -> fun wp -> fun e -> - let uu____12460 = (e1.mlift).mlift_wp u t wp in - let uu____12461 = l1 u t wp e in - l2 u t uu____12460 uu____12461)) - | uu____12462 -> FStar_Pervasives_Native.None in + let uu____12560 = (e1.mlift).mlift_wp u t wp in + let uu____12561 = l1 u t wp e in + l2 u t uu____12560 uu____12561)) + | uu____12562 -> FStar_Pervasives_Native.None in { mlift_wp; mlift_term } in { msource = (e1.msource); @@ -3183,22 +3196,22 @@ let build_lattice: env -> FStar_Syntax_Syntax.sigelt -> env = mlift = composed_lift } in let mk_mlift_wp lift_t u r wp1 = - let uu____12510 = inst_tscheme_with lift_t [u] in - match uu____12510 with - | (uu____12517,lift_t1) -> - let uu____12519 = - let uu____12522 = - let uu____12523 = - let uu____12538 = - let uu____12541 = FStar_Syntax_Syntax.as_arg r in - let uu____12542 = - let uu____12545 = FStar_Syntax_Syntax.as_arg wp1 in - [uu____12545] in - uu____12541 :: uu____12542 in - (lift_t1, uu____12538) in - FStar_Syntax_Syntax.Tm_app uu____12523 in - FStar_Syntax_Syntax.mk uu____12522 in - uu____12519 FStar_Pervasives_Native.None + let uu____12610 = inst_tscheme_with lift_t [u] in + match uu____12610 with + | (uu____12617,lift_t1) -> + let uu____12619 = + let uu____12622 = + let uu____12623 = + let uu____12638 = + let uu____12641 = FStar_Syntax_Syntax.as_arg r in + let uu____12642 = + let uu____12645 = FStar_Syntax_Syntax.as_arg wp1 in + [uu____12645] in + uu____12641 :: uu____12642 in + (lift_t1, uu____12638) in + FStar_Syntax_Syntax.Tm_app uu____12623 in + FStar_Syntax_Syntax.mk uu____12622 in + uu____12619 FStar_Pervasives_Native.None wp1.FStar_Syntax_Syntax.pos in let sub_mlift_wp = match sub1.FStar_Syntax_Syntax.lift_wp with @@ -3207,25 +3220,25 @@ let build_lattice: env -> FStar_Syntax_Syntax.sigelt -> env = | FStar_Pervasives_Native.None -> failwith "sub effect should've been elaborated at this stage" in let mk_mlift_term lift_t u r wp1 e = - let uu____12595 = inst_tscheme_with lift_t [u] in - match uu____12595 with - | (uu____12602,lift_t1) -> - let uu____12604 = - let uu____12607 = - let uu____12608 = - let uu____12623 = - let uu____12626 = FStar_Syntax_Syntax.as_arg r in - let uu____12627 = - let uu____12630 = FStar_Syntax_Syntax.as_arg wp1 in - let uu____12631 = - let uu____12634 = FStar_Syntax_Syntax.as_arg e in - [uu____12634] in - uu____12630 :: uu____12631 in - uu____12626 :: uu____12627 in - (lift_t1, uu____12623) in - FStar_Syntax_Syntax.Tm_app uu____12608 in - FStar_Syntax_Syntax.mk uu____12607 in - uu____12604 FStar_Pervasives_Native.None + let uu____12695 = inst_tscheme_with lift_t [u] in + match uu____12695 with + | (uu____12702,lift_t1) -> + let uu____12704 = + let uu____12707 = + let uu____12708 = + let uu____12723 = + let uu____12726 = FStar_Syntax_Syntax.as_arg r in + let uu____12727 = + let uu____12730 = FStar_Syntax_Syntax.as_arg wp1 in + let uu____12731 = + let uu____12734 = FStar_Syntax_Syntax.as_arg e in + [uu____12734] in + uu____12730 :: uu____12731 in + uu____12726 :: uu____12727 in + (lift_t1, uu____12723) in + FStar_Syntax_Syntax.Tm_app uu____12708 in + FStar_Syntax_Syntax.mk uu____12707 in + uu____12704 FStar_Pervasives_Native.None e.FStar_Syntax_Syntax.pos in let sub_mlift_term = FStar_Util.map_opt sub1.FStar_Syntax_Syntax.lift mk_mlift_term in @@ -3244,37 +3257,37 @@ let build_lattice: env -> FStar_Syntax_Syntax.sigelt -> env = } in let print_mlift l = let bogus_term s = - let uu____12676 = - let uu____12677 = + let uu____12776 = + let uu____12777 = FStar_Ident.lid_of_path [s] FStar_Range.dummyRange in - FStar_Syntax_Syntax.lid_as_fv uu____12677 + FStar_Syntax_Syntax.lid_as_fv uu____12777 FStar_Syntax_Syntax.Delta_constant FStar_Pervasives_Native.None in - FStar_Syntax_Syntax.fv_to_tm uu____12676 in + FStar_Syntax_Syntax.fv_to_tm uu____12776 in let arg = bogus_term "ARG" in let wp = bogus_term "WP" in let e = bogus_term "COMP" in - let uu____12681 = - let uu____12682 = l.mlift_wp FStar_Syntax_Syntax.U_zero arg wp in - FStar_Syntax_Print.term_to_string uu____12682 in - let uu____12683 = - let uu____12684 = + let uu____12781 = + let uu____12782 = l.mlift_wp FStar_Syntax_Syntax.U_zero arg wp in + FStar_Syntax_Print.term_to_string uu____12782 in + let uu____12783 = + let uu____12784 = FStar_Util.map_opt l.mlift_term (fun l1 -> - let uu____12706 = l1 FStar_Syntax_Syntax.U_zero arg wp e in - FStar_Syntax_Print.term_to_string uu____12706) in - FStar_Util.dflt "none" uu____12684 in - FStar_Util.format2 "{ wp : %s ; term : %s }" uu____12681 - uu____12683 in + let uu____12806 = l1 FStar_Syntax_Syntax.U_zero arg wp e in + FStar_Syntax_Print.term_to_string uu____12806) in + FStar_Util.dflt "none" uu____12784 in + FStar_Util.format2 "{ wp : %s ; term : %s }" uu____12781 + uu____12783 in let order = edge :: ((env.effects).order) in let ms = FStar_All.pipe_right (env.effects).decls (FStar_List.map - (fun uu____12732 -> - match uu____12732 with - | (e,uu____12740) -> e.FStar_Syntax_Syntax.mname)) in - let find_edge order1 uu____12759 = - match uu____12759 with + (fun uu____12832 -> + match uu____12832 with + | (e,uu____12840) -> e.FStar_Syntax_Syntax.mname)) in + let find_edge order1 uu____12859 = + match uu____12859 with | (i,j) -> if FStar_Ident.lid_equals i j then @@ -3288,7 +3301,7 @@ let build_lattice: env -> FStar_Syntax_Syntax.sigelt -> env = (FStar_Ident.lid_equals e.mtarget j))) in let order1 = let fold_fun order1 k = - let uu____12797 = + let uu____12897 = FStar_All.pipe_right ms (FStar_List.collect (fun i -> @@ -3301,21 +3314,21 @@ let build_lattice: env -> FStar_Syntax_Syntax.sigelt -> env = if FStar_Ident.lid_equals j k then [] else - (let uu____12818 = - let uu____12827 = + (let uu____12918 = + let uu____12927 = find_edge order1 (i, k) in - let uu____12830 = + let uu____12930 = find_edge order1 (k, j) in - (uu____12827, uu____12830) in - match uu____12818 with + (uu____12927, uu____12930) in + match uu____12918 with | (FStar_Pervasives_Native.Some e1,FStar_Pervasives_Native.Some e2) -> - let uu____12845 = + let uu____12945 = compose_edges e1 e2 in - [uu____12845] - | uu____12846 -> []))))) in - FStar_List.append order1 uu____12797 in + [uu____12945] + | uu____12946 -> []))))) in + FStar_List.append order1 uu____12897 in FStar_All.pipe_right ms (FStar_List.fold_left fold_fun order) in let order2 = FStar_Util.remove_dups @@ -3326,26 +3339,26 @@ let build_lattice: env -> FStar_Syntax_Syntax.sigelt -> env = (FStar_All.pipe_right order2 (FStar_List.iter (fun edge1 -> - let uu____12876 = + let uu____12976 = (FStar_Ident.lid_equals edge1.msource FStar_Parser_Const.effect_DIV_lid) && - (let uu____12878 = + (let uu____12978 = lookup_effect_quals env edge1.mtarget in - FStar_All.pipe_right uu____12878 + FStar_All.pipe_right uu____12978 (FStar_List.contains FStar_Syntax_Syntax.TotalEffect)) in - if uu____12876 + if uu____12976 then - let uu____12883 = - let uu____12888 = + let uu____12983 = + let uu____12988 = FStar_Util.format1 "Divergent computations cannot be included in an effect %s marked 'total'" (edge1.mtarget).FStar_Ident.str in (FStar_Errors.Fatal_DivergentComputationCannotBeIncludedInTotal, - uu____12888) in - let uu____12889 = get_range env in - FStar_Errors.raise_error uu____12883 uu____12889 + uu____12988) in + let uu____12989 = get_range env in + FStar_Errors.raise_error uu____12983 uu____12989 else ())); (let joins = FStar_All.pipe_right ms @@ -3364,13 +3377,13 @@ let build_lattice: env -> FStar_Syntax_Syntax.sigelt -> env = (FStar_List.fold_left (fun bopt -> fun k -> - let uu____13014 = - let uu____13023 = + let uu____13114 = + let uu____13123 = find_edge order2 (i, k) in - let uu____13026 = + let uu____13126 = find_edge order2 (j, k) in - (uu____13023, uu____13026) in - match uu____13014 with + (uu____13123, uu____13126) in + match uu____13114 with | (FStar_Pervasives_Native.Some ik,FStar_Pervasives_Native.Some jk) -> @@ -3380,24 +3393,24 @@ let build_lattice: env -> FStar_Syntax_Syntax.sigelt -> env = FStar_Pervasives_Native.Some (k, ik, jk) | FStar_Pervasives_Native.Some - (ub,uu____13068,uu____13069) + (ub,uu____13168,uu____13169) -> - let uu____13076 = - let uu____13081 = - let uu____13082 = + let uu____13176 = + let uu____13181 = + let uu____13182 = find_edge order2 (k, ub) in FStar_Util.is_some - uu____13082 in - let uu____13085 = - let uu____13086 = + uu____13182 in + let uu____13185 = + let uu____13186 = find_edge order2 (ub, k) in FStar_Util.is_some - uu____13086 in - (uu____13081, - uu____13085) in - (match uu____13076 with + uu____13186 in + (uu____13181, + uu____13185) in + (match uu____13176 with | (true ,true ) -> if FStar_Ident.lid_equals @@ -3418,53 +3431,53 @@ let build_lattice: env -> FStar_Syntax_Syntax.sigelt -> env = (k, ik, jk) | (false ,true ) -> bopt)) - | uu____13121 -> bopt) + | uu____13221 -> bopt) FStar_Pervasives_Native.None) in match join_opt with | FStar_Pervasives_Native.None -> [] | FStar_Pervasives_Native.Some (k,e1,e2) -> [(i, j, k, (e1.mlift), (e2.mlift))])))) in let effects = - let uu___94_13194 = env.effects in - { decls = (uu___94_13194.decls); order = order2; joins } in - let uu___95_13195 = env in + let uu___96_13294 = env.effects in + { decls = (uu___96_13294.decls); order = order2; joins } in + let uu___97_13295 = env in { - solver = (uu___95_13195.solver); - range = (uu___95_13195.range); - curmodule = (uu___95_13195.curmodule); - gamma = (uu___95_13195.gamma); - gamma_cache = (uu___95_13195.gamma_cache); - modules = (uu___95_13195.modules); - expected_typ = (uu___95_13195.expected_typ); - sigtab = (uu___95_13195.sigtab); - is_pattern = (uu___95_13195.is_pattern); - instantiate_imp = (uu___95_13195.instantiate_imp); + solver = (uu___97_13295.solver); + range = (uu___97_13295.range); + curmodule = (uu___97_13295.curmodule); + gamma = (uu___97_13295.gamma); + gamma_cache = (uu___97_13295.gamma_cache); + modules = (uu___97_13295.modules); + expected_typ = (uu___97_13295.expected_typ); + sigtab = (uu___97_13295.sigtab); + is_pattern = (uu___97_13295.is_pattern); + instantiate_imp = (uu___97_13295.instantiate_imp); effects; - generalize = (uu___95_13195.generalize); - letrecs = (uu___95_13195.letrecs); - top_level = (uu___95_13195.top_level); - check_uvars = (uu___95_13195.check_uvars); - use_eq = (uu___95_13195.use_eq); - is_iface = (uu___95_13195.is_iface); - admit = (uu___95_13195.admit); - lax = (uu___95_13195.lax); - lax_universes = (uu___95_13195.lax_universes); - failhard = (uu___95_13195.failhard); - nosynth = (uu___95_13195.nosynth); - tc_term = (uu___95_13195.tc_term); - type_of = (uu___95_13195.type_of); - universe_of = (uu___95_13195.universe_of); - use_bv_sorts = (uu___95_13195.use_bv_sorts); - qname_and_index = (uu___95_13195.qname_and_index); - proof_ns = (uu___95_13195.proof_ns); - synth = (uu___95_13195.synth); - is_native_tactic = (uu___95_13195.is_native_tactic); - identifier_info = (uu___95_13195.identifier_info); - tc_hooks = (uu___95_13195.tc_hooks); - dsenv = (uu___95_13195.dsenv); - dep_graph = (uu___95_13195.dep_graph) + generalize = (uu___97_13295.generalize); + letrecs = (uu___97_13295.letrecs); + top_level = (uu___97_13295.top_level); + check_uvars = (uu___97_13295.check_uvars); + use_eq = (uu___97_13295.use_eq); + is_iface = (uu___97_13295.is_iface); + admit = (uu___97_13295.admit); + lax = (uu___97_13295.lax); + lax_universes = (uu___97_13295.lax_universes); + failhard = (uu___97_13295.failhard); + nosynth = (uu___97_13295.nosynth); + tc_term = (uu___97_13295.tc_term); + type_of = (uu___97_13295.type_of); + universe_of = (uu___97_13295.universe_of); + use_bv_sorts = (uu___97_13295.use_bv_sorts); + qname_and_index = (uu___97_13295.qname_and_index); + proof_ns = (uu___97_13295.proof_ns); + synth = (uu___97_13295.synth); + is_native_tactic = (uu___97_13295.is_native_tactic); + identifier_info = (uu___97_13295.identifier_info); + tc_hooks = (uu___97_13295.tc_hooks); + dsenv = (uu___97_13295.dsenv); + dep_graph = (uu___97_13295.dep_graph) })) - | uu____13196 -> env + | uu____13296 -> env let comp_to_comp_typ: env -> FStar_Syntax_Syntax.comp -> FStar_Syntax_Syntax.comp_typ = fun env -> @@ -3477,78 +3490,78 @@ let comp_to_comp_typ: | FStar_Syntax_Syntax.GTotal (t,FStar_Pervasives_Native.None ) -> let u = env.universe_of env t in FStar_Syntax_Syntax.mk_GTotal' t (FStar_Pervasives_Native.Some u) - | uu____13220 -> c in + | uu____13320 -> c in FStar_Syntax_Util.comp_to_comp_typ c1 let rec unfold_effect_abbrev: env -> FStar_Syntax_Syntax.comp -> FStar_Syntax_Syntax.comp_typ = fun env -> fun comp -> let c = comp_to_comp_typ env comp in - let uu____13228 = + let uu____13328 = lookup_effect_abbrev env c.FStar_Syntax_Syntax.comp_univs c.FStar_Syntax_Syntax.effect_name in - match uu____13228 with + match uu____13328 with | FStar_Pervasives_Native.None -> c | FStar_Pervasives_Native.Some (binders,cdef) -> - let uu____13245 = FStar_Syntax_Subst.open_comp binders cdef in - (match uu____13245 with + let uu____13345 = FStar_Syntax_Subst.open_comp binders cdef in + (match uu____13345 with | (binders1,cdef1) -> (if (FStar_List.length binders1) <> ((FStar_List.length c.FStar_Syntax_Syntax.effect_args) + (Prims.parse_int "1")) then - (let uu____13263 = - let uu____13268 = - let uu____13269 = + (let uu____13363 = + let uu____13368 = + let uu____13369 = FStar_Util.string_of_int (FStar_List.length binders1) in - let uu____13274 = + let uu____13374 = FStar_Util.string_of_int ((FStar_List.length c.FStar_Syntax_Syntax.effect_args) + (Prims.parse_int "1")) in - let uu____13281 = - let uu____13282 = FStar_Syntax_Syntax.mk_Comp c in - FStar_Syntax_Print.comp_to_string uu____13282 in + let uu____13381 = + let uu____13382 = FStar_Syntax_Syntax.mk_Comp c in + FStar_Syntax_Print.comp_to_string uu____13382 in FStar_Util.format3 "Effect constructor is not fully applied; expected %s args, got %s args, i.e., %s" - uu____13269 uu____13274 uu____13281 in + uu____13369 uu____13374 uu____13381 in (FStar_Errors.Fatal_ConstructorArgLengthMismatch, - uu____13268) in - FStar_Errors.raise_error uu____13263 + uu____13368) in + FStar_Errors.raise_error uu____13363 comp.FStar_Syntax_Syntax.pos) else (); (let inst1 = - let uu____13287 = - let uu____13296 = + let uu____13387 = + let uu____13396 = FStar_Syntax_Syntax.as_arg c.FStar_Syntax_Syntax.result_typ in - uu____13296 :: (c.FStar_Syntax_Syntax.effect_args) in + uu____13396 :: (c.FStar_Syntax_Syntax.effect_args) in FStar_List.map2 - (fun uu____13313 -> - fun uu____13314 -> - match (uu____13313, uu____13314) with - | ((x,uu____13336),(t,uu____13338)) -> + (fun uu____13413 -> + fun uu____13414 -> + match (uu____13413, uu____13414) with + | ((x,uu____13436),(t,uu____13438)) -> FStar_Syntax_Syntax.NT (x, t)) binders1 - uu____13287 in + uu____13387 in let c1 = FStar_Syntax_Subst.subst_comp inst1 cdef1 in let c2 = - let uu____13357 = - let uu___96_13358 = comp_to_comp_typ env c1 in + let uu____13457 = + let uu___98_13458 = comp_to_comp_typ env c1 in { FStar_Syntax_Syntax.comp_univs = - (uu___96_13358.FStar_Syntax_Syntax.comp_univs); + (uu___98_13458.FStar_Syntax_Syntax.comp_univs); FStar_Syntax_Syntax.effect_name = - (uu___96_13358.FStar_Syntax_Syntax.effect_name); + (uu___98_13458.FStar_Syntax_Syntax.effect_name); FStar_Syntax_Syntax.result_typ = - (uu___96_13358.FStar_Syntax_Syntax.result_typ); + (uu___98_13458.FStar_Syntax_Syntax.result_typ); FStar_Syntax_Syntax.effect_args = - (uu___96_13358.FStar_Syntax_Syntax.effect_args); + (uu___98_13458.FStar_Syntax_Syntax.effect_args); FStar_Syntax_Syntax.flags = (c.FStar_Syntax_Syntax.flags) } in - FStar_All.pipe_right uu____13357 + FStar_All.pipe_right uu____13457 FStar_Syntax_Syntax.mk_Comp in unfold_effect_abbrev env c2))) let effect_repr_aux: @@ -3565,60 +3578,60 @@ let effect_repr_aux: fun u_c -> let effect_name = norm_eff_name env (FStar_Syntax_Util.comp_effect_name c) in - let uu____13380 = effect_decl_opt env effect_name in - match uu____13380 with + let uu____13480 = effect_decl_opt env effect_name in + match uu____13480 with | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None | FStar_Pervasives_Native.Some (ed,qualifiers) -> - let uu____13413 = + let uu____13513 = only_reifiable && - (let uu____13415 = + (let uu____13515 = FStar_All.pipe_right qualifiers (FStar_List.contains FStar_Syntax_Syntax.Reifiable) in - Prims.op_Negation uu____13415) in - if uu____13413 + Prims.op_Negation uu____13515) in + if uu____13513 then FStar_Pervasives_Native.None else (match (ed.FStar_Syntax_Syntax.repr).FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Tm_unknown -> FStar_Pervasives_Native.None - | uu____13431 -> + | uu____13531 -> let c1 = unfold_effect_abbrev env c in let res_typ = c1.FStar_Syntax_Syntax.result_typ in let wp = match c1.FStar_Syntax_Syntax.effect_args with - | hd1::uu____13450 -> hd1 + | hd1::uu____13550 -> hd1 | [] -> let name = FStar_Ident.string_of_lid effect_name in let message = - let uu____13479 = + let uu____13579 = FStar_Util.format1 "Not enough arguments for effect %s. " name in - Prims.strcat uu____13479 + Prims.strcat uu____13579 (Prims.strcat "This usually happens when you use a partially applied DM4F effect, " "like [TAC int] instead of [Tac int].") in - let uu____13480 = get_range env in + let uu____13580 = get_range env in FStar_Errors.raise_error (FStar_Errors.Fatal_NotEnoughArgumentsForEffect, - message) uu____13480 in + message) uu____13580 in let repr = inst_effect_fun_with [u_c] env ed ([], (ed.FStar_Syntax_Syntax.repr)) in - let uu____13490 = - let uu____13493 = get_range env in - let uu____13494 = - let uu____13497 = - let uu____13498 = - let uu____13513 = - let uu____13516 = + let uu____13590 = + let uu____13593 = get_range env in + let uu____13594 = + let uu____13597 = + let uu____13598 = + let uu____13613 = + let uu____13616 = FStar_Syntax_Syntax.as_arg res_typ in - [uu____13516; wp] in - (repr, uu____13513) in - FStar_Syntax_Syntax.Tm_app uu____13498 in - FStar_Syntax_Syntax.mk uu____13497 in - uu____13494 FStar_Pervasives_Native.None uu____13493 in - FStar_Pervasives_Native.Some uu____13490) + [uu____13616; wp] in + (repr, uu____13613) in + FStar_Syntax_Syntax.Tm_app uu____13598 in + FStar_Syntax_Syntax.mk uu____13597 in + uu____13594 FStar_Pervasives_Native.None uu____13593 in + FStar_Pervasives_Native.Some uu____13590) let effect_repr: env -> FStar_Syntax_Syntax.comp -> @@ -3634,15 +3647,15 @@ let reify_comp: fun c -> fun u_c -> let no_reify l = - let uu____13562 = - let uu____13567 = - let uu____13568 = FStar_Ident.string_of_lid l in - FStar_Util.format1 "Effect %s cannot be reified" uu____13568 in - (FStar_Errors.Fatal_EffectCannotBeReified, uu____13567) in - let uu____13569 = get_range env in - FStar_Errors.raise_error uu____13562 uu____13569 in - let uu____13570 = effect_repr_aux true env c u_c in - match uu____13570 with + let uu____13662 = + let uu____13667 = + let uu____13668 = FStar_Ident.string_of_lid l in + FStar_Util.format1 "Effect %s cannot be reified" uu____13668 in + (FStar_Errors.Fatal_EffectCannotBeReified, uu____13667) in + let uu____13669 = get_range env in + FStar_Errors.raise_error uu____13662 uu____13669 in + let uu____13670 = effect_repr_aux true env c u_c in + match uu____13670 with | FStar_Pervasives_Native.None -> no_reify (FStar_Syntax_Util.comp_effect_name c) | FStar_Pervasives_Native.Some tm -> tm @@ -3660,65 +3673,65 @@ let is_reifiable_comp: env -> FStar_Syntax_Syntax.comp -> Prims.bool = match c.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Comp ct -> is_reifiable_effect env ct.FStar_Syntax_Syntax.effect_name - | uu____13604 -> false + | uu____13704 -> false let is_reifiable_function: env -> FStar_Syntax_Syntax.term -> Prims.bool = fun env -> fun t -> - let uu____13611 = - let uu____13612 = FStar_Syntax_Subst.compress t in - uu____13612.FStar_Syntax_Syntax.n in - match uu____13611 with - | FStar_Syntax_Syntax.Tm_arrow (uu____13615,c) -> + let uu____13711 = + let uu____13712 = FStar_Syntax_Subst.compress t in + uu____13712.FStar_Syntax_Syntax.n in + match uu____13711 with + | FStar_Syntax_Syntax.Tm_arrow (uu____13715,c) -> is_reifiable_comp env c - | uu____13633 -> false + | uu____13733 -> false let push_in_gamma: env -> binding -> env = fun env -> fun s -> let rec push1 x rest = match rest with - | (Binding_sig uu____13655)::uu____13656 -> x :: rest - | (Binding_sig_inst uu____13665)::uu____13666 -> x :: rest + | (Binding_sig uu____13755)::uu____13756 -> x :: rest + | (Binding_sig_inst uu____13765)::uu____13766 -> x :: rest | [] -> [x] | local::rest1 -> - let uu____13681 = push1 x rest1 in local :: uu____13681 in + let uu____13781 = push1 x rest1 in local :: uu____13781 in (env.tc_hooks).tc_push_in_gamma_hook env s; - (let uu___97_13685 = env in - let uu____13686 = push1 s env.gamma in + (let uu___99_13785 = env in + let uu____13786 = push1 s env.gamma in { - solver = (uu___97_13685.solver); - range = (uu___97_13685.range); - curmodule = (uu___97_13685.curmodule); - gamma = uu____13686; - gamma_cache = (uu___97_13685.gamma_cache); - modules = (uu___97_13685.modules); - expected_typ = (uu___97_13685.expected_typ); - sigtab = (uu___97_13685.sigtab); - is_pattern = (uu___97_13685.is_pattern); - instantiate_imp = (uu___97_13685.instantiate_imp); - effects = (uu___97_13685.effects); - generalize = (uu___97_13685.generalize); - letrecs = (uu___97_13685.letrecs); - top_level = (uu___97_13685.top_level); - check_uvars = (uu___97_13685.check_uvars); - use_eq = (uu___97_13685.use_eq); - is_iface = (uu___97_13685.is_iface); - admit = (uu___97_13685.admit); - lax = (uu___97_13685.lax); - lax_universes = (uu___97_13685.lax_universes); - failhard = (uu___97_13685.failhard); - nosynth = (uu___97_13685.nosynth); - tc_term = (uu___97_13685.tc_term); - type_of = (uu___97_13685.type_of); - universe_of = (uu___97_13685.universe_of); - use_bv_sorts = (uu___97_13685.use_bv_sorts); - qname_and_index = (uu___97_13685.qname_and_index); - proof_ns = (uu___97_13685.proof_ns); - synth = (uu___97_13685.synth); - is_native_tactic = (uu___97_13685.is_native_tactic); - identifier_info = (uu___97_13685.identifier_info); - tc_hooks = (uu___97_13685.tc_hooks); - dsenv = (uu___97_13685.dsenv); - dep_graph = (uu___97_13685.dep_graph) + solver = (uu___99_13785.solver); + range = (uu___99_13785.range); + curmodule = (uu___99_13785.curmodule); + gamma = uu____13786; + gamma_cache = (uu___99_13785.gamma_cache); + modules = (uu___99_13785.modules); + expected_typ = (uu___99_13785.expected_typ); + sigtab = (uu___99_13785.sigtab); + is_pattern = (uu___99_13785.is_pattern); + instantiate_imp = (uu___99_13785.instantiate_imp); + effects = (uu___99_13785.effects); + generalize = (uu___99_13785.generalize); + letrecs = (uu___99_13785.letrecs); + top_level = (uu___99_13785.top_level); + check_uvars = (uu___99_13785.check_uvars); + use_eq = (uu___99_13785.use_eq); + is_iface = (uu___99_13785.is_iface); + admit = (uu___99_13785.admit); + lax = (uu___99_13785.lax); + lax_universes = (uu___99_13785.lax_universes); + failhard = (uu___99_13785.failhard); + nosynth = (uu___99_13785.nosynth); + tc_term = (uu___99_13785.tc_term); + type_of = (uu___99_13785.type_of); + universe_of = (uu___99_13785.universe_of); + use_bv_sorts = (uu___99_13785.use_bv_sorts); + qname_and_index = (uu___99_13785.qname_and_index); + proof_ns = (uu___99_13785.proof_ns); + synth = (uu___99_13785.synth); + is_native_tactic = (uu___99_13785.is_native_tactic); + identifier_info = (uu___99_13785.identifier_info); + tc_hooks = (uu___99_13785.tc_hooks); + dsenv = (uu___99_13785.dsenv); + dep_graph = (uu___99_13785.dep_graph) }) let push_sigelt: env -> FStar_Syntax_Syntax.sigelt -> env = fun env -> @@ -3739,42 +3752,42 @@ let push_sigelt_inst: let push_local_binding: env -> binding -> env = fun env -> fun b -> - let uu___98_13716 = env in + let uu___100_13816 = env in { - solver = (uu___98_13716.solver); - range = (uu___98_13716.range); - curmodule = (uu___98_13716.curmodule); + solver = (uu___100_13816.solver); + range = (uu___100_13816.range); + curmodule = (uu___100_13816.curmodule); gamma = (b :: (env.gamma)); - gamma_cache = (uu___98_13716.gamma_cache); - modules = (uu___98_13716.modules); - expected_typ = (uu___98_13716.expected_typ); - sigtab = (uu___98_13716.sigtab); - is_pattern = (uu___98_13716.is_pattern); - instantiate_imp = (uu___98_13716.instantiate_imp); - effects = (uu___98_13716.effects); - generalize = (uu___98_13716.generalize); - letrecs = (uu___98_13716.letrecs); - top_level = (uu___98_13716.top_level); - check_uvars = (uu___98_13716.check_uvars); - use_eq = (uu___98_13716.use_eq); - is_iface = (uu___98_13716.is_iface); - admit = (uu___98_13716.admit); - lax = (uu___98_13716.lax); - lax_universes = (uu___98_13716.lax_universes); - failhard = (uu___98_13716.failhard); - nosynth = (uu___98_13716.nosynth); - tc_term = (uu___98_13716.tc_term); - type_of = (uu___98_13716.type_of); - universe_of = (uu___98_13716.universe_of); - use_bv_sorts = (uu___98_13716.use_bv_sorts); - qname_and_index = (uu___98_13716.qname_and_index); - proof_ns = (uu___98_13716.proof_ns); - synth = (uu___98_13716.synth); - is_native_tactic = (uu___98_13716.is_native_tactic); - identifier_info = (uu___98_13716.identifier_info); - tc_hooks = (uu___98_13716.tc_hooks); - dsenv = (uu___98_13716.dsenv); - dep_graph = (uu___98_13716.dep_graph) + gamma_cache = (uu___100_13816.gamma_cache); + modules = (uu___100_13816.modules); + expected_typ = (uu___100_13816.expected_typ); + sigtab = (uu___100_13816.sigtab); + is_pattern = (uu___100_13816.is_pattern); + instantiate_imp = (uu___100_13816.instantiate_imp); + effects = (uu___100_13816.effects); + generalize = (uu___100_13816.generalize); + letrecs = (uu___100_13816.letrecs); + top_level = (uu___100_13816.top_level); + check_uvars = (uu___100_13816.check_uvars); + use_eq = (uu___100_13816.use_eq); + is_iface = (uu___100_13816.is_iface); + admit = (uu___100_13816.admit); + lax = (uu___100_13816.lax); + lax_universes = (uu___100_13816.lax_universes); + failhard = (uu___100_13816.failhard); + nosynth = (uu___100_13816.nosynth); + tc_term = (uu___100_13816.tc_term); + type_of = (uu___100_13816.type_of); + universe_of = (uu___100_13816.universe_of); + use_bv_sorts = (uu___100_13816.use_bv_sorts); + qname_and_index = (uu___100_13816.qname_and_index); + proof_ns = (uu___100_13816.proof_ns); + synth = (uu___100_13816.synth); + is_native_tactic = (uu___100_13816.is_native_tactic); + identifier_info = (uu___100_13816.identifier_info); + tc_hooks = (uu___100_13816.tc_hooks); + dsenv = (uu___100_13816.dsenv); + dep_graph = (uu___100_13816.dep_graph) } let push_bv: env -> FStar_Syntax_Syntax.bv -> env = fun env -> fun x -> push_local_binding env (Binding_var x) @@ -3788,51 +3801,51 @@ let pop_bv: | (Binding_var x)::rest -> FStar_Pervasives_Native.Some (x, - (let uu___99_13747 = env in + (let uu___101_13847 = env in { - solver = (uu___99_13747.solver); - range = (uu___99_13747.range); - curmodule = (uu___99_13747.curmodule); + solver = (uu___101_13847.solver); + range = (uu___101_13847.range); + curmodule = (uu___101_13847.curmodule); gamma = rest; - gamma_cache = (uu___99_13747.gamma_cache); - modules = (uu___99_13747.modules); - expected_typ = (uu___99_13747.expected_typ); - sigtab = (uu___99_13747.sigtab); - is_pattern = (uu___99_13747.is_pattern); - instantiate_imp = (uu___99_13747.instantiate_imp); - effects = (uu___99_13747.effects); - generalize = (uu___99_13747.generalize); - letrecs = (uu___99_13747.letrecs); - top_level = (uu___99_13747.top_level); - check_uvars = (uu___99_13747.check_uvars); - use_eq = (uu___99_13747.use_eq); - is_iface = (uu___99_13747.is_iface); - admit = (uu___99_13747.admit); - lax = (uu___99_13747.lax); - lax_universes = (uu___99_13747.lax_universes); - failhard = (uu___99_13747.failhard); - nosynth = (uu___99_13747.nosynth); - tc_term = (uu___99_13747.tc_term); - type_of = (uu___99_13747.type_of); - universe_of = (uu___99_13747.universe_of); - use_bv_sorts = (uu___99_13747.use_bv_sorts); - qname_and_index = (uu___99_13747.qname_and_index); - proof_ns = (uu___99_13747.proof_ns); - synth = (uu___99_13747.synth); - is_native_tactic = (uu___99_13747.is_native_tactic); - identifier_info = (uu___99_13747.identifier_info); - tc_hooks = (uu___99_13747.tc_hooks); - dsenv = (uu___99_13747.dsenv); - dep_graph = (uu___99_13747.dep_graph) + gamma_cache = (uu___101_13847.gamma_cache); + modules = (uu___101_13847.modules); + expected_typ = (uu___101_13847.expected_typ); + sigtab = (uu___101_13847.sigtab); + is_pattern = (uu___101_13847.is_pattern); + instantiate_imp = (uu___101_13847.instantiate_imp); + effects = (uu___101_13847.effects); + generalize = (uu___101_13847.generalize); + letrecs = (uu___101_13847.letrecs); + top_level = (uu___101_13847.top_level); + check_uvars = (uu___101_13847.check_uvars); + use_eq = (uu___101_13847.use_eq); + is_iface = (uu___101_13847.is_iface); + admit = (uu___101_13847.admit); + lax = (uu___101_13847.lax); + lax_universes = (uu___101_13847.lax_universes); + failhard = (uu___101_13847.failhard); + nosynth = (uu___101_13847.nosynth); + tc_term = (uu___101_13847.tc_term); + type_of = (uu___101_13847.type_of); + universe_of = (uu___101_13847.universe_of); + use_bv_sorts = (uu___101_13847.use_bv_sorts); + qname_and_index = (uu___101_13847.qname_and_index); + proof_ns = (uu___101_13847.proof_ns); + synth = (uu___101_13847.synth); + is_native_tactic = (uu___101_13847.is_native_tactic); + identifier_info = (uu___101_13847.identifier_info); + tc_hooks = (uu___101_13847.tc_hooks); + dsenv = (uu___101_13847.dsenv); + dep_graph = (uu___101_13847.dep_graph) })) - | uu____13748 -> FStar_Pervasives_Native.None + | uu____13848 -> FStar_Pervasives_Native.None let push_binders: env -> FStar_Syntax_Syntax.binders -> env = fun env -> fun bs -> FStar_List.fold_left (fun env1 -> - fun uu____13770 -> - match uu____13770 with | (x,uu____13776) -> push_bv env1 x) env + fun uu____13870 -> + match uu____13870 with | (x,uu____13876) -> push_bv env1 x) env bs let binding_of_lb: FStar_Syntax_Syntax.lbname -> @@ -3845,12 +3858,12 @@ let binding_of_lb: match x with | FStar_Util.Inl x1 -> let x2 = - let uu___100_13804 = x1 in + let uu___102_13904 = x1 in { FStar_Syntax_Syntax.ppname = - (uu___100_13804.FStar_Syntax_Syntax.ppname); + (uu___102_13904.FStar_Syntax_Syntax.ppname); FStar_Syntax_Syntax.index = - (uu___100_13804.FStar_Syntax_Syntax.index); + (uu___102_13904.FStar_Syntax_Syntax.index); FStar_Syntax_Syntax.sort = (FStar_Pervasives_Native.snd t) } in Binding_var x2 @@ -3865,42 +3878,42 @@ let push_module: env -> FStar_Syntax_Syntax.modul -> env = fun env -> fun m -> add_sigelts env m.FStar_Syntax_Syntax.exports; - (let uu___101_13834 = env in + (let uu___103_13934 = env in { - solver = (uu___101_13834.solver); - range = (uu___101_13834.range); - curmodule = (uu___101_13834.curmodule); + solver = (uu___103_13934.solver); + range = (uu___103_13934.range); + curmodule = (uu___103_13934.curmodule); gamma = []; - gamma_cache = (uu___101_13834.gamma_cache); + gamma_cache = (uu___103_13934.gamma_cache); modules = (m :: (env.modules)); expected_typ = FStar_Pervasives_Native.None; - sigtab = (uu___101_13834.sigtab); - is_pattern = (uu___101_13834.is_pattern); - instantiate_imp = (uu___101_13834.instantiate_imp); - effects = (uu___101_13834.effects); - generalize = (uu___101_13834.generalize); - letrecs = (uu___101_13834.letrecs); - top_level = (uu___101_13834.top_level); - check_uvars = (uu___101_13834.check_uvars); - use_eq = (uu___101_13834.use_eq); - is_iface = (uu___101_13834.is_iface); - admit = (uu___101_13834.admit); - lax = (uu___101_13834.lax); - lax_universes = (uu___101_13834.lax_universes); - failhard = (uu___101_13834.failhard); - nosynth = (uu___101_13834.nosynth); - tc_term = (uu___101_13834.tc_term); - type_of = (uu___101_13834.type_of); - universe_of = (uu___101_13834.universe_of); - use_bv_sorts = (uu___101_13834.use_bv_sorts); - qname_and_index = (uu___101_13834.qname_and_index); - proof_ns = (uu___101_13834.proof_ns); - synth = (uu___101_13834.synth); - is_native_tactic = (uu___101_13834.is_native_tactic); - identifier_info = (uu___101_13834.identifier_info); - tc_hooks = (uu___101_13834.tc_hooks); - dsenv = (uu___101_13834.dsenv); - dep_graph = (uu___101_13834.dep_graph) + sigtab = (uu___103_13934.sigtab); + is_pattern = (uu___103_13934.is_pattern); + instantiate_imp = (uu___103_13934.instantiate_imp); + effects = (uu___103_13934.effects); + generalize = (uu___103_13934.generalize); + letrecs = (uu___103_13934.letrecs); + top_level = (uu___103_13934.top_level); + check_uvars = (uu___103_13934.check_uvars); + use_eq = (uu___103_13934.use_eq); + is_iface = (uu___103_13934.is_iface); + admit = (uu___103_13934.admit); + lax = (uu___103_13934.lax); + lax_universes = (uu___103_13934.lax_universes); + failhard = (uu___103_13934.failhard); + nosynth = (uu___103_13934.nosynth); + tc_term = (uu___103_13934.tc_term); + type_of = (uu___103_13934.type_of); + universe_of = (uu___103_13934.universe_of); + use_bv_sorts = (uu___103_13934.use_bv_sorts); + qname_and_index = (uu___103_13934.qname_and_index); + proof_ns = (uu___103_13934.proof_ns); + synth = (uu___103_13934.synth); + is_native_tactic = (uu___103_13934.is_native_tactic); + identifier_info = (uu___103_13934.identifier_info); + tc_hooks = (uu___103_13934.tc_hooks); + dsenv = (uu___103_13934.dsenv); + dep_graph = (uu___103_13934.dep_graph) }) let push_univ_vars: env -> FStar_Syntax_Syntax.univ_names -> env = fun env -> @@ -3919,52 +3932,52 @@ let open_universes_in: fun env -> fun uvs -> fun terms -> - let uu____13866 = FStar_Syntax_Subst.univ_var_opening uvs in - match uu____13866 with + let uu____13966 = FStar_Syntax_Subst.univ_var_opening uvs in + match uu____13966 with | (univ_subst,univ_vars) -> let env' = push_univ_vars env univ_vars in - let uu____13894 = + let uu____13994 = FStar_List.map (FStar_Syntax_Subst.subst univ_subst) terms in - (env', univ_vars, uu____13894) + (env', univ_vars, uu____13994) let set_expected_typ: env -> FStar_Syntax_Syntax.typ -> env = fun env -> fun t -> - let uu___102_13907 = env in + let uu___104_14007 = env in { - solver = (uu___102_13907.solver); - range = (uu___102_13907.range); - curmodule = (uu___102_13907.curmodule); - gamma = (uu___102_13907.gamma); - gamma_cache = (uu___102_13907.gamma_cache); - modules = (uu___102_13907.modules); + solver = (uu___104_14007.solver); + range = (uu___104_14007.range); + curmodule = (uu___104_14007.curmodule); + gamma = (uu___104_14007.gamma); + gamma_cache = (uu___104_14007.gamma_cache); + modules = (uu___104_14007.modules); expected_typ = (FStar_Pervasives_Native.Some t); - sigtab = (uu___102_13907.sigtab); - is_pattern = (uu___102_13907.is_pattern); - instantiate_imp = (uu___102_13907.instantiate_imp); - effects = (uu___102_13907.effects); - generalize = (uu___102_13907.generalize); - letrecs = (uu___102_13907.letrecs); - top_level = (uu___102_13907.top_level); - check_uvars = (uu___102_13907.check_uvars); + sigtab = (uu___104_14007.sigtab); + is_pattern = (uu___104_14007.is_pattern); + instantiate_imp = (uu___104_14007.instantiate_imp); + effects = (uu___104_14007.effects); + generalize = (uu___104_14007.generalize); + letrecs = (uu___104_14007.letrecs); + top_level = (uu___104_14007.top_level); + check_uvars = (uu___104_14007.check_uvars); use_eq = false; - is_iface = (uu___102_13907.is_iface); - admit = (uu___102_13907.admit); - lax = (uu___102_13907.lax); - lax_universes = (uu___102_13907.lax_universes); - failhard = (uu___102_13907.failhard); - nosynth = (uu___102_13907.nosynth); - tc_term = (uu___102_13907.tc_term); - type_of = (uu___102_13907.type_of); - universe_of = (uu___102_13907.universe_of); - use_bv_sorts = (uu___102_13907.use_bv_sorts); - qname_and_index = (uu___102_13907.qname_and_index); - proof_ns = (uu___102_13907.proof_ns); - synth = (uu___102_13907.synth); - is_native_tactic = (uu___102_13907.is_native_tactic); - identifier_info = (uu___102_13907.identifier_info); - tc_hooks = (uu___102_13907.tc_hooks); - dsenv = (uu___102_13907.dsenv); - dep_graph = (uu___102_13907.dep_graph) + is_iface = (uu___104_14007.is_iface); + admit = (uu___104_14007.admit); + lax = (uu___104_14007.lax); + lax_universes = (uu___104_14007.lax_universes); + failhard = (uu___104_14007.failhard); + nosynth = (uu___104_14007.nosynth); + tc_term = (uu___104_14007.tc_term); + type_of = (uu___104_14007.type_of); + universe_of = (uu___104_14007.universe_of); + use_bv_sorts = (uu___104_14007.use_bv_sorts); + qname_and_index = (uu___104_14007.qname_and_index); + proof_ns = (uu___104_14007.proof_ns); + synth = (uu___104_14007.synth); + is_native_tactic = (uu___104_14007.is_native_tactic); + identifier_info = (uu___104_14007.identifier_info); + tc_hooks = (uu___104_14007.tc_hooks); + dsenv = (uu___104_14007.dsenv); + dep_graph = (uu___104_14007.dep_graph) } let expected_typ: env -> FStar_Syntax_Syntax.typ FStar_Pervasives_Native.option = @@ -3978,44 +3991,44 @@ let clear_expected_typ: FStar_Pervasives_Native.tuple2 = fun env_ -> - let uu____13931 = expected_typ env_ in - ((let uu___103_13937 = env_ in + let uu____14031 = expected_typ env_ in + ((let uu___105_14037 = env_ in { - solver = (uu___103_13937.solver); - range = (uu___103_13937.range); - curmodule = (uu___103_13937.curmodule); - gamma = (uu___103_13937.gamma); - gamma_cache = (uu___103_13937.gamma_cache); - modules = (uu___103_13937.modules); + solver = (uu___105_14037.solver); + range = (uu___105_14037.range); + curmodule = (uu___105_14037.curmodule); + gamma = (uu___105_14037.gamma); + gamma_cache = (uu___105_14037.gamma_cache); + modules = (uu___105_14037.modules); expected_typ = FStar_Pervasives_Native.None; - sigtab = (uu___103_13937.sigtab); - is_pattern = (uu___103_13937.is_pattern); - instantiate_imp = (uu___103_13937.instantiate_imp); - effects = (uu___103_13937.effects); - generalize = (uu___103_13937.generalize); - letrecs = (uu___103_13937.letrecs); - top_level = (uu___103_13937.top_level); - check_uvars = (uu___103_13937.check_uvars); + sigtab = (uu___105_14037.sigtab); + is_pattern = (uu___105_14037.is_pattern); + instantiate_imp = (uu___105_14037.instantiate_imp); + effects = (uu___105_14037.effects); + generalize = (uu___105_14037.generalize); + letrecs = (uu___105_14037.letrecs); + top_level = (uu___105_14037.top_level); + check_uvars = (uu___105_14037.check_uvars); use_eq = false; - is_iface = (uu___103_13937.is_iface); - admit = (uu___103_13937.admit); - lax = (uu___103_13937.lax); - lax_universes = (uu___103_13937.lax_universes); - failhard = (uu___103_13937.failhard); - nosynth = (uu___103_13937.nosynth); - tc_term = (uu___103_13937.tc_term); - type_of = (uu___103_13937.type_of); - universe_of = (uu___103_13937.universe_of); - use_bv_sorts = (uu___103_13937.use_bv_sorts); - qname_and_index = (uu___103_13937.qname_and_index); - proof_ns = (uu___103_13937.proof_ns); - synth = (uu___103_13937.synth); - is_native_tactic = (uu___103_13937.is_native_tactic); - identifier_info = (uu___103_13937.identifier_info); - tc_hooks = (uu___103_13937.tc_hooks); - dsenv = (uu___103_13937.dsenv); - dep_graph = (uu___103_13937.dep_graph) - }), uu____13931) + is_iface = (uu___105_14037.is_iface); + admit = (uu___105_14037.admit); + lax = (uu___105_14037.lax); + lax_universes = (uu___105_14037.lax_universes); + failhard = (uu___105_14037.failhard); + nosynth = (uu___105_14037.nosynth); + tc_term = (uu___105_14037.tc_term); + type_of = (uu___105_14037.type_of); + universe_of = (uu___105_14037.universe_of); + use_bv_sorts = (uu___105_14037.use_bv_sorts); + qname_and_index = (uu___105_14037.qname_and_index); + proof_ns = (uu___105_14037.proof_ns); + synth = (uu___105_14037.synth); + is_native_tactic = (uu___105_14037.is_native_tactic); + identifier_info = (uu___105_14037.identifier_info); + tc_hooks = (uu___105_14037.tc_hooks); + dsenv = (uu___105_14037.dsenv); + dep_graph = (uu___105_14037.dep_graph) + }), uu____14031) let finish_module: env -> FStar_Syntax_Syntax.modul -> env = let empty_lid = FStar_Ident.lid_of_ids [FStar_Ident.id_of_text ""] in fun env -> @@ -4025,52 +4038,52 @@ let finish_module: env -> FStar_Syntax_Syntax.modul -> env = FStar_Ident.lid_equals m.FStar_Syntax_Syntax.name FStar_Parser_Const.prims_lid then - let uu____13950 = + let uu____14050 = FStar_All.pipe_right env.gamma (FStar_List.collect - (fun uu___77_13960 -> - match uu___77_13960 with - | Binding_sig (uu____13963,se) -> [se] - | uu____13969 -> [])) in - FStar_All.pipe_right uu____13950 FStar_List.rev + (fun uu___79_14060 -> + match uu___79_14060 with + | Binding_sig (uu____14063,se) -> [se] + | uu____14069 -> [])) in + FStar_All.pipe_right uu____14050 FStar_List.rev else m.FStar_Syntax_Syntax.exports in add_sigelts env sigs; - (let uu___104_13976 = env in + (let uu___106_14076 = env in { - solver = (uu___104_13976.solver); - range = (uu___104_13976.range); + solver = (uu___106_14076.solver); + range = (uu___106_14076.range); curmodule = empty_lid; gamma = []; - gamma_cache = (uu___104_13976.gamma_cache); + gamma_cache = (uu___106_14076.gamma_cache); modules = (m :: (env.modules)); - expected_typ = (uu___104_13976.expected_typ); - sigtab = (uu___104_13976.sigtab); - is_pattern = (uu___104_13976.is_pattern); - instantiate_imp = (uu___104_13976.instantiate_imp); - effects = (uu___104_13976.effects); - generalize = (uu___104_13976.generalize); - letrecs = (uu___104_13976.letrecs); - top_level = (uu___104_13976.top_level); - check_uvars = (uu___104_13976.check_uvars); - use_eq = (uu___104_13976.use_eq); - is_iface = (uu___104_13976.is_iface); - admit = (uu___104_13976.admit); - lax = (uu___104_13976.lax); - lax_universes = (uu___104_13976.lax_universes); - failhard = (uu___104_13976.failhard); - nosynth = (uu___104_13976.nosynth); - tc_term = (uu___104_13976.tc_term); - type_of = (uu___104_13976.type_of); - universe_of = (uu___104_13976.universe_of); - use_bv_sorts = (uu___104_13976.use_bv_sorts); - qname_and_index = (uu___104_13976.qname_and_index); - proof_ns = (uu___104_13976.proof_ns); - synth = (uu___104_13976.synth); - is_native_tactic = (uu___104_13976.is_native_tactic); - identifier_info = (uu___104_13976.identifier_info); - tc_hooks = (uu___104_13976.tc_hooks); - dsenv = (uu___104_13976.dsenv); - dep_graph = (uu___104_13976.dep_graph) + expected_typ = (uu___106_14076.expected_typ); + sigtab = (uu___106_14076.sigtab); + is_pattern = (uu___106_14076.is_pattern); + instantiate_imp = (uu___106_14076.instantiate_imp); + effects = (uu___106_14076.effects); + generalize = (uu___106_14076.generalize); + letrecs = (uu___106_14076.letrecs); + top_level = (uu___106_14076.top_level); + check_uvars = (uu___106_14076.check_uvars); + use_eq = (uu___106_14076.use_eq); + is_iface = (uu___106_14076.is_iface); + admit = (uu___106_14076.admit); + lax = (uu___106_14076.lax); + lax_universes = (uu___106_14076.lax_universes); + failhard = (uu___106_14076.failhard); + nosynth = (uu___106_14076.nosynth); + tc_term = (uu___106_14076.tc_term); + type_of = (uu___106_14076.type_of); + universe_of = (uu___106_14076.universe_of); + use_bv_sorts = (uu___106_14076.use_bv_sorts); + qname_and_index = (uu___106_14076.qname_and_index); + proof_ns = (uu___106_14076.proof_ns); + synth = (uu___106_14076.synth); + is_native_tactic = (uu___106_14076.is_native_tactic); + identifier_info = (uu___106_14076.identifier_info); + tc_hooks = (uu___106_14076.tc_hooks); + dsenv = (uu___106_14076.dsenv); + dep_graph = (uu___106_14076.dep_graph) }) let uvars_in_env: env -> FStar_Syntax_Syntax.uvars = fun env -> @@ -4079,23 +4092,23 @@ let uvars_in_env: env -> FStar_Syntax_Syntax.uvars = let rec aux out g = match g with | [] -> out - | (Binding_univ uu____14057)::tl1 -> aux out tl1 - | (Binding_lid (uu____14061,(uu____14062,t)))::tl1 -> - let uu____14077 = - let uu____14084 = FStar_Syntax_Free.uvars t in - ext out uu____14084 in - aux uu____14077 tl1 + | (Binding_univ uu____14157)::tl1 -> aux out tl1 + | (Binding_lid (uu____14161,(uu____14162,t)))::tl1 -> + let uu____14177 = + let uu____14184 = FStar_Syntax_Free.uvars t in + ext out uu____14184 in + aux uu____14177 tl1 | (Binding_var - { FStar_Syntax_Syntax.ppname = uu____14091; - FStar_Syntax_Syntax.index = uu____14092; + { FStar_Syntax_Syntax.ppname = uu____14191; + FStar_Syntax_Syntax.index = uu____14192; FStar_Syntax_Syntax.sort = t;_})::tl1 -> - let uu____14099 = - let uu____14106 = FStar_Syntax_Free.uvars t in - ext out uu____14106 in - aux uu____14099 tl1 - | (Binding_sig uu____14113)::uu____14114 -> out - | (Binding_sig_inst uu____14123)::uu____14124 -> out in + let uu____14199 = + let uu____14206 = FStar_Syntax_Free.uvars t in + ext out uu____14206 in + aux uu____14199 tl1 + | (Binding_sig uu____14213)::uu____14214 -> out + | (Binding_sig_inst uu____14223)::uu____14224 -> out in aux no_uvs env.gamma let univ_vars: env -> FStar_Syntax_Syntax.universe_uvar FStar_Util.set = fun env -> @@ -4104,23 +4117,23 @@ let univ_vars: env -> FStar_Syntax_Syntax.universe_uvar FStar_Util.set = let rec aux out g = match g with | [] -> out - | (Binding_sig_inst uu____14179)::tl1 -> aux out tl1 - | (Binding_univ uu____14191)::tl1 -> aux out tl1 - | (Binding_lid (uu____14195,(uu____14196,t)))::tl1 -> - let uu____14211 = - let uu____14214 = FStar_Syntax_Free.univs t in - ext out uu____14214 in - aux uu____14211 tl1 + | (Binding_sig_inst uu____14279)::tl1 -> aux out tl1 + | (Binding_univ uu____14291)::tl1 -> aux out tl1 + | (Binding_lid (uu____14295,(uu____14296,t)))::tl1 -> + let uu____14311 = + let uu____14314 = FStar_Syntax_Free.univs t in + ext out uu____14314 in + aux uu____14311 tl1 | (Binding_var - { FStar_Syntax_Syntax.ppname = uu____14217; - FStar_Syntax_Syntax.index = uu____14218; + { FStar_Syntax_Syntax.ppname = uu____14317; + FStar_Syntax_Syntax.index = uu____14318; FStar_Syntax_Syntax.sort = t;_})::tl1 -> - let uu____14225 = - let uu____14228 = FStar_Syntax_Free.univs t in - ext out uu____14228 in - aux uu____14225 tl1 - | (Binding_sig uu____14231)::uu____14232 -> out in + let uu____14325 = + let uu____14328 = FStar_Syntax_Free.univs t in + ext out uu____14328 in + aux uu____14325 tl1 + | (Binding_sig uu____14331)::uu____14332 -> out in aux no_univs env.gamma let univnames: env -> FStar_Syntax_Syntax.univ_name FStar_Util.fifo_set = fun env -> @@ -4129,98 +4142,98 @@ let univnames: env -> FStar_Syntax_Syntax.univ_name FStar_Util.fifo_set = let rec aux out g = match g with | [] -> out - | (Binding_sig_inst uu____14285)::tl1 -> aux out tl1 + | (Binding_sig_inst uu____14385)::tl1 -> aux out tl1 | (Binding_univ uname)::tl1 -> - let uu____14301 = FStar_Util.fifo_set_add uname out in - aux uu____14301 tl1 - | (Binding_lid (uu____14304,(uu____14305,t)))::tl1 -> - let uu____14320 = - let uu____14323 = FStar_Syntax_Free.univnames t in - ext out uu____14323 in - aux uu____14320 tl1 + let uu____14401 = FStar_Util.fifo_set_add uname out in + aux uu____14401 tl1 + | (Binding_lid (uu____14404,(uu____14405,t)))::tl1 -> + let uu____14420 = + let uu____14423 = FStar_Syntax_Free.univnames t in + ext out uu____14423 in + aux uu____14420 tl1 | (Binding_var - { FStar_Syntax_Syntax.ppname = uu____14326; - FStar_Syntax_Syntax.index = uu____14327; + { FStar_Syntax_Syntax.ppname = uu____14426; + FStar_Syntax_Syntax.index = uu____14427; FStar_Syntax_Syntax.sort = t;_})::tl1 -> - let uu____14334 = - let uu____14337 = FStar_Syntax_Free.univnames t in - ext out uu____14337 in - aux uu____14334 tl1 - | (Binding_sig uu____14340)::uu____14341 -> out in + let uu____14434 = + let uu____14437 = FStar_Syntax_Free.univnames t in + ext out uu____14437 in + aux uu____14434 tl1 + | (Binding_sig uu____14440)::uu____14441 -> out in aux no_univ_names env.gamma let bound_vars_of_bindings: binding Prims.list -> FStar_Syntax_Syntax.bv Prims.list = fun bs -> FStar_All.pipe_right bs (FStar_List.collect - (fun uu___78_14365 -> - match uu___78_14365 with + (fun uu___80_14465 -> + match uu___80_14465 with | Binding_var x -> [x] - | Binding_lid uu____14369 -> [] - | Binding_sig uu____14374 -> [] - | Binding_univ uu____14381 -> [] - | Binding_sig_inst uu____14382 -> [])) + | Binding_lid uu____14469 -> [] + | Binding_sig uu____14474 -> [] + | Binding_univ uu____14481 -> [] + | Binding_sig_inst uu____14482 -> [])) let binders_of_bindings: binding Prims.list -> FStar_Syntax_Syntax.binders = fun bs -> - let uu____14398 = - let uu____14401 = bound_vars_of_bindings bs in - FStar_All.pipe_right uu____14401 + let uu____14498 = + let uu____14501 = bound_vars_of_bindings bs in + FStar_All.pipe_right uu____14501 (FStar_List.map FStar_Syntax_Syntax.mk_binder) in - FStar_All.pipe_right uu____14398 FStar_List.rev + FStar_All.pipe_right uu____14498 FStar_List.rev let bound_vars: env -> FStar_Syntax_Syntax.bv Prims.list = fun env -> bound_vars_of_bindings env.gamma let all_binders: env -> FStar_Syntax_Syntax.binders = fun env -> binders_of_bindings env.gamma let print_gamma: env -> Prims.unit = fun env -> - let uu____14423 = - let uu____14424 = + let uu____14523 = + let uu____14524 = FStar_All.pipe_right env.gamma (FStar_List.map - (fun uu___79_14434 -> - match uu___79_14434 with + (fun uu___81_14534 -> + match uu___81_14534 with | Binding_var x -> - let uu____14436 = FStar_Syntax_Print.bv_to_string x in - Prims.strcat "Binding_var " uu____14436 + let uu____14536 = FStar_Syntax_Print.bv_to_string x in + Prims.strcat "Binding_var " uu____14536 | Binding_univ u -> Prims.strcat "Binding_univ " u.FStar_Ident.idText - | Binding_lid (l,uu____14439) -> - let uu____14440 = FStar_Ident.string_of_lid l in - Prims.strcat "Binding_lid " uu____14440 - | Binding_sig (ls,uu____14442) -> - let uu____14447 = - let uu____14448 = + | Binding_lid (l,uu____14539) -> + let uu____14540 = FStar_Ident.string_of_lid l in + Prims.strcat "Binding_lid " uu____14540 + | Binding_sig (ls,uu____14542) -> + let uu____14547 = + let uu____14548 = FStar_All.pipe_right ls (FStar_List.map FStar_Ident.string_of_lid) in - FStar_All.pipe_right uu____14448 + FStar_All.pipe_right uu____14548 (FStar_String.concat ", ") in - Prims.strcat "Binding_sig " uu____14447 - | Binding_sig_inst (ls,uu____14458,uu____14459) -> - let uu____14464 = - let uu____14465 = + Prims.strcat "Binding_sig " uu____14547 + | Binding_sig_inst (ls,uu____14558,uu____14559) -> + let uu____14564 = + let uu____14565 = FStar_All.pipe_right ls (FStar_List.map FStar_Ident.string_of_lid) in - FStar_All.pipe_right uu____14465 + FStar_All.pipe_right uu____14565 (FStar_String.concat ", ") in - Prims.strcat "Binding_sig_inst " uu____14464)) in - FStar_All.pipe_right uu____14424 (FStar_String.concat "::\n") in - FStar_All.pipe_right uu____14423 (FStar_Util.print1 "%s\n") + Prims.strcat "Binding_sig_inst " uu____14564)) in + FStar_All.pipe_right uu____14524 (FStar_String.concat "::\n") in + FStar_All.pipe_right uu____14523 (FStar_Util.print1 "%s\n") let eq_gamma: env -> env -> Prims.bool = fun env -> fun env' -> - let uu____14482 = FStar_Util.physical_equality env.gamma env'.gamma in - if uu____14482 + let uu____14582 = FStar_Util.physical_equality env.gamma env'.gamma in + if uu____14582 then true else (let g = all_binders env in let g' = all_binders env' in ((FStar_List.length g) = (FStar_List.length g')) && (FStar_List.forall2 - (fun uu____14510 -> - fun uu____14511 -> - match (uu____14510, uu____14511) with - | ((b1,uu____14529),(b2,uu____14531)) -> + (fun uu____14610 -> + fun uu____14611 -> + match (uu____14610, uu____14611) with + | ((b1,uu____14629),(b2,uu____14631)) -> FStar_Syntax_Syntax.bv_eq b1 b2) g g')) let fold_env: 'a . env -> ('a -> binding -> 'a) -> 'a -> 'a = fun env -> @@ -4228,24 +4241,24 @@ let fold_env: 'a . env -> ('a -> binding -> 'a) -> 'a -> 'a = fun a -> FStar_List.fold_right (fun e -> fun a1 -> f a1 e) env.gamma a let string_of_delta_level: delta_level -> Prims.string = - fun uu___80_14573 -> - match uu___80_14573 with + fun uu___82_14673 -> + match uu___82_14673 with | NoDelta -> "NoDelta" | Inlining -> "Inlining" | Eager_unfolding_only -> "Eager_unfolding_only" - | Unfold uu____14574 -> "Unfold _" + | Unfold uu____14674 -> "Unfold _" | UnfoldTac -> "UnfoldTac" let lidents: env -> FStar_Ident.lident Prims.list = fun env -> let keys = FStar_List.fold_left (fun keys -> - fun uu___81_14592 -> - match uu___81_14592 with - | Binding_sig (lids,uu____14598) -> FStar_List.append lids keys - | uu____14603 -> keys) [] env.gamma in + fun uu___83_14692 -> + match uu___83_14692 with + | Binding_sig (lids,uu____14698) -> FStar_List.append lids keys + | uu____14703 -> keys) [] env.gamma in FStar_Util.smap_fold (sigtab env) - (fun uu____14609 -> + (fun uu____14709 -> fun v1 -> fun keys1 -> FStar_List.append (FStar_Syntax_Util.lids_of_sigelt v1) keys1) @@ -4255,62 +4268,62 @@ let should_enc_path: env -> Prims.string Prims.list -> Prims.bool = fun path -> let rec list_prefix xs ys = match (xs, ys) with - | ([],uu____14643) -> true + | ([],uu____14743) -> true | (x::xs1,y::ys1) -> (x = y) && (list_prefix xs1 ys1) - | (uu____14662,uu____14663) -> false in - let uu____14672 = + | (uu____14762,uu____14763) -> false in + let uu____14772 = FStar_List.tryFind - (fun uu____14690 -> - match uu____14690 with | (p,uu____14698) -> list_prefix p path) + (fun uu____14790 -> + match uu____14790 with | (p,uu____14798) -> list_prefix p path) env.proof_ns in - match uu____14672 with + match uu____14772 with | FStar_Pervasives_Native.None -> false - | FStar_Pervasives_Native.Some (uu____14709,b) -> b + | FStar_Pervasives_Native.Some (uu____14809,b) -> b let should_enc_lid: env -> FStar_Ident.lident -> Prims.bool = fun env -> fun lid -> - let uu____14727 = FStar_Ident.path_of_lid lid in - should_enc_path env uu____14727 + let uu____14827 = FStar_Ident.path_of_lid lid in + should_enc_path env uu____14827 let cons_proof_ns: Prims.bool -> env -> name_prefix -> env = fun b -> fun e -> fun path -> - let uu___105_14739 = e in + let uu___107_14839 = e in { - solver = (uu___105_14739.solver); - range = (uu___105_14739.range); - curmodule = (uu___105_14739.curmodule); - gamma = (uu___105_14739.gamma); - gamma_cache = (uu___105_14739.gamma_cache); - modules = (uu___105_14739.modules); - expected_typ = (uu___105_14739.expected_typ); - sigtab = (uu___105_14739.sigtab); - is_pattern = (uu___105_14739.is_pattern); - instantiate_imp = (uu___105_14739.instantiate_imp); - effects = (uu___105_14739.effects); - generalize = (uu___105_14739.generalize); - letrecs = (uu___105_14739.letrecs); - top_level = (uu___105_14739.top_level); - check_uvars = (uu___105_14739.check_uvars); - use_eq = (uu___105_14739.use_eq); - is_iface = (uu___105_14739.is_iface); - admit = (uu___105_14739.admit); - lax = (uu___105_14739.lax); - lax_universes = (uu___105_14739.lax_universes); - failhard = (uu___105_14739.failhard); - nosynth = (uu___105_14739.nosynth); - tc_term = (uu___105_14739.tc_term); - type_of = (uu___105_14739.type_of); - universe_of = (uu___105_14739.universe_of); - use_bv_sorts = (uu___105_14739.use_bv_sorts); - qname_and_index = (uu___105_14739.qname_and_index); + solver = (uu___107_14839.solver); + range = (uu___107_14839.range); + curmodule = (uu___107_14839.curmodule); + gamma = (uu___107_14839.gamma); + gamma_cache = (uu___107_14839.gamma_cache); + modules = (uu___107_14839.modules); + expected_typ = (uu___107_14839.expected_typ); + sigtab = (uu___107_14839.sigtab); + is_pattern = (uu___107_14839.is_pattern); + instantiate_imp = (uu___107_14839.instantiate_imp); + effects = (uu___107_14839.effects); + generalize = (uu___107_14839.generalize); + letrecs = (uu___107_14839.letrecs); + top_level = (uu___107_14839.top_level); + check_uvars = (uu___107_14839.check_uvars); + use_eq = (uu___107_14839.use_eq); + is_iface = (uu___107_14839.is_iface); + admit = (uu___107_14839.admit); + lax = (uu___107_14839.lax); + lax_universes = (uu___107_14839.lax_universes); + failhard = (uu___107_14839.failhard); + nosynth = (uu___107_14839.nosynth); + tc_term = (uu___107_14839.tc_term); + type_of = (uu___107_14839.type_of); + universe_of = (uu___107_14839.universe_of); + use_bv_sorts = (uu___107_14839.use_bv_sorts); + qname_and_index = (uu___107_14839.qname_and_index); proof_ns = ((path, b) :: (e.proof_ns)); - synth = (uu___105_14739.synth); - is_native_tactic = (uu___105_14739.is_native_tactic); - identifier_info = (uu___105_14739.identifier_info); - tc_hooks = (uu___105_14739.tc_hooks); - dsenv = (uu___105_14739.dsenv); - dep_graph = (uu___105_14739.dep_graph) + synth = (uu___107_14839.synth); + is_native_tactic = (uu___107_14839.is_native_tactic); + identifier_info = (uu___107_14839.identifier_info); + tc_hooks = (uu___107_14839.tc_hooks); + dsenv = (uu___107_14839.dsenv); + dep_graph = (uu___107_14839.dep_graph) } let add_proof_ns: env -> name_prefix -> env = fun e -> fun path -> cons_proof_ns true e path @@ -4320,88 +4333,88 @@ let get_proof_ns: env -> proof_namespace = fun e -> e.proof_ns let set_proof_ns: proof_namespace -> env -> env = fun ns -> fun e -> - let uu___106_14765 = e in + let uu___108_14865 = e in { - solver = (uu___106_14765.solver); - range = (uu___106_14765.range); - curmodule = (uu___106_14765.curmodule); - gamma = (uu___106_14765.gamma); - gamma_cache = (uu___106_14765.gamma_cache); - modules = (uu___106_14765.modules); - expected_typ = (uu___106_14765.expected_typ); - sigtab = (uu___106_14765.sigtab); - is_pattern = (uu___106_14765.is_pattern); - instantiate_imp = (uu___106_14765.instantiate_imp); - effects = (uu___106_14765.effects); - generalize = (uu___106_14765.generalize); - letrecs = (uu___106_14765.letrecs); - top_level = (uu___106_14765.top_level); - check_uvars = (uu___106_14765.check_uvars); - use_eq = (uu___106_14765.use_eq); - is_iface = (uu___106_14765.is_iface); - admit = (uu___106_14765.admit); - lax = (uu___106_14765.lax); - lax_universes = (uu___106_14765.lax_universes); - failhard = (uu___106_14765.failhard); - nosynth = (uu___106_14765.nosynth); - tc_term = (uu___106_14765.tc_term); - type_of = (uu___106_14765.type_of); - universe_of = (uu___106_14765.universe_of); - use_bv_sorts = (uu___106_14765.use_bv_sorts); - qname_and_index = (uu___106_14765.qname_and_index); + solver = (uu___108_14865.solver); + range = (uu___108_14865.range); + curmodule = (uu___108_14865.curmodule); + gamma = (uu___108_14865.gamma); + gamma_cache = (uu___108_14865.gamma_cache); + modules = (uu___108_14865.modules); + expected_typ = (uu___108_14865.expected_typ); + sigtab = (uu___108_14865.sigtab); + is_pattern = (uu___108_14865.is_pattern); + instantiate_imp = (uu___108_14865.instantiate_imp); + effects = (uu___108_14865.effects); + generalize = (uu___108_14865.generalize); + letrecs = (uu___108_14865.letrecs); + top_level = (uu___108_14865.top_level); + check_uvars = (uu___108_14865.check_uvars); + use_eq = (uu___108_14865.use_eq); + is_iface = (uu___108_14865.is_iface); + admit = (uu___108_14865.admit); + lax = (uu___108_14865.lax); + lax_universes = (uu___108_14865.lax_universes); + failhard = (uu___108_14865.failhard); + nosynth = (uu___108_14865.nosynth); + tc_term = (uu___108_14865.tc_term); + type_of = (uu___108_14865.type_of); + universe_of = (uu___108_14865.universe_of); + use_bv_sorts = (uu___108_14865.use_bv_sorts); + qname_and_index = (uu___108_14865.qname_and_index); proof_ns = ns; - synth = (uu___106_14765.synth); - is_native_tactic = (uu___106_14765.is_native_tactic); - identifier_info = (uu___106_14765.identifier_info); - tc_hooks = (uu___106_14765.tc_hooks); - dsenv = (uu___106_14765.dsenv); - dep_graph = (uu___106_14765.dep_graph) + synth = (uu___108_14865.synth); + is_native_tactic = (uu___108_14865.is_native_tactic); + identifier_info = (uu___108_14865.identifier_info); + tc_hooks = (uu___108_14865.tc_hooks); + dsenv = (uu___108_14865.dsenv); + dep_graph = (uu___108_14865.dep_graph) } let unbound_vars: env -> FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.bv FStar_Util.set = fun e -> fun t -> - let uu____14776 = FStar_Syntax_Free.names t in - let uu____14779 = bound_vars e in + let uu____14876 = FStar_Syntax_Free.names t in + let uu____14879 = bound_vars e in FStar_List.fold_left (fun s -> fun bv -> FStar_Util.set_remove bv s) - uu____14776 uu____14779 + uu____14876 uu____14879 let closed: env -> FStar_Syntax_Syntax.term -> Prims.bool = fun e -> fun t -> - let uu____14796 = unbound_vars e t in - FStar_Util.set_is_empty uu____14796 + let uu____14896 = unbound_vars e t in + FStar_Util.set_is_empty uu____14896 let closed': FStar_Syntax_Syntax.term -> Prims.bool = fun t -> - let uu____14802 = FStar_Syntax_Free.names t in - FStar_Util.set_is_empty uu____14802 + let uu____14902 = FStar_Syntax_Free.names t in + FStar_Util.set_is_empty uu____14902 let string_of_proof_ns: env -> Prims.string = fun env -> - let aux uu____14817 = - match uu____14817 with + let aux uu____14917 = + match uu____14917 with | (p,b) -> if (p = []) && b then "*" else - (let uu____14833 = FStar_Ident.text_of_path p in - Prims.strcat (if b then "+" else "-") uu____14833) in - let uu____14835 = - let uu____14838 = FStar_List.map aux env.proof_ns in - FStar_All.pipe_right uu____14838 FStar_List.rev in - FStar_All.pipe_right uu____14835 (FStar_String.concat " ") + (let uu____14933 = FStar_Ident.text_of_path p in + Prims.strcat (if b then "+" else "-") uu____14933) in + let uu____14935 = + let uu____14938 = FStar_List.map aux env.proof_ns in + FStar_All.pipe_right uu____14938 FStar_List.rev in + FStar_All.pipe_right uu____14935 (FStar_String.concat " ") let dummy_solver: solver_t = { - init = (fun uu____14855 -> ()); - push = (fun uu____14857 -> ()); - pop = (fun uu____14859 -> ()); - encode_modul = (fun uu____14862 -> fun uu____14863 -> ()); - encode_sig = (fun uu____14866 -> fun uu____14867 -> ()); + init = (fun uu____14955 -> ()); + push = (fun uu____14957 -> ()); + pop = (fun uu____14959 -> ()); + encode_modul = (fun uu____14962 -> fun uu____14963 -> ()); + encode_sig = (fun uu____14966 -> fun uu____14967 -> ()); preprocess = (fun e -> fun g -> - let uu____14873 = - let uu____14880 = FStar_Options.peek () in (e, g, uu____14880) in - [uu____14873]); - solve = (fun uu____14896 -> fun uu____14897 -> fun uu____14898 -> ()); - finish = (fun uu____14904 -> ()); - refresh = (fun uu____14906 -> ()) + let uu____14973 = + let uu____14980 = FStar_Options.peek () in (e, g, uu____14980) in + [uu____14973]); + solve = (fun uu____14996 -> fun uu____14997 -> fun uu____14998 -> ()); + finish = (fun uu____15004 -> ()); + refresh = (fun uu____15006 -> ()) } \ No newline at end of file diff --git a/src/ocaml-output/FStar_TypeChecker_Normalize.ml b/src/ocaml-output/FStar_TypeChecker_Normalize.ml index 7f4478b3f0b..203046bdd5e 100644 --- a/src/ocaml-output/FStar_TypeChecker_Normalize.ml +++ b/src/ocaml-output/FStar_TypeChecker_Normalize.ml @@ -220,43 +220,51 @@ type cfg = tcenv: FStar_TypeChecker_Env.env; delta_level: FStar_TypeChecker_Env.delta_level Prims.list; primitive_steps: primitive_step Prims.list; - strong: Prims.bool;}[@@deriving show] + strong: Prims.bool; + memoize_lazy: Prims.bool;}[@@deriving show] let __proj__Mkcfg__item__steps: cfg -> steps = fun projectee -> match projectee with | { steps = __fname__steps; tcenv = __fname__tcenv; delta_level = __fname__delta_level; - primitive_steps = __fname__primitive_steps; - strong = __fname__strong;_} -> __fname__steps + primitive_steps = __fname__primitive_steps; strong = __fname__strong; + memoize_lazy = __fname__memoize_lazy;_} -> __fname__steps let __proj__Mkcfg__item__tcenv: cfg -> FStar_TypeChecker_Env.env = fun projectee -> match projectee with | { steps = __fname__steps; tcenv = __fname__tcenv; delta_level = __fname__delta_level; - primitive_steps = __fname__primitive_steps; - strong = __fname__strong;_} -> __fname__tcenv + primitive_steps = __fname__primitive_steps; strong = __fname__strong; + memoize_lazy = __fname__memoize_lazy;_} -> __fname__tcenv let __proj__Mkcfg__item__delta_level: cfg -> FStar_TypeChecker_Env.delta_level Prims.list = fun projectee -> match projectee with | { steps = __fname__steps; tcenv = __fname__tcenv; delta_level = __fname__delta_level; - primitive_steps = __fname__primitive_steps; - strong = __fname__strong;_} -> __fname__delta_level + primitive_steps = __fname__primitive_steps; strong = __fname__strong; + memoize_lazy = __fname__memoize_lazy;_} -> __fname__delta_level let __proj__Mkcfg__item__primitive_steps: cfg -> primitive_step Prims.list = fun projectee -> match projectee with | { steps = __fname__steps; tcenv = __fname__tcenv; delta_level = __fname__delta_level; - primitive_steps = __fname__primitive_steps; - strong = __fname__strong;_} -> __fname__primitive_steps + primitive_steps = __fname__primitive_steps; strong = __fname__strong; + memoize_lazy = __fname__memoize_lazy;_} -> __fname__primitive_steps let __proj__Mkcfg__item__strong: cfg -> Prims.bool = fun projectee -> match projectee with | { steps = __fname__steps; tcenv = __fname__tcenv; delta_level = __fname__delta_level; - primitive_steps = __fname__primitive_steps; - strong = __fname__strong;_} -> __fname__strong + primitive_steps = __fname__primitive_steps; strong = __fname__strong; + memoize_lazy = __fname__memoize_lazy;_} -> __fname__strong +let __proj__Mkcfg__item__memoize_lazy: cfg -> Prims.bool = + fun projectee -> + match projectee with + | { steps = __fname__steps; tcenv = __fname__tcenv; + delta_level = __fname__delta_level; + primitive_steps = __fname__primitive_steps; strong = __fname__strong; + memoize_lazy = __fname__memoize_lazy;_} -> __fname__memoize_lazy type branches = (FStar_Syntax_Syntax.pat,FStar_Syntax_Syntax.term FStar_Pervasives_Native.option,FStar_Syntax_Syntax.term) @@ -286,7 +294,7 @@ type stack_elt = FStar_Pervasives_Native.tuple2[@@deriving show] let uu___is_Arg: stack_elt -> Prims.bool = fun projectee -> - match projectee with | Arg _0 -> true | uu____784 -> false + match projectee with | Arg _0 -> true | uu____806 -> false let __proj__Arg__item___0: stack_elt -> (closure,FStar_Syntax_Syntax.aqual,FStar_Range.range) @@ -294,7 +302,7 @@ let __proj__Arg__item___0: = fun projectee -> match projectee with | Arg _0 -> _0 let uu___is_UnivArgs: stack_elt -> Prims.bool = fun projectee -> - match projectee with | UnivArgs _0 -> true | uu____820 -> false + match projectee with | UnivArgs _0 -> true | uu____842 -> false let __proj__UnivArgs__item___0: stack_elt -> (FStar_Syntax_Syntax.universe Prims.list,FStar_Range.range) @@ -302,7 +310,7 @@ let __proj__UnivArgs__item___0: = fun projectee -> match projectee with | UnivArgs _0 -> _0 let uu___is_MemoLazy: stack_elt -> Prims.bool = fun projectee -> - match projectee with | MemoLazy _0 -> true | uu____856 -> false + match projectee with | MemoLazy _0 -> true | uu____878 -> false let __proj__MemoLazy__item___0: stack_elt -> (env,FStar_Syntax_Syntax.term) FStar_Pervasives_Native.tuple2 @@ -310,14 +318,14 @@ let __proj__MemoLazy__item___0: = fun projectee -> match projectee with | MemoLazy _0 -> _0 let uu___is_Match: stack_elt -> Prims.bool = fun projectee -> - match projectee with | Match _0 -> true | uu____925 -> false + match projectee with | Match _0 -> true | uu____947 -> false let __proj__Match__item___0: stack_elt -> (env,branches,FStar_Range.range) FStar_Pervasives_Native.tuple3 = fun projectee -> match projectee with | Match _0 -> _0 let uu___is_Abs: stack_elt -> Prims.bool = fun projectee -> - match projectee with | Abs _0 -> true | uu____967 -> false + match projectee with | Abs _0 -> true | uu____989 -> false let __proj__Abs__item___0: stack_elt -> (env,FStar_Syntax_Syntax.binders,env,FStar_Syntax_Syntax.residual_comp @@ -326,7 +334,7 @@ let __proj__Abs__item___0: = fun projectee -> match projectee with | Abs _0 -> _0 let uu___is_App: stack_elt -> Prims.bool = fun projectee -> - match projectee with | App _0 -> true | uu____1023 -> false + match projectee with | App _0 -> true | uu____1045 -> false let __proj__App__item___0: stack_elt -> (env,FStar_Syntax_Syntax.term,FStar_Syntax_Syntax.aqual,FStar_Range.range) @@ -334,7 +342,7 @@ let __proj__App__item___0: = fun projectee -> match projectee with | App _0 -> _0 let uu___is_Meta: stack_elt -> Prims.bool = fun projectee -> - match projectee with | Meta _0 -> true | uu____1063 -> false + match projectee with | Meta _0 -> true | uu____1085 -> false let __proj__Meta__item___0: stack_elt -> (FStar_Syntax_Syntax.metadata,FStar_Range.range) @@ -342,7 +350,7 @@ let __proj__Meta__item___0: = fun projectee -> match projectee with | Meta _0 -> _0 let uu___is_Let: stack_elt -> Prims.bool = fun projectee -> - match projectee with | Let _0 -> true | uu____1095 -> false + match projectee with | Let _0 -> true | uu____1117 -> false let __proj__Let__item___0: stack_elt -> (env,FStar_Syntax_Syntax.binders,FStar_Syntax_Syntax.letbinding,FStar_Range.range) @@ -350,96 +358,100 @@ let __proj__Let__item___0: = fun projectee -> match projectee with | Let _0 -> _0 let uu___is_Cfg: stack_elt -> Prims.bool = fun projectee -> - match projectee with | Cfg _0 -> true | uu____1131 -> false + match projectee with | Cfg _0 -> true | uu____1153 -> false let __proj__Cfg__item___0: stack_elt -> cfg = fun projectee -> match projectee with | Cfg _0 -> _0 let uu___is_Debug: stack_elt -> Prims.bool = fun projectee -> - match projectee with | Debug _0 -> true | uu____1147 -> false + match projectee with | Debug _0 -> true | uu____1169 -> false let __proj__Debug__item___0: stack_elt -> (FStar_Syntax_Syntax.term,FStar_Util.time) FStar_Pervasives_Native.tuple2 = fun projectee -> match projectee with | Debug _0 -> _0 type stack = stack_elt Prims.list[@@deriving show] let mk: - 'Auu____1172 . - 'Auu____1172 -> - FStar_Range.range -> 'Auu____1172 FStar_Syntax_Syntax.syntax + 'Auu____1194 . + 'Auu____1194 -> + FStar_Range.range -> 'Auu____1194 FStar_Syntax_Syntax.syntax = fun t -> fun r -> FStar_Syntax_Syntax.mk t FStar_Pervasives_Native.None r -let set_memo: 'a . 'a FStar_Syntax_Syntax.memo -> 'a -> Prims.unit = - fun r -> - fun t -> - let uu____1232 = FStar_ST.op_Bang r in - match uu____1232 with - | FStar_Pervasives_Native.Some uu____1309 -> - failwith "Unexpected set_memo: thunk already evaluated" - | FStar_Pervasives_Native.None -> - FStar_ST.op_Colon_Equals r (FStar_Pervasives_Native.Some t) +let set_memo: 'a . cfg -> 'a FStar_Syntax_Syntax.memo -> 'a -> Prims.unit = + fun cfg -> + fun r -> + fun t -> + if cfg.memoize_lazy + then + let uu____1248 = FStar_ST.op_Bang r in + match uu____1248 with + | FStar_Pervasives_Native.Some uu____1325 -> + failwith "Unexpected set_memo: thunk already evaluated" + | FStar_Pervasives_Native.None -> + FStar_ST.op_Colon_Equals r (FStar_Pervasives_Native.Some t) + else () let env_to_string: closure Prims.list -> Prims.string = fun env -> - let uu____1391 = FStar_List.map closure_to_string env in - FStar_All.pipe_right uu____1391 (FStar_String.concat "; ") + let uu____1408 = FStar_List.map closure_to_string env in + FStar_All.pipe_right uu____1408 (FStar_String.concat "; ") let stack_elt_to_string: stack_elt -> Prims.string = - fun uu___72_1398 -> - match uu___72_1398 with - | Arg (c,uu____1400,uu____1401) -> - let uu____1402 = closure_to_string c in - FStar_Util.format1 "Closure %s" uu____1402 - | MemoLazy uu____1403 -> "MemoLazy" - | Abs (uu____1410,bs,uu____1412,uu____1413,uu____1414) -> - let uu____1419 = + fun uu___72_1415 -> + match uu___72_1415 with + | Arg (c,uu____1417,uu____1418) -> + let uu____1419 = closure_to_string c in + FStar_Util.format1 "Closure %s" uu____1419 + | MemoLazy uu____1420 -> "MemoLazy" + | Abs (uu____1427,bs,uu____1429,uu____1430,uu____1431) -> + let uu____1436 = FStar_All.pipe_left FStar_Util.string_of_int (FStar_List.length bs) in - FStar_Util.format1 "Abs %s" uu____1419 - | UnivArgs uu____1424 -> "UnivArgs" - | Match uu____1431 -> "Match" - | App (uu____1438,t,uu____1440,uu____1441) -> - let uu____1442 = FStar_Syntax_Print.term_to_string t in - FStar_Util.format1 "App %s" uu____1442 - | Meta (m,uu____1444) -> "Meta" - | Let uu____1445 -> "Let" - | Cfg uu____1454 -> "Cfg" - | Debug (t,uu____1456) -> - let uu____1457 = FStar_Syntax_Print.term_to_string t in - FStar_Util.format1 "Debug %s" uu____1457 + FStar_Util.format1 "Abs %s" uu____1436 + | UnivArgs uu____1441 -> "UnivArgs" + | Match uu____1448 -> "Match" + | App (uu____1455,t,uu____1457,uu____1458) -> + let uu____1459 = FStar_Syntax_Print.term_to_string t in + FStar_Util.format1 "App %s" uu____1459 + | Meta (m,uu____1461) -> "Meta" + | Let uu____1462 -> "Let" + | Cfg uu____1471 -> "Cfg" + | Debug (t,uu____1473) -> + let uu____1474 = FStar_Syntax_Print.term_to_string t in + FStar_Util.format1 "Debug %s" uu____1474 let stack_to_string: stack_elt Prims.list -> Prims.string = fun s -> - let uu____1465 = FStar_List.map stack_elt_to_string s in - FStar_All.pipe_right uu____1465 (FStar_String.concat "; ") + let uu____1482 = FStar_List.map stack_elt_to_string s in + FStar_All.pipe_right uu____1482 (FStar_String.concat "; ") let log: cfg -> (Prims.unit -> Prims.unit) -> Prims.unit = fun cfg -> fun f -> - let uu____1481 = + let uu____1498 = FStar_TypeChecker_Env.debug cfg.tcenv (FStar_Options.Other "Norm") in - if uu____1481 then f () else () + if uu____1498 then f () else () let log_primops: cfg -> (Prims.unit -> Prims.unit) -> Prims.unit = fun cfg -> fun f -> - let uu____1494 = + let uu____1511 = (FStar_TypeChecker_Env.debug cfg.tcenv (FStar_Options.Other "Norm")) || (FStar_TypeChecker_Env.debug cfg.tcenv (FStar_Options.Other "Primops")) in - if uu____1494 then f () else () -let is_empty: 'Auu____1498 . 'Auu____1498 Prims.list -> Prims.bool = - fun uu___73_1504 -> - match uu___73_1504 with | [] -> true | uu____1507 -> false + if uu____1511 then f () else () +let is_empty: 'Auu____1515 . 'Auu____1515 Prims.list -> Prims.bool = + fun uu___73_1521 -> + match uu___73_1521 with | [] -> true | uu____1524 -> false let lookup_bvar: - 'Auu____1514 'Auu____1515 . - ('Auu____1515,'Auu____1514) FStar_Pervasives_Native.tuple2 Prims.list -> - FStar_Syntax_Syntax.bv -> 'Auu____1514 + 'Auu____1531 'Auu____1532 . + ('Auu____1532,'Auu____1531) FStar_Pervasives_Native.tuple2 Prims.list -> + FStar_Syntax_Syntax.bv -> 'Auu____1531 = fun env -> fun x -> try - let uu____1539 = FStar_List.nth env x.FStar_Syntax_Syntax.index in - FStar_Pervasives_Native.snd uu____1539 + let uu____1556 = FStar_List.nth env x.FStar_Syntax_Syntax.index in + FStar_Pervasives_Native.snd uu____1556 with - | uu____1552 -> - let uu____1553 = - let uu____1554 = FStar_Syntax_Print.db_to_string x in - FStar_Util.format1 "Failed to find %s\n" uu____1554 in - failwith uu____1553 + | uu____1569 -> + let uu____1570 = + let uu____1571 = FStar_Syntax_Print.db_to_string x in + FStar_Util.format1 "Failed to find %s\n" uu____1571 in + failwith uu____1570 let downgrade_ghost_effect_name: FStar_Ident.lident -> FStar_Ident.lident FStar_Pervasives_Native.option = fun l -> @@ -460,86 +472,86 @@ let norm_universe: fun u -> let norm_univs us = let us1 = FStar_Util.sort_with FStar_Syntax_Util.compare_univs us in - let uu____1591 = + let uu____1608 = FStar_List.fold_left - (fun uu____1617 -> + (fun uu____1634 -> fun u1 -> - match uu____1617 with + match uu____1634 with | (cur_kernel,cur_max,out) -> - let uu____1642 = FStar_Syntax_Util.univ_kernel u1 in - (match uu____1642 with + let uu____1659 = FStar_Syntax_Util.univ_kernel u1 in + (match uu____1659 with | (k_u,n1) -> - let uu____1657 = + let uu____1674 = FStar_Syntax_Util.eq_univs cur_kernel k_u in - if uu____1657 + if uu____1674 then (cur_kernel, u1, out) else (k_u, u1, (cur_max :: out)))) (FStar_Syntax_Syntax.U_zero, FStar_Syntax_Syntax.U_zero, []) us1 in - match uu____1591 with - | (uu____1675,u1,out) -> FStar_List.rev (u1 :: out) in + match uu____1608 with + | (uu____1692,u1,out) -> FStar_List.rev (u1 :: out) in let rec aux u1 = let u2 = FStar_Syntax_Subst.compress_univ u1 in match u2 with | FStar_Syntax_Syntax.U_bvar x -> (try - let uu____1700 = - let uu____1701 = FStar_List.nth env x in - FStar_Pervasives_Native.snd uu____1701 in - match uu____1700 with + let uu____1717 = + let uu____1718 = FStar_List.nth env x in + FStar_Pervasives_Native.snd uu____1718 in + match uu____1717 with | Univ u3 -> aux u3 | Dummy -> [u2] - | uu____1719 -> + | uu____1736 -> failwith "Impossible: universe variable bound to a term" with - | uu____1728 -> - let uu____1729 = + | uu____1745 -> + let uu____1746 = FStar_All.pipe_right cfg.steps (FStar_List.contains AllowUnboundUniverses) in - if uu____1729 + if uu____1746 then [FStar_Syntax_Syntax.U_unknown] else failwith "Universe variable not found") - | FStar_Syntax_Syntax.U_unif uu____1735 when + | FStar_Syntax_Syntax.U_unif uu____1752 when FStar_All.pipe_right cfg.steps (FStar_List.contains CheckNoUvars) -> [FStar_Syntax_Syntax.U_zero] | FStar_Syntax_Syntax.U_zero -> [u2] - | FStar_Syntax_Syntax.U_unif uu____1744 -> [u2] - | FStar_Syntax_Syntax.U_name uu____1753 -> [u2] + | FStar_Syntax_Syntax.U_unif uu____1761 -> [u2] + | FStar_Syntax_Syntax.U_name uu____1770 -> [u2] | FStar_Syntax_Syntax.U_unknown -> [u2] | FStar_Syntax_Syntax.U_max [] -> [FStar_Syntax_Syntax.U_zero] | FStar_Syntax_Syntax.U_max us -> let us1 = - let uu____1760 = FStar_List.collect aux us in - FStar_All.pipe_right uu____1760 norm_univs in + let uu____1777 = FStar_List.collect aux us in + FStar_All.pipe_right uu____1777 norm_univs in (match us1 with | u_k::hd1::rest -> let rest1 = hd1 :: rest in - let uu____1777 = FStar_Syntax_Util.univ_kernel u_k in - (match uu____1777 with + let uu____1794 = FStar_Syntax_Util.univ_kernel u_k in + (match uu____1794 with | (FStar_Syntax_Syntax.U_zero ,n1) -> - let uu____1785 = + let uu____1802 = FStar_All.pipe_right rest1 (FStar_List.for_all (fun u3 -> - let uu____1793 = + let uu____1810 = FStar_Syntax_Util.univ_kernel u3 in - match uu____1793 with - | (uu____1798,m) -> n1 <= m)) in - if uu____1785 then rest1 else us1 - | uu____1803 -> us1) - | uu____1808 -> us1) + match uu____1810 with + | (uu____1815,m) -> n1 <= m)) in + if uu____1802 then rest1 else us1 + | uu____1820 -> us1) + | uu____1825 -> us1) | FStar_Syntax_Syntax.U_succ u3 -> - let uu____1812 = aux u3 in + let uu____1829 = aux u3 in FStar_List.map (fun _0_40 -> FStar_Syntax_Syntax.U_succ _0_40) - uu____1812 in - let uu____1815 = + uu____1829 in + let uu____1832 = FStar_All.pipe_right cfg.steps (FStar_List.contains EraseUniverses) in - if uu____1815 + if uu____1832 then FStar_Syntax_Syntax.U_unknown else - (let uu____1817 = aux u in - match uu____1817 with + (let uu____1834 = aux u in + match uu____1834 with | [] -> FStar_Syntax_Syntax.U_zero | (FStar_Syntax_Syntax.U_zero )::[] -> FStar_Syntax_Syntax.U_zero | (FStar_Syntax_Syntax.U_zero )::u1::[] -> u1 @@ -553,57 +565,57 @@ let rec closure_as_term: fun env -> fun t -> log cfg - (fun uu____1921 -> - let uu____1922 = FStar_Syntax_Print.tag_of_term t in - let uu____1923 = FStar_Syntax_Print.term_to_string t in - FStar_Util.print2 ">>> %s Closure_as_term %s\n" uu____1922 - uu____1923); + (fun uu____1938 -> + let uu____1939 = FStar_Syntax_Print.tag_of_term t in + let uu____1940 = FStar_Syntax_Print.term_to_string t in + FStar_Util.print2 ">>> %s Closure_as_term %s\n" uu____1939 + uu____1940); (match env with | [] when FStar_All.pipe_left Prims.op_Negation (FStar_List.contains CompressUvars cfg.steps) -> t - | uu____1930 -> + | uu____1947 -> let t1 = FStar_Syntax_Subst.compress t in (match t1.FStar_Syntax_Syntax.n with - | FStar_Syntax_Syntax.Tm_delayed uu____1932 -> + | FStar_Syntax_Syntax.Tm_delayed uu____1949 -> failwith "Impossible" | FStar_Syntax_Syntax.Tm_unknown -> t1 - | FStar_Syntax_Syntax.Tm_constant uu____1957 -> t1 - | FStar_Syntax_Syntax.Tm_name uu____1958 -> t1 - | FStar_Syntax_Syntax.Tm_fvar uu____1959 -> t1 - | FStar_Syntax_Syntax.Tm_uvar uu____1960 -> - let uu____1977 = + | FStar_Syntax_Syntax.Tm_constant uu____1974 -> t1 + | FStar_Syntax_Syntax.Tm_name uu____1975 -> t1 + | FStar_Syntax_Syntax.Tm_fvar uu____1976 -> t1 + | FStar_Syntax_Syntax.Tm_uvar uu____1977 -> + let uu____1994 = FStar_All.pipe_right cfg.steps (FStar_List.contains CheckNoUvars) in - if uu____1977 + if uu____1994 then - let uu____1978 = - let uu____1979 = + let uu____1995 = + let uu____1996 = FStar_Range.string_of_range t1.FStar_Syntax_Syntax.pos in - let uu____1980 = FStar_Syntax_Print.term_to_string t1 in + let uu____1997 = FStar_Syntax_Print.term_to_string t1 in FStar_Util.format2 "(%s): CheckNoUvars: Unexpected unification variable remains: %s" - uu____1979 uu____1980 in - failwith uu____1978 + uu____1996 uu____1997 in + failwith uu____1995 else t1 | FStar_Syntax_Syntax.Tm_type u -> - let uu____1983 = - let uu____1984 = norm_universe cfg env u in - FStar_Syntax_Syntax.Tm_type uu____1984 in - mk uu____1983 t1.FStar_Syntax_Syntax.pos + let uu____2000 = + let uu____2001 = norm_universe cfg env u in + FStar_Syntax_Syntax.Tm_type uu____2001 in + mk uu____2000 t1.FStar_Syntax_Syntax.pos | FStar_Syntax_Syntax.Tm_uinst (t',us) -> - let uu____1991 = FStar_List.map (norm_universe cfg env) us in - FStar_Syntax_Syntax.mk_Tm_uinst t' uu____1991 + let uu____2008 = FStar_List.map (norm_universe cfg env) us in + FStar_Syntax_Syntax.mk_Tm_uinst t' uu____2008 | FStar_Syntax_Syntax.Tm_bvar x -> - let uu____1993 = lookup_bvar env x in - (match uu____1993 with - | Univ uu____1996 -> + let uu____2010 = lookup_bvar env x in + (match uu____2010 with + | Univ uu____2013 -> failwith "Impossible: term variable is bound to a universe" | Dummy -> t1 - | Clos (env1,t0,r,uu____2000) -> + | Clos (env1,t0,uu____2016,uu____2017) -> closure_as_term cfg env1 t0) | FStar_Syntax_Syntax.Tm_app (head1,args) -> let head2 = closure_as_term_delayed cfg env head1 in @@ -611,196 +623,196 @@ let rec closure_as_term: mk (FStar_Syntax_Syntax.Tm_app (head2, args1)) t1.FStar_Syntax_Syntax.pos | FStar_Syntax_Syntax.Tm_abs (bs,body,lopt) -> - let uu____2112 = closures_as_binders_delayed cfg env bs in - (match uu____2112 with + let uu____2129 = closures_as_binders_delayed cfg env bs in + (match uu____2129 with | (bs1,env1) -> let body1 = closure_as_term_delayed cfg env1 body in - let uu____2140 = - let uu____2141 = - let uu____2158 = close_lcomp_opt cfg env1 lopt in - (bs1, body1, uu____2158) in - FStar_Syntax_Syntax.Tm_abs uu____2141 in - mk uu____2140 t1.FStar_Syntax_Syntax.pos) + let uu____2157 = + let uu____2158 = + let uu____2175 = close_lcomp_opt cfg env1 lopt in + (bs1, body1, uu____2175) in + FStar_Syntax_Syntax.Tm_abs uu____2158 in + mk uu____2157 t1.FStar_Syntax_Syntax.pos) | FStar_Syntax_Syntax.Tm_arrow (bs,c) -> - let uu____2189 = closures_as_binders_delayed cfg env bs in - (match uu____2189 with + let uu____2206 = closures_as_binders_delayed cfg env bs in + (match uu____2206 with | (bs1,env1) -> let c1 = close_comp cfg env1 c in mk (FStar_Syntax_Syntax.Tm_arrow (bs1, c1)) t1.FStar_Syntax_Syntax.pos) | FStar_Syntax_Syntax.Tm_refine (x,phi) -> - let uu____2231 = - let uu____2242 = - let uu____2249 = FStar_Syntax_Syntax.mk_binder x in - [uu____2249] in - closures_as_binders_delayed cfg env uu____2242 in - (match uu____2231 with + let uu____2248 = + let uu____2259 = + let uu____2266 = FStar_Syntax_Syntax.mk_binder x in + [uu____2266] in + closures_as_binders_delayed cfg env uu____2259 in + (match uu____2248 with | (x1,env1) -> let phi1 = closure_as_term_delayed cfg env1 phi in - let uu____2267 = - let uu____2268 = - let uu____2275 = - let uu____2276 = FStar_List.hd x1 in - FStar_All.pipe_right uu____2276 + let uu____2284 = + let uu____2285 = + let uu____2292 = + let uu____2293 = FStar_List.hd x1 in + FStar_All.pipe_right uu____2293 FStar_Pervasives_Native.fst in - (uu____2275, phi1) in - FStar_Syntax_Syntax.Tm_refine uu____2268 in - mk uu____2267 t1.FStar_Syntax_Syntax.pos) + (uu____2292, phi1) in + FStar_Syntax_Syntax.Tm_refine uu____2285 in + mk uu____2284 t1.FStar_Syntax_Syntax.pos) | FStar_Syntax_Syntax.Tm_ascribed (t11,(annot,tacopt),lopt) -> let annot1 = match annot with | FStar_Util.Inl t2 -> - let uu____2367 = closure_as_term_delayed cfg env t2 in - FStar_Util.Inl uu____2367 + let uu____2384 = closure_as_term_delayed cfg env t2 in + FStar_Util.Inl uu____2384 | FStar_Util.Inr c -> - let uu____2381 = close_comp cfg env c in - FStar_Util.Inr uu____2381 in + let uu____2398 = close_comp cfg env c in + FStar_Util.Inr uu____2398 in let tacopt1 = FStar_Util.map_opt tacopt (closure_as_term_delayed cfg env) in - let uu____2397 = - let uu____2398 = - let uu____2425 = closure_as_term_delayed cfg env t11 in - (uu____2425, (annot1, tacopt1), lopt) in - FStar_Syntax_Syntax.Tm_ascribed uu____2398 in - mk uu____2397 t1.FStar_Syntax_Syntax.pos + let uu____2414 = + let uu____2415 = + let uu____2442 = closure_as_term_delayed cfg env t11 in + (uu____2442, (annot1, tacopt1), lopt) in + FStar_Syntax_Syntax.Tm_ascribed uu____2415 in + mk uu____2414 t1.FStar_Syntax_Syntax.pos | FStar_Syntax_Syntax.Tm_meta (t',FStar_Syntax_Syntax.Meta_pattern args) -> - let uu____2476 = - let uu____2477 = - let uu____2484 = closure_as_term_delayed cfg env t' in - let uu____2487 = - let uu____2488 = + let uu____2493 = + let uu____2494 = + let uu____2501 = closure_as_term_delayed cfg env t' in + let uu____2504 = + let uu____2505 = FStar_All.pipe_right args (FStar_List.map (closures_as_args_delayed cfg env)) in - FStar_Syntax_Syntax.Meta_pattern uu____2488 in - (uu____2484, uu____2487) in - FStar_Syntax_Syntax.Tm_meta uu____2477 in - mk uu____2476 t1.FStar_Syntax_Syntax.pos + FStar_Syntax_Syntax.Meta_pattern uu____2505 in + (uu____2501, uu____2504) in + FStar_Syntax_Syntax.Tm_meta uu____2494 in + mk uu____2493 t1.FStar_Syntax_Syntax.pos | FStar_Syntax_Syntax.Tm_meta (t',FStar_Syntax_Syntax.Meta_monadic (m,tbody)) -> - let uu____2548 = - let uu____2549 = - let uu____2556 = closure_as_term_delayed cfg env t' in - let uu____2559 = - let uu____2560 = - let uu____2567 = + let uu____2565 = + let uu____2566 = + let uu____2573 = closure_as_term_delayed cfg env t' in + let uu____2576 = + let uu____2577 = + let uu____2584 = closure_as_term_delayed cfg env tbody in - (m, uu____2567) in - FStar_Syntax_Syntax.Meta_monadic uu____2560 in - (uu____2556, uu____2559) in - FStar_Syntax_Syntax.Tm_meta uu____2549 in - mk uu____2548 t1.FStar_Syntax_Syntax.pos + (m, uu____2584) in + FStar_Syntax_Syntax.Meta_monadic uu____2577 in + (uu____2573, uu____2576) in + FStar_Syntax_Syntax.Tm_meta uu____2566 in + mk uu____2565 t1.FStar_Syntax_Syntax.pos | FStar_Syntax_Syntax.Tm_meta (t',FStar_Syntax_Syntax.Meta_monadic_lift (m1,m2,tbody)) -> - let uu____2586 = - let uu____2587 = - let uu____2594 = closure_as_term_delayed cfg env t' in - let uu____2597 = - let uu____2598 = - let uu____2607 = + let uu____2603 = + let uu____2604 = + let uu____2611 = closure_as_term_delayed cfg env t' in + let uu____2614 = + let uu____2615 = + let uu____2624 = closure_as_term_delayed cfg env tbody in - (m1, m2, uu____2607) in - FStar_Syntax_Syntax.Meta_monadic_lift uu____2598 in - (uu____2594, uu____2597) in - FStar_Syntax_Syntax.Tm_meta uu____2587 in - mk uu____2586 t1.FStar_Syntax_Syntax.pos + (m1, m2, uu____2624) in + FStar_Syntax_Syntax.Meta_monadic_lift uu____2615 in + (uu____2611, uu____2614) in + FStar_Syntax_Syntax.Tm_meta uu____2604 in + mk uu____2603 t1.FStar_Syntax_Syntax.pos | FStar_Syntax_Syntax.Tm_meta (t',m) -> - let uu____2620 = - let uu____2621 = - let uu____2628 = closure_as_term_delayed cfg env t' in - (uu____2628, m) in - FStar_Syntax_Syntax.Tm_meta uu____2621 in - mk uu____2620 t1.FStar_Syntax_Syntax.pos + let uu____2637 = + let uu____2638 = + let uu____2645 = closure_as_term_delayed cfg env t' in + (uu____2645, m) in + FStar_Syntax_Syntax.Tm_meta uu____2638 in + mk uu____2637 t1.FStar_Syntax_Syntax.pos | FStar_Syntax_Syntax.Tm_let ((false ,lb::[]),body) -> let env0 = env in let env1 = FStar_List.fold_left - (fun env1 -> fun uu____2668 -> dummy :: env1) env + (fun env1 -> fun uu____2685 -> dummy :: env1) env lb.FStar_Syntax_Syntax.lbunivs in let typ = closure_as_term_delayed cfg env1 lb.FStar_Syntax_Syntax.lbtyp in let def = closure_as_term cfg env1 lb.FStar_Syntax_Syntax.lbdef in - let uu____2687 = - let uu____2698 = FStar_Syntax_Syntax.is_top_level [lb] in - if uu____2698 + let uu____2704 = + let uu____2715 = FStar_Syntax_Syntax.is_top_level [lb] in + if uu____2715 then ((lb.FStar_Syntax_Syntax.lbname), body) else (let x = FStar_Util.left lb.FStar_Syntax_Syntax.lbname in - let uu____2717 = + let uu____2734 = closure_as_term cfg (dummy :: env0) body in ((FStar_Util.Inl - (let uu___92_2729 = x in + (let uu___92_2746 = x in { FStar_Syntax_Syntax.ppname = - (uu___92_2729.FStar_Syntax_Syntax.ppname); + (uu___92_2746.FStar_Syntax_Syntax.ppname); FStar_Syntax_Syntax.index = - (uu___92_2729.FStar_Syntax_Syntax.index); + (uu___92_2746.FStar_Syntax_Syntax.index); FStar_Syntax_Syntax.sort = typ - })), uu____2717)) in - (match uu____2687 with + })), uu____2734)) in + (match uu____2704 with | (nm,body1) -> let lb1 = - let uu___93_2745 = lb in + let uu___93_2762 = lb in { FStar_Syntax_Syntax.lbname = nm; FStar_Syntax_Syntax.lbunivs = - (uu___93_2745.FStar_Syntax_Syntax.lbunivs); + (uu___93_2762.FStar_Syntax_Syntax.lbunivs); FStar_Syntax_Syntax.lbtyp = typ; FStar_Syntax_Syntax.lbeff = - (uu___93_2745.FStar_Syntax_Syntax.lbeff); + (uu___93_2762.FStar_Syntax_Syntax.lbeff); FStar_Syntax_Syntax.lbdef = def } in mk (FStar_Syntax_Syntax.Tm_let ((false, [lb1]), body1)) t1.FStar_Syntax_Syntax.pos) - | FStar_Syntax_Syntax.Tm_let ((uu____2756,lbs),body) -> + | FStar_Syntax_Syntax.Tm_let ((uu____2773,lbs),body) -> let norm_one_lb env1 lb = let env_univs = FStar_List.fold_right - (fun uu____2815 -> fun env2 -> dummy :: env2) + (fun uu____2832 -> fun env2 -> dummy :: env2) lb.FStar_Syntax_Syntax.lbunivs env1 in let env2 = - let uu____2840 = FStar_Syntax_Syntax.is_top_level lbs in - if uu____2840 + let uu____2857 = FStar_Syntax_Syntax.is_top_level lbs in + if uu____2857 then env_univs else FStar_List.fold_right - (fun uu____2860 -> fun env2 -> dummy :: env2) lbs + (fun uu____2877 -> fun env2 -> dummy :: env2) lbs env_univs in let ty = closure_as_term cfg env_univs lb.FStar_Syntax_Syntax.lbtyp in let nm = - let uu____2882 = FStar_Syntax_Syntax.is_top_level lbs in - if uu____2882 + let uu____2899 = FStar_Syntax_Syntax.is_top_level lbs in + if uu____2899 then lb.FStar_Syntax_Syntax.lbname else (let x = FStar_Util.left lb.FStar_Syntax_Syntax.lbname in FStar_All.pipe_right - (let uu___94_2894 = x in + (let uu___94_2911 = x in { FStar_Syntax_Syntax.ppname = - (uu___94_2894.FStar_Syntax_Syntax.ppname); + (uu___94_2911.FStar_Syntax_Syntax.ppname); FStar_Syntax_Syntax.index = - (uu___94_2894.FStar_Syntax_Syntax.index); + (uu___94_2911.FStar_Syntax_Syntax.index); FStar_Syntax_Syntax.sort = ty }) (fun _0_41 -> FStar_Util.Inl _0_41)) in - let uu___95_2895 = lb in - let uu____2896 = + let uu___95_2912 = lb in + let uu____2913 = closure_as_term cfg env2 lb.FStar_Syntax_Syntax.lbdef in { FStar_Syntax_Syntax.lbname = nm; FStar_Syntax_Syntax.lbunivs = - (uu___95_2895.FStar_Syntax_Syntax.lbunivs); + (uu___95_2912.FStar_Syntax_Syntax.lbunivs); FStar_Syntax_Syntax.lbtyp = ty; FStar_Syntax_Syntax.lbeff = - (uu___95_2895.FStar_Syntax_Syntax.lbeff); - FStar_Syntax_Syntax.lbdef = uu____2896 + (uu___95_2912.FStar_Syntax_Syntax.lbeff); + FStar_Syntax_Syntax.lbdef = uu____2913 } in let lbs1 = FStar_All.pipe_right lbs @@ -808,127 +820,127 @@ let rec closure_as_term: let body1 = let body_env = FStar_List.fold_right - (fun uu____2926 -> fun env1 -> dummy :: env1) lbs1 + (fun uu____2943 -> fun env1 -> dummy :: env1) lbs1 env in closure_as_term cfg body_env body in mk (FStar_Syntax_Syntax.Tm_let ((true, lbs1), body1)) t1.FStar_Syntax_Syntax.pos | FStar_Syntax_Syntax.Tm_match (head1,branches) -> let head2 = closure_as_term cfg env head1 in - let norm_one_branch env1 uu____3015 = - match uu____3015 with + let norm_one_branch env1 uu____3032 = + match uu____3032 with | (pat,w_opt,tm) -> let rec norm_pat env2 p = match p.FStar_Syntax_Syntax.v with - | FStar_Syntax_Syntax.Pat_constant uu____3070 -> + | FStar_Syntax_Syntax.Pat_constant uu____3087 -> (p, env2) | FStar_Syntax_Syntax.Pat_cons (fv,pats) -> - let uu____3091 = + let uu____3108 = FStar_All.pipe_right pats (FStar_List.fold_left - (fun uu____3151 -> - fun uu____3152 -> - match (uu____3151, uu____3152) with + (fun uu____3168 -> + fun uu____3169 -> + match (uu____3168, uu____3169) with | ((pats1,env3),(p1,b)) -> - let uu____3243 = + let uu____3260 = norm_pat env3 p1 in - (match uu____3243 with + (match uu____3260 with | (p2,env4) -> (((p2, b) :: pats1), env4))) ([], env2)) in - (match uu____3091 with + (match uu____3108 with | (pats1,env3) -> - ((let uu___96_3325 = p in + ((let uu___96_3342 = p in { FStar_Syntax_Syntax.v = (FStar_Syntax_Syntax.Pat_cons (fv, (FStar_List.rev pats1))); FStar_Syntax_Syntax.p = - (uu___96_3325.FStar_Syntax_Syntax.p) + (uu___96_3342.FStar_Syntax_Syntax.p) }), env3)) | FStar_Syntax_Syntax.Pat_var x -> let x1 = - let uu___97_3344 = x in - let uu____3345 = + let uu___97_3361 = x in + let uu____3362 = closure_as_term cfg env2 x.FStar_Syntax_Syntax.sort in { FStar_Syntax_Syntax.ppname = - (uu___97_3344.FStar_Syntax_Syntax.ppname); + (uu___97_3361.FStar_Syntax_Syntax.ppname); FStar_Syntax_Syntax.index = - (uu___97_3344.FStar_Syntax_Syntax.index); - FStar_Syntax_Syntax.sort = uu____3345 + (uu___97_3361.FStar_Syntax_Syntax.index); + FStar_Syntax_Syntax.sort = uu____3362 } in - ((let uu___98_3359 = p in + ((let uu___98_3376 = p in { FStar_Syntax_Syntax.v = (FStar_Syntax_Syntax.Pat_var x1); FStar_Syntax_Syntax.p = - (uu___98_3359.FStar_Syntax_Syntax.p) + (uu___98_3376.FStar_Syntax_Syntax.p) }), (dummy :: env2)) | FStar_Syntax_Syntax.Pat_wild x -> let x1 = - let uu___99_3370 = x in - let uu____3371 = + let uu___99_3387 = x in + let uu____3388 = closure_as_term cfg env2 x.FStar_Syntax_Syntax.sort in { FStar_Syntax_Syntax.ppname = - (uu___99_3370.FStar_Syntax_Syntax.ppname); + (uu___99_3387.FStar_Syntax_Syntax.ppname); FStar_Syntax_Syntax.index = - (uu___99_3370.FStar_Syntax_Syntax.index); - FStar_Syntax_Syntax.sort = uu____3371 + (uu___99_3387.FStar_Syntax_Syntax.index); + FStar_Syntax_Syntax.sort = uu____3388 } in - ((let uu___100_3385 = p in + ((let uu___100_3402 = p in { FStar_Syntax_Syntax.v = (FStar_Syntax_Syntax.Pat_wild x1); FStar_Syntax_Syntax.p = - (uu___100_3385.FStar_Syntax_Syntax.p) + (uu___100_3402.FStar_Syntax_Syntax.p) }), (dummy :: env2)) | FStar_Syntax_Syntax.Pat_dot_term (x,t2) -> let x1 = - let uu___101_3401 = x in - let uu____3402 = + let uu___101_3418 = x in + let uu____3419 = closure_as_term cfg env2 x.FStar_Syntax_Syntax.sort in { FStar_Syntax_Syntax.ppname = - (uu___101_3401.FStar_Syntax_Syntax.ppname); + (uu___101_3418.FStar_Syntax_Syntax.ppname); FStar_Syntax_Syntax.index = - (uu___101_3401.FStar_Syntax_Syntax.index); - FStar_Syntax_Syntax.sort = uu____3402 + (uu___101_3418.FStar_Syntax_Syntax.index); + FStar_Syntax_Syntax.sort = uu____3419 } in let t3 = closure_as_term cfg env2 t2 in - ((let uu___102_3409 = p in + ((let uu___102_3426 = p in { FStar_Syntax_Syntax.v = (FStar_Syntax_Syntax.Pat_dot_term (x1, t3)); FStar_Syntax_Syntax.p = - (uu___102_3409.FStar_Syntax_Syntax.p) + (uu___102_3426.FStar_Syntax_Syntax.p) }), env2) in - let uu____3412 = norm_pat env1 pat in - (match uu____3412 with + let uu____3429 = norm_pat env1 pat in + (match uu____3429 with | (pat1,env2) -> let w_opt1 = match w_opt with | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None | FStar_Pervasives_Native.Some w -> - let uu____3441 = + let uu____3458 = closure_as_term cfg env2 w in - FStar_Pervasives_Native.Some uu____3441 in + FStar_Pervasives_Native.Some uu____3458 in let tm1 = closure_as_term cfg env2 tm in (pat1, w_opt1, tm1)) in - let uu____3447 = - let uu____3448 = - let uu____3471 = + let uu____3464 = + let uu____3465 = + let uu____3488 = FStar_All.pipe_right branches (FStar_List.map (norm_one_branch env)) in - (head2, uu____3471) in - FStar_Syntax_Syntax.Tm_match uu____3448 in - mk uu____3447 t1.FStar_Syntax_Syntax.pos)) + (head2, uu____3488) in + FStar_Syntax_Syntax.Tm_match uu____3465 in + mk uu____3464 t1.FStar_Syntax_Syntax.pos)) and closure_as_term_delayed: cfg -> env -> @@ -943,7 +955,7 @@ and closure_as_term_delayed: FStar_All.pipe_left Prims.op_Negation (FStar_List.contains CompressUvars cfg.steps) -> t - | uu____3557 -> closure_as_term cfg env t + | uu____3574 -> closure_as_term cfg env t and closures_as_args_delayed: cfg -> env -> @@ -960,13 +972,13 @@ and closures_as_args_delayed: FStar_All.pipe_left Prims.op_Negation (FStar_List.contains CompressUvars cfg.steps) -> args - | uu____3583 -> + | uu____3600 -> FStar_List.map - (fun uu____3600 -> - match uu____3600 with + (fun uu____3617 -> + match uu____3617 with | (x,imp) -> - let uu____3619 = closure_as_term_delayed cfg env x in - (uu____3619, imp)) args + let uu____3636 = closure_as_term_delayed cfg env x in + (uu____3636, imp)) args and closures_as_binders_delayed: cfg -> env -> @@ -979,28 +991,28 @@ and closures_as_binders_delayed: fun cfg -> fun env -> fun bs -> - let uu____3633 = + let uu____3650 = FStar_All.pipe_right bs (FStar_List.fold_left - (fun uu____3682 -> - fun uu____3683 -> - match (uu____3682, uu____3683) with + (fun uu____3699 -> + fun uu____3700 -> + match (uu____3699, uu____3700) with | ((env1,out),(b,imp)) -> let b1 = - let uu___103_3753 = b in - let uu____3754 = + let uu___103_3770 = b in + let uu____3771 = closure_as_term_delayed cfg env1 b.FStar_Syntax_Syntax.sort in { FStar_Syntax_Syntax.ppname = - (uu___103_3753.FStar_Syntax_Syntax.ppname); + (uu___103_3770.FStar_Syntax_Syntax.ppname); FStar_Syntax_Syntax.index = - (uu___103_3753.FStar_Syntax_Syntax.index); - FStar_Syntax_Syntax.sort = uu____3754 + (uu___103_3770.FStar_Syntax_Syntax.index); + FStar_Syntax_Syntax.sort = uu____3771 } in let env2 = dummy :: env1 in (env2, ((b1, imp) :: out))) (env, [])) in - match uu____3633 with | (env1,bs1) -> ((FStar_List.rev bs1), env1) + match uu____3650 with | (env1,bs1) -> ((FStar_List.rev bs1), env1) and close_comp: cfg -> env -> @@ -1015,18 +1027,18 @@ and close_comp: FStar_All.pipe_left Prims.op_Negation (FStar_List.contains CompressUvars cfg.steps) -> c - | uu____3847 -> + | uu____3864 -> (match c.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Total (t,uopt) -> - let uu____3860 = closure_as_term_delayed cfg env t in - let uu____3861 = + let uu____3877 = closure_as_term_delayed cfg env t in + let uu____3878 = FStar_Option.map (norm_universe cfg env) uopt in - FStar_Syntax_Syntax.mk_Total' uu____3860 uu____3861 + FStar_Syntax_Syntax.mk_Total' uu____3877 uu____3878 | FStar_Syntax_Syntax.GTotal (t,uopt) -> - let uu____3874 = closure_as_term_delayed cfg env t in - let uu____3875 = + let uu____3891 = closure_as_term_delayed cfg env t in + let uu____3892 = FStar_Option.map (norm_universe cfg env) uopt in - FStar_Syntax_Syntax.mk_GTotal' uu____3874 uu____3875 + FStar_Syntax_Syntax.mk_GTotal' uu____3891 uu____3892 | FStar_Syntax_Syntax.Comp c1 -> let rt = closure_as_term_delayed cfg env @@ -1037,27 +1049,27 @@ and close_comp: let flags1 = FStar_All.pipe_right c1.FStar_Syntax_Syntax.flags (FStar_List.map - (fun uu___74_3901 -> - match uu___74_3901 with + (fun uu___74_3918 -> + match uu___74_3918 with | FStar_Syntax_Syntax.DECREASES t -> - let uu____3905 = + let uu____3922 = closure_as_term_delayed cfg env t in - FStar_Syntax_Syntax.DECREASES uu____3905 + FStar_Syntax_Syntax.DECREASES uu____3922 | f -> f)) in - let uu____3909 = - let uu___104_3910 = c1 in - let uu____3911 = + let uu____3926 = + let uu___104_3927 = c1 in + let uu____3928 = FStar_List.map (norm_universe cfg env) c1.FStar_Syntax_Syntax.comp_univs in { - FStar_Syntax_Syntax.comp_univs = uu____3911; + FStar_Syntax_Syntax.comp_univs = uu____3928; FStar_Syntax_Syntax.effect_name = - (uu___104_3910.FStar_Syntax_Syntax.effect_name); + (uu___104_3927.FStar_Syntax_Syntax.effect_name); FStar_Syntax_Syntax.result_typ = rt; FStar_Syntax_Syntax.effect_args = args; FStar_Syntax_Syntax.flags = flags1 } in - FStar_Syntax_Syntax.mk_Comp uu____3909) + FStar_Syntax_Syntax.mk_Comp uu____3926) and filter_out_lcomp_cflags: FStar_Syntax_Syntax.cflags Prims.list -> FStar_Syntax_Syntax.cflags Prims.list @@ -1065,10 +1077,10 @@ and filter_out_lcomp_cflags: fun flags1 -> FStar_All.pipe_right flags1 (FStar_List.filter - (fun uu___75_3921 -> - match uu___75_3921 with - | FStar_Syntax_Syntax.DECREASES uu____3922 -> false - | uu____3925 -> true)) + (fun uu___75_3938 -> + match uu___75_3938 with + | FStar_Syntax_Syntax.DECREASES uu____3939 -> false + | uu____3942 -> true)) and close_lcomp_opt: cfg -> env -> @@ -1083,23 +1095,23 @@ and close_lcomp_opt: let flags1 = FStar_All.pipe_right rc.FStar_Syntax_Syntax.residual_flags (FStar_List.filter - (fun uu___76_3943 -> - match uu___76_3943 with - | FStar_Syntax_Syntax.DECREASES uu____3944 -> false - | uu____3947 -> true)) in + (fun uu___76_3960 -> + match uu___76_3960 with + | FStar_Syntax_Syntax.DECREASES uu____3961 -> false + | uu____3964 -> true)) in let rc1 = - let uu___105_3949 = rc in - let uu____3950 = + let uu___105_3966 = rc in + let uu____3967 = FStar_Util.map_opt rc.FStar_Syntax_Syntax.residual_typ (closure_as_term cfg env) in { FStar_Syntax_Syntax.residual_effect = - (uu___105_3949.FStar_Syntax_Syntax.residual_effect); - FStar_Syntax_Syntax.residual_typ = uu____3950; + (uu___105_3966.FStar_Syntax_Syntax.residual_effect); + FStar_Syntax_Syntax.residual_typ = uu____3967; FStar_Syntax_Syntax.residual_flags = flags1 } in FStar_Pervasives_Native.Some rc1 - | uu____3957 -> lopt + | uu____3974 -> lopt let built_in_primitive_steps: primitive_step Prims.list = let arg_as_int a = FStar_All.pipe_right (FStar_Pervasives_Native.fst a) @@ -1114,19 +1126,19 @@ let built_in_primitive_steps: primitive_step Prims.list = FStar_All.pipe_right (FStar_Pervasives_Native.fst a) FStar_Syntax_Embeddings.unembed_string_safe in let arg_as_list u a = - let uu____4047 = FStar_Syntax_Embeddings.unembed_list_safe u in - FStar_All.pipe_right (FStar_Pervasives_Native.fst a) uu____4047 in - let arg_as_bounded_int uu____4075 = - match uu____4075 with - | (a,uu____4087) -> - let uu____4094 = - let uu____4095 = FStar_Syntax_Subst.compress a in - uu____4095.FStar_Syntax_Syntax.n in - (match uu____4094 with + let uu____4064 = FStar_Syntax_Embeddings.unembed_list_safe u in + FStar_All.pipe_right (FStar_Pervasives_Native.fst a) uu____4064 in + let arg_as_bounded_int uu____4092 = + match uu____4092 with + | (a,uu____4104) -> + let uu____4111 = + let uu____4112 = FStar_Syntax_Subst.compress a in + uu____4112.FStar_Syntax_Syntax.n in + (match uu____4111 with | FStar_Syntax_Syntax.Tm_app ({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_fvar fv1; - FStar_Syntax_Syntax.pos = uu____4105; - FStar_Syntax_Syntax.vars = uu____4106;_},({ + FStar_Syntax_Syntax.pos = uu____4122; + FStar_Syntax_Syntax.vars = uu____4123;_},({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_constant @@ -1134,39 +1146,39 @@ let built_in_primitive_steps: primitive_step Prims.list = (i,FStar_Pervasives_Native.None )); FStar_Syntax_Syntax.pos - = uu____4108; + = uu____4125; FStar_Syntax_Syntax.vars - = uu____4109;_},uu____4110)::[]) + = uu____4126;_},uu____4127)::[]) when FStar_Util.ends_with (FStar_Ident.text_of_lid (fv1.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v) "int_to_t" -> - let uu____4149 = - let uu____4154 = FStar_BigInt.big_int_of_string i in - (fv1, uu____4154) in - FStar_Pervasives_Native.Some uu____4149 - | uu____4159 -> FStar_Pervasives_Native.None) in + let uu____4166 = + let uu____4171 = FStar_BigInt.big_int_of_string i in + (fv1, uu____4171) in + FStar_Pervasives_Native.Some uu____4166 + | uu____4176 -> FStar_Pervasives_Native.None) in let lift_unary f aopts = match aopts with | (FStar_Pervasives_Native.Some a)::[] -> - let uu____4201 = f a in FStar_Pervasives_Native.Some uu____4201 - | uu____4202 -> FStar_Pervasives_Native.None in + let uu____4218 = f a in FStar_Pervasives_Native.Some uu____4218 + | uu____4219 -> FStar_Pervasives_Native.None in let lift_binary f aopts = match aopts with | (FStar_Pervasives_Native.Some a0)::(FStar_Pervasives_Native.Some a1)::[] -> - let uu____4252 = f a0 a1 in FStar_Pervasives_Native.Some uu____4252 - | uu____4253 -> FStar_Pervasives_Native.None in + let uu____4269 = f a0 a1 in FStar_Pervasives_Native.Some uu____4269 + | uu____4270 -> FStar_Pervasives_Native.None in let unary_op as_a f res args = - let uu____4302 = FStar_List.map as_a args in - lift_unary (f res.psc_range) uu____4302 in + let uu____4319 = FStar_List.map as_a args in + lift_unary (f res.psc_range) uu____4319 in let binary_op as_a f res args = - let uu____4358 = FStar_List.map as_a args in - lift_binary (f res.psc_range) uu____4358 in - let as_primitive_step uu____4382 = - match uu____4382 with + let uu____4375 = FStar_List.map as_a args in + lift_binary (f res.psc_range) uu____4375 in + let as_primitive_step uu____4399 = + match uu____4399 with | (l,arity,f) -> { name = l; @@ -1179,128 +1191,128 @@ let built_in_primitive_steps: primitive_step Prims.list = unary_op arg_as_int (fun r -> fun x -> - let uu____4430 = f x in - FStar_Syntax_Embeddings.embed_int r uu____4430) in + let uu____4447 = f x in + FStar_Syntax_Embeddings.embed_int r uu____4447) in let binary_int_op f = binary_op arg_as_int (fun r -> fun x -> fun y -> - let uu____4458 = f x y in - FStar_Syntax_Embeddings.embed_int r uu____4458) in + let uu____4475 = f x y in + FStar_Syntax_Embeddings.embed_int r uu____4475) in let unary_bool_op f = unary_op arg_as_bool (fun r -> fun x -> - let uu____4479 = f x in - FStar_Syntax_Embeddings.embed_bool r uu____4479) in + let uu____4496 = f x in + FStar_Syntax_Embeddings.embed_bool r uu____4496) in let binary_bool_op f = binary_op arg_as_bool (fun r -> fun x -> fun y -> - let uu____4507 = f x y in - FStar_Syntax_Embeddings.embed_bool r uu____4507) in + let uu____4524 = f x y in + FStar_Syntax_Embeddings.embed_bool r uu____4524) in let binary_string_op f = binary_op arg_as_string (fun r -> fun x -> fun y -> - let uu____4535 = f x y in - FStar_Syntax_Embeddings.embed_string r uu____4535) in + let uu____4552 = f x y in + FStar_Syntax_Embeddings.embed_string r uu____4552) in let mixed_binary_op as_a as_b embed_c f res args = match args with | a::b::[] -> - let uu____4652 = - let uu____4661 = as_a a in - let uu____4664 = as_b b in (uu____4661, uu____4664) in - (match uu____4652 with + let uu____4669 = + let uu____4678 = as_a a in + let uu____4681 = as_b b in (uu____4678, uu____4681) in + (match uu____4669 with | (FStar_Pervasives_Native.Some a1,FStar_Pervasives_Native.Some b1) -> - let uu____4679 = - let uu____4680 = f res.psc_range a1 b1 in - embed_c res.psc_range uu____4680 in - FStar_Pervasives_Native.Some uu____4679 - | uu____4681 -> FStar_Pervasives_Native.None) - | uu____4690 -> FStar_Pervasives_Native.None in + let uu____4696 = + let uu____4697 = f res.psc_range a1 b1 in + embed_c res.psc_range uu____4697 in + FStar_Pervasives_Native.Some uu____4696 + | uu____4698 -> FStar_Pervasives_Native.None) + | uu____4707 -> FStar_Pervasives_Native.None in let list_of_string' rng s = let name l = - let uu____4704 = - let uu____4705 = + let uu____4721 = + let uu____4722 = FStar_Syntax_Syntax.lid_as_fv l FStar_Syntax_Syntax.Delta_constant FStar_Pervasives_Native.None in - FStar_Syntax_Syntax.Tm_fvar uu____4705 in - mk uu____4704 rng in + FStar_Syntax_Syntax.Tm_fvar uu____4722 in + mk uu____4721 rng in let char_t = name FStar_Parser_Const.char_lid in let charterm c = mk (FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_char c)) rng in - let uu____4715 = - let uu____4718 = FStar_String.list_of_string s in - FStar_List.map charterm uu____4718 in - FStar_All.pipe_left (FStar_Syntax_Util.mk_list char_t rng) uu____4715 in + let uu____4732 = + let uu____4735 = FStar_String.list_of_string s in + FStar_List.map charterm uu____4735 in + FStar_All.pipe_left (FStar_Syntax_Util.mk_list char_t rng) uu____4732 in let string_of_list' rng l = let s = FStar_String.string_of_list l in FStar_Syntax_Util.exp_string s in let string_compare' rng s1 s2 = let r = FStar_String.compare s1 s2 in - let uu____4750 = - let uu____4751 = FStar_Util.string_of_int r in - FStar_BigInt.big_int_of_string uu____4751 in - FStar_Syntax_Embeddings.embed_int rng uu____4750 in + let uu____4767 = + let uu____4768 = FStar_Util.string_of_int r in + FStar_BigInt.big_int_of_string uu____4768 in + FStar_Syntax_Embeddings.embed_int rng uu____4767 in let string_concat' psc args = match args with | a1::a2::[] -> - let uu____4769 = arg_as_string a1 in - (match uu____4769 with + let uu____4786 = arg_as_string a1 in + (match uu____4786 with | FStar_Pervasives_Native.Some s1 -> - let uu____4775 = + let uu____4792 = arg_as_list FStar_Syntax_Embeddings.unembed_string_safe a2 in - (match uu____4775 with + (match uu____4792 with | FStar_Pervasives_Native.Some s2 -> let r = FStar_String.concat s1 s2 in - let uu____4788 = + let uu____4805 = FStar_Syntax_Embeddings.embed_string psc.psc_range r in - FStar_Pervasives_Native.Some uu____4788 - | uu____4789 -> FStar_Pervasives_Native.None) - | uu____4794 -> FStar_Pervasives_Native.None) - | uu____4797 -> FStar_Pervasives_Native.None in + FStar_Pervasives_Native.Some uu____4805 + | uu____4806 -> FStar_Pervasives_Native.None) + | uu____4811 -> FStar_Pervasives_Native.None) + | uu____4814 -> FStar_Pervasives_Native.None in let string_of_int1 rng i = - let uu____4807 = FStar_BigInt.string_of_big_int i in - FStar_Syntax_Embeddings.embed_string rng uu____4807 in + let uu____4824 = FStar_BigInt.string_of_big_int i in + FStar_Syntax_Embeddings.embed_string rng uu____4824 in let string_of_bool1 rng b = FStar_Syntax_Embeddings.embed_string rng (if b then "true" else "false") in let term_of_range r = FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_range r)) FStar_Pervasives_Native.None r in - let mk_range1 uu____4831 args = + let mk_range1 uu____4848 args = match args with | fn::from_line::from_col::to_line::to_col::[] -> - let uu____4842 = - let uu____4863 = arg_as_string fn in - let uu____4866 = arg_as_int from_line in - let uu____4869 = arg_as_int from_col in - let uu____4872 = arg_as_int to_line in - let uu____4875 = arg_as_int to_col in - (uu____4863, uu____4866, uu____4869, uu____4872, uu____4875) in - (match uu____4842 with + let uu____4859 = + let uu____4880 = arg_as_string fn in + let uu____4883 = arg_as_int from_line in + let uu____4886 = arg_as_int from_col in + let uu____4889 = arg_as_int to_line in + let uu____4892 = arg_as_int to_col in + (uu____4880, uu____4883, uu____4886, uu____4889, uu____4892) in + (match uu____4859 with | (FStar_Pervasives_Native.Some fn1,FStar_Pervasives_Native.Some from_l,FStar_Pervasives_Native.Some from_c,FStar_Pervasives_Native.Some to_l,FStar_Pervasives_Native.Some to_c) -> let r = - let uu____4906 = - let uu____4907 = FStar_BigInt.to_int_fs from_l in - let uu____4908 = FStar_BigInt.to_int_fs from_c in - FStar_Range.mk_pos uu____4907 uu____4908 in - let uu____4909 = - let uu____4910 = FStar_BigInt.to_int_fs to_l in - let uu____4911 = FStar_BigInt.to_int_fs to_c in - FStar_Range.mk_pos uu____4910 uu____4911 in - FStar_Range.mk_range fn1 uu____4906 uu____4909 in - let uu____4912 = term_of_range r in - FStar_Pervasives_Native.Some uu____4912 - | uu____4917 -> FStar_Pervasives_Native.None) - | uu____4938 -> FStar_Pervasives_Native.None in + let uu____4923 = + let uu____4924 = FStar_BigInt.to_int_fs from_l in + let uu____4925 = FStar_BigInt.to_int_fs from_c in + FStar_Range.mk_pos uu____4924 uu____4925 in + let uu____4926 = + let uu____4927 = FStar_BigInt.to_int_fs to_l in + let uu____4928 = FStar_BigInt.to_int_fs to_c in + FStar_Range.mk_pos uu____4927 uu____4928 in + FStar_Range.mk_range fn1 uu____4923 uu____4926 in + let uu____4929 = term_of_range r in + FStar_Pervasives_Native.Some uu____4929 + | uu____4934 -> FStar_Pervasives_Native.None) + | uu____4955 -> FStar_Pervasives_Native.None in let decidable_eq neg psc args = let r = psc.psc_range in let tru = @@ -1308,116 +1320,116 @@ let built_in_primitive_steps: primitive_step Prims.list = let fal = mk (FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_bool false)) r in match args with - | (_typ,uu____4965)::(a1,uu____4967)::(a2,uu____4969)::[] -> - let uu____5006 = FStar_Syntax_Util.eq_tm a1 a2 in - (match uu____5006 with + | (_typ,uu____4982)::(a1,uu____4984)::(a2,uu____4986)::[] -> + let uu____5023 = FStar_Syntax_Util.eq_tm a1 a2 in + (match uu____5023 with | FStar_Syntax_Util.Equal -> FStar_Pervasives_Native.Some (if neg then fal else tru) | FStar_Syntax_Util.NotEqual -> FStar_Pervasives_Native.Some (if neg then tru else fal) - | uu____5019 -> FStar_Pervasives_Native.None) - | uu____5020 -> failwith "Unexpected number of arguments" in + | uu____5036 -> FStar_Pervasives_Native.None) + | uu____5037 -> failwith "Unexpected number of arguments" in let idstep psc args = match args with - | (a1,uu____5047)::[] -> FStar_Pervasives_Native.Some a1 - | uu____5056 -> failwith "Unexpected number of arguments" in + | (a1,uu____5064)::[] -> FStar_Pervasives_Native.Some a1 + | uu____5073 -> failwith "Unexpected number of arguments" in let basic_ops = - let uu____5080 = - let uu____5095 = - let uu____5110 = - let uu____5125 = - let uu____5140 = - let uu____5155 = - let uu____5170 = - let uu____5185 = - let uu____5200 = - let uu____5215 = - let uu____5230 = - let uu____5245 = - let uu____5260 = - let uu____5275 = - let uu____5290 = - let uu____5305 = - let uu____5320 = - let uu____5335 = - let uu____5350 = - let uu____5365 = - let uu____5380 = - let uu____5393 = + let uu____5097 = + let uu____5112 = + let uu____5127 = + let uu____5142 = + let uu____5157 = + let uu____5172 = + let uu____5187 = + let uu____5202 = + let uu____5217 = + let uu____5232 = + let uu____5247 = + let uu____5262 = + let uu____5277 = + let uu____5292 = + let uu____5307 = + let uu____5322 = + let uu____5337 = + let uu____5352 = + let uu____5367 = + let uu____5382 = + let uu____5397 = + let uu____5410 = FStar_Parser_Const.p2l ["FStar"; "String"; "list_of_string"] in - (uu____5393, + (uu____5410, (Prims.parse_int "1"), (unary_op arg_as_string list_of_string')) in - let uu____5400 = - let uu____5415 = - let uu____5428 = + let uu____5417 = + let uu____5432 = + let uu____5445 = FStar_Parser_Const.p2l ["FStar"; "String"; "string_of_list"] in - (uu____5428, + (uu____5445, (Prims.parse_int "1"), (unary_op (arg_as_list FStar_Syntax_Embeddings.unembed_char_safe) string_of_list')) in - let uu____5439 = - let uu____5454 = - let uu____5469 = + let uu____5456 = + let uu____5471 = + let uu____5486 = FStar_Parser_Const.p2l ["FStar"; "String"; "concat"] in - (uu____5469, + (uu____5486, (Prims.parse_int "2"), string_concat') in - let uu____5478 = - let uu____5495 = - let uu____5510 = + let uu____5495 = + let uu____5512 = + let uu____5527 = FStar_Parser_Const.p2l ["Prims"; "mk_range"] in - (uu____5510, + (uu____5527, (Prims.parse_int "5"), mk_range1) in - let uu____5519 = - let uu____5536 = - let uu____5555 = + let uu____5536 = + let uu____5553 = + let uu____5572 = FStar_Parser_Const.p2l ["FStar"; "Range"; "prims_to_fstar_range"] in - (uu____5555, + (uu____5572, (Prims.parse_int "1"), idstep) in - [uu____5536] in - uu____5495 :: uu____5519 in - uu____5454 :: uu____5478 in - uu____5415 :: uu____5439 in - uu____5380 :: uu____5400 in + [uu____5553] in + uu____5512 :: uu____5536 in + uu____5471 :: uu____5495 in + uu____5432 :: uu____5456 in + uu____5397 :: uu____5417 in (FStar_Parser_Const.op_notEq, (Prims.parse_int "3"), (decidable_eq true)) :: - uu____5365 in + uu____5382 in (FStar_Parser_Const.op_Eq, (Prims.parse_int "3"), - (decidable_eq false)) :: uu____5350 in + (decidable_eq false)) :: uu____5367 in (FStar_Parser_Const.string_compare, (Prims.parse_int "2"), (binary_op arg_as_string string_compare')) - :: uu____5335 in + :: uu____5352 in (FStar_Parser_Const.string_of_bool_lid, (Prims.parse_int "1"), (unary_op arg_as_bool string_of_bool1)) - :: uu____5320 in + :: uu____5337 in (FStar_Parser_Const.string_of_int_lid, (Prims.parse_int "1"), (unary_op arg_as_int string_of_int1)) :: - uu____5305 in + uu____5322 in (FStar_Parser_Const.str_make_lid, (Prims.parse_int "2"), (mixed_binary_op arg_as_int arg_as_char @@ -1425,79 +1437,79 @@ let built_in_primitive_steps: primitive_step Prims.list = (fun r -> fun x -> fun y -> - let uu____5773 = + let uu____5790 = FStar_BigInt.to_int_fs x in - FStar_String.make uu____5773 y))) - :: uu____5290 in + FStar_String.make uu____5790 y))) + :: uu____5307 in (FStar_Parser_Const.strcat_lid', (Prims.parse_int "2"), (binary_string_op (fun x -> fun y -> Prims.strcat x y))) - :: uu____5275 in + :: uu____5292 in (FStar_Parser_Const.strcat_lid, (Prims.parse_int "2"), (binary_string_op (fun x -> fun y -> Prims.strcat x y))) - :: uu____5260 in + :: uu____5277 in (FStar_Parser_Const.op_Or, (Prims.parse_int "2"), (binary_bool_op (fun x -> fun y -> x || y))) :: - uu____5245 in + uu____5262 in (FStar_Parser_Const.op_And, (Prims.parse_int "2"), (binary_bool_op (fun x -> fun y -> x && y))) :: - uu____5230 in + uu____5247 in (FStar_Parser_Const.op_Modulus, (Prims.parse_int "2"), (binary_int_op (fun x -> fun y -> FStar_BigInt.mod_big_int x y))) - :: uu____5215 in + :: uu____5232 in (FStar_Parser_Const.op_GTE, (Prims.parse_int "2"), (binary_op arg_as_int (fun r -> fun x -> fun y -> - let uu____5919 = FStar_BigInt.ge_big_int x y in + let uu____5936 = FStar_BigInt.ge_big_int x y in FStar_Syntax_Embeddings.embed_bool r - uu____5919))) - :: uu____5200 in + uu____5936))) + :: uu____5217 in (FStar_Parser_Const.op_GT, (Prims.parse_int "2"), (binary_op arg_as_int (fun r -> fun x -> fun y -> - let uu____5945 = FStar_BigInt.gt_big_int x y in - FStar_Syntax_Embeddings.embed_bool r uu____5945))) - :: uu____5185 in + let uu____5962 = FStar_BigInt.gt_big_int x y in + FStar_Syntax_Embeddings.embed_bool r uu____5962))) + :: uu____5202 in (FStar_Parser_Const.op_LTE, (Prims.parse_int "2"), (binary_op arg_as_int (fun r -> fun x -> fun y -> - let uu____5971 = FStar_BigInt.le_big_int x y in - FStar_Syntax_Embeddings.embed_bool r uu____5971))) - :: uu____5170 in + let uu____5988 = FStar_BigInt.le_big_int x y in + FStar_Syntax_Embeddings.embed_bool r uu____5988))) + :: uu____5187 in (FStar_Parser_Const.op_LT, (Prims.parse_int "2"), (binary_op arg_as_int (fun r -> fun x -> fun y -> - let uu____5997 = FStar_BigInt.lt_big_int x y in - FStar_Syntax_Embeddings.embed_bool r uu____5997))) - :: uu____5155 in + let uu____6014 = FStar_BigInt.lt_big_int x y in + FStar_Syntax_Embeddings.embed_bool r uu____6014))) + :: uu____5172 in (FStar_Parser_Const.op_Division, (Prims.parse_int "2"), (binary_int_op (fun x -> fun y -> FStar_BigInt.div_big_int x y))) - :: uu____5140 in + :: uu____5157 in (FStar_Parser_Const.op_Multiply, (Prims.parse_int "2"), (binary_int_op (fun x -> fun y -> FStar_BigInt.mult_big_int x y))) - :: uu____5125 in + :: uu____5142 in (FStar_Parser_Const.op_Subtraction, (Prims.parse_int "2"), (binary_int_op (fun x -> fun y -> FStar_BigInt.sub_big_int x y))) - :: uu____5110 in + :: uu____5127 in (FStar_Parser_Const.op_Addition, (Prims.parse_int "2"), (binary_int_op (fun x -> fun y -> FStar_BigInt.add_big_int x y))) - :: uu____5095 in + :: uu____5112 in (FStar_Parser_Const.op_Minus, (Prims.parse_int "1"), - (unary_int_op (fun x -> FStar_BigInt.minus_big_int x))) :: uu____5080 in + (unary_int_op (fun x -> FStar_BigInt.minus_big_int x))) :: uu____5097 in let bounded_arith_ops = let bounded_int_types = ["Int8"; @@ -1512,108 +1524,108 @@ let built_in_primitive_steps: primitive_step Prims.list = let int_as_bounded r int_to_t1 n1 = let c = FStar_Syntax_Embeddings.embed_int r n1 in let int_to_t2 = FStar_Syntax_Syntax.fv_to_tm int_to_t1 in - let uu____6147 = - let uu____6148 = - let uu____6149 = FStar_Syntax_Syntax.as_arg c in [uu____6149] in - FStar_Syntax_Syntax.mk_Tm_app int_to_t2 uu____6148 in - uu____6147 FStar_Pervasives_Native.None r in + let uu____6164 = + let uu____6165 = + let uu____6166 = FStar_Syntax_Syntax.as_arg c in [uu____6166] in + FStar_Syntax_Syntax.mk_Tm_app int_to_t2 uu____6165 in + uu____6164 FStar_Pervasives_Native.None r in FStar_All.pipe_right bounded_int_types (FStar_List.collect (fun m -> - let uu____6184 = - let uu____6197 = FStar_Parser_Const.p2l ["FStar"; m; "add"] in - (uu____6197, (Prims.parse_int "2"), + let uu____6201 = + let uu____6214 = FStar_Parser_Const.p2l ["FStar"; m; "add"] in + (uu____6214, (Prims.parse_int "2"), (binary_op arg_as_bounded_int (fun r -> - fun uu____6217 -> - fun uu____6218 -> - match (uu____6217, uu____6218) with - | ((int_to_t1,x),(uu____6237,y)) -> - let uu____6247 = FStar_BigInt.add_big_int x y in - int_as_bounded r int_to_t1 uu____6247))) in - let uu____6248 = - let uu____6263 = - let uu____6276 = FStar_Parser_Const.p2l ["FStar"; m; "sub"] in - (uu____6276, (Prims.parse_int "2"), + fun uu____6234 -> + fun uu____6235 -> + match (uu____6234, uu____6235) with + | ((int_to_t1,x),(uu____6254,y)) -> + let uu____6264 = FStar_BigInt.add_big_int x y in + int_as_bounded r int_to_t1 uu____6264))) in + let uu____6265 = + let uu____6280 = + let uu____6293 = FStar_Parser_Const.p2l ["FStar"; m; "sub"] in + (uu____6293, (Prims.parse_int "2"), (binary_op arg_as_bounded_int (fun r -> - fun uu____6296 -> - fun uu____6297 -> - match (uu____6296, uu____6297) with - | ((int_to_t1,x),(uu____6316,y)) -> - let uu____6326 = FStar_BigInt.sub_big_int x y in - int_as_bounded r int_to_t1 uu____6326))) in - let uu____6327 = - let uu____6342 = - let uu____6355 = FStar_Parser_Const.p2l ["FStar"; m; "mul"] in - (uu____6355, (Prims.parse_int "2"), + fun uu____6313 -> + fun uu____6314 -> + match (uu____6313, uu____6314) with + | ((int_to_t1,x),(uu____6333,y)) -> + let uu____6343 = FStar_BigInt.sub_big_int x y in + int_as_bounded r int_to_t1 uu____6343))) in + let uu____6344 = + let uu____6359 = + let uu____6372 = FStar_Parser_Const.p2l ["FStar"; m; "mul"] in + (uu____6372, (Prims.parse_int "2"), (binary_op arg_as_bounded_int (fun r -> - fun uu____6375 -> - fun uu____6376 -> - match (uu____6375, uu____6376) with - | ((int_to_t1,x),(uu____6395,y)) -> - let uu____6405 = + fun uu____6392 -> + fun uu____6393 -> + match (uu____6392, uu____6393) with + | ((int_to_t1,x),(uu____6412,y)) -> + let uu____6422 = FStar_BigInt.mult_big_int x y in - int_as_bounded r int_to_t1 uu____6405))) in - [uu____6342] in - uu____6263 :: uu____6327 in - uu____6184 :: uu____6248)) in + int_as_bounded r int_to_t1 uu____6422))) in + [uu____6359] in + uu____6280 :: uu____6344 in + uu____6201 :: uu____6265)) in FStar_List.map as_primitive_step (FStar_List.append basic_ops bounded_arith_ops) let equality_ops: primitive_step Prims.list = let interp_prop psc args = let r = psc.psc_range in match args with - | (_typ,uu____6495)::(a1,uu____6497)::(a2,uu____6499)::[] -> - let uu____6536 = FStar_Syntax_Util.eq_tm a1 a2 in - (match uu____6536 with + | (_typ,uu____6512)::(a1,uu____6514)::(a2,uu____6516)::[] -> + let uu____6553 = FStar_Syntax_Util.eq_tm a1 a2 in + (match uu____6553 with | FStar_Syntax_Util.Equal -> FStar_Pervasives_Native.Some - (let uu___106_6542 = FStar_Syntax_Util.t_true in + (let uu___106_6559 = FStar_Syntax_Util.t_true in { FStar_Syntax_Syntax.n = - (uu___106_6542.FStar_Syntax_Syntax.n); + (uu___106_6559.FStar_Syntax_Syntax.n); FStar_Syntax_Syntax.pos = r; FStar_Syntax_Syntax.vars = - (uu___106_6542.FStar_Syntax_Syntax.vars) + (uu___106_6559.FStar_Syntax_Syntax.vars) }) | FStar_Syntax_Util.NotEqual -> FStar_Pervasives_Native.Some - (let uu___107_6546 = FStar_Syntax_Util.t_false in + (let uu___107_6563 = FStar_Syntax_Util.t_false in { FStar_Syntax_Syntax.n = - (uu___107_6546.FStar_Syntax_Syntax.n); + (uu___107_6563.FStar_Syntax_Syntax.n); FStar_Syntax_Syntax.pos = r; FStar_Syntax_Syntax.vars = - (uu___107_6546.FStar_Syntax_Syntax.vars) + (uu___107_6563.FStar_Syntax_Syntax.vars) }) - | uu____6547 -> FStar_Pervasives_Native.None) - | (_typ,uu____6549)::uu____6550::(a1,uu____6552)::(a2,uu____6554)::[] -> - let uu____6603 = FStar_Syntax_Util.eq_tm a1 a2 in - (match uu____6603 with + | uu____6564 -> FStar_Pervasives_Native.None) + | (_typ,uu____6566)::uu____6567::(a1,uu____6569)::(a2,uu____6571)::[] -> + let uu____6620 = FStar_Syntax_Util.eq_tm a1 a2 in + (match uu____6620 with | FStar_Syntax_Util.Equal -> FStar_Pervasives_Native.Some - (let uu___106_6609 = FStar_Syntax_Util.t_true in + (let uu___106_6626 = FStar_Syntax_Util.t_true in { FStar_Syntax_Syntax.n = - (uu___106_6609.FStar_Syntax_Syntax.n); + (uu___106_6626.FStar_Syntax_Syntax.n); FStar_Syntax_Syntax.pos = r; FStar_Syntax_Syntax.vars = - (uu___106_6609.FStar_Syntax_Syntax.vars) + (uu___106_6626.FStar_Syntax_Syntax.vars) }) | FStar_Syntax_Util.NotEqual -> FStar_Pervasives_Native.Some - (let uu___107_6613 = FStar_Syntax_Util.t_false in + (let uu___107_6630 = FStar_Syntax_Util.t_false in { FStar_Syntax_Syntax.n = - (uu___107_6613.FStar_Syntax_Syntax.n); + (uu___107_6630.FStar_Syntax_Syntax.n); FStar_Syntax_Syntax.pos = r; FStar_Syntax_Syntax.vars = - (uu___107_6613.FStar_Syntax_Syntax.vars) + (uu___107_6630.FStar_Syntax_Syntax.vars) }) - | uu____6614 -> FStar_Pervasives_Native.None) - | uu____6615 -> failwith "Unexpected number of arguments" in + | uu____6631 -> FStar_Pervasives_Native.None) + | uu____6632 -> failwith "Unexpected number of arguments" in let propositional_equality = { name = FStar_Parser_Const.eq2_lid; @@ -1637,15 +1649,15 @@ let unembed_binder: = fun t -> try - let uu____6634 = - let uu____6635 = FStar_Syntax_Util.un_alien t in - FStar_All.pipe_right uu____6635 FStar_Dyn.undyn in - FStar_Pervasives_Native.Some uu____6634 - with | uu____6641 -> FStar_Pervasives_Native.None + let uu____6651 = + let uu____6652 = FStar_Syntax_Util.un_alien t in + FStar_All.pipe_right uu____6652 FStar_Dyn.undyn in + FStar_Pervasives_Native.Some uu____6651 + with | uu____6658 -> FStar_Pervasives_Native.None let mk_psc_subst: - 'Auu____6645 . + 'Auu____6662 . cfg -> - ((FStar_Syntax_Syntax.bv,'Auu____6645) FStar_Pervasives_Native.tuple2 + ((FStar_Syntax_Syntax.bv,'Auu____6662) FStar_Pervasives_Native.tuple2 FStar_Pervasives_Native.option,closure) FStar_Pervasives_Native.tuple2 Prims.list -> FStar_Syntax_Syntax.subst_elt Prims.list @@ -1653,105 +1665,105 @@ let mk_psc_subst: fun cfg -> fun env -> FStar_List.fold_right - (fun uu____6705 -> + (fun uu____6722 -> fun subst1 -> - match uu____6705 with + match uu____6722 with | (binder_opt,closure) -> (match (binder_opt, closure) with | (FStar_Pervasives_Native.Some b,Clos - (env1,term,memo,uu____6747)) -> - let uu____6806 = b in - (match uu____6806 with - | (bv,uu____6814) -> - let uu____6815 = - let uu____6816 = + (env1,term,uu____6763,uu____6764)) -> + let uu____6823 = b in + (match uu____6823 with + | (bv,uu____6831) -> + let uu____6832 = + let uu____6833 = FStar_Syntax_Util.is_constructed_typ bv.FStar_Syntax_Syntax.sort FStar_Parser_Const.fstar_reflection_types_binder_lid in - Prims.op_Negation uu____6816 in - if uu____6815 + Prims.op_Negation uu____6833 in + if uu____6832 then subst1 else (let term1 = closure_as_term cfg env1 term in - let uu____6821 = unembed_binder term1 in - match uu____6821 with + let uu____6838 = unembed_binder term1 in + match uu____6838 with | FStar_Pervasives_Native.None -> subst1 | FStar_Pervasives_Native.Some x -> let b1 = - let uu____6828 = - let uu___110_6829 = bv in - let uu____6830 = + let uu____6845 = + let uu___110_6846 = bv in + let uu____6847 = FStar_Syntax_Subst.subst subst1 (FStar_Pervasives_Native.fst x).FStar_Syntax_Syntax.sort in { FStar_Syntax_Syntax.ppname = - (uu___110_6829.FStar_Syntax_Syntax.ppname); + (uu___110_6846.FStar_Syntax_Syntax.ppname); FStar_Syntax_Syntax.index = - (uu___110_6829.FStar_Syntax_Syntax.index); - FStar_Syntax_Syntax.sort = uu____6830 + (uu___110_6846.FStar_Syntax_Syntax.index); + FStar_Syntax_Syntax.sort = uu____6847 } in - FStar_Syntax_Syntax.freshen_bv uu____6828 in + FStar_Syntax_Syntax.freshen_bv uu____6845 in let b_for_x = - let uu____6834 = - let uu____6841 = + let uu____6851 = + let uu____6858 = FStar_Syntax_Syntax.bv_to_name b1 in ((FStar_Pervasives_Native.fst x), - uu____6841) in - FStar_Syntax_Syntax.NT uu____6834 in + uu____6858) in + FStar_Syntax_Syntax.NT uu____6851 in let subst2 = FStar_List.filter - (fun uu___77_6850 -> - match uu___77_6850 with + (fun uu___77_6867 -> + match uu___77_6867 with | FStar_Syntax_Syntax.NT - (uu____6851,{ + (uu____6868,{ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_name b'; FStar_Syntax_Syntax.pos - = uu____6853; + = uu____6870; FStar_Syntax_Syntax.vars - = uu____6854;_}) + = uu____6871;_}) -> Prims.op_Negation (FStar_Ident.ident_equals b1.FStar_Syntax_Syntax.ppname b'.FStar_Syntax_Syntax.ppname) - | uu____6859 -> true) subst1 in + | uu____6876 -> true) subst1 in b_for_x :: subst2)) - | uu____6860 -> subst1)) env [] + | uu____6877 -> subst1)) env [] let reduce_primops: - 'Auu____6877 'Auu____6878 . + 'Auu____6894 'Auu____6895 . cfg -> - ((FStar_Syntax_Syntax.bv,'Auu____6878) FStar_Pervasives_Native.tuple2 + ((FStar_Syntax_Syntax.bv,'Auu____6895) FStar_Pervasives_Native.tuple2 FStar_Pervasives_Native.option,closure) FStar_Pervasives_Native.tuple2 Prims.list -> - 'Auu____6877 -> FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term + 'Auu____6894 -> FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term = fun cfg -> fun env -> fun stack -> fun tm -> - let uu____6919 = + let uu____6936 = FStar_All.pipe_left Prims.op_Negation (FStar_List.contains Primops cfg.steps) in - if uu____6919 + if uu____6936 then tm else - (let uu____6921 = FStar_Syntax_Util.head_and_args tm in - match uu____6921 with + (let uu____6938 = FStar_Syntax_Util.head_and_args tm in + match uu____6938 with | (head1,args) -> - let uu____6958 = - let uu____6959 = FStar_Syntax_Util.un_uinst head1 in - uu____6959.FStar_Syntax_Syntax.n in - (match uu____6958 with + let uu____6975 = + let uu____6976 = FStar_Syntax_Util.un_uinst head1 in + uu____6976.FStar_Syntax_Syntax.n in + (match uu____6975 with | FStar_Syntax_Syntax.Tm_fvar fv -> - let uu____6963 = + let uu____6980 = FStar_List.tryFind (fun ps -> FStar_Syntax_Syntax.fv_eq_lid fv ps.name) cfg.primitive_steps in - (match uu____6963 with + (match uu____6980 with | FStar_Pervasives_Native.Some prim_step when prim_step.strong_reduction_ok || (Prims.op_Negation cfg.strong) @@ -1759,161 +1771,162 @@ let reduce_primops: if (FStar_List.length args) < prim_step.arity then (log_primops cfg - (fun uu____6980 -> - let uu____6981 = + (fun uu____6997 -> + let uu____6998 = FStar_Syntax_Print.lid_to_string prim_step.name in - let uu____6982 = + let uu____6999 = FStar_Util.string_of_int (FStar_List.length args) in - let uu____6989 = + let uu____7006 = FStar_Util.string_of_int prim_step.arity in FStar_Util.print3 "primop: found partially applied %s (%s/%s args)\n" - uu____6981 uu____6982 uu____6989); + uu____6998 uu____6999 uu____7006); tm) else (log_primops cfg - (fun uu____6994 -> - let uu____6995 = + (fun uu____7011 -> + let uu____7012 = FStar_Syntax_Print.term_to_string tm in FStar_Util.print1 "primop: trying to reduce <%s>\n" - uu____6995); + uu____7012); (let psc = { psc_range = (head1.FStar_Syntax_Syntax.pos); psc_subst = - (fun uu____6998 -> + (fun uu____7015 -> if prim_step.requires_binder_substitution then mk_psc_subst cfg env else []) } in - let uu____7000 = + let uu____7017 = prim_step.interpretation psc args in - match uu____7000 with + match uu____7017 with | FStar_Pervasives_Native.None -> (log_primops cfg - (fun uu____7006 -> - let uu____7007 = + (fun uu____7023 -> + let uu____7024 = FStar_Syntax_Print.term_to_string tm in FStar_Util.print1 "primop: <%s> did not reduce\n" - uu____7007); + uu____7024); tm) | FStar_Pervasives_Native.Some reduced -> (log_primops cfg - (fun uu____7013 -> - let uu____7014 = + (fun uu____7030 -> + let uu____7031 = FStar_Syntax_Print.term_to_string tm in - let uu____7015 = + let uu____7032 = FStar_Syntax_Print.term_to_string reduced in FStar_Util.print2 "primop: <%s> reduced to <%s>\n" - uu____7014 uu____7015); + uu____7031 uu____7032); reduced))) - | FStar_Pervasives_Native.Some uu____7016 -> + | FStar_Pervasives_Native.Some uu____7033 -> (log_primops cfg - (fun uu____7020 -> - let uu____7021 = + (fun uu____7037 -> + let uu____7038 = FStar_Syntax_Print.term_to_string tm in FStar_Util.print1 "primop: not reducing <%s> since we're doing strong reduction\n" - uu____7021); + uu____7038); tm) | FStar_Pervasives_Native.None -> tm) | FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_range_of ) when Prims.op_Negation cfg.strong -> (log_primops cfg - (fun uu____7025 -> - let uu____7026 = + (fun uu____7042 -> + let uu____7043 = FStar_Syntax_Print.term_to_string tm in FStar_Util.print1 "primop: reducing <%s>\n" - uu____7026); + uu____7043); (match args with - | (a1,uu____7028)::[] -> + | (a1,uu____7045)::[] -> FStar_Syntax_Embeddings.embed_range tm.FStar_Syntax_Syntax.pos a1.FStar_Syntax_Syntax.pos - | uu____7045 -> tm)) + | uu____7062 -> tm)) | FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_set_range_of ) when Prims.op_Negation cfg.strong -> (log_primops cfg - (fun uu____7057 -> - let uu____7058 = + (fun uu____7074 -> + let uu____7075 = FStar_Syntax_Print.term_to_string tm in FStar_Util.print1 "primop: reducing <%s>\n" - uu____7058); + uu____7075); (match args with - | (t,uu____7060)::(r,uu____7062)::[] -> - let uu____7089 = + | (t,uu____7077)::(r,uu____7079)::[] -> + let uu____7106 = FStar_Syntax_Embeddings.unembed_range r in - (match uu____7089 with + (match uu____7106 with | FStar_Pervasives_Native.Some rng -> - let uu___111_7093 = t in + let uu___111_7110 = t in { FStar_Syntax_Syntax.n = - (uu___111_7093.FStar_Syntax_Syntax.n); + (uu___111_7110.FStar_Syntax_Syntax.n); FStar_Syntax_Syntax.pos = rng; FStar_Syntax_Syntax.vars = - (uu___111_7093.FStar_Syntax_Syntax.vars) + (uu___111_7110.FStar_Syntax_Syntax.vars) } | FStar_Pervasives_Native.None -> tm) - | uu____7096 -> tm)) - | uu____7105 -> tm)) + | uu____7113 -> tm)) + | uu____7122 -> tm)) let reduce_equality: - 'Auu____7110 'Auu____7111 . + 'Auu____7127 'Auu____7128 . cfg -> - ((FStar_Syntax_Syntax.bv,'Auu____7111) FStar_Pervasives_Native.tuple2 + ((FStar_Syntax_Syntax.bv,'Auu____7128) FStar_Pervasives_Native.tuple2 FStar_Pervasives_Native.option,closure) FStar_Pervasives_Native.tuple2 Prims.list -> - 'Auu____7110 -> FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term + 'Auu____7127 -> FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term = fun cfg -> fun tm -> reduce_primops - (let uu___112_7149 = cfg in + (let uu___112_7166 = cfg in { steps = [Primops]; - tcenv = (uu___112_7149.tcenv); - delta_level = (uu___112_7149.delta_level); + tcenv = (uu___112_7166.tcenv); + delta_level = (uu___112_7166.delta_level); primitive_steps = equality_ops; - strong = (uu___112_7149.strong) + strong = (uu___112_7166.strong); + memoize_lazy = (uu___112_7166.memoize_lazy) }) tm let maybe_simplify_aux: - 'Auu____7156 'Auu____7157 . + 'Auu____7173 'Auu____7174 . cfg -> - ((FStar_Syntax_Syntax.bv,'Auu____7157) FStar_Pervasives_Native.tuple2 + ((FStar_Syntax_Syntax.bv,'Auu____7174) FStar_Pervasives_Native.tuple2 FStar_Pervasives_Native.option,closure) FStar_Pervasives_Native.tuple2 Prims.list -> - 'Auu____7156 -> FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term + 'Auu____7173 -> FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term = fun cfg -> fun env -> fun stack -> fun tm -> let tm1 = reduce_primops cfg env stack tm in - let uu____7199 = + let uu____7216 = FStar_All.pipe_left Prims.op_Negation (FStar_List.contains Simplify cfg.steps) in - if uu____7199 + if uu____7216 then tm1 else (let w t = - let uu___113_7211 = t in + let uu___113_7228 = t in { FStar_Syntax_Syntax.n = - (uu___113_7211.FStar_Syntax_Syntax.n); + (uu___113_7228.FStar_Syntax_Syntax.n); FStar_Syntax_Syntax.pos = (tm1.FStar_Syntax_Syntax.pos); FStar_Syntax_Syntax.vars = - (uu___113_7211.FStar_Syntax_Syntax.vars) + (uu___113_7228.FStar_Syntax_Syntax.vars) } in let simp_t t = match t.FStar_Syntax_Syntax.n with @@ -1925,25 +1938,25 @@ let maybe_simplify_aux: FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.false_lid -> FStar_Pervasives_Native.Some false - | uu____7228 -> FStar_Pervasives_Native.None in + | uu____7245 -> FStar_Pervasives_Native.None in let maybe_auto_squash t = - let uu____7233 = FStar_Syntax_Util.is_sub_singleton t in - if uu____7233 + let uu____7250 = FStar_Syntax_Util.is_sub_singleton t in + if uu____7250 then t else FStar_Syntax_Util.mk_auto_squash FStar_Syntax_Syntax.U_zero t in let squashed_head_un_auto_squash_args t = - let maybe_un_auto_squash_arg uu____7254 = - match uu____7254 with + let maybe_un_auto_squash_arg uu____7271 = + match uu____7271 with | (t1,q) -> - let uu____7267 = FStar_Syntax_Util.is_auto_squash t1 in - (match uu____7267 with + let uu____7284 = FStar_Syntax_Util.is_auto_squash t1 in + (match uu____7284 with | FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.U_zero ,t2) -> (t2, q) - | uu____7295 -> (t1, q)) in - let uu____7304 = FStar_Syntax_Util.head_and_args t in - match uu____7304 with + | uu____7312 -> (t1, q)) in + let uu____7321 = FStar_Syntax_Util.head_and_args t in + match uu____7321 with | (head1,args) -> let args1 = FStar_List.map maybe_un_auto_squash_arg args in FStar_Syntax_Syntax.mk_Tm_app head1 args1 @@ -1957,177 +1970,177 @@ let maybe_simplify_aux: ({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_fvar fv; - FStar_Syntax_Syntax.pos = uu____7401; - FStar_Syntax_Syntax.vars = uu____7402;_},uu____7403); - FStar_Syntax_Syntax.pos = uu____7404; - FStar_Syntax_Syntax.vars = uu____7405;_},args) + FStar_Syntax_Syntax.pos = uu____7418; + FStar_Syntax_Syntax.vars = uu____7419;_},uu____7420); + FStar_Syntax_Syntax.pos = uu____7421; + FStar_Syntax_Syntax.vars = uu____7422;_},args) -> - let uu____7431 = + let uu____7448 = FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.and_lid in - if uu____7431 + if uu____7448 then - let uu____7432 = + let uu____7449 = FStar_All.pipe_right args (FStar_List.map simplify1) in - (match uu____7432 with - | (FStar_Pervasives_Native.Some (true ),uu____7487):: - (uu____7488,(arg,uu____7490))::[] -> + (match uu____7449 with + | (FStar_Pervasives_Native.Some (true ),uu____7504):: + (uu____7505,(arg,uu____7507))::[] -> maybe_auto_squash arg - | (uu____7555,(arg,uu____7557))::(FStar_Pervasives_Native.Some - (true ),uu____7558)::[] + | (uu____7572,(arg,uu____7574))::(FStar_Pervasives_Native.Some + (true ),uu____7575)::[] -> maybe_auto_squash arg - | (FStar_Pervasives_Native.Some (false ),uu____7623)::uu____7624::[] + | (FStar_Pervasives_Native.Some (false ),uu____7640)::uu____7641::[] -> w FStar_Syntax_Util.t_false - | uu____7687::(FStar_Pervasives_Native.Some (false - ),uu____7688)::[] + | uu____7704::(FStar_Pervasives_Native.Some (false + ),uu____7705)::[] -> w FStar_Syntax_Util.t_false - | uu____7751 -> squashed_head_un_auto_squash_args tm1) + | uu____7768 -> squashed_head_un_auto_squash_args tm1) else - (let uu____7767 = + (let uu____7784 = FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.or_lid in - if uu____7767 + if uu____7784 then - let uu____7768 = + let uu____7785 = FStar_All.pipe_right args (FStar_List.map simplify1) in - match uu____7768 with - | (FStar_Pervasives_Native.Some (true ),uu____7823)::uu____7824::[] + match uu____7785 with + | (FStar_Pervasives_Native.Some (true ),uu____7840)::uu____7841::[] -> w FStar_Syntax_Util.t_true - | uu____7887::(FStar_Pervasives_Native.Some (true - ),uu____7888)::[] + | uu____7904::(FStar_Pervasives_Native.Some (true + ),uu____7905)::[] -> w FStar_Syntax_Util.t_true - | (FStar_Pervasives_Native.Some (false ),uu____7951):: - (uu____7952,(arg,uu____7954))::[] -> + | (FStar_Pervasives_Native.Some (false ),uu____7968):: + (uu____7969,(arg,uu____7971))::[] -> maybe_auto_squash arg - | (uu____8019,(arg,uu____8021))::(FStar_Pervasives_Native.Some - (false ),uu____8022)::[] + | (uu____8036,(arg,uu____8038))::(FStar_Pervasives_Native.Some + (false ),uu____8039)::[] -> maybe_auto_squash arg - | uu____8087 -> squashed_head_un_auto_squash_args tm1 + | uu____8104 -> squashed_head_un_auto_squash_args tm1 else - (let uu____8103 = + (let uu____8120 = FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.imp_lid in - if uu____8103 + if uu____8120 then - let uu____8104 = + let uu____8121 = FStar_All.pipe_right args (FStar_List.map simplify1) in - match uu____8104 with - | uu____8159::(FStar_Pervasives_Native.Some (true - ),uu____8160)::[] + match uu____8121 with + | uu____8176::(FStar_Pervasives_Native.Some (true + ),uu____8177)::[] -> w FStar_Syntax_Util.t_true - | (FStar_Pervasives_Native.Some (false ),uu____8223)::uu____8224::[] + | (FStar_Pervasives_Native.Some (false ),uu____8240)::uu____8241::[] -> w FStar_Syntax_Util.t_true - | (FStar_Pervasives_Native.Some (true ),uu____8287):: - (uu____8288,(arg,uu____8290))::[] -> + | (FStar_Pervasives_Native.Some (true ),uu____8304):: + (uu____8305,(arg,uu____8307))::[] -> maybe_auto_squash arg - | (uu____8355,(p,uu____8357))::(uu____8358,(q,uu____8360))::[] + | (uu____8372,(p,uu____8374))::(uu____8375,(q,uu____8377))::[] -> - let uu____8425 = FStar_Syntax_Util.term_eq p q in - (if uu____8425 + let uu____8442 = FStar_Syntax_Util.term_eq p q in + (if uu____8442 then w FStar_Syntax_Util.t_true else squashed_head_un_auto_squash_args tm1) - | uu____8427 -> + | uu____8444 -> squashed_head_un_auto_squash_args tm1 else - (let uu____8443 = + (let uu____8460 = FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.not_lid in - if uu____8443 + if uu____8460 then - let uu____8444 = + let uu____8461 = FStar_All.pipe_right args (FStar_List.map simplify1) in - match uu____8444 with + match uu____8461 with | (FStar_Pervasives_Native.Some (true - ),uu____8499)::[] -> + ),uu____8516)::[] -> w FStar_Syntax_Util.t_false | (FStar_Pervasives_Native.Some (false - ),uu____8538)::[] -> + ),uu____8555)::[] -> w FStar_Syntax_Util.t_true - | uu____8577 -> + | uu____8594 -> squashed_head_un_auto_squash_args tm1 else - (let uu____8593 = + (let uu____8610 = FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.forall_lid in - if uu____8593 + if uu____8610 then match args with - | (t,uu____8595)::[] -> - let uu____8612 = - let uu____8613 = + | (t,uu____8612)::[] -> + let uu____8629 = + let uu____8630 = FStar_Syntax_Subst.compress t in - uu____8613.FStar_Syntax_Syntax.n in - (match uu____8612 with + uu____8630.FStar_Syntax_Syntax.n in + (match uu____8629 with | FStar_Syntax_Syntax.Tm_abs - (uu____8616::[],body,uu____8618) -> + (uu____8633::[],body,uu____8635) -> (match simp_t body with | FStar_Pervasives_Native.Some (true ) -> w FStar_Syntax_Util.t_true - | uu____8645 -> tm1) - | uu____8648 -> tm1) - | (uu____8649,FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.Implicit uu____8650)):: - (t,uu____8652)::[] -> - let uu____8691 = - let uu____8692 = + | uu____8662 -> tm1) + | uu____8665 -> tm1) + | (uu____8666,FStar_Pervasives_Native.Some + (FStar_Syntax_Syntax.Implicit uu____8667)):: + (t,uu____8669)::[] -> + let uu____8708 = + let uu____8709 = FStar_Syntax_Subst.compress t in - uu____8692.FStar_Syntax_Syntax.n in - (match uu____8691 with + uu____8709.FStar_Syntax_Syntax.n in + (match uu____8708 with | FStar_Syntax_Syntax.Tm_abs - (uu____8695::[],body,uu____8697) -> + (uu____8712::[],body,uu____8714) -> (match simp_t body with | FStar_Pervasives_Native.Some (true ) -> w FStar_Syntax_Util.t_true - | uu____8724 -> tm1) - | uu____8727 -> tm1) - | uu____8728 -> tm1 + | uu____8741 -> tm1) + | uu____8744 -> tm1) + | uu____8745 -> tm1 else - (let uu____8738 = + (let uu____8755 = FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.exists_lid in - if uu____8738 + if uu____8755 then match args with - | (t,uu____8740)::[] -> - let uu____8757 = - let uu____8758 = + | (t,uu____8757)::[] -> + let uu____8774 = + let uu____8775 = FStar_Syntax_Subst.compress t in - uu____8758.FStar_Syntax_Syntax.n in - (match uu____8757 with + uu____8775.FStar_Syntax_Syntax.n in + (match uu____8774 with | FStar_Syntax_Syntax.Tm_abs - (uu____8761::[],body,uu____8763) + (uu____8778::[],body,uu____8780) -> (match simp_t body with | FStar_Pervasives_Native.Some (false ) -> w FStar_Syntax_Util.t_false - | uu____8790 -> tm1) - | uu____8793 -> tm1) - | (uu____8794,FStar_Pervasives_Native.Some + | uu____8807 -> tm1) + | uu____8810 -> tm1) + | (uu____8811,FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Implicit - uu____8795))::(t,uu____8797)::[] -> - let uu____8836 = - let uu____8837 = + uu____8812))::(t,uu____8814)::[] -> + let uu____8853 = + let uu____8854 = FStar_Syntax_Subst.compress t in - uu____8837.FStar_Syntax_Syntax.n in - (match uu____8836 with + uu____8854.FStar_Syntax_Syntax.n in + (match uu____8853 with | FStar_Syntax_Syntax.Tm_abs - (uu____8840::[],body,uu____8842) + (uu____8857::[],body,uu____8859) -> (match simp_t body with | FStar_Pervasives_Native.Some (false ) -> w FStar_Syntax_Util.t_false - | uu____8869 -> tm1) - | uu____8872 -> tm1) - | uu____8873 -> tm1 + | uu____8886 -> tm1) + | uu____8889 -> tm1) + | uu____8890 -> tm1 else - (let uu____8883 = + (let uu____8900 = FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.b2t_lid in - if uu____8883 + if uu____8900 then match args with | ({ @@ -2135,203 +2148,203 @@ let maybe_simplify_aux: FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_bool (true )); FStar_Syntax_Syntax.pos = - uu____8884; + uu____8901; FStar_Syntax_Syntax.vars = - uu____8885;_},uu____8886)::[] + uu____8902;_},uu____8903)::[] -> w FStar_Syntax_Util.t_true | ({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_bool (false )); FStar_Syntax_Syntax.pos = - uu____8903; + uu____8920; FStar_Syntax_Syntax.vars = - uu____8904;_},uu____8905)::[] + uu____8921;_},uu____8922)::[] -> w FStar_Syntax_Util.t_false - | uu____8922 -> tm1 + | uu____8939 -> tm1 else - (let uu____8932 = + (let uu____8949 = FStar_Syntax_Util.is_auto_squash tm1 in - match uu____8932 with + match uu____8949 with | FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.U_zero ,t) when FStar_Syntax_Util.is_sub_singleton t -> t - | uu____8952 -> + | uu____8969 -> reduce_equality cfg env stack tm1))))))) | FStar_Syntax_Syntax.Tm_app ({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_fvar fv; - FStar_Syntax_Syntax.pos = uu____8962; - FStar_Syntax_Syntax.vars = uu____8963;_},args) + FStar_Syntax_Syntax.pos = uu____8979; + FStar_Syntax_Syntax.vars = uu____8980;_},args) -> - let uu____8985 = + let uu____9002 = FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.and_lid in - if uu____8985 + if uu____9002 then - let uu____8986 = + let uu____9003 = FStar_All.pipe_right args (FStar_List.map simplify1) in - (match uu____8986 with - | (FStar_Pervasives_Native.Some (true ),uu____9041):: - (uu____9042,(arg,uu____9044))::[] -> + (match uu____9003 with + | (FStar_Pervasives_Native.Some (true ),uu____9058):: + (uu____9059,(arg,uu____9061))::[] -> maybe_auto_squash arg - | (uu____9109,(arg,uu____9111))::(FStar_Pervasives_Native.Some - (true ),uu____9112)::[] + | (uu____9126,(arg,uu____9128))::(FStar_Pervasives_Native.Some + (true ),uu____9129)::[] -> maybe_auto_squash arg - | (FStar_Pervasives_Native.Some (false ),uu____9177)::uu____9178::[] + | (FStar_Pervasives_Native.Some (false ),uu____9194)::uu____9195::[] -> w FStar_Syntax_Util.t_false - | uu____9241::(FStar_Pervasives_Native.Some (false - ),uu____9242)::[] + | uu____9258::(FStar_Pervasives_Native.Some (false + ),uu____9259)::[] -> w FStar_Syntax_Util.t_false - | uu____9305 -> squashed_head_un_auto_squash_args tm1) + | uu____9322 -> squashed_head_un_auto_squash_args tm1) else - (let uu____9321 = + (let uu____9338 = FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.or_lid in - if uu____9321 + if uu____9338 then - let uu____9322 = + let uu____9339 = FStar_All.pipe_right args (FStar_List.map simplify1) in - match uu____9322 with - | (FStar_Pervasives_Native.Some (true ),uu____9377)::uu____9378::[] + match uu____9339 with + | (FStar_Pervasives_Native.Some (true ),uu____9394)::uu____9395::[] -> w FStar_Syntax_Util.t_true - | uu____9441::(FStar_Pervasives_Native.Some (true - ),uu____9442)::[] + | uu____9458::(FStar_Pervasives_Native.Some (true + ),uu____9459)::[] -> w FStar_Syntax_Util.t_true - | (FStar_Pervasives_Native.Some (false ),uu____9505):: - (uu____9506,(arg,uu____9508))::[] -> + | (FStar_Pervasives_Native.Some (false ),uu____9522):: + (uu____9523,(arg,uu____9525))::[] -> maybe_auto_squash arg - | (uu____9573,(arg,uu____9575))::(FStar_Pervasives_Native.Some - (false ),uu____9576)::[] + | (uu____9590,(arg,uu____9592))::(FStar_Pervasives_Native.Some + (false ),uu____9593)::[] -> maybe_auto_squash arg - | uu____9641 -> squashed_head_un_auto_squash_args tm1 + | uu____9658 -> squashed_head_un_auto_squash_args tm1 else - (let uu____9657 = + (let uu____9674 = FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.imp_lid in - if uu____9657 + if uu____9674 then - let uu____9658 = + let uu____9675 = FStar_All.pipe_right args (FStar_List.map simplify1) in - match uu____9658 with - | uu____9713::(FStar_Pervasives_Native.Some (true - ),uu____9714)::[] + match uu____9675 with + | uu____9730::(FStar_Pervasives_Native.Some (true + ),uu____9731)::[] -> w FStar_Syntax_Util.t_true - | (FStar_Pervasives_Native.Some (false ),uu____9777)::uu____9778::[] + | (FStar_Pervasives_Native.Some (false ),uu____9794)::uu____9795::[] -> w FStar_Syntax_Util.t_true - | (FStar_Pervasives_Native.Some (true ),uu____9841):: - (uu____9842,(arg,uu____9844))::[] -> + | (FStar_Pervasives_Native.Some (true ),uu____9858):: + (uu____9859,(arg,uu____9861))::[] -> maybe_auto_squash arg - | (uu____9909,(p,uu____9911))::(uu____9912,(q,uu____9914))::[] + | (uu____9926,(p,uu____9928))::(uu____9929,(q,uu____9931))::[] -> - let uu____9979 = FStar_Syntax_Util.term_eq p q in - (if uu____9979 + let uu____9996 = FStar_Syntax_Util.term_eq p q in + (if uu____9996 then w FStar_Syntax_Util.t_true else squashed_head_un_auto_squash_args tm1) - | uu____9981 -> + | uu____9998 -> squashed_head_un_auto_squash_args tm1 else - (let uu____9997 = + (let uu____10014 = FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.not_lid in - if uu____9997 + if uu____10014 then - let uu____9998 = + let uu____10015 = FStar_All.pipe_right args (FStar_List.map simplify1) in - match uu____9998 with + match uu____10015 with | (FStar_Pervasives_Native.Some (true - ),uu____10053)::[] -> + ),uu____10070)::[] -> w FStar_Syntax_Util.t_false | (FStar_Pervasives_Native.Some (false - ),uu____10092)::[] -> + ),uu____10109)::[] -> w FStar_Syntax_Util.t_true - | uu____10131 -> + | uu____10148 -> squashed_head_un_auto_squash_args tm1 else - (let uu____10147 = + (let uu____10164 = FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.forall_lid in - if uu____10147 + if uu____10164 then match args with - | (t,uu____10149)::[] -> - let uu____10166 = - let uu____10167 = + | (t,uu____10166)::[] -> + let uu____10183 = + let uu____10184 = FStar_Syntax_Subst.compress t in - uu____10167.FStar_Syntax_Syntax.n in - (match uu____10166 with + uu____10184.FStar_Syntax_Syntax.n in + (match uu____10183 with | FStar_Syntax_Syntax.Tm_abs - (uu____10170::[],body,uu____10172) -> + (uu____10187::[],body,uu____10189) -> (match simp_t body with | FStar_Pervasives_Native.Some (true ) -> w FStar_Syntax_Util.t_true - | uu____10199 -> tm1) - | uu____10202 -> tm1) - | (uu____10203,FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.Implicit uu____10204)):: - (t,uu____10206)::[] -> - let uu____10245 = - let uu____10246 = + | uu____10216 -> tm1) + | uu____10219 -> tm1) + | (uu____10220,FStar_Pervasives_Native.Some + (FStar_Syntax_Syntax.Implicit uu____10221)):: + (t,uu____10223)::[] -> + let uu____10262 = + let uu____10263 = FStar_Syntax_Subst.compress t in - uu____10246.FStar_Syntax_Syntax.n in - (match uu____10245 with + uu____10263.FStar_Syntax_Syntax.n in + (match uu____10262 with | FStar_Syntax_Syntax.Tm_abs - (uu____10249::[],body,uu____10251) -> + (uu____10266::[],body,uu____10268) -> (match simp_t body with | FStar_Pervasives_Native.Some (true ) -> w FStar_Syntax_Util.t_true - | uu____10278 -> tm1) - | uu____10281 -> tm1) - | uu____10282 -> tm1 + | uu____10295 -> tm1) + | uu____10298 -> tm1) + | uu____10299 -> tm1 else - (let uu____10292 = + (let uu____10309 = FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.exists_lid in - if uu____10292 + if uu____10309 then match args with - | (t,uu____10294)::[] -> - let uu____10311 = - let uu____10312 = + | (t,uu____10311)::[] -> + let uu____10328 = + let uu____10329 = FStar_Syntax_Subst.compress t in - uu____10312.FStar_Syntax_Syntax.n in - (match uu____10311 with + uu____10329.FStar_Syntax_Syntax.n in + (match uu____10328 with | FStar_Syntax_Syntax.Tm_abs - (uu____10315::[],body,uu____10317) + (uu____10332::[],body,uu____10334) -> (match simp_t body with | FStar_Pervasives_Native.Some (false ) -> w FStar_Syntax_Util.t_false - | uu____10344 -> tm1) - | uu____10347 -> tm1) - | (uu____10348,FStar_Pervasives_Native.Some + | uu____10361 -> tm1) + | uu____10364 -> tm1) + | (uu____10365,FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Implicit - uu____10349))::(t,uu____10351)::[] -> - let uu____10390 = - let uu____10391 = + uu____10366))::(t,uu____10368)::[] -> + let uu____10407 = + let uu____10408 = FStar_Syntax_Subst.compress t in - uu____10391.FStar_Syntax_Syntax.n in - (match uu____10390 with + uu____10408.FStar_Syntax_Syntax.n in + (match uu____10407 with | FStar_Syntax_Syntax.Tm_abs - (uu____10394::[],body,uu____10396) + (uu____10411::[],body,uu____10413) -> (match simp_t body with | FStar_Pervasives_Native.Some (false ) -> w FStar_Syntax_Util.t_false - | uu____10423 -> tm1) - | uu____10426 -> tm1) - | uu____10427 -> tm1 + | uu____10440 -> tm1) + | uu____10443 -> tm1) + | uu____10444 -> tm1 else - (let uu____10437 = + (let uu____10454 = FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.b2t_lid in - if uu____10437 + if uu____10454 then match args with | ({ @@ -2339,80 +2352,80 @@ let maybe_simplify_aux: FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_bool (true )); FStar_Syntax_Syntax.pos = - uu____10438; + uu____10455; FStar_Syntax_Syntax.vars = - uu____10439;_},uu____10440)::[] + uu____10456;_},uu____10457)::[] -> w FStar_Syntax_Util.t_true | ({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_bool (false )); FStar_Syntax_Syntax.pos = - uu____10457; + uu____10474; FStar_Syntax_Syntax.vars = - uu____10458;_},uu____10459)::[] + uu____10475;_},uu____10476)::[] -> w FStar_Syntax_Util.t_false - | uu____10476 -> tm1 + | uu____10493 -> tm1 else - (let uu____10486 = + (let uu____10503 = FStar_Syntax_Util.is_auto_squash tm1 in - match uu____10486 with + match uu____10503 with | FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.U_zero ,t) when FStar_Syntax_Util.is_sub_singleton t -> t - | uu____10506 -> + | uu____10523 -> reduce_equality cfg env stack tm1))))))) - | uu____10515 -> tm1) + | uu____10532 -> tm1) let maybe_simplify: - 'Auu____10522 'Auu____10523 . + 'Auu____10539 'Auu____10540 . cfg -> - ((FStar_Syntax_Syntax.bv,'Auu____10523) FStar_Pervasives_Native.tuple2 + ((FStar_Syntax_Syntax.bv,'Auu____10540) FStar_Pervasives_Native.tuple2 FStar_Pervasives_Native.option,closure) FStar_Pervasives_Native.tuple2 Prims.list -> - 'Auu____10522 -> FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term + 'Auu____10539 -> FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term = fun cfg -> fun env -> fun stack -> fun tm -> let tm' = maybe_simplify_aux cfg env stack tm in - (let uu____10566 = + (let uu____10583 = FStar_All.pipe_left (FStar_TypeChecker_Env.debug cfg.tcenv) (FStar_Options.Other "380") in - if uu____10566 + if uu____10583 then - let uu____10567 = FStar_Syntax_Print.term_to_string tm in - let uu____10568 = FStar_Syntax_Print.term_to_string tm' in + let uu____10584 = FStar_Syntax_Print.term_to_string tm in + let uu____10585 = FStar_Syntax_Print.term_to_string tm' in FStar_Util.print3 "%sSimplified\n\t%s to\n\t%s\n" (if FStar_List.contains Simplify cfg.steps then "" else "NOT ") - uu____10567 uu____10568 + uu____10584 uu____10585 else ()); tm' let is_norm_request: - 'Auu____10574 . - FStar_Syntax_Syntax.term -> 'Auu____10574 Prims.list -> Prims.bool + 'Auu____10591 . + FStar_Syntax_Syntax.term -> 'Auu____10591 Prims.list -> Prims.bool = fun hd1 -> fun args -> - let uu____10587 = - let uu____10594 = - let uu____10595 = FStar_Syntax_Util.un_uinst hd1 in - uu____10595.FStar_Syntax_Syntax.n in - (uu____10594, args) in - match uu____10587 with - | (FStar_Syntax_Syntax.Tm_fvar fv,uu____10601::uu____10602::[]) -> + let uu____10604 = + let uu____10611 = + let uu____10612 = FStar_Syntax_Util.un_uinst hd1 in + uu____10612.FStar_Syntax_Syntax.n in + (uu____10611, args) in + match uu____10604 with + | (FStar_Syntax_Syntax.Tm_fvar fv,uu____10618::uu____10619::[]) -> FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.normalize_term - | (FStar_Syntax_Syntax.Tm_fvar fv,uu____10606::[]) -> + | (FStar_Syntax_Syntax.Tm_fvar fv,uu____10623::[]) -> FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.normalize - | (FStar_Syntax_Syntax.Tm_fvar fv,steps::uu____10611::uu____10612::[]) + | (FStar_Syntax_Syntax.Tm_fvar fv,steps::uu____10628::uu____10629::[]) -> FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.norm - | uu____10615 -> false + | uu____10632 -> false let tr_norm_step: FStar_Syntax_Embeddings.norm_step -> step Prims.list = - fun uu___78_10626 -> - match uu___78_10626 with + fun uu___78_10643 -> + match uu___78_10643 with | FStar_Syntax_Embeddings.Zeta -> [Zeta] | FStar_Syntax_Embeddings.Iota -> [Iota] | FStar_Syntax_Embeddings.Delta -> @@ -2422,19 +2435,19 @@ let tr_norm_step: FStar_Syntax_Embeddings.norm_step -> step Prims.list = | FStar_Syntax_Embeddings.HNF -> [HNF] | FStar_Syntax_Embeddings.Primops -> [Primops] | FStar_Syntax_Embeddings.UnfoldOnly names1 -> - let uu____10632 = - let uu____10635 = - let uu____10636 = FStar_List.map FStar_Ident.lid_of_str names1 in - UnfoldOnly uu____10636 in - [uu____10635] in - (UnfoldUntil FStar_Syntax_Syntax.Delta_constant) :: uu____10632 + let uu____10649 = + let uu____10652 = + let uu____10653 = FStar_List.map FStar_Ident.lid_of_str names1 in + UnfoldOnly uu____10653 in + [uu____10652] in + (UnfoldUntil FStar_Syntax_Syntax.Delta_constant) :: uu____10649 let tr_norm_steps: FStar_Syntax_Embeddings.norm_step Prims.list -> step Prims.list = fun s -> FStar_List.concatMap tr_norm_step s let get_norm_request: - 'Auu____10651 . + 'Auu____10668 . (FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term) -> - (FStar_Syntax_Syntax.term,'Auu____10651) FStar_Pervasives_Native.tuple2 + (FStar_Syntax_Syntax.term,'Auu____10668) FStar_Pervasives_Native.tuple2 Prims.list -> (step Prims.list,FStar_Syntax_Syntax.term) FStar_Pervasives_Native.tuple2 @@ -2442,16 +2455,16 @@ let get_norm_request: fun full_norm -> fun args -> let parse_steps s = - let uu____10689 = - let uu____10692 = - let uu____10697 = + let uu____10706 = + let uu____10709 = + let uu____10714 = FStar_Syntax_Embeddings.unembed_list FStar_Syntax_Embeddings.unembed_norm_step in - uu____10697 s in - FStar_All.pipe_right uu____10692 FStar_Util.must in - FStar_All.pipe_right uu____10689 tr_norm_steps in + uu____10714 s in + FStar_All.pipe_right uu____10709 FStar_Util.must in + FStar_All.pipe_right uu____10706 tr_norm_steps in match args with - | uu____10722::(tm,uu____10724)::[] -> + | uu____10739::(tm,uu____10741)::[] -> let s = [Beta; Zeta; @@ -2460,7 +2473,7 @@ let get_norm_request: UnfoldUntil FStar_Syntax_Syntax.Delta_constant; Reify] in (s, tm) - | (tm,uu____10747)::[] -> + | (tm,uu____10764)::[] -> let s = [Beta; Zeta; @@ -2469,35 +2482,35 @@ let get_norm_request: UnfoldUntil FStar_Syntax_Syntax.Delta_constant; Reify] in (s, tm) - | (steps,uu____10762)::uu____10763::(tm,uu____10765)::[] -> + | (steps,uu____10779)::uu____10780::(tm,uu____10782)::[] -> let add_exclude s z = if Prims.op_Negation (FStar_List.contains z s) then (Exclude z) :: s else s in let s = - let uu____10805 = - let uu____10808 = full_norm steps in parse_steps uu____10808 in - Beta :: uu____10805 in + let uu____10822 = + let uu____10825 = full_norm steps in parse_steps uu____10825 in + Beta :: uu____10822 in let s1 = add_exclude s Zeta in let s2 = add_exclude s1 Iota in (s2, tm) - | uu____10817 -> failwith "Impossible" + | uu____10834 -> failwith "Impossible" let is_reify_head: stack_elt Prims.list -> Prims.bool = - fun uu___79_10834 -> - match uu___79_10834 with + fun uu___79_10851 -> + match uu___79_10851 with | (App - (uu____10837,{ + (uu____10854,{ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_reify ); - FStar_Syntax_Syntax.pos = uu____10838; - FStar_Syntax_Syntax.vars = uu____10839;_},uu____10840,uu____10841))::uu____10842 + FStar_Syntax_Syntax.pos = uu____10855; + FStar_Syntax_Syntax.vars = uu____10856;_},uu____10857,uu____10858))::uu____10859 -> true - | uu____10849 -> false + | uu____10866 -> false let firstn: - 'Auu____10855 . + 'Auu____10872 . Prims.int -> - 'Auu____10855 Prims.list -> - ('Auu____10855 Prims.list,'Auu____10855 Prims.list) + 'Auu____10872 Prims.list -> + ('Auu____10872 Prims.list,'Auu____10872 Prims.list) FStar_Pervasives_Native.tuple2 = fun k -> @@ -2508,14 +2521,14 @@ let should_reify: cfg -> stack_elt Prims.list -> Prims.bool = fun stack -> match stack with | (App - (uu____10891,{ + (uu____10908,{ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_reify ); - FStar_Syntax_Syntax.pos = uu____10892; - FStar_Syntax_Syntax.vars = uu____10893;_},uu____10894,uu____10895))::uu____10896 + FStar_Syntax_Syntax.pos = uu____10909; + FStar_Syntax_Syntax.vars = uu____10910;_},uu____10911,uu____10912))::uu____10913 -> FStar_All.pipe_right cfg.steps (FStar_List.contains Reify) - | uu____10903 -> false + | uu____10920 -> false let rec norm: cfg -> env -> stack -> FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term = @@ -2525,75 +2538,75 @@ let rec norm: fun t -> let t1 = FStar_Syntax_Subst.compress t in log cfg - (fun uu____11058 -> - let uu____11059 = FStar_Syntax_Print.tag_of_term t1 in - let uu____11060 = FStar_Syntax_Print.term_to_string t1 in - let uu____11061 = + (fun uu____11067 -> + let uu____11068 = FStar_Syntax_Print.tag_of_term t1 in + let uu____11069 = FStar_Syntax_Print.term_to_string t1 in + let uu____11070 = FStar_Util.string_of_int (FStar_List.length env) in - let uu____11068 = - let uu____11069 = - let uu____11072 = firstn (Prims.parse_int "4") stack in + let uu____11077 = + let uu____11078 = + let uu____11081 = firstn (Prims.parse_int "4") stack in FStar_All.pipe_left FStar_Pervasives_Native.fst - uu____11072 in - stack_to_string uu____11069 in + uu____11081 in + stack_to_string uu____11078 in FStar_Util.print4 ">>> %s\nNorm %s with with %s env elements top of the stack %s \n" - uu____11059 uu____11060 uu____11061 uu____11068); + uu____11068 uu____11069 uu____11070 uu____11077); (match t1.FStar_Syntax_Syntax.n with - | FStar_Syntax_Syntax.Tm_delayed uu____11095 -> + | FStar_Syntax_Syntax.Tm_delayed uu____11104 -> failwith "Impossible: got a delayed substitution" - | FStar_Syntax_Syntax.Tm_uvar uu____11120 when + | FStar_Syntax_Syntax.Tm_uvar uu____11129 when FStar_All.pipe_right cfg.steps (FStar_List.contains CheckNoUvars) -> - let uu____11137 = - let uu____11138 = + let uu____11146 = + let uu____11147 = FStar_Range.string_of_range t1.FStar_Syntax_Syntax.pos in - let uu____11139 = FStar_Syntax_Print.term_to_string t1 in + let uu____11148 = FStar_Syntax_Print.term_to_string t1 in FStar_Util.format2 "(%s) CheckNoUvars: Unexpected unification variable remains: %s" - uu____11138 uu____11139 in - failwith uu____11137 + uu____11147 uu____11148 in + failwith uu____11146 | FStar_Syntax_Syntax.Tm_unknown -> rebuild cfg env stack t1 - | FStar_Syntax_Syntax.Tm_uvar uu____11140 -> + | FStar_Syntax_Syntax.Tm_uvar uu____11149 -> rebuild cfg env stack t1 - | FStar_Syntax_Syntax.Tm_constant uu____11157 -> + | FStar_Syntax_Syntax.Tm_constant uu____11166 -> rebuild cfg env stack t1 - | FStar_Syntax_Syntax.Tm_name uu____11158 -> + | FStar_Syntax_Syntax.Tm_name uu____11167 -> rebuild cfg env stack t1 | FStar_Syntax_Syntax.Tm_fvar - { FStar_Syntax_Syntax.fv_name = uu____11159; + { FStar_Syntax_Syntax.fv_name = uu____11168; FStar_Syntax_Syntax.fv_delta = FStar_Syntax_Syntax.Delta_constant ; - FStar_Syntax_Syntax.fv_qual = uu____11160;_} + FStar_Syntax_Syntax.fv_qual = uu____11169;_} -> rebuild cfg env stack t1 | FStar_Syntax_Syntax.Tm_fvar - { FStar_Syntax_Syntax.fv_name = uu____11163; - FStar_Syntax_Syntax.fv_delta = uu____11164; + { FStar_Syntax_Syntax.fv_name = uu____11172; + FStar_Syntax_Syntax.fv_delta = uu____11173; FStar_Syntax_Syntax.fv_qual = FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Data_ctor );_} -> rebuild cfg env stack t1 | FStar_Syntax_Syntax.Tm_fvar - { FStar_Syntax_Syntax.fv_name = uu____11165; - FStar_Syntax_Syntax.fv_delta = uu____11166; + { FStar_Syntax_Syntax.fv_name = uu____11174; + FStar_Syntax_Syntax.fv_delta = uu____11175; FStar_Syntax_Syntax.fv_qual = FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.Record_ctor uu____11167);_} + (FStar_Syntax_Syntax.Record_ctor uu____11176);_} -> rebuild cfg env stack t1 | FStar_Syntax_Syntax.Tm_fvar fv when - let uu____11175 = FStar_Syntax_Syntax.lid_of_fv fv in - FStar_TypeChecker_Env.is_action cfg.tcenv uu____11175 -> + let uu____11184 = FStar_Syntax_Syntax.lid_of_fv fv in + FStar_TypeChecker_Env.is_action cfg.tcenv uu____11184 -> let b = should_reify cfg stack in (log cfg - (fun uu____11181 -> - let uu____11182 = FStar_Syntax_Print.term_to_string t1 in - let uu____11183 = FStar_Util.string_of_bool b in + (fun uu____11190 -> + let uu____11191 = FStar_Syntax_Print.term_to_string t1 in + let uu____11192 = FStar_Util.string_of_bool b in FStar_Util.print2 ">>> For DM4F action %s, should_reify = %s\n" - uu____11182 uu____11183); + uu____11191 uu____11192); if b then - (let uu____11184 = FStar_List.tl stack in - do_unfold_fv cfg env uu____11184 t1 fv) + (let uu____11193 = FStar_List.tl stack in + do_unfold_fv cfg env uu____11193 t1 fv) else rebuild cfg env stack t1) | FStar_Syntax_Syntax.Tm_app (hd1,args) when ((FStar_Syntax_Util.is_fstar_tactics_embed hd1) || @@ -2604,21 +2617,21 @@ let rec norm: let args1 = closures_as_args_delayed cfg env args in let hd2 = closure_as_term cfg env hd1 in let t2 = - let uu___114_11223 = t1 in + let uu___114_11232 = t1 in { FStar_Syntax_Syntax.n = (FStar_Syntax_Syntax.Tm_app (hd2, args1)); FStar_Syntax_Syntax.pos = - (uu___114_11223.FStar_Syntax_Syntax.pos); + (uu___114_11232.FStar_Syntax_Syntax.pos); FStar_Syntax_Syntax.vars = - (uu___114_11223.FStar_Syntax_Syntax.vars) + (uu___114_11232.FStar_Syntax_Syntax.vars) } in rebuild cfg env stack t2 | FStar_Syntax_Syntax.Tm_app (hd1,args) when - ((let uu____11256 = + ((let uu____11265 = FStar_All.pipe_right cfg.steps (FStar_List.contains NoFullNorm) in - Prims.op_Negation uu____11256) && (is_norm_request hd1 args)) + Prims.op_Negation uu____11265) && (is_norm_request hd1 args)) && (Prims.op_Negation (FStar_Ident.lid_equals @@ -2626,91 +2639,93 @@ let rec norm: FStar_Parser_Const.prims_lid)) -> let cfg' = - let uu___115_11264 = cfg in - let uu____11265 = + let uu___115_11273 = cfg in + let uu____11274 = FStar_List.filter - (fun uu___80_11268 -> - match uu___80_11268 with - | UnfoldOnly uu____11269 -> false + (fun uu___80_11277 -> + match uu___80_11277 with + | UnfoldOnly uu____11278 -> false | NoDeltaSteps -> false - | uu____11272 -> true) cfg.steps in + | uu____11281 -> true) cfg.steps in { - steps = uu____11265; - tcenv = (uu___115_11264.tcenv); + steps = uu____11274; + tcenv = (uu___115_11273.tcenv); delta_level = [FStar_TypeChecker_Env.Unfold FStar_Syntax_Syntax.Delta_constant]; - primitive_steps = (uu___115_11264.primitive_steps); - strong = (uu___115_11264.strong) + primitive_steps = (uu___115_11273.primitive_steps); + strong = (uu___115_11273.strong); + memoize_lazy = (uu___115_11273.memoize_lazy) } in - let uu____11273 = get_norm_request (norm cfg' env []) args in - (match uu____11273 with + let uu____11282 = get_norm_request (norm cfg' env []) args in + (match uu____11282 with | (s,tm) -> let delta_level = - let uu____11289 = + let uu____11298 = FStar_All.pipe_right s (FStar_Util.for_some - (fun uu___81_11294 -> - match uu___81_11294 with - | UnfoldUntil uu____11295 -> true - | UnfoldOnly uu____11296 -> true - | uu____11299 -> false)) in - if uu____11289 + (fun uu___81_11303 -> + match uu___81_11303 with + | UnfoldUntil uu____11304 -> true + | UnfoldOnly uu____11305 -> true + | uu____11308 -> false)) in + if uu____11298 then [FStar_TypeChecker_Env.Unfold FStar_Syntax_Syntax.Delta_constant] else [FStar_TypeChecker_Env.NoDelta] in let cfg'1 = - let uu___116_11304 = cfg in + let uu___116_11313 = cfg in { steps = s; - tcenv = (uu___116_11304.tcenv); + tcenv = (uu___116_11313.tcenv); delta_level; - primitive_steps = (uu___116_11304.primitive_steps); - strong = (uu___116_11304.strong) + primitive_steps = (uu___116_11313.primitive_steps); + strong = (uu___116_11313.strong); + memoize_lazy = (uu___116_11313.memoize_lazy) } in let stack' = let tail1 = (Cfg cfg) :: stack in - let uu____11311 = + let uu____11320 = FStar_All.pipe_left (FStar_TypeChecker_Env.debug cfg.tcenv) (FStar_Options.Other "print_normalized_terms") in - if uu____11311 + if uu____11320 then - let uu____11314 = - let uu____11315 = - let uu____11320 = FStar_Util.now () in - (t1, uu____11320) in - Debug uu____11315 in - uu____11314 :: tail1 + let uu____11323 = + let uu____11324 = + let uu____11329 = FStar_Util.now () in + (t1, uu____11329) in + Debug uu____11324 in + uu____11323 :: tail1 else tail1 in norm cfg'1 env stack' tm) | FStar_Syntax_Syntax.Tm_type u -> let u1 = norm_universe cfg env u in - let uu____11324 = + let uu____11333 = mk (FStar_Syntax_Syntax.Tm_type u1) t1.FStar_Syntax_Syntax.pos in - rebuild cfg env stack uu____11324 + rebuild cfg env stack uu____11333 | FStar_Syntax_Syntax.Tm_uinst (t',us) -> - let uu____11331 = + let uu____11340 = FStar_All.pipe_right cfg.steps (FStar_List.contains EraseUniverses) in - if uu____11331 + if uu____11340 then norm cfg env stack t' else (let us1 = - let uu____11334 = - let uu____11341 = + let uu____11343 = + let uu____11350 = FStar_List.map (norm_universe cfg env) us in - (uu____11341, (t1.FStar_Syntax_Syntax.pos)) in - UnivArgs uu____11334 in + (uu____11350, (t1.FStar_Syntax_Syntax.pos)) in + UnivArgs uu____11343 in let stack1 = us1 :: stack in norm cfg env stack1 t') | FStar_Syntax_Syntax.Tm_fvar f -> let should_delta = FStar_All.pipe_right cfg.delta_level (FStar_Util.for_some - (fun uu___82_11354 -> - match uu___82_11354 with + (fun uu___82_11363 -> + match uu___82_11363 with | FStar_TypeChecker_Env.UnfoldTac -> false | FStar_TypeChecker_Env.NoDelta -> false | FStar_TypeChecker_Env.Inlining -> true @@ -2720,7 +2735,7 @@ let rec norm: FStar_TypeChecker_Common.delta_depth_greater_than f.FStar_Syntax_Syntax.fv_delta l)) in let should_delta1 = - let uu____11357 = + let uu____11366 = (FStar_List.mem FStar_TypeChecker_Env.UnfoldTac cfg.delta_level) && @@ -2753,38 +2768,38 @@ let rec norm: || (FStar_Syntax_Syntax.fv_eq_lid f FStar_Parser_Const.false_lid)) in - if uu____11357 + if uu____11366 then false else - (let uu____11359 = + (let uu____11368 = FStar_All.pipe_right cfg.steps (FStar_List.tryFind - (fun uu___83_11366 -> - match uu___83_11366 with - | UnfoldOnly uu____11367 -> true - | uu____11370 -> false)) in - match uu____11359 with + (fun uu___83_11375 -> + match uu___83_11375 with + | UnfoldOnly uu____11376 -> true + | uu____11379 -> false)) in + match uu____11368 with | FStar_Pervasives_Native.Some (UnfoldOnly lids) -> should_delta && (FStar_Util.for_some (FStar_Syntax_Syntax.fv_eq_lid f) lids) - | uu____11374 -> should_delta) in + | uu____11383 -> should_delta) in (log cfg - (fun uu____11382 -> - let uu____11383 = FStar_Syntax_Print.term_to_string t1 in - let uu____11384 = + (fun uu____11391 -> + let uu____11392 = FStar_Syntax_Print.term_to_string t1 in + let uu____11393 = FStar_Range.string_of_range t1.FStar_Syntax_Syntax.pos in - let uu____11385 = + let uu____11394 = FStar_Util.string_of_bool should_delta1 in FStar_Util.print3 ">>> For %s (%s), should_delta = %s\n" - uu____11383 uu____11384 uu____11385); + uu____11392 uu____11393 uu____11394); if Prims.op_Negation should_delta1 then rebuild cfg env stack t1 else do_unfold_fv cfg env stack t1 f) | FStar_Syntax_Syntax.Tm_bvar x -> - let uu____11388 = lookup_bvar env x in - (match uu____11388 with - | Univ uu____11391 -> + let uu____11397 = lookup_bvar env x in + (match uu____11397 with + | Univ uu____11400 -> failwith "Impossible: term variable is bound to a universe" | Dummy -> failwith "Term variable not found" @@ -2794,60 +2809,60 @@ let rec norm: (Prims.op_Negation (FStar_List.contains (Exclude Zeta) cfg.steps)) then - let uu____11440 = FStar_ST.op_Bang r in - (match uu____11440 with + let uu____11449 = FStar_ST.op_Bang r in + (match uu____11449 with | FStar_Pervasives_Native.Some (env2,t') -> (log cfg - (fun uu____11587 -> - let uu____11588 = + (fun uu____11596 -> + let uu____11597 = FStar_Syntax_Print.term_to_string t1 in - let uu____11589 = + let uu____11598 = FStar_Syntax_Print.term_to_string t' in FStar_Util.print2 - "Lazy hit: %s cached to %s\n" uu____11588 - uu____11589); - (let uu____11590 = - let uu____11591 = + "Lazy hit: %s cached to %s\n" uu____11597 + uu____11598); + (let uu____11599 = + let uu____11600 = FStar_Syntax_Subst.compress t' in - uu____11591.FStar_Syntax_Syntax.n in - match uu____11590 with - | FStar_Syntax_Syntax.Tm_abs uu____11594 -> + uu____11600.FStar_Syntax_Syntax.n in + match uu____11599 with + | FStar_Syntax_Syntax.Tm_abs uu____11603 -> norm cfg env2 stack t' - | uu____11611 -> rebuild cfg env2 stack t')) + | uu____11620 -> rebuild cfg env2 stack t')) | FStar_Pervasives_Native.None -> norm cfg env1 ((MemoLazy r) :: stack) t0) else norm cfg env1 stack t0) | FStar_Syntax_Syntax.Tm_abs (bs,body,lopt) -> (match stack with - | (UnivArgs uu____11681)::uu____11682 -> + | (UnivArgs uu____11690)::uu____11691 -> failwith "Ill-typed term: universes cannot be applied to term abstraction" - | (Match uu____11691)::uu____11692 -> + | (Match uu____11700)::uu____11701 -> failwith "Ill-typed term: cannot pattern match an abstraction" - | (Arg (c,uu____11702,uu____11703))::stack_rest -> + | (Arg (c,uu____11711,uu____11712))::stack_rest -> (match c with - | Univ uu____11707 -> + | Univ uu____11716 -> norm cfg ((FStar_Pervasives_Native.None, c) :: env) stack_rest t1 - | uu____11716 -> + | uu____11725 -> (match bs with | [] -> failwith "Impossible" | b::[] -> (log cfg - (fun uu____11737 -> - let uu____11738 = closure_to_string c in + (fun uu____11746 -> + let uu____11747 = closure_to_string c in FStar_Util.print1 "\tShifted %s\n" - uu____11738); + uu____11747); norm cfg (((FStar_Pervasives_Native.Some b), c) :: env) stack_rest body) | b::tl1 -> (log cfg - (fun uu____11778 -> - let uu____11779 = closure_to_string c in + (fun uu____11787 -> + let uu____11788 = closure_to_string c in FStar_Util.print1 "\tShifted %s\n" - uu____11779); + uu____11788); (let body1 = mk (FStar_Syntax_Syntax.Tm_abs @@ -2858,352 +2873,357 @@ let rec norm: env) stack_rest body1)))) | (Cfg cfg1)::stack1 -> norm cfg1 env stack1 t1 | (MemoLazy r)::stack1 -> - (set_memo r (env, t1); + (set_memo cfg r (env, t1); log cfg - (fun uu____11857 -> - let uu____11858 = + (fun uu____11866 -> + let uu____11867 = FStar_Syntax_Print.term_to_string t1 in - FStar_Util.print1 "\tSet memo %s\n" uu____11858); + FStar_Util.print1 "\tSet memo %s\n" uu____11867); norm cfg env stack1 t1) - | (Debug uu____11859)::uu____11860 -> + | (Debug uu____11868)::uu____11869 -> if FStar_List.contains Weak cfg.steps then - let uu____11867 = closure_as_term cfg env t1 in - rebuild cfg env stack uu____11867 + let uu____11876 = closure_as_term cfg env t1 in + rebuild cfg env stack uu____11876 else - (let uu____11869 = + (let uu____11878 = FStar_Syntax_Subst.open_term' bs body in - match uu____11869 with + match uu____11878 with | (bs1,body1,opening) -> let env' = FStar_All.pipe_right bs1 (FStar_List.fold_left (fun env1 -> - fun uu____11911 -> dummy :: env1) env) in + fun uu____11920 -> dummy :: env1) env) in let lopt1 = match lopt with | FStar_Pervasives_Native.Some rc -> let rct = - let uu____11939 = + let uu____11948 = FStar_All.pipe_right cfg.steps (FStar_List.contains CheckNoUvars) in - if uu____11939 + if uu____11948 then FStar_Util.map_opt rc.FStar_Syntax_Syntax.residual_typ (fun t2 -> - let uu____11949 = + let uu____11958 = FStar_Syntax_Subst.subst opening t2 in - norm cfg env' [] uu____11949) + norm cfg env' [] uu____11958) else FStar_Util.map_opt rc.FStar_Syntax_Syntax.residual_typ (FStar_Syntax_Subst.subst opening) in FStar_Pervasives_Native.Some - (let uu___117_11954 = rc in + (let uu___117_11963 = rc in { FStar_Syntax_Syntax.residual_effect = - (uu___117_11954.FStar_Syntax_Syntax.residual_effect); + (uu___117_11963.FStar_Syntax_Syntax.residual_effect); FStar_Syntax_Syntax.residual_typ = rct; FStar_Syntax_Syntax.residual_flags = - (uu___117_11954.FStar_Syntax_Syntax.residual_flags) + (uu___117_11963.FStar_Syntax_Syntax.residual_flags) }) - | uu____11955 -> lopt in + | uu____11964 -> lopt in (log cfg - (fun uu____11961 -> - let uu____11962 = + (fun uu____11970 -> + let uu____11971 = FStar_All.pipe_left FStar_Util.string_of_int (FStar_List.length bs1) in FStar_Util.print1 "\tShifted %s dummies\n" - uu____11962); + uu____11971); (let stack1 = (Cfg cfg) :: stack in let cfg1 = - let uu___118_11971 = cfg in + let uu___118_11980 = cfg in { - steps = (uu___118_11971.steps); - tcenv = (uu___118_11971.tcenv); - delta_level = (uu___118_11971.delta_level); + steps = (uu___118_11980.steps); + tcenv = (uu___118_11980.tcenv); + delta_level = (uu___118_11980.delta_level); primitive_steps = - (uu___118_11971.primitive_steps); - strong = true + (uu___118_11980.primitive_steps); + strong = true; + memoize_lazy = (uu___118_11980.memoize_lazy) } in norm cfg1 env' ((Abs (env, bs1, env', lopt1, (t1.FStar_Syntax_Syntax.pos))) :: stack1) body1))) - | (Meta uu____11982)::uu____11983 -> + | (Meta uu____11991)::uu____11992 -> if FStar_List.contains Weak cfg.steps then - let uu____11990 = closure_as_term cfg env t1 in - rebuild cfg env stack uu____11990 + let uu____11999 = closure_as_term cfg env t1 in + rebuild cfg env stack uu____11999 else - (let uu____11992 = + (let uu____12001 = FStar_Syntax_Subst.open_term' bs body in - match uu____11992 with + match uu____12001 with | (bs1,body1,opening) -> let env' = FStar_All.pipe_right bs1 (FStar_List.fold_left (fun env1 -> - fun uu____12034 -> dummy :: env1) env) in + fun uu____12043 -> dummy :: env1) env) in let lopt1 = match lopt with | FStar_Pervasives_Native.Some rc -> let rct = - let uu____12062 = + let uu____12071 = FStar_All.pipe_right cfg.steps (FStar_List.contains CheckNoUvars) in - if uu____12062 + if uu____12071 then FStar_Util.map_opt rc.FStar_Syntax_Syntax.residual_typ (fun t2 -> - let uu____12072 = + let uu____12081 = FStar_Syntax_Subst.subst opening t2 in - norm cfg env' [] uu____12072) + norm cfg env' [] uu____12081) else FStar_Util.map_opt rc.FStar_Syntax_Syntax.residual_typ (FStar_Syntax_Subst.subst opening) in FStar_Pervasives_Native.Some - (let uu___117_12077 = rc in + (let uu___117_12086 = rc in { FStar_Syntax_Syntax.residual_effect = - (uu___117_12077.FStar_Syntax_Syntax.residual_effect); + (uu___117_12086.FStar_Syntax_Syntax.residual_effect); FStar_Syntax_Syntax.residual_typ = rct; FStar_Syntax_Syntax.residual_flags = - (uu___117_12077.FStar_Syntax_Syntax.residual_flags) + (uu___117_12086.FStar_Syntax_Syntax.residual_flags) }) - | uu____12078 -> lopt in + | uu____12087 -> lopt in (log cfg - (fun uu____12084 -> - let uu____12085 = + (fun uu____12093 -> + let uu____12094 = FStar_All.pipe_left FStar_Util.string_of_int (FStar_List.length bs1) in FStar_Util.print1 "\tShifted %s dummies\n" - uu____12085); + uu____12094); (let stack1 = (Cfg cfg) :: stack in let cfg1 = - let uu___118_12094 = cfg in + let uu___118_12103 = cfg in { - steps = (uu___118_12094.steps); - tcenv = (uu___118_12094.tcenv); - delta_level = (uu___118_12094.delta_level); + steps = (uu___118_12103.steps); + tcenv = (uu___118_12103.tcenv); + delta_level = (uu___118_12103.delta_level); primitive_steps = - (uu___118_12094.primitive_steps); - strong = true + (uu___118_12103.primitive_steps); + strong = true; + memoize_lazy = (uu___118_12103.memoize_lazy) } in norm cfg1 env' ((Abs (env, bs1, env', lopt1, (t1.FStar_Syntax_Syntax.pos))) :: stack1) body1))) - | (Let uu____12105)::uu____12106 -> + | (Let uu____12114)::uu____12115 -> if FStar_List.contains Weak cfg.steps then - let uu____12117 = closure_as_term cfg env t1 in - rebuild cfg env stack uu____12117 + let uu____12126 = closure_as_term cfg env t1 in + rebuild cfg env stack uu____12126 else - (let uu____12119 = + (let uu____12128 = FStar_Syntax_Subst.open_term' bs body in - match uu____12119 with + match uu____12128 with | (bs1,body1,opening) -> let env' = FStar_All.pipe_right bs1 (FStar_List.fold_left (fun env1 -> - fun uu____12161 -> dummy :: env1) env) in + fun uu____12170 -> dummy :: env1) env) in let lopt1 = match lopt with | FStar_Pervasives_Native.Some rc -> let rct = - let uu____12189 = + let uu____12198 = FStar_All.pipe_right cfg.steps (FStar_List.contains CheckNoUvars) in - if uu____12189 + if uu____12198 then FStar_Util.map_opt rc.FStar_Syntax_Syntax.residual_typ (fun t2 -> - let uu____12199 = + let uu____12208 = FStar_Syntax_Subst.subst opening t2 in - norm cfg env' [] uu____12199) + norm cfg env' [] uu____12208) else FStar_Util.map_opt rc.FStar_Syntax_Syntax.residual_typ (FStar_Syntax_Subst.subst opening) in FStar_Pervasives_Native.Some - (let uu___117_12204 = rc in + (let uu___117_12213 = rc in { FStar_Syntax_Syntax.residual_effect = - (uu___117_12204.FStar_Syntax_Syntax.residual_effect); + (uu___117_12213.FStar_Syntax_Syntax.residual_effect); FStar_Syntax_Syntax.residual_typ = rct; FStar_Syntax_Syntax.residual_flags = - (uu___117_12204.FStar_Syntax_Syntax.residual_flags) + (uu___117_12213.FStar_Syntax_Syntax.residual_flags) }) - | uu____12205 -> lopt in + | uu____12214 -> lopt in (log cfg - (fun uu____12211 -> - let uu____12212 = + (fun uu____12220 -> + let uu____12221 = FStar_All.pipe_left FStar_Util.string_of_int (FStar_List.length bs1) in FStar_Util.print1 "\tShifted %s dummies\n" - uu____12212); + uu____12221); (let stack1 = (Cfg cfg) :: stack in let cfg1 = - let uu___118_12221 = cfg in + let uu___118_12230 = cfg in { - steps = (uu___118_12221.steps); - tcenv = (uu___118_12221.tcenv); - delta_level = (uu___118_12221.delta_level); + steps = (uu___118_12230.steps); + tcenv = (uu___118_12230.tcenv); + delta_level = (uu___118_12230.delta_level); primitive_steps = - (uu___118_12221.primitive_steps); - strong = true + (uu___118_12230.primitive_steps); + strong = true; + memoize_lazy = (uu___118_12230.memoize_lazy) } in norm cfg1 env' ((Abs (env, bs1, env', lopt1, (t1.FStar_Syntax_Syntax.pos))) :: stack1) body1))) - | (App uu____12232)::uu____12233 -> + | (App uu____12241)::uu____12242 -> if FStar_List.contains Weak cfg.steps then - let uu____12244 = closure_as_term cfg env t1 in - rebuild cfg env stack uu____12244 + let uu____12253 = closure_as_term cfg env t1 in + rebuild cfg env stack uu____12253 else - (let uu____12246 = + (let uu____12255 = FStar_Syntax_Subst.open_term' bs body in - match uu____12246 with + match uu____12255 with | (bs1,body1,opening) -> let env' = FStar_All.pipe_right bs1 (FStar_List.fold_left (fun env1 -> - fun uu____12288 -> dummy :: env1) env) in + fun uu____12297 -> dummy :: env1) env) in let lopt1 = match lopt with | FStar_Pervasives_Native.Some rc -> let rct = - let uu____12316 = + let uu____12325 = FStar_All.pipe_right cfg.steps (FStar_List.contains CheckNoUvars) in - if uu____12316 + if uu____12325 then FStar_Util.map_opt rc.FStar_Syntax_Syntax.residual_typ (fun t2 -> - let uu____12326 = + let uu____12335 = FStar_Syntax_Subst.subst opening t2 in - norm cfg env' [] uu____12326) + norm cfg env' [] uu____12335) else FStar_Util.map_opt rc.FStar_Syntax_Syntax.residual_typ (FStar_Syntax_Subst.subst opening) in FStar_Pervasives_Native.Some - (let uu___117_12331 = rc in + (let uu___117_12340 = rc in { FStar_Syntax_Syntax.residual_effect = - (uu___117_12331.FStar_Syntax_Syntax.residual_effect); + (uu___117_12340.FStar_Syntax_Syntax.residual_effect); FStar_Syntax_Syntax.residual_typ = rct; FStar_Syntax_Syntax.residual_flags = - (uu___117_12331.FStar_Syntax_Syntax.residual_flags) + (uu___117_12340.FStar_Syntax_Syntax.residual_flags) }) - | uu____12332 -> lopt in + | uu____12341 -> lopt in (log cfg - (fun uu____12338 -> - let uu____12339 = + (fun uu____12347 -> + let uu____12348 = FStar_All.pipe_left FStar_Util.string_of_int (FStar_List.length bs1) in FStar_Util.print1 "\tShifted %s dummies\n" - uu____12339); + uu____12348); (let stack1 = (Cfg cfg) :: stack in let cfg1 = - let uu___118_12348 = cfg in + let uu___118_12357 = cfg in { - steps = (uu___118_12348.steps); - tcenv = (uu___118_12348.tcenv); - delta_level = (uu___118_12348.delta_level); + steps = (uu___118_12357.steps); + tcenv = (uu___118_12357.tcenv); + delta_level = (uu___118_12357.delta_level); primitive_steps = - (uu___118_12348.primitive_steps); - strong = true + (uu___118_12357.primitive_steps); + strong = true; + memoize_lazy = (uu___118_12357.memoize_lazy) } in norm cfg1 env' ((Abs (env, bs1, env', lopt1, (t1.FStar_Syntax_Syntax.pos))) :: stack1) body1))) - | (Abs uu____12359)::uu____12360 -> + | (Abs uu____12368)::uu____12369 -> if FStar_List.contains Weak cfg.steps then - let uu____12375 = closure_as_term cfg env t1 in - rebuild cfg env stack uu____12375 + let uu____12384 = closure_as_term cfg env t1 in + rebuild cfg env stack uu____12384 else - (let uu____12377 = + (let uu____12386 = FStar_Syntax_Subst.open_term' bs body in - match uu____12377 with + match uu____12386 with | (bs1,body1,opening) -> let env' = FStar_All.pipe_right bs1 (FStar_List.fold_left (fun env1 -> - fun uu____12419 -> dummy :: env1) env) in + fun uu____12428 -> dummy :: env1) env) in let lopt1 = match lopt with | FStar_Pervasives_Native.Some rc -> let rct = - let uu____12447 = + let uu____12456 = FStar_All.pipe_right cfg.steps (FStar_List.contains CheckNoUvars) in - if uu____12447 + if uu____12456 then FStar_Util.map_opt rc.FStar_Syntax_Syntax.residual_typ (fun t2 -> - let uu____12457 = + let uu____12466 = FStar_Syntax_Subst.subst opening t2 in - norm cfg env' [] uu____12457) + norm cfg env' [] uu____12466) else FStar_Util.map_opt rc.FStar_Syntax_Syntax.residual_typ (FStar_Syntax_Subst.subst opening) in FStar_Pervasives_Native.Some - (let uu___117_12462 = rc in + (let uu___117_12471 = rc in { FStar_Syntax_Syntax.residual_effect = - (uu___117_12462.FStar_Syntax_Syntax.residual_effect); + (uu___117_12471.FStar_Syntax_Syntax.residual_effect); FStar_Syntax_Syntax.residual_typ = rct; FStar_Syntax_Syntax.residual_flags = - (uu___117_12462.FStar_Syntax_Syntax.residual_flags) + (uu___117_12471.FStar_Syntax_Syntax.residual_flags) }) - | uu____12463 -> lopt in + | uu____12472 -> lopt in (log cfg - (fun uu____12469 -> - let uu____12470 = + (fun uu____12478 -> + let uu____12479 = FStar_All.pipe_left FStar_Util.string_of_int (FStar_List.length bs1) in FStar_Util.print1 "\tShifted %s dummies\n" - uu____12470); + uu____12479); (let stack1 = (Cfg cfg) :: stack in let cfg1 = - let uu___118_12479 = cfg in + let uu___118_12488 = cfg in { - steps = (uu___118_12479.steps); - tcenv = (uu___118_12479.tcenv); - delta_level = (uu___118_12479.delta_level); + steps = (uu___118_12488.steps); + tcenv = (uu___118_12488.tcenv); + delta_level = (uu___118_12488.delta_level); primitive_steps = - (uu___118_12479.primitive_steps); - strong = true + (uu___118_12488.primitive_steps); + strong = true; + memoize_lazy = (uu___118_12488.memoize_lazy) } in norm cfg1 env' ((Abs @@ -3213,66 +3233,67 @@ let rec norm: | [] -> if FStar_List.contains Weak cfg.steps then - let uu____12490 = closure_as_term cfg env t1 in - rebuild cfg env stack uu____12490 + let uu____12499 = closure_as_term cfg env t1 in + rebuild cfg env stack uu____12499 else - (let uu____12492 = + (let uu____12501 = FStar_Syntax_Subst.open_term' bs body in - match uu____12492 with + match uu____12501 with | (bs1,body1,opening) -> let env' = FStar_All.pipe_right bs1 (FStar_List.fold_left (fun env1 -> - fun uu____12534 -> dummy :: env1) env) in + fun uu____12543 -> dummy :: env1) env) in let lopt1 = match lopt with | FStar_Pervasives_Native.Some rc -> let rct = - let uu____12562 = + let uu____12571 = FStar_All.pipe_right cfg.steps (FStar_List.contains CheckNoUvars) in - if uu____12562 + if uu____12571 then FStar_Util.map_opt rc.FStar_Syntax_Syntax.residual_typ (fun t2 -> - let uu____12572 = + let uu____12581 = FStar_Syntax_Subst.subst opening t2 in - norm cfg env' [] uu____12572) + norm cfg env' [] uu____12581) else FStar_Util.map_opt rc.FStar_Syntax_Syntax.residual_typ (FStar_Syntax_Subst.subst opening) in FStar_Pervasives_Native.Some - (let uu___117_12577 = rc in + (let uu___117_12586 = rc in { FStar_Syntax_Syntax.residual_effect = - (uu___117_12577.FStar_Syntax_Syntax.residual_effect); + (uu___117_12586.FStar_Syntax_Syntax.residual_effect); FStar_Syntax_Syntax.residual_typ = rct; FStar_Syntax_Syntax.residual_flags = - (uu___117_12577.FStar_Syntax_Syntax.residual_flags) + (uu___117_12586.FStar_Syntax_Syntax.residual_flags) }) - | uu____12578 -> lopt in + | uu____12587 -> lopt in (log cfg - (fun uu____12584 -> - let uu____12585 = + (fun uu____12593 -> + let uu____12594 = FStar_All.pipe_left FStar_Util.string_of_int (FStar_List.length bs1) in FStar_Util.print1 "\tShifted %s dummies\n" - uu____12585); + uu____12594); (let stack1 = (Cfg cfg) :: stack in let cfg1 = - let uu___118_12594 = cfg in + let uu___118_12603 = cfg in { - steps = (uu___118_12594.steps); - tcenv = (uu___118_12594.tcenv); - delta_level = (uu___118_12594.delta_level); + steps = (uu___118_12603.steps); + tcenv = (uu___118_12603.tcenv); + delta_level = (uu___118_12603.delta_level); primitive_steps = - (uu___118_12594.primitive_steps); - strong = true + (uu___118_12603.primitive_steps); + strong = true; + memoize_lazy = (uu___118_12603.memoize_lazy) } in norm cfg1 env' ((Abs @@ -3283,29 +3304,29 @@ let rec norm: let stack1 = FStar_All.pipe_right stack (FStar_List.fold_right - (fun uu____12643 -> + (fun uu____12652 -> fun stack1 -> - match uu____12643 with + match uu____12652 with | (a,aq) -> - let uu____12655 = - let uu____12656 = - let uu____12663 = - let uu____12664 = - let uu____12695 = + let uu____12664 = + let uu____12665 = + let uu____12672 = + let uu____12673 = + let uu____12704 = FStar_Util.mk_ref FStar_Pervasives_Native.None in - (env, a, uu____12695, false) in - Clos uu____12664 in - (uu____12663, aq, + (env, a, uu____12704, false) in + Clos uu____12673 in + (uu____12672, aq, (t1.FStar_Syntax_Syntax.pos)) in - Arg uu____12656 in - uu____12655 :: stack1) args) in + Arg uu____12665 in + uu____12664 :: stack1) args) in (log cfg - (fun uu____12779 -> - let uu____12780 = + (fun uu____12788 -> + let uu____12789 = FStar_All.pipe_left FStar_Util.string_of_int (FStar_List.length args) in - FStar_Util.print1 "\tPushed %s arguments\n" uu____12780); + FStar_Util.print1 "\tPushed %s arguments\n" uu____12789); norm cfg env stack1 head1) | FStar_Syntax_Syntax.Tm_refine (x,f) -> if FStar_List.contains Weak cfg.steps @@ -3316,135 +3337,135 @@ let rec norm: let t2 = mk (FStar_Syntax_Syntax.Tm_refine - ((let uu___119_12816 = x in + ((let uu___119_12825 = x in { FStar_Syntax_Syntax.ppname = - (uu___119_12816.FStar_Syntax_Syntax.ppname); + (uu___119_12825.FStar_Syntax_Syntax.ppname); FStar_Syntax_Syntax.index = - (uu___119_12816.FStar_Syntax_Syntax.index); + (uu___119_12825.FStar_Syntax_Syntax.index); FStar_Syntax_Syntax.sort = t_x }), f)) t1.FStar_Syntax_Syntax.pos in rebuild cfg env stack t2 - | uu____12817 -> - let uu____12822 = closure_as_term cfg env t1 in - rebuild cfg env stack uu____12822) + | uu____12826 -> + let uu____12831 = closure_as_term cfg env t1 in + rebuild cfg env stack uu____12831) else (let t_x = norm cfg env [] x.FStar_Syntax_Syntax.sort in - let uu____12825 = + let uu____12834 = FStar_Syntax_Subst.open_term [(x, FStar_Pervasives_Native.None)] f in - match uu____12825 with + match uu____12834 with | (closing,f1) -> let f2 = norm cfg (dummy :: env) [] f1 in let t2 = - let uu____12856 = - let uu____12857 = - let uu____12864 = + let uu____12865 = + let uu____12866 = + let uu____12873 = FStar_Syntax_Subst.close closing f2 in - ((let uu___120_12866 = x in + ((let uu___120_12875 = x in { FStar_Syntax_Syntax.ppname = - (uu___120_12866.FStar_Syntax_Syntax.ppname); + (uu___120_12875.FStar_Syntax_Syntax.ppname); FStar_Syntax_Syntax.index = - (uu___120_12866.FStar_Syntax_Syntax.index); + (uu___120_12875.FStar_Syntax_Syntax.index); FStar_Syntax_Syntax.sort = t_x - }), uu____12864) in - FStar_Syntax_Syntax.Tm_refine uu____12857 in - mk uu____12856 t1.FStar_Syntax_Syntax.pos in + }), uu____12873) in + FStar_Syntax_Syntax.Tm_refine uu____12866 in + mk uu____12865 t1.FStar_Syntax_Syntax.pos in rebuild cfg env stack t2) | FStar_Syntax_Syntax.Tm_arrow (bs,c) -> if FStar_List.contains Weak cfg.steps then - let uu____12885 = closure_as_term cfg env t1 in - rebuild cfg env stack uu____12885 + let uu____12894 = closure_as_term cfg env t1 in + rebuild cfg env stack uu____12894 else - (let uu____12887 = FStar_Syntax_Subst.open_comp bs c in - match uu____12887 with + (let uu____12896 = FStar_Syntax_Subst.open_comp bs c in + match uu____12896 with | (bs1,c1) -> let c2 = - let uu____12895 = + let uu____12904 = FStar_All.pipe_right bs1 (FStar_List.fold_left (fun env1 -> - fun uu____12919 -> dummy :: env1) env) in - norm_comp cfg uu____12895 c1 in + fun uu____12928 -> dummy :: env1) env) in + norm_comp cfg uu____12904 c1 in let t2 = - let uu____12941 = norm_binders cfg env bs1 in - FStar_Syntax_Util.arrow uu____12941 c2 in + let uu____12950 = norm_binders cfg env bs1 in + FStar_Syntax_Util.arrow uu____12950 c2 in rebuild cfg env stack t2) | FStar_Syntax_Syntax.Tm_ascribed (t11,(tc,tacopt),l) -> (match stack with - | (Match uu____13000)::uu____13001 -> + | (Match uu____13009)::uu____13010 -> (log cfg - (fun uu____13012 -> + (fun uu____13021 -> FStar_Util.print_string "+++ Dropping ascription \n"); norm cfg env stack t11) - | (Arg uu____13013)::uu____13014 -> + | (Arg uu____13022)::uu____13023 -> (log cfg - (fun uu____13025 -> + (fun uu____13034 -> FStar_Util.print_string "+++ Dropping ascription \n"); norm cfg env stack t11) | (App - (uu____13026,{ + (uu____13035,{ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_reify ); - FStar_Syntax_Syntax.pos = uu____13027; - FStar_Syntax_Syntax.vars = uu____13028;_},uu____13029,uu____13030))::uu____13031 + FStar_Syntax_Syntax.pos = uu____13036; + FStar_Syntax_Syntax.vars = uu____13037;_},uu____13038,uu____13039))::uu____13040 -> (log cfg - (fun uu____13040 -> + (fun uu____13049 -> FStar_Util.print_string "+++ Dropping ascription \n"); norm cfg env stack t11) - | (MemoLazy uu____13041)::uu____13042 -> + | (MemoLazy uu____13050)::uu____13051 -> (log cfg - (fun uu____13053 -> + (fun uu____13062 -> FStar_Util.print_string "+++ Dropping ascription \n"); norm cfg env stack t11) - | uu____13054 -> + | uu____13063 -> (log cfg - (fun uu____13057 -> + (fun uu____13066 -> FStar_Util.print_string "+++ Keeping ascription \n"); (let t12 = norm cfg env [] t11 in log cfg - (fun uu____13061 -> + (fun uu____13070 -> FStar_Util.print_string "+++ Normalizing ascription \n"); (let tc1 = match tc with | FStar_Util.Inl t2 -> - let uu____13078 = norm cfg env [] t2 in - FStar_Util.Inl uu____13078 + let uu____13087 = norm cfg env [] t2 in + FStar_Util.Inl uu____13087 | FStar_Util.Inr c -> - let uu____13086 = norm_comp cfg env c in - FStar_Util.Inr uu____13086 in + let uu____13095 = norm_comp cfg env c in + FStar_Util.Inr uu____13095 in let tacopt1 = FStar_Util.map_opt tacopt (norm cfg env []) in match stack with | (Cfg cfg1)::stack1 -> let t2 = - let uu____13099 = - let uu____13100 = - let uu____13127 = + let uu____13108 = + let uu____13109 = + let uu____13136 = FStar_Syntax_Util.unascribe t12 in - (uu____13127, (tc1, tacopt1), l) in - FStar_Syntax_Syntax.Tm_ascribed uu____13100 in - mk uu____13099 t1.FStar_Syntax_Syntax.pos in + (uu____13136, (tc1, tacopt1), l) in + FStar_Syntax_Syntax.Tm_ascribed uu____13109 in + mk uu____13108 t1.FStar_Syntax_Syntax.pos in norm cfg1 env stack1 t2 - | uu____13146 -> - let uu____13147 = - let uu____13148 = - let uu____13149 = - let uu____13176 = + | uu____13155 -> + let uu____13156 = + let uu____13157 = + let uu____13158 = + let uu____13185 = FStar_Syntax_Util.unascribe t12 in - (uu____13176, (tc1, tacopt1), l) in - FStar_Syntax_Syntax.Tm_ascribed uu____13149 in - mk uu____13148 t1.FStar_Syntax_Syntax.pos in - rebuild cfg env stack uu____13147)))) + (uu____13185, (tc1, tacopt1), l) in + FStar_Syntax_Syntax.Tm_ascribed uu____13158 in + mk uu____13157 t1.FStar_Syntax_Syntax.pos in + rebuild cfg env stack uu____13156)))) | FStar_Syntax_Syntax.Tm_match (head1,branches) -> let stack1 = (Match (env, branches, (t1.FStar_Syntax_Syntax.pos))) :: @@ -3458,159 +3479,161 @@ let rec norm: FStar_All.pipe_right lbs (FStar_List.map (fun lb -> - let uu____13286 = + let uu____13295 = FStar_Syntax_Subst.univ_var_opening lb.FStar_Syntax_Syntax.lbunivs in - match uu____13286 with + match uu____13295 with | (openings,lbunivs) -> let cfg1 = - let uu___121_13306 = cfg in - let uu____13307 = + let uu___121_13315 = cfg in + let uu____13316 = FStar_TypeChecker_Env.push_univ_vars cfg.tcenv lbunivs in { - steps = (uu___121_13306.steps); - tcenv = uu____13307; - delta_level = (uu___121_13306.delta_level); + steps = (uu___121_13315.steps); + tcenv = uu____13316; + delta_level = (uu___121_13315.delta_level); primitive_steps = - (uu___121_13306.primitive_steps); - strong = (uu___121_13306.strong) + (uu___121_13315.primitive_steps); + strong = (uu___121_13315.strong); + memoize_lazy = (uu___121_13315.memoize_lazy) } in let norm1 t2 = - let uu____13312 = - let uu____13313 = + let uu____13321 = + let uu____13322 = FStar_Syntax_Subst.subst openings t2 in - norm cfg1 env [] uu____13313 in + norm cfg1 env [] uu____13322 in FStar_Syntax_Subst.close_univ_vars lbunivs - uu____13312 in + uu____13321 in let lbtyp = norm1 lb.FStar_Syntax_Syntax.lbtyp in let lbdef = norm1 lb.FStar_Syntax_Syntax.lbdef in - let uu___122_13316 = lb in + let uu___122_13325 = lb in { FStar_Syntax_Syntax.lbname = - (uu___122_13316.FStar_Syntax_Syntax.lbname); + (uu___122_13325.FStar_Syntax_Syntax.lbname); FStar_Syntax_Syntax.lbunivs = lbunivs; FStar_Syntax_Syntax.lbtyp = lbtyp; FStar_Syntax_Syntax.lbeff = - (uu___122_13316.FStar_Syntax_Syntax.lbeff); + (uu___122_13325.FStar_Syntax_Syntax.lbeff); FStar_Syntax_Syntax.lbdef = lbdef })) in - let uu____13317 = + let uu____13326 = mk (FStar_Syntax_Syntax.Tm_let ((b, lbs1), lbody)) t1.FStar_Syntax_Syntax.pos in - rebuild cfg env stack uu____13317 + rebuild cfg env stack uu____13326 | FStar_Syntax_Syntax.Tm_let - ((uu____13328,{ + ((uu____13337,{ FStar_Syntax_Syntax.lbname = FStar_Util.Inr - uu____13329; - FStar_Syntax_Syntax.lbunivs = uu____13330; - FStar_Syntax_Syntax.lbtyp = uu____13331; - FStar_Syntax_Syntax.lbeff = uu____13332; - FStar_Syntax_Syntax.lbdef = uu____13333;_}::uu____13334),uu____13335) + uu____13338; + FStar_Syntax_Syntax.lbunivs = uu____13339; + FStar_Syntax_Syntax.lbtyp = uu____13340; + FStar_Syntax_Syntax.lbeff = uu____13341; + FStar_Syntax_Syntax.lbdef = uu____13342;_}::uu____13343),uu____13344) -> rebuild cfg env stack t1 | FStar_Syntax_Syntax.Tm_let ((false ,lb::[]),body) -> let n1 = FStar_TypeChecker_Env.norm_eff_name cfg.tcenv lb.FStar_Syntax_Syntax.lbeff in - let uu____13371 = - (let uu____13374 = + let uu____13380 = + (let uu____13383 = FStar_All.pipe_right cfg.steps (FStar_List.contains NoDeltaSteps) in - Prims.op_Negation uu____13374) && + Prims.op_Negation uu____13383) && ((FStar_Syntax_Util.is_pure_effect n1) || ((FStar_Syntax_Util.is_ghost_effect n1) && - (let uu____13376 = + (let uu____13385 = FStar_All.pipe_right cfg.steps (FStar_List.contains PureSubtermsWithinComputations) in - Prims.op_Negation uu____13376))) in - if uu____13371 + Prims.op_Negation uu____13385))) in + if uu____13380 then let binder = - let uu____13378 = + let uu____13387 = FStar_Util.left lb.FStar_Syntax_Syntax.lbname in - FStar_Syntax_Syntax.mk_binder uu____13378 in + FStar_Syntax_Syntax.mk_binder uu____13387 in let env1 = - let uu____13388 = - let uu____13395 = - let uu____13396 = - let uu____13427 = + let uu____13397 = + let uu____13404 = + let uu____13405 = + let uu____13436 = FStar_Util.mk_ref FStar_Pervasives_Native.None in - (env, (lb.FStar_Syntax_Syntax.lbdef), uu____13427, + (env, (lb.FStar_Syntax_Syntax.lbdef), uu____13436, false) in - Clos uu____13396 in - ((FStar_Pervasives_Native.Some binder), uu____13395) in - uu____13388 :: env in + Clos uu____13405 in + ((FStar_Pervasives_Native.Some binder), uu____13404) in + uu____13397 :: env in (log cfg - (fun uu____13520 -> + (fun uu____13529 -> FStar_Util.print_string "+++ Reducing Tm_let\n"); norm cfg env1 stack body) else - (let uu____13522 = - let uu____13527 = - let uu____13528 = - let uu____13529 = + (let uu____13531 = + let uu____13536 = + let uu____13537 = + let uu____13538 = FStar_All.pipe_right lb.FStar_Syntax_Syntax.lbname FStar_Util.left in - FStar_All.pipe_right uu____13529 + FStar_All.pipe_right uu____13538 FStar_Syntax_Syntax.mk_binder in - [uu____13528] in - FStar_Syntax_Subst.open_term uu____13527 body in - match uu____13522 with + [uu____13537] in + FStar_Syntax_Subst.open_term uu____13536 body in + match uu____13531 with | (bs,body1) -> (log cfg - (fun uu____13538 -> + (fun uu____13547 -> FStar_Util.print_string "+++ Normalizing Tm_let -- type\n"); (let ty = norm cfg env [] lb.FStar_Syntax_Syntax.lbtyp in let lbname = let x = - let uu____13546 = FStar_List.hd bs in - FStar_Pervasives_Native.fst uu____13546 in + let uu____13555 = FStar_List.hd bs in + FStar_Pervasives_Native.fst uu____13555 in FStar_Util.Inl - (let uu___123_13556 = x in + (let uu___123_13565 = x in { FStar_Syntax_Syntax.ppname = - (uu___123_13556.FStar_Syntax_Syntax.ppname); + (uu___123_13565.FStar_Syntax_Syntax.ppname); FStar_Syntax_Syntax.index = - (uu___123_13556.FStar_Syntax_Syntax.index); + (uu___123_13565.FStar_Syntax_Syntax.index); FStar_Syntax_Syntax.sort = ty }) in log cfg - (fun uu____13559 -> + (fun uu____13568 -> FStar_Util.print_string "+++ Normalizing Tm_let -- definiens\n"); (let lb1 = - let uu___124_13561 = lb in - let uu____13562 = + let uu___124_13570 = lb in + let uu____13571 = norm cfg env [] lb.FStar_Syntax_Syntax.lbdef in { FStar_Syntax_Syntax.lbname = lbname; FStar_Syntax_Syntax.lbunivs = - (uu___124_13561.FStar_Syntax_Syntax.lbunivs); + (uu___124_13570.FStar_Syntax_Syntax.lbunivs); FStar_Syntax_Syntax.lbtyp = ty; FStar_Syntax_Syntax.lbeff = - (uu___124_13561.FStar_Syntax_Syntax.lbeff); - FStar_Syntax_Syntax.lbdef = uu____13562 + (uu___124_13570.FStar_Syntax_Syntax.lbeff); + FStar_Syntax_Syntax.lbdef = uu____13571 } in let env' = FStar_All.pipe_right bs (FStar_List.fold_left (fun env1 -> - fun uu____13597 -> dummy :: env1) env) in + fun uu____13606 -> dummy :: env1) env) in let stack1 = (Cfg cfg) :: stack in let cfg1 = - let uu___125_13620 = cfg in + let uu___125_13629 = cfg in { - steps = (uu___125_13620.steps); - tcenv = (uu___125_13620.tcenv); - delta_level = (uu___125_13620.delta_level); + steps = (uu___125_13629.steps); + tcenv = (uu___125_13629.tcenv); + delta_level = (uu___125_13629.delta_level); primitive_steps = - (uu___125_13620.primitive_steps); - strong = true + (uu___125_13629.primitive_steps); + strong = true; + memoize_lazy = (uu___125_13629.memoize_lazy) } in log cfg1 - (fun uu____13623 -> + (fun uu____13632 -> FStar_Util.print_string "+++ Normalizing Tm_let -- body\n"); norm cfg1 env' @@ -3622,8 +3645,8 @@ let rec norm: (FStar_List.contains PureSubtermsWithinComputations cfg.steps)) -> - let uu____13640 = FStar_Syntax_Subst.open_let_rec lbs body in - (match uu____13640 with + let uu____13649 = FStar_Syntax_Subst.open_let_rec lbs body in + (match uu____13649 with | (lbs1,body1) -> let lbs2 = FStar_List.map @@ -3631,108 +3654,108 @@ let rec norm: let ty = norm cfg env [] lb.FStar_Syntax_Syntax.lbtyp in let lbname = - let uu____13676 = - let uu___126_13677 = + let uu____13685 = + let uu___126_13686 = FStar_Util.left lb.FStar_Syntax_Syntax.lbname in { FStar_Syntax_Syntax.ppname = - (uu___126_13677.FStar_Syntax_Syntax.ppname); + (uu___126_13686.FStar_Syntax_Syntax.ppname); FStar_Syntax_Syntax.index = - (uu___126_13677.FStar_Syntax_Syntax.index); + (uu___126_13686.FStar_Syntax_Syntax.index); FStar_Syntax_Syntax.sort = ty } in - FStar_Util.Inl uu____13676 in - let uu____13678 = + FStar_Util.Inl uu____13685 in + let uu____13687 = FStar_Syntax_Util.abs_formals lb.FStar_Syntax_Syntax.lbdef in - match uu____13678 with + match uu____13687 with | (xs,def_body,lopt) -> let xs1 = norm_binders cfg env xs in let env1 = - let uu____13704 = - FStar_List.map (fun uu____13720 -> dummy) + let uu____13713 = + FStar_List.map (fun uu____13729 -> dummy) lbs1 in - let uu____13721 = - let uu____13730 = + let uu____13730 = + let uu____13739 = FStar_List.map - (fun uu____13750 -> dummy) xs1 in - FStar_List.append uu____13730 env in - FStar_List.append uu____13704 uu____13721 in + (fun uu____13759 -> dummy) xs1 in + FStar_List.append uu____13739 env in + FStar_List.append uu____13713 uu____13730 in let def_body1 = norm cfg env1 [] def_body in let lopt1 = match lopt with | FStar_Pervasives_Native.Some rc -> - let uu____13774 = - let uu___127_13775 = rc in - let uu____13776 = + let uu____13783 = + let uu___127_13784 = rc in + let uu____13785 = FStar_Util.map_opt rc.FStar_Syntax_Syntax.residual_typ (norm cfg env1 []) in { FStar_Syntax_Syntax.residual_effect = - (uu___127_13775.FStar_Syntax_Syntax.residual_effect); + (uu___127_13784.FStar_Syntax_Syntax.residual_effect); FStar_Syntax_Syntax.residual_typ = - uu____13776; + uu____13785; FStar_Syntax_Syntax.residual_flags = - (uu___127_13775.FStar_Syntax_Syntax.residual_flags) + (uu___127_13784.FStar_Syntax_Syntax.residual_flags) } in - FStar_Pervasives_Native.Some uu____13774 - | uu____13783 -> lopt in + FStar_Pervasives_Native.Some uu____13783 + | uu____13792 -> lopt in let def = FStar_Syntax_Util.abs xs1 def_body1 lopt1 in - let uu___128_13787 = lb in + let uu___128_13796 = lb in { FStar_Syntax_Syntax.lbname = lbname; FStar_Syntax_Syntax.lbunivs = - (uu___128_13787.FStar_Syntax_Syntax.lbunivs); + (uu___128_13796.FStar_Syntax_Syntax.lbunivs); FStar_Syntax_Syntax.lbtyp = ty; FStar_Syntax_Syntax.lbeff = - (uu___128_13787.FStar_Syntax_Syntax.lbeff); + (uu___128_13796.FStar_Syntax_Syntax.lbeff); FStar_Syntax_Syntax.lbdef = def }) lbs1 in let env' = - let uu____13797 = - FStar_List.map (fun uu____13813 -> dummy) lbs2 in - FStar_List.append uu____13797 env in + let uu____13806 = + FStar_List.map (fun uu____13822 -> dummy) lbs2 in + FStar_List.append uu____13806 env in let body2 = norm cfg env' [] body1 in - let uu____13821 = + let uu____13830 = FStar_Syntax_Subst.close_let_rec lbs2 body2 in - (match uu____13821 with + (match uu____13830 with | (lbs3,body3) -> let t2 = - let uu___129_13837 = t1 in + let uu___129_13846 = t1 in { FStar_Syntax_Syntax.n = (FStar_Syntax_Syntax.Tm_let ((true, lbs3), body3)); FStar_Syntax_Syntax.pos = - (uu___129_13837.FStar_Syntax_Syntax.pos); + (uu___129_13846.FStar_Syntax_Syntax.pos); FStar_Syntax_Syntax.vars = - (uu___129_13837.FStar_Syntax_Syntax.vars) + (uu___129_13846.FStar_Syntax_Syntax.vars) } in rebuild cfg env stack t2)) | FStar_Syntax_Syntax.Tm_let (lbs,body) when FStar_List.contains (Exclude Zeta) cfg.steps -> - let uu____13864 = closure_as_term cfg env t1 in - rebuild cfg env stack uu____13864 + let uu____13873 = closure_as_term cfg env t1 in + rebuild cfg env stack uu____13873 | FStar_Syntax_Syntax.Tm_let (lbs,body) -> - let uu____13883 = + let uu____13892 = FStar_List.fold_right (fun lb -> - fun uu____13959 -> - match uu____13959 with + fun uu____13968 -> + match uu____13968 with | (rec_env,memos,i) -> let bv = - let uu___130_14080 = + let uu___130_14089 = FStar_Util.left lb.FStar_Syntax_Syntax.lbname in { FStar_Syntax_Syntax.ppname = - (uu___130_14080.FStar_Syntax_Syntax.ppname); + (uu___130_14089.FStar_Syntax_Syntax.ppname); FStar_Syntax_Syntax.index = i; FStar_Syntax_Syntax.sort = - (uu___130_14080.FStar_Syntax_Syntax.sort) + (uu___130_14089.FStar_Syntax_Syntax.sort) } in let f_i = FStar_Syntax_Syntax.bv_to_tm bv in let fix_f_i = @@ -3748,9 +3771,9 @@ let rec norm: (i + (Prims.parse_int "1")))) (FStar_Pervasives_Native.snd lbs) (env, [], (Prims.parse_int "0")) in - (match uu____13883 with - | (rec_env,memos,uu____14293) -> - let uu____14346 = + (match uu____13892 with + | (rec_env,memos,uu____14302) -> + let uu____14355 = FStar_List.map2 (fun lb -> fun memo -> @@ -3762,25 +3785,25 @@ let rec norm: FStar_List.fold_right (fun lb -> fun env1 -> - let uu____14889 = - let uu____14896 = - let uu____14897 = - let uu____14928 = + let uu____14898 = + let uu____14905 = + let uu____14906 = + let uu____14937 = FStar_Util.mk_ref FStar_Pervasives_Native.None in (rec_env, (lb.FStar_Syntax_Syntax.lbdef), - uu____14928, false) in - Clos uu____14897 in - (FStar_Pervasives_Native.None, uu____14896) in - uu____14889 :: env1) + uu____14937, false) in + Clos uu____14906 in + (FStar_Pervasives_Native.None, uu____14905) in + uu____14898 :: env1) (FStar_Pervasives_Native.snd lbs) env in norm cfg body_env stack body) | FStar_Syntax_Syntax.Tm_meta (head1,m) -> (log cfg - (fun uu____15038 -> - let uu____15039 = + (fun uu____15047 -> + let uu____15048 = FStar_Syntax_Print.metadata_to_string m in - FStar_Util.print1 ">> metadata = %s\n" uu____15039); + FStar_Util.print1 ">> metadata = %s\n" uu____15048); (match m with | FStar_Syntax_Syntax.Meta_monadic (m1,t2) -> reduce_impure_comp cfg env stack head1 @@ -3788,17 +3811,17 @@ let rec norm: | FStar_Syntax_Syntax.Meta_monadic_lift (m1,m',t2) -> reduce_impure_comp cfg env stack head1 (FStar_Util.Inr (m1, m')) t2 - | uu____15061 -> + | uu____15070 -> if FStar_List.contains Unmeta cfg.steps then norm cfg env stack head1 else (match stack with - | uu____15063::uu____15064 -> + | uu____15072::uu____15073 -> (match m with | FStar_Syntax_Syntax.Meta_labeled - (l,r,uu____15069) -> + (l,r,uu____15078) -> norm cfg env ((Meta (m, r)) :: stack) head1 - | FStar_Syntax_Syntax.Meta_alien uu____15070 -> + | FStar_Syntax_Syntax.Meta_alien uu____15079 -> rebuild cfg env stack t1 | FStar_Syntax_Syntax.Meta_pattern args -> let args1 = norm_pattern_args cfg env args in @@ -3808,17 +3831,17 @@ let rec norm: args1), (t1.FStar_Syntax_Syntax.pos))) :: stack) head1 - | uu____15101 -> norm cfg env stack head1) + | uu____15110 -> norm cfg env stack head1) | [] -> let head2 = norm cfg env [] head1 in let m1 = match m with | FStar_Syntax_Syntax.Meta_pattern args -> - let uu____15115 = + let uu____15124 = norm_pattern_args cfg env args in FStar_Syntax_Syntax.Meta_pattern - uu____15115 - | uu____15126 -> m in + uu____15124 + | uu____15135 -> m in let t2 = mk (FStar_Syntax_Syntax.Tm_meta (head2, m1)) t1.FStar_Syntax_Syntax.pos in @@ -3836,35 +3859,35 @@ and do_unfold_fv: fun t0 -> fun f -> let r_env = - let uu____15138 = FStar_Syntax_Syntax.range_of_fv f in - FStar_TypeChecker_Env.set_range cfg.tcenv uu____15138 in - let uu____15139 = + let uu____15147 = FStar_Syntax_Syntax.range_of_fv f in + FStar_TypeChecker_Env.set_range cfg.tcenv uu____15147 in + let uu____15148 = FStar_TypeChecker_Env.lookup_definition cfg.delta_level r_env (f.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in - match uu____15139 with + match uu____15148 with | FStar_Pervasives_Native.None -> (log cfg - (fun uu____15152 -> + (fun uu____15161 -> FStar_Util.print "Tm_fvar case 2\n" []); rebuild cfg env stack t0) | FStar_Pervasives_Native.Some (us,t) -> (log cfg - (fun uu____15163 -> - let uu____15164 = FStar_Syntax_Print.term_to_string t0 in - let uu____15165 = FStar_Syntax_Print.term_to_string t in - FStar_Util.print2 ">>> Unfolded %s to %s\n" uu____15164 - uu____15165); + (fun uu____15172 -> + let uu____15173 = FStar_Syntax_Print.term_to_string t0 in + let uu____15174 = FStar_Syntax_Print.term_to_string t in + FStar_Util.print2 ">>> Unfolded %s to %s\n" uu____15173 + uu____15174); (let t1 = - let uu____15167 = + let uu____15176 = (FStar_All.pipe_right cfg.steps (FStar_List.contains (UnfoldUntil FStar_Syntax_Syntax.Delta_constant))) && - (let uu____15169 = + (let uu____15178 = FStar_All.pipe_right cfg.steps (FStar_List.contains UnfoldTac) in - Prims.op_Negation uu____15169) in - if uu____15167 + Prims.op_Negation uu____15178) in + if uu____15176 then t else FStar_Syntax_Subst.set_use_range @@ -3875,7 +3898,7 @@ and do_unfold_fv: if n1 > (Prims.parse_int "0") then match stack with - | (UnivArgs (us',uu____15179))::stack1 -> + | (UnivArgs (us',uu____15188))::stack1 -> let env1 = FStar_All.pipe_right us' (FStar_List.fold_left @@ -3884,19 +3907,19 @@ and do_unfold_fv: (FStar_Pervasives_Native.None, (Univ u)) :: env1) env) in norm cfg env1 stack1 t1 - | uu____15234 when + | uu____15243 when FStar_All.pipe_right cfg.steps (FStar_List.contains EraseUniverses) -> norm cfg env stack t1 - | uu____15237 -> - let uu____15240 = - let uu____15241 = + | uu____15246 -> + let uu____15249 = + let uu____15250 = FStar_Syntax_Print.lid_to_string (f.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in FStar_Util.format1 "Impossible: missing universe instantiation on %s" - uu____15241 in - failwith uu____15240 + uu____15250 in + failwith uu____15249 else norm cfg env stack t1)) and reduce_impure_comp: cfg -> @@ -3918,12 +3941,12 @@ and reduce_impure_comp: let t1 = norm cfg env [] t in let stack1 = (Cfg cfg) :: stack in let cfg1 = - let uu____15262 = + let uu____15271 = FStar_All.pipe_right cfg.steps (FStar_List.contains PureSubtermsWithinComputations) in - if uu____15262 + if uu____15271 then - let uu___131_15263 = cfg in + let uu___131_15272 = cfg in { steps = [PureSubtermsWithinComputations; @@ -3932,21 +3955,23 @@ and reduce_impure_comp: EraseUniverses; Exclude Zeta; NoDeltaSteps]; - tcenv = (uu___131_15263.tcenv); + tcenv = (uu___131_15272.tcenv); delta_level = [FStar_TypeChecker_Env.Inlining; FStar_TypeChecker_Env.Eager_unfolding_only]; - primitive_steps = (uu___131_15263.primitive_steps); - strong = (uu___131_15263.strong) + primitive_steps = (uu___131_15272.primitive_steps); + strong = (uu___131_15272.strong); + memoize_lazy = (uu___131_15272.memoize_lazy) } else - (let uu___132_15265 = cfg in + (let uu___132_15274 = cfg in { steps = (FStar_List.append [Exclude Zeta] cfg.steps); - tcenv = (uu___132_15265.tcenv); - delta_level = (uu___132_15265.delta_level); - primitive_steps = (uu___132_15265.primitive_steps); - strong = (uu___132_15265.strong) + tcenv = (uu___132_15274.tcenv); + delta_level = (uu___132_15274.delta_level); + primitive_steps = (uu___132_15274.primitive_steps); + strong = (uu___132_15274.strong); + memoize_lazy = (uu___132_15274.memoize_lazy) }) in let metadata = match m with @@ -3975,104 +4000,104 @@ and do_reify_monadic: fun t -> let head2 = FStar_Syntax_Util.unascribe head1 in log cfg - (fun uu____15294 -> - let uu____15295 = FStar_Syntax_Print.tag_of_term head2 in - let uu____15296 = + (fun uu____15303 -> + let uu____15304 = FStar_Syntax_Print.tag_of_term head2 in + let uu____15305 = FStar_Syntax_Print.term_to_string head2 in - FStar_Util.print2 "Reifying: (%s) %s\n" uu____15295 - uu____15296); - (let uu____15297 = - let uu____15298 = FStar_Syntax_Subst.compress head2 in - uu____15298.FStar_Syntax_Syntax.n in - match uu____15297 with + FStar_Util.print2 "Reifying: (%s) %s\n" uu____15304 + uu____15305); + (let uu____15306 = + let uu____15307 = FStar_Syntax_Subst.compress head2 in + uu____15307.FStar_Syntax_Syntax.n in + match uu____15306 with | FStar_Syntax_Syntax.Tm_let ((false ,lb::[]),body) -> let ed = FStar_TypeChecker_Env.get_effect_decl cfg.tcenv m in - let uu____15316 = ed.FStar_Syntax_Syntax.bind_repr in - (match uu____15316 with - | (uu____15317,bind_repr) -> + let uu____15325 = ed.FStar_Syntax_Syntax.bind_repr in + (match uu____15325 with + | (uu____15326,bind_repr) -> (match lb.FStar_Syntax_Syntax.lbname with - | FStar_Util.Inr uu____15323 -> + | FStar_Util.Inr uu____15332 -> failwith "Cannot reify a top-level let binding" | FStar_Util.Inl x -> let is_return e = - let uu____15331 = - let uu____15332 = + let uu____15340 = + let uu____15341 = FStar_Syntax_Subst.compress e in - uu____15332.FStar_Syntax_Syntax.n in - match uu____15331 with + uu____15341.FStar_Syntax_Syntax.n in + match uu____15340 with | FStar_Syntax_Syntax.Tm_meta (e1,FStar_Syntax_Syntax.Meta_monadic - (uu____15338,uu____15339)) + (uu____15347,uu____15348)) -> - let uu____15348 = - let uu____15349 = + let uu____15357 = + let uu____15358 = FStar_Syntax_Subst.compress e1 in - uu____15349.FStar_Syntax_Syntax.n in - (match uu____15348 with + uu____15358.FStar_Syntax_Syntax.n in + (match uu____15357 with | FStar_Syntax_Syntax.Tm_meta (e2,FStar_Syntax_Syntax.Meta_monadic_lift - (uu____15355,msrc,uu____15357)) + (uu____15364,msrc,uu____15366)) when FStar_Syntax_Util.is_pure_effect msrc -> - let uu____15366 = + let uu____15375 = FStar_Syntax_Subst.compress e2 in FStar_Pervasives_Native.Some - uu____15366 - | uu____15367 -> + uu____15375 + | uu____15376 -> FStar_Pervasives_Native.None) - | uu____15368 -> + | uu____15377 -> FStar_Pervasives_Native.None in - let uu____15369 = + let uu____15378 = is_return lb.FStar_Syntax_Syntax.lbdef in - (match uu____15369 with + (match uu____15378 with | FStar_Pervasives_Native.Some e -> let lb1 = - let uu___133_15374 = lb in + let uu___133_15383 = lb in { FStar_Syntax_Syntax.lbname = - (uu___133_15374.FStar_Syntax_Syntax.lbname); + (uu___133_15383.FStar_Syntax_Syntax.lbname); FStar_Syntax_Syntax.lbunivs = - (uu___133_15374.FStar_Syntax_Syntax.lbunivs); + (uu___133_15383.FStar_Syntax_Syntax.lbunivs); FStar_Syntax_Syntax.lbtyp = - (uu___133_15374.FStar_Syntax_Syntax.lbtyp); + (uu___133_15383.FStar_Syntax_Syntax.lbtyp); FStar_Syntax_Syntax.lbeff = FStar_Parser_Const.effect_PURE_lid; FStar_Syntax_Syntax.lbdef = e } in - let uu____15375 = FStar_List.tl stack in - let uu____15376 = - let uu____15377 = - let uu____15380 = - let uu____15381 = - let uu____15394 = + let uu____15384 = FStar_List.tl stack in + let uu____15385 = + let uu____15386 = + let uu____15389 = + let uu____15390 = + let uu____15403 = FStar_Syntax_Util.mk_reify body in - ((false, [lb1]), uu____15394) in + ((false, [lb1]), uu____15403) in FStar_Syntax_Syntax.Tm_let - uu____15381 in - FStar_Syntax_Syntax.mk uu____15380 in - uu____15377 + uu____15390 in + FStar_Syntax_Syntax.mk uu____15389 in + uu____15386 FStar_Pervasives_Native.None head2.FStar_Syntax_Syntax.pos in - norm cfg env uu____15375 uu____15376 + norm cfg env uu____15384 uu____15385 | FStar_Pervasives_Native.None -> - let uu____15410 = - let uu____15411 = is_return body in - match uu____15411 with + let uu____15419 = + let uu____15420 = is_return body in + match uu____15420 with | FStar_Pervasives_Native.Some { FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_bvar y; FStar_Syntax_Syntax.pos = - uu____15415; + uu____15424; FStar_Syntax_Syntax.vars = - uu____15416;_} + uu____15425;_} -> FStar_Syntax_Syntax.bv_eq x y - | uu____15421 -> false in - if uu____15410 + | uu____15430 -> false in + if uu____15419 then norm cfg env stack lb.FStar_Syntax_Syntax.lbdef @@ -4096,195 +4121,195 @@ and do_reify_monadic: = [] } in let body2 = - let uu____15444 = - let uu____15447 = - let uu____15448 = - let uu____15465 = - let uu____15468 = + let uu____15453 = + let uu____15456 = + let uu____15457 = + let uu____15474 = + let uu____15477 = FStar_Syntax_Syntax.mk_binder x in - [uu____15468] in - (uu____15465, body1, + [uu____15477] in + (uu____15474, body1, (FStar_Pervasives_Native.Some body_rc)) in FStar_Syntax_Syntax.Tm_abs - uu____15448 in - FStar_Syntax_Syntax.mk uu____15447 in - uu____15444 + uu____15457 in + FStar_Syntax_Syntax.mk uu____15456 in + uu____15453 FStar_Pervasives_Native.None body1.FStar_Syntax_Syntax.pos in let close1 = closure_as_term cfg env in let bind_inst = - let uu____15484 = - let uu____15485 = + let uu____15493 = + let uu____15494 = FStar_Syntax_Subst.compress bind_repr in - uu____15485.FStar_Syntax_Syntax.n in - match uu____15484 with + uu____15494.FStar_Syntax_Syntax.n in + match uu____15493 with | FStar_Syntax_Syntax.Tm_uinst - (bind1,uu____15491::uu____15492::[]) + (bind1,uu____15500::uu____15501::[]) -> - let uu____15499 = - let uu____15502 = - let uu____15503 = - let uu____15510 = - let uu____15513 = - let uu____15514 = + let uu____15508 = + let uu____15511 = + let uu____15512 = + let uu____15519 = + let uu____15522 = + let uu____15523 = close1 lb.FStar_Syntax_Syntax.lbtyp in (cfg.tcenv).FStar_TypeChecker_Env.universe_of cfg.tcenv - uu____15514 in - let uu____15515 = - let uu____15518 = - let uu____15519 = + uu____15523 in + let uu____15524 = + let uu____15527 = + let uu____15528 = close1 t in (cfg.tcenv).FStar_TypeChecker_Env.universe_of cfg.tcenv - uu____15519 in - [uu____15518] in - uu____15513 :: - uu____15515 in - (bind1, uu____15510) in + uu____15528 in + [uu____15527] in + uu____15522 :: + uu____15524 in + (bind1, uu____15519) in FStar_Syntax_Syntax.Tm_uinst - uu____15503 in + uu____15512 in FStar_Syntax_Syntax.mk - uu____15502 in - uu____15499 + uu____15511 in + uu____15508 FStar_Pervasives_Native.None rng - | uu____15527 -> + | uu____15536 -> failwith "NIY : Reification of indexed effects" in let reified = - let uu____15533 = - let uu____15536 = - let uu____15537 = - let uu____15552 = - let uu____15555 = + let uu____15542 = + let uu____15545 = + let uu____15546 = + let uu____15561 = + let uu____15564 = FStar_Syntax_Syntax.as_arg lb.FStar_Syntax_Syntax.lbtyp in - let uu____15556 = - let uu____15559 = + let uu____15565 = + let uu____15568 = FStar_Syntax_Syntax.as_arg t in - let uu____15560 = - let uu____15563 = + let uu____15569 = + let uu____15572 = FStar_Syntax_Syntax.as_arg FStar_Syntax_Syntax.tun in - let uu____15564 = - let uu____15567 = + let uu____15573 = + let uu____15576 = FStar_Syntax_Syntax.as_arg head3 in - let uu____15568 = - let uu____15571 = + let uu____15577 = + let uu____15580 = FStar_Syntax_Syntax.as_arg FStar_Syntax_Syntax.tun in - let uu____15572 = - let uu____15575 = + let uu____15581 = + let uu____15584 = FStar_Syntax_Syntax.as_arg body2 in - [uu____15575] in - uu____15571 :: - uu____15572 in - uu____15567 :: - uu____15568 in - uu____15563 :: - uu____15564 in - uu____15559 :: uu____15560 in - uu____15555 :: uu____15556 in - (bind_inst, uu____15552) in + [uu____15584] in + uu____15580 :: + uu____15581 in + uu____15576 :: + uu____15577 in + uu____15572 :: + uu____15573 in + uu____15568 :: uu____15569 in + uu____15564 :: uu____15565 in + (bind_inst, uu____15561) in FStar_Syntax_Syntax.Tm_app - uu____15537 in - FStar_Syntax_Syntax.mk uu____15536 in - uu____15533 + uu____15546 in + FStar_Syntax_Syntax.mk uu____15545 in + uu____15542 FStar_Pervasives_Native.None rng in log cfg - (fun uu____15586 -> - let uu____15587 = + (fun uu____15595 -> + let uu____15596 = FStar_Syntax_Print.term_to_string reified in FStar_Util.print1 - "Reified to %s\n" uu____15587); - (let uu____15588 = FStar_List.tl stack in - norm cfg env uu____15588 reified))))) + "Reified to %s\n" uu____15596); + (let uu____15597 = FStar_List.tl stack in + norm cfg env uu____15597 reified))))) | FStar_Syntax_Syntax.Tm_app (head_app,args) -> let ed = FStar_TypeChecker_Env.get_effect_decl cfg.tcenv m in - let uu____15612 = ed.FStar_Syntax_Syntax.bind_repr in - (match uu____15612 with - | (uu____15613,bind_repr) -> + let uu____15621 = ed.FStar_Syntax_Syntax.bind_repr in + (match uu____15621 with + | (uu____15622,bind_repr) -> let maybe_unfold_action head3 = let maybe_extract_fv t1 = let t2 = - let uu____15648 = - let uu____15649 = + let uu____15657 = + let uu____15658 = FStar_Syntax_Subst.compress t1 in - uu____15649.FStar_Syntax_Syntax.n in - match uu____15648 with + uu____15658.FStar_Syntax_Syntax.n in + match uu____15657 with | FStar_Syntax_Syntax.Tm_uinst - (t2,uu____15655) -> t2 - | uu____15660 -> head3 in - let uu____15661 = - let uu____15662 = + (t2,uu____15664) -> t2 + | uu____15669 -> head3 in + let uu____15670 = + let uu____15671 = FStar_Syntax_Subst.compress t2 in - uu____15662.FStar_Syntax_Syntax.n in - match uu____15661 with + uu____15671.FStar_Syntax_Syntax.n in + match uu____15670 with | FStar_Syntax_Syntax.Tm_fvar x -> FStar_Pervasives_Native.Some x - | uu____15668 -> FStar_Pervasives_Native.None in - let uu____15669 = maybe_extract_fv head3 in - match uu____15669 with + | uu____15677 -> FStar_Pervasives_Native.None in + let uu____15678 = maybe_extract_fv head3 in + match uu____15678 with | FStar_Pervasives_Native.Some x when - let uu____15679 = + let uu____15688 = FStar_Syntax_Syntax.lid_of_fv x in FStar_TypeChecker_Env.is_action cfg.tcenv - uu____15679 + uu____15688 -> let head4 = norm cfg env [] head3 in let action_unfolded = - let uu____15684 = maybe_extract_fv head4 in - match uu____15684 with - | FStar_Pervasives_Native.Some uu____15689 + let uu____15693 = maybe_extract_fv head4 in + match uu____15693 with + | FStar_Pervasives_Native.Some uu____15698 -> FStar_Pervasives_Native.Some true - | uu____15690 -> + | uu____15699 -> FStar_Pervasives_Native.Some false in (head4, action_unfolded) - | uu____15695 -> + | uu____15704 -> (head3, FStar_Pervasives_Native.None) in - ((let is_arg_impure uu____15710 = - match uu____15710 with + ((let is_arg_impure uu____15719 = + match uu____15719 with | (e,q) -> - let uu____15717 = - let uu____15718 = + let uu____15726 = + let uu____15727 = FStar_Syntax_Subst.compress e in - uu____15718.FStar_Syntax_Syntax.n in - (match uu____15717 with + uu____15727.FStar_Syntax_Syntax.n in + (match uu____15726 with | FStar_Syntax_Syntax.Tm_meta (e0,FStar_Syntax_Syntax.Meta_monadic_lift (m1,m2,t')) -> Prims.op_Negation (FStar_Syntax_Util.is_pure_effect m1) - | uu____15733 -> false) in - let uu____15734 = - let uu____15735 = - let uu____15742 = + | uu____15742 -> false) in + let uu____15743 = + let uu____15744 = + let uu____15751 = FStar_Syntax_Syntax.as_arg head_app in - uu____15742 :: args in - FStar_Util.for_some is_arg_impure uu____15735 in - if uu____15734 + uu____15751 :: args in + FStar_Util.for_some is_arg_impure uu____15744 in + if uu____15743 then - let uu____15747 = - let uu____15748 = + let uu____15756 = + let uu____15757 = FStar_Syntax_Print.term_to_string head2 in FStar_Util.format1 "Incompability between typechecker and normalizer; this monadic application contains impure terms %s\n" - uu____15748 in - failwith uu____15747 + uu____15757 in + failwith uu____15756 else ()); - (let uu____15750 = maybe_unfold_action head_app in - match uu____15750 with + (let uu____15759 = maybe_unfold_action head_app in + match uu____15759 with | (head_app1,found_action) -> let mk1 tm = FStar_Syntax_Syntax.mk tm @@ -4306,43 +4331,43 @@ and do_reify_monadic: (m, t)))) | FStar_Pervasives_Native.Some (true ) -> body in - let uu____15787 = FStar_List.tl stack in - norm cfg env uu____15787 body1))) + let uu____15796 = FStar_List.tl stack in + norm cfg env uu____15796 body1))) | FStar_Syntax_Syntax.Tm_meta - (e,FStar_Syntax_Syntax.Meta_monadic uu____15789) -> + (e,FStar_Syntax_Syntax.Meta_monadic uu____15798) -> do_reify_monadic fallback cfg env stack e m t | FStar_Syntax_Syntax.Tm_meta (e,FStar_Syntax_Syntax.Meta_monadic_lift (msrc,mtgt,t')) -> let lifted = - let uu____15813 = closure_as_term cfg env t' in - reify_lift cfg e msrc mtgt uu____15813 in + let uu____15822 = closure_as_term cfg env t' in + reify_lift cfg e msrc mtgt uu____15822 in (log cfg - (fun uu____15817 -> - let uu____15818 = + (fun uu____15826 -> + let uu____15827 = FStar_Syntax_Print.term_to_string lifted in FStar_Util.print1 "Reified lift to (2): %s\n" - uu____15818); - (let uu____15819 = FStar_List.tl stack in - norm cfg env uu____15819 lifted)) - | FStar_Syntax_Syntax.Tm_meta (e,uu____15821) -> + uu____15827); + (let uu____15828 = FStar_List.tl stack in + norm cfg env uu____15828 lifted)) + | FStar_Syntax_Syntax.Tm_meta (e,uu____15830) -> do_reify_monadic fallback cfg env stack e m t | FStar_Syntax_Syntax.Tm_match (e,branches) -> let branches1 = FStar_All.pipe_right branches (FStar_List.map - (fun uu____15946 -> - match uu____15946 with + (fun uu____15955 -> + match uu____15955 with | (pat,wopt,tm) -> - let uu____15994 = + let uu____16003 = FStar_Syntax_Util.mk_reify tm in - (pat, wopt, uu____15994))) in + (pat, wopt, uu____16003))) in let tm = mk (FStar_Syntax_Syntax.Tm_match (e, branches1)) head2.FStar_Syntax_Syntax.pos in - let uu____16026 = FStar_List.tl stack in - norm cfg env uu____16026 tm - | uu____16027 -> fallback ()) + let uu____16035 = FStar_List.tl stack in + norm cfg env uu____16035 tm + | uu____16036 -> fallback ()) and reify_lift: cfg -> FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax -> @@ -4357,88 +4382,88 @@ and reify_lift: fun t -> let env = cfg.tcenv in log cfg - (fun uu____16041 -> - let uu____16042 = FStar_Ident.string_of_lid msrc in - let uu____16043 = FStar_Ident.string_of_lid mtgt in - let uu____16044 = FStar_Syntax_Print.term_to_string e in - FStar_Util.print3 "Reifying lift %s -> %s: %s\n" uu____16042 - uu____16043 uu____16044); + (fun uu____16050 -> + let uu____16051 = FStar_Ident.string_of_lid msrc in + let uu____16052 = FStar_Ident.string_of_lid mtgt in + let uu____16053 = FStar_Syntax_Print.term_to_string e in + FStar_Util.print3 "Reifying lift %s -> %s: %s\n" uu____16051 + uu____16052 uu____16053); if FStar_Syntax_Util.is_pure_effect msrc then (let ed = FStar_TypeChecker_Env.get_effect_decl env mtgt in - let uu____16046 = ed.FStar_Syntax_Syntax.return_repr in - match uu____16046 with - | (uu____16047,return_repr) -> + let uu____16055 = ed.FStar_Syntax_Syntax.return_repr in + match uu____16055 with + | (uu____16056,return_repr) -> let return_inst = - let uu____16056 = - let uu____16057 = + let uu____16065 = + let uu____16066 = FStar_Syntax_Subst.compress return_repr in - uu____16057.FStar_Syntax_Syntax.n in - match uu____16056 with + uu____16066.FStar_Syntax_Syntax.n in + match uu____16065 with | FStar_Syntax_Syntax.Tm_uinst - (return_tm,uu____16063::[]) -> - let uu____16070 = - let uu____16073 = - let uu____16074 = - let uu____16081 = - let uu____16084 = + (return_tm,uu____16072::[]) -> + let uu____16079 = + let uu____16082 = + let uu____16083 = + let uu____16090 = + let uu____16093 = env.FStar_TypeChecker_Env.universe_of env t in - [uu____16084] in - (return_tm, uu____16081) in - FStar_Syntax_Syntax.Tm_uinst uu____16074 in - FStar_Syntax_Syntax.mk uu____16073 in - uu____16070 FStar_Pervasives_Native.None + [uu____16093] in + (return_tm, uu____16090) in + FStar_Syntax_Syntax.Tm_uinst uu____16083 in + FStar_Syntax_Syntax.mk uu____16082 in + uu____16079 FStar_Pervasives_Native.None e.FStar_Syntax_Syntax.pos - | uu____16092 -> + | uu____16101 -> failwith "NIY : Reification of indexed effects" in - let uu____16095 = - let uu____16098 = - let uu____16099 = - let uu____16114 = - let uu____16117 = FStar_Syntax_Syntax.as_arg t in - let uu____16118 = - let uu____16121 = FStar_Syntax_Syntax.as_arg e in - [uu____16121] in - uu____16117 :: uu____16118 in - (return_inst, uu____16114) in - FStar_Syntax_Syntax.Tm_app uu____16099 in - FStar_Syntax_Syntax.mk uu____16098 in - uu____16095 FStar_Pervasives_Native.None + let uu____16104 = + let uu____16107 = + let uu____16108 = + let uu____16123 = + let uu____16126 = FStar_Syntax_Syntax.as_arg t in + let uu____16127 = + let uu____16130 = FStar_Syntax_Syntax.as_arg e in + [uu____16130] in + uu____16126 :: uu____16127 in + (return_inst, uu____16123) in + FStar_Syntax_Syntax.Tm_app uu____16108 in + FStar_Syntax_Syntax.mk uu____16107 in + uu____16104 FStar_Pervasives_Native.None e.FStar_Syntax_Syntax.pos) else - (let uu____16130 = + (let uu____16139 = FStar_TypeChecker_Env.monad_leq env msrc mtgt in - match uu____16130 with + match uu____16139 with | FStar_Pervasives_Native.None -> - let uu____16133 = + let uu____16142 = FStar_Util.format2 "Impossible : trying to reify a lift between unrelated effects (%s and %s)" (FStar_Ident.text_of_lid msrc) (FStar_Ident.text_of_lid mtgt) in - failwith uu____16133 + failwith uu____16142 | FStar_Pervasives_Native.Some - { FStar_TypeChecker_Env.msource = uu____16134; - FStar_TypeChecker_Env.mtarget = uu____16135; + { FStar_TypeChecker_Env.msource = uu____16143; + FStar_TypeChecker_Env.mtarget = uu____16144; FStar_TypeChecker_Env.mlift = - { FStar_TypeChecker_Env.mlift_wp = uu____16136; + { FStar_TypeChecker_Env.mlift_wp = uu____16145; FStar_TypeChecker_Env.mlift_term = FStar_Pervasives_Native.None ;_};_} -> failwith "Impossible : trying to reify a non-reifiable lift (from %s to %s)" | FStar_Pervasives_Native.Some - { FStar_TypeChecker_Env.msource = uu____16151; - FStar_TypeChecker_Env.mtarget = uu____16152; + { FStar_TypeChecker_Env.msource = uu____16160; + FStar_TypeChecker_Env.mtarget = uu____16161; FStar_TypeChecker_Env.mlift = - { FStar_TypeChecker_Env.mlift_wp = uu____16153; + { FStar_TypeChecker_Env.mlift_wp = uu____16162; FStar_TypeChecker_Env.mlift_term = FStar_Pervasives_Native.Some lift;_};_} -> - let uu____16177 = + let uu____16186 = env.FStar_TypeChecker_Env.universe_of env t in - let uu____16178 = FStar_Syntax_Util.mk_reify e in - lift uu____16177 t FStar_Syntax_Syntax.tun uu____16178) + let uu____16187 = FStar_Syntax_Util.mk_reify e in + lift uu____16186 t FStar_Syntax_Syntax.tun uu____16187) and norm_pattern_args: cfg -> env -> @@ -4453,69 +4478,68 @@ and norm_pattern_args: FStar_All.pipe_right args (FStar_List.map (FStar_List.map - (fun uu____16234 -> - match uu____16234 with + (fun uu____16243 -> + match uu____16243 with | (a,imp) -> - let uu____16245 = norm cfg env [] a in - (uu____16245, imp)))) + let uu____16254 = norm cfg env [] a in + (uu____16254, imp)))) and norm_comp: cfg -> env -> FStar_Syntax_Syntax.comp -> FStar_Syntax_Syntax.comp = fun cfg -> fun env -> fun comp -> - let comp1 = ghost_to_pure_aux cfg env comp in - match comp1.FStar_Syntax_Syntax.n with + match comp.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Total (t,uopt) -> - let uu___134_16262 = comp1 in - let uu____16265 = - let uu____16266 = - let uu____16275 = norm cfg env [] t in - let uu____16276 = + let uu___134_16268 = comp in + let uu____16269 = + let uu____16270 = + let uu____16279 = norm cfg env [] t in + let uu____16280 = FStar_Option.map (norm_universe cfg env) uopt in - (uu____16275, uu____16276) in - FStar_Syntax_Syntax.Total uu____16266 in + (uu____16279, uu____16280) in + FStar_Syntax_Syntax.Total uu____16270 in { - FStar_Syntax_Syntax.n = uu____16265; + FStar_Syntax_Syntax.n = uu____16269; FStar_Syntax_Syntax.pos = - (uu___134_16262.FStar_Syntax_Syntax.pos); + (uu___134_16268.FStar_Syntax_Syntax.pos); FStar_Syntax_Syntax.vars = - (uu___134_16262.FStar_Syntax_Syntax.vars) + (uu___134_16268.FStar_Syntax_Syntax.vars) } | FStar_Syntax_Syntax.GTotal (t,uopt) -> - let uu___135_16291 = comp1 in - let uu____16294 = - let uu____16295 = - let uu____16304 = norm cfg env [] t in - let uu____16305 = + let uu___135_16295 = comp in + let uu____16296 = + let uu____16297 = + let uu____16306 = norm cfg env [] t in + let uu____16307 = FStar_Option.map (norm_universe cfg env) uopt in - (uu____16304, uu____16305) in - FStar_Syntax_Syntax.GTotal uu____16295 in + (uu____16306, uu____16307) in + FStar_Syntax_Syntax.GTotal uu____16297 in { - FStar_Syntax_Syntax.n = uu____16294; + FStar_Syntax_Syntax.n = uu____16296; FStar_Syntax_Syntax.pos = - (uu___135_16291.FStar_Syntax_Syntax.pos); + (uu___135_16295.FStar_Syntax_Syntax.pos); FStar_Syntax_Syntax.vars = - (uu___135_16291.FStar_Syntax_Syntax.vars) + (uu___135_16295.FStar_Syntax_Syntax.vars) } | FStar_Syntax_Syntax.Comp ct -> let norm_args args = FStar_All.pipe_right args (FStar_List.map - (fun uu____16357 -> - match uu____16357 with + (fun uu____16359 -> + match uu____16359 with | (a,i) -> - let uu____16368 = norm cfg env [] a in - (uu____16368, i))) in + let uu____16370 = norm cfg env [] a in + (uu____16370, i))) in let flags1 = FStar_All.pipe_right ct.FStar_Syntax_Syntax.flags (FStar_List.map - (fun uu___84_16379 -> - match uu___84_16379 with + (fun uu___84_16381 -> + match uu___84_16381 with | FStar_Syntax_Syntax.DECREASES t -> - let uu____16383 = norm cfg env [] t in - FStar_Syntax_Syntax.DECREASES uu____16383 + let uu____16385 = norm cfg env [] t in + FStar_Syntax_Syntax.DECREASES uu____16385 | f -> f)) in - let uu___136_16387 = comp1 in + let uu___136_16389 = comp in let uu____16390 = let uu____16391 = let uu___137_16392 = ct in @@ -4538,136 +4562,42 @@ and norm_comp: { FStar_Syntax_Syntax.n = uu____16390; FStar_Syntax_Syntax.pos = - (uu___136_16387.FStar_Syntax_Syntax.pos); - FStar_Syntax_Syntax.vars = - (uu___136_16387.FStar_Syntax_Syntax.vars) - } -and ghost_to_pure_aux: - cfg -> - env -> - FStar_Syntax_Syntax.comp -> - FStar_Syntax_Syntax.comp' FStar_Syntax_Syntax.syntax - = - fun cfg -> - fun env -> - fun c -> - let norm1 t = - norm - (let uu___138_16415 = cfg in - { - steps = - [Eager_unfolding; - UnfoldUntil FStar_Syntax_Syntax.Delta_constant; - AllowUnboundUniverses]; - tcenv = (uu___138_16415.tcenv); - delta_level = (uu___138_16415.delta_level); - primitive_steps = (uu___138_16415.primitive_steps); - strong = (uu___138_16415.strong) - }) env [] t in - let non_info t = - let uu____16420 = norm1 t in - FStar_Syntax_Util.non_informative uu____16420 in - match c.FStar_Syntax_Syntax.n with - | FStar_Syntax_Syntax.Total uu____16423 -> c - | FStar_Syntax_Syntax.GTotal (t,uopt) when non_info t -> - let uu___139_16442 = c in - { - FStar_Syntax_Syntax.n = (FStar_Syntax_Syntax.Total (t, uopt)); - FStar_Syntax_Syntax.pos = - (uu___139_16442.FStar_Syntax_Syntax.pos); + (uu___136_16389.FStar_Syntax_Syntax.pos); FStar_Syntax_Syntax.vars = - (uu___139_16442.FStar_Syntax_Syntax.vars) + (uu___136_16389.FStar_Syntax_Syntax.vars) } - | FStar_Syntax_Syntax.Comp ct -> - let l = - FStar_TypeChecker_Env.norm_eff_name cfg.tcenv - ct.FStar_Syntax_Syntax.effect_name in - let uu____16449 = - (FStar_Syntax_Util.is_ghost_effect l) && - (non_info ct.FStar_Syntax_Syntax.result_typ) in - if uu____16449 - then - let ct1 = - match downgrade_ghost_effect_name - ct.FStar_Syntax_Syntax.effect_name - with - | FStar_Pervasives_Native.Some pure_eff -> - let flags1 = - if - FStar_Ident.lid_equals pure_eff - FStar_Parser_Const.effect_Tot_lid - then FStar_Syntax_Syntax.TOTAL :: - (ct.FStar_Syntax_Syntax.flags) - else ct.FStar_Syntax_Syntax.flags in - let uu___140_16460 = ct in - { - FStar_Syntax_Syntax.comp_univs = - (uu___140_16460.FStar_Syntax_Syntax.comp_univs); - FStar_Syntax_Syntax.effect_name = pure_eff; - FStar_Syntax_Syntax.result_typ = - (uu___140_16460.FStar_Syntax_Syntax.result_typ); - FStar_Syntax_Syntax.effect_args = - (uu___140_16460.FStar_Syntax_Syntax.effect_args); - FStar_Syntax_Syntax.flags = flags1 - } - | FStar_Pervasives_Native.None -> - let ct1 = - FStar_TypeChecker_Env.unfold_effect_abbrev cfg.tcenv c in - let uu___141_16462 = ct1 in - { - FStar_Syntax_Syntax.comp_univs = - (uu___141_16462.FStar_Syntax_Syntax.comp_univs); - FStar_Syntax_Syntax.effect_name = - FStar_Parser_Const.effect_PURE_lid; - FStar_Syntax_Syntax.result_typ = - (uu___141_16462.FStar_Syntax_Syntax.result_typ); - FStar_Syntax_Syntax.effect_args = - (uu___141_16462.FStar_Syntax_Syntax.effect_args); - FStar_Syntax_Syntax.flags = - (uu___141_16462.FStar_Syntax_Syntax.flags) - } in - let uu___142_16463 = c in - { - FStar_Syntax_Syntax.n = (FStar_Syntax_Syntax.Comp ct1); - FStar_Syntax_Syntax.pos = - (uu___142_16463.FStar_Syntax_Syntax.pos); - FStar_Syntax_Syntax.vars = - (uu___142_16463.FStar_Syntax_Syntax.vars) - } - else c - | uu____16465 -> c and norm_binder: cfg -> env -> FStar_Syntax_Syntax.binder -> FStar_Syntax_Syntax.binder = fun cfg -> fun env -> - fun uu____16468 -> - match uu____16468 with + fun uu____16408 -> + match uu____16408 with | (x,imp) -> - let uu____16471 = - let uu___143_16472 = x in - let uu____16473 = norm cfg env [] x.FStar_Syntax_Syntax.sort in + let uu____16411 = + let uu___138_16412 = x in + let uu____16413 = norm cfg env [] x.FStar_Syntax_Syntax.sort in { FStar_Syntax_Syntax.ppname = - (uu___143_16472.FStar_Syntax_Syntax.ppname); + (uu___138_16412.FStar_Syntax_Syntax.ppname); FStar_Syntax_Syntax.index = - (uu___143_16472.FStar_Syntax_Syntax.index); - FStar_Syntax_Syntax.sort = uu____16473 + (uu___138_16412.FStar_Syntax_Syntax.index); + FStar_Syntax_Syntax.sort = uu____16413 } in - (uu____16471, imp) + (uu____16411, imp) and norm_binders: cfg -> env -> FStar_Syntax_Syntax.binders -> FStar_Syntax_Syntax.binders = fun cfg -> fun env -> fun bs -> - let uu____16479 = + let uu____16419 = FStar_List.fold_left - (fun uu____16497 -> + (fun uu____16437 -> fun b -> - match uu____16497 with + match uu____16437 with | (nbs',env1) -> let b1 = norm_binder cfg env1 b in ((b1 :: nbs'), (dummy :: env1))) ([], env) bs in - match uu____16479 with | (nbs,uu____16537) -> FStar_List.rev nbs + match uu____16419 with | (nbs,uu____16477) -> FStar_List.rev nbs and norm_lcomp_opt: cfg -> env -> @@ -4681,20 +4611,20 @@ and norm_lcomp_opt: | FStar_Pervasives_Native.Some rc -> let flags1 = filter_out_lcomp_cflags rc.FStar_Syntax_Syntax.residual_flags in - let uu____16553 = - let uu___144_16554 = rc in - let uu____16555 = + let uu____16493 = + let uu___139_16494 = rc in + let uu____16495 = FStar_Util.map_opt rc.FStar_Syntax_Syntax.residual_typ (norm cfg env []) in { FStar_Syntax_Syntax.residual_effect = - (uu___144_16554.FStar_Syntax_Syntax.residual_effect); - FStar_Syntax_Syntax.residual_typ = uu____16555; + (uu___139_16494.FStar_Syntax_Syntax.residual_effect); + FStar_Syntax_Syntax.residual_typ = uu____16495; FStar_Syntax_Syntax.residual_flags = - (uu___144_16554.FStar_Syntax_Syntax.residual_flags) + (uu___139_16494.FStar_Syntax_Syntax.residual_flags) } in - FStar_Pervasives_Native.Some uu____16553 - | uu____16562 -> lopt + FStar_Pervasives_Native.Some uu____16493 + | uu____16502 -> lopt and rebuild: cfg -> env -> stack -> FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term = @@ -4703,40 +4633,40 @@ and rebuild: fun stack -> fun t -> log cfg - (fun uu____16575 -> - let uu____16576 = FStar_Syntax_Print.tag_of_term t in - let uu____16577 = FStar_Syntax_Print.term_to_string t in - let uu____16578 = + (fun uu____16515 -> + let uu____16516 = FStar_Syntax_Print.tag_of_term t in + let uu____16517 = FStar_Syntax_Print.term_to_string t in + let uu____16518 = FStar_Util.string_of_int (FStar_List.length env) in - let uu____16585 = - let uu____16586 = - let uu____16589 = firstn (Prims.parse_int "4") stack in + let uu____16525 = + let uu____16526 = + let uu____16529 = firstn (Prims.parse_int "4") stack in FStar_All.pipe_left FStar_Pervasives_Native.fst - uu____16589 in - stack_to_string uu____16586 in + uu____16529 in + stack_to_string uu____16526 in FStar_Util.print4 ">>> %s\nRebuild %s with %s env elements and top of the stack %s \n" - uu____16576 uu____16577 uu____16578 uu____16585); + uu____16516 uu____16517 uu____16518 uu____16525); (match stack with | [] -> t | (Debug (tm,time_then))::stack1 -> - ((let uu____16618 = + ((let uu____16558 = FStar_All.pipe_left (FStar_TypeChecker_Env.debug cfg.tcenv) (FStar_Options.Other "print_normalized_terms") in - if uu____16618 + if uu____16558 then let time_now = FStar_Util.now () in - let uu____16620 = - let uu____16621 = - let uu____16622 = + let uu____16560 = + let uu____16561 = + let uu____16562 = FStar_Util.time_diff time_then time_now in - FStar_Pervasives_Native.snd uu____16622 in - FStar_Util.string_of_int uu____16621 in - let uu____16627 = FStar_Syntax_Print.term_to_string tm in - let uu____16628 = FStar_Syntax_Print.term_to_string t in + FStar_Pervasives_Native.snd uu____16562 in + FStar_Util.string_of_int uu____16561 in + let uu____16567 = FStar_Syntax_Print.term_to_string tm in + let uu____16568 = FStar_Syntax_Print.term_to_string t in FStar_Util.print3 "Normalized (%s ms) %s\n\tto %s\n" - uu____16620 uu____16627 uu____16628 + uu____16560 uu____16567 uu____16568 else ()); rebuild cfg env stack1 t) | (Cfg cfg1)::stack1 -> rebuild cfg1 env stack1 t @@ -4744,11 +4674,11 @@ and rebuild: let t1 = mk (FStar_Syntax_Syntax.Tm_meta (t, m)) r in rebuild cfg env stack1 t1 | (MemoLazy r)::stack1 -> - (set_memo r (env, t); + (set_memo cfg r (env, t); log cfg - (fun uu____16682 -> - let uu____16683 = FStar_Syntax_Print.term_to_string t in - FStar_Util.print1 "\tSet memo %s\n" uu____16683); + (fun uu____16622 -> + let uu____16623 = FStar_Syntax_Print.term_to_string t in + FStar_Util.print1 "\tSet memo %s\n" uu____16623); rebuild cfg env stack1 t) | (Let (env',bs,lb,r))::stack1 -> let body = FStar_Syntax_Subst.close bs t in @@ -4760,28 +4690,28 @@ and rebuild: | (Abs (env',bs,env'',lopt,r))::stack1 -> let bs1 = norm_binders cfg env' bs in let lopt1 = norm_lcomp_opt cfg env'' lopt in - let uu____16719 = - let uu___145_16720 = FStar_Syntax_Util.abs bs1 t lopt1 in + let uu____16659 = + let uu___140_16660 = FStar_Syntax_Util.abs bs1 t lopt1 in { FStar_Syntax_Syntax.n = - (uu___145_16720.FStar_Syntax_Syntax.n); + (uu___140_16660.FStar_Syntax_Syntax.n); FStar_Syntax_Syntax.pos = r; FStar_Syntax_Syntax.vars = - (uu___145_16720.FStar_Syntax_Syntax.vars) + (uu___140_16660.FStar_Syntax_Syntax.vars) } in - rebuild cfg env stack1 uu____16719 - | (Arg (Univ uu____16721,uu____16722,uu____16723))::uu____16724 -> + rebuild cfg env stack1 uu____16659 + | (Arg (Univ uu____16661,uu____16662,uu____16663))::uu____16664 -> failwith "Impossible" - | (Arg (Dummy ,uu____16727,uu____16728))::uu____16729 -> + | (Arg (Dummy ,uu____16667,uu____16668))::uu____16669 -> failwith "Impossible" | (UnivArgs (us,r))::stack1 -> let t1 = FStar_Syntax_Syntax.mk_Tm_uinst t us in rebuild cfg env stack1 t1 - | (Arg (Clos (env_arg,tm,m,uu____16745),aq,r))::stack1 -> + | (Arg (Clos (env_arg,tm,m,uu____16685),aq,r))::stack1 -> (log cfg - (fun uu____16798 -> - let uu____16799 = FStar_Syntax_Print.term_to_string tm in - FStar_Util.print1 "Rebuilding with arg %s\n" uu____16799); + (fun uu____16738 -> + let uu____16739 = FStar_Syntax_Print.term_to_string tm in + FStar_Util.print1 "Rebuilding with arg %s\n" uu____16739); if FStar_List.contains (Exclude Iota) cfg.steps then (if FStar_List.contains HNF cfg.steps @@ -4795,8 +4725,8 @@ and rebuild: (let stack2 = (App (env, t, aq, r)) :: stack1 in norm cfg env_arg stack2 tm)) else - (let uu____16809 = FStar_ST.op_Bang m in - match uu____16809 with + (let uu____16749 = FStar_ST.op_Bang m in + match uu____16749 with | FStar_Pervasives_Native.None -> if FStar_List.contains HNF cfg.steps then @@ -4809,27 +4739,27 @@ and rebuild: (let stack2 = (MemoLazy m) :: (App (env, t, aq, r)) :: stack1 in norm cfg env_arg stack2 tm) - | FStar_Pervasives_Native.Some (uu____16975,a) -> + | FStar_Pervasives_Native.Some (uu____16915,a) -> let t1 = FStar_Syntax_Syntax.extend_app t (a, aq) FStar_Pervasives_Native.None r in rebuild cfg env_arg stack1 t1)) | (App (env1,head1,aq,r))::stack' when should_reify cfg stack -> let t0 = t in - let fallback msg uu____17022 = + let fallback msg uu____16962 = log cfg - (fun uu____17026 -> - let uu____17027 = FStar_Syntax_Print.term_to_string t in + (fun uu____16966 -> + let uu____16967 = FStar_Syntax_Print.term_to_string t in FStar_Util.print2 "Not reifying%s: %s\n" msg - uu____17027); + uu____16967); (let t1 = FStar_Syntax_Syntax.extend_app head1 (t, aq) FStar_Pervasives_Native.None r in rebuild cfg env1 stack' t1) in - let uu____17031 = - let uu____17032 = FStar_Syntax_Subst.compress t in - uu____17032.FStar_Syntax_Syntax.n in - (match uu____17031 with + let uu____16971 = + let uu____16972 = FStar_Syntax_Subst.compress t in + uu____16972.FStar_Syntax_Syntax.n in + (match uu____16971 with | FStar_Syntax_Syntax.Tm_meta (t1,FStar_Syntax_Syntax.Meta_monadic (m,ty)) -> do_reify_monadic (fallback " (1)") cfg env1 stack t1 m ty @@ -4837,57 +4767,57 @@ and rebuild: (t1,FStar_Syntax_Syntax.Meta_monadic_lift (msrc,mtgt,ty)) -> let lifted = - let uu____17059 = closure_as_term cfg env1 ty in - reify_lift cfg t1 msrc mtgt uu____17059 in + let uu____16999 = closure_as_term cfg env1 ty in + reify_lift cfg t1 msrc mtgt uu____16999 in (log cfg - (fun uu____17063 -> - let uu____17064 = + (fun uu____17003 -> + let uu____17004 = FStar_Syntax_Print.term_to_string lifted in FStar_Util.print1 "Reified lift to (1): %s\n" - uu____17064); - (let uu____17065 = FStar_List.tl stack in - norm cfg env1 uu____17065 lifted)) + uu____17004); + (let uu____17005 = FStar_List.tl stack in + norm cfg env1 uu____17005 lifted)) | FStar_Syntax_Syntax.Tm_app ({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_constant - (FStar_Const.Const_reflect uu____17066); - FStar_Syntax_Syntax.pos = uu____17067; - FStar_Syntax_Syntax.vars = uu____17068;_},(e,uu____17070)::[]) + (FStar_Const.Const_reflect uu____17006); + FStar_Syntax_Syntax.pos = uu____17007; + FStar_Syntax_Syntax.vars = uu____17008;_},(e,uu____17010)::[]) -> norm cfg env1 stack' e - | uu____17099 -> fallback " (2)" ()) + | uu____17039 -> fallback " (2)" ()) | (App (env1,head1,aq,r))::stack1 -> let t1 = FStar_Syntax_Syntax.extend_app head1 (t, aq) FStar_Pervasives_Native.None r in - let uu____17110 = maybe_simplify cfg env1 stack1 t1 in - rebuild cfg env1 stack1 uu____17110 + let uu____17050 = maybe_simplify cfg env1 stack1 t1 in + rebuild cfg env1 stack1 uu____17050 | (Match (env1,branches,r))::stack1 -> (log cfg - (fun uu____17122 -> - let uu____17123 = FStar_Syntax_Print.term_to_string t in + (fun uu____17062 -> + let uu____17063 = FStar_Syntax_Print.term_to_string t in FStar_Util.print1 "Rebuilding with match, scrutinee is %s ...\n" - uu____17123); + uu____17063); (let scrutinee = t in - let norm_and_rebuild_match uu____17128 = + let norm_and_rebuild_match uu____17068 = log cfg - (fun uu____17133 -> - let uu____17134 = + (fun uu____17073 -> + let uu____17074 = FStar_Syntax_Print.term_to_string scrutinee in - let uu____17135 = - let uu____17136 = + let uu____17075 = + let uu____17076 = FStar_All.pipe_right branches (FStar_List.map - (fun uu____17153 -> - match uu____17153 with - | (p,uu____17163,uu____17164) -> + (fun uu____17093 -> + match uu____17093 with + | (p,uu____17103,uu____17104) -> FStar_Syntax_Print.pat_to_string p)) in - FStar_All.pipe_right uu____17136 + FStar_All.pipe_right uu____17076 (FStar_String.concat "\n\t") in FStar_Util.print2 "match is irreducible: scrutinee=%s\nbranches=%s\n" - uu____17134 uu____17135); + uu____17074 uu____17075); (let whnf = (FStar_List.contains Weak cfg.steps) || (FStar_List.contains HNF cfg.steps) in @@ -4895,20 +4825,21 @@ and rebuild: let new_delta = FStar_All.pipe_right cfg.delta_level (FStar_List.filter - (fun uu___85_17181 -> - match uu___85_17181 with + (fun uu___85_17121 -> + match uu___85_17121 with | FStar_TypeChecker_Env.Inlining -> true | FStar_TypeChecker_Env.Eager_unfolding_only -> true - | uu____17182 -> false)) in + | uu____17122 -> false)) in let steps' = [Exclude Zeta] in - let uu___146_17186 = cfg in + let uu___141_17126 = cfg in { steps = (FStar_List.append steps' cfg.steps); - tcenv = (uu___146_17186.tcenv); + tcenv = (uu___141_17126.tcenv); delta_level = new_delta; - primitive_steps = (uu___146_17186.primitive_steps); - strong = true + primitive_steps = (uu___141_17126.primitive_steps); + strong = true; + memoize_lazy = (uu___141_17126.memoize_lazy) } in let norm_or_whnf env2 t1 = if whnf @@ -4916,102 +4847,102 @@ and rebuild: else norm cfg_exclude_iota_zeta env2 [] t1 in let rec norm_pat env2 p = match p.FStar_Syntax_Syntax.v with - | FStar_Syntax_Syntax.Pat_constant uu____17218 -> + | FStar_Syntax_Syntax.Pat_constant uu____17158 -> (p, env2) | FStar_Syntax_Syntax.Pat_cons (fv,pats) -> - let uu____17239 = + let uu____17179 = FStar_All.pipe_right pats (FStar_List.fold_left - (fun uu____17299 -> - fun uu____17300 -> - match (uu____17299, uu____17300) with + (fun uu____17239 -> + fun uu____17240 -> + match (uu____17239, uu____17240) with | ((pats1,env3),(p1,b)) -> - let uu____17391 = norm_pat env3 p1 in - (match uu____17391 with + let uu____17331 = norm_pat env3 p1 in + (match uu____17331 with | (p2,env4) -> (((p2, b) :: pats1), env4))) ([], env2)) in - (match uu____17239 with + (match uu____17179 with | (pats1,env3) -> - ((let uu___147_17473 = p in + ((let uu___142_17413 = p in { FStar_Syntax_Syntax.v = (FStar_Syntax_Syntax.Pat_cons (fv, (FStar_List.rev pats1))); FStar_Syntax_Syntax.p = - (uu___147_17473.FStar_Syntax_Syntax.p) + (uu___142_17413.FStar_Syntax_Syntax.p) }), env3)) | FStar_Syntax_Syntax.Pat_var x -> let x1 = - let uu___148_17492 = x in - let uu____17493 = + let uu___143_17432 = x in + let uu____17433 = norm_or_whnf env2 x.FStar_Syntax_Syntax.sort in { FStar_Syntax_Syntax.ppname = - (uu___148_17492.FStar_Syntax_Syntax.ppname); + (uu___143_17432.FStar_Syntax_Syntax.ppname); FStar_Syntax_Syntax.index = - (uu___148_17492.FStar_Syntax_Syntax.index); - FStar_Syntax_Syntax.sort = uu____17493 + (uu___143_17432.FStar_Syntax_Syntax.index); + FStar_Syntax_Syntax.sort = uu____17433 } in - ((let uu___149_17507 = p in + ((let uu___144_17447 = p in { FStar_Syntax_Syntax.v = (FStar_Syntax_Syntax.Pat_var x1); FStar_Syntax_Syntax.p = - (uu___149_17507.FStar_Syntax_Syntax.p) + (uu___144_17447.FStar_Syntax_Syntax.p) }), (dummy :: env2)) | FStar_Syntax_Syntax.Pat_wild x -> let x1 = - let uu___150_17518 = x in - let uu____17519 = + let uu___145_17458 = x in + let uu____17459 = norm_or_whnf env2 x.FStar_Syntax_Syntax.sort in { FStar_Syntax_Syntax.ppname = - (uu___150_17518.FStar_Syntax_Syntax.ppname); + (uu___145_17458.FStar_Syntax_Syntax.ppname); FStar_Syntax_Syntax.index = - (uu___150_17518.FStar_Syntax_Syntax.index); - FStar_Syntax_Syntax.sort = uu____17519 + (uu___145_17458.FStar_Syntax_Syntax.index); + FStar_Syntax_Syntax.sort = uu____17459 } in - ((let uu___151_17533 = p in + ((let uu___146_17473 = p in { FStar_Syntax_Syntax.v = (FStar_Syntax_Syntax.Pat_wild x1); FStar_Syntax_Syntax.p = - (uu___151_17533.FStar_Syntax_Syntax.p) + (uu___146_17473.FStar_Syntax_Syntax.p) }), (dummy :: env2)) | FStar_Syntax_Syntax.Pat_dot_term (x,t1) -> let x1 = - let uu___152_17549 = x in - let uu____17550 = + let uu___147_17489 = x in + let uu____17490 = norm_or_whnf env2 x.FStar_Syntax_Syntax.sort in { FStar_Syntax_Syntax.ppname = - (uu___152_17549.FStar_Syntax_Syntax.ppname); + (uu___147_17489.FStar_Syntax_Syntax.ppname); FStar_Syntax_Syntax.index = - (uu___152_17549.FStar_Syntax_Syntax.index); - FStar_Syntax_Syntax.sort = uu____17550 + (uu___147_17489.FStar_Syntax_Syntax.index); + FStar_Syntax_Syntax.sort = uu____17490 } in let t2 = norm_or_whnf env2 t1 in - ((let uu___153_17557 = p in + ((let uu___148_17497 = p in { FStar_Syntax_Syntax.v = (FStar_Syntax_Syntax.Pat_dot_term (x1, t2)); FStar_Syntax_Syntax.p = - (uu___153_17557.FStar_Syntax_Syntax.p) + (uu___148_17497.FStar_Syntax_Syntax.p) }), env2) in let branches1 = match env1 with | [] when whnf -> branches - | uu____17567 -> + | uu____17507 -> FStar_All.pipe_right branches (FStar_List.map (fun branch1 -> - let uu____17581 = + let uu____17521 = FStar_Syntax_Subst.open_branch branch1 in - match uu____17581 with + match uu____17521 with | (p,wopt,e) -> - let uu____17601 = norm_pat env1 p in - (match uu____17601 with + let uu____17541 = norm_pat env1 p in + (match uu____17541 with | (p1,env2) -> let wopt1 = match wopt with @@ -5020,38 +4951,38 @@ and rebuild: FStar_Pervasives_Native.None | FStar_Pervasives_Native.Some w -> - let uu____17626 = + let uu____17566 = norm_or_whnf env2 w in FStar_Pervasives_Native.Some - uu____17626 in + uu____17566 in let e1 = norm_or_whnf env2 e in FStar_Syntax_Util.branch (p1, wopt1, e1)))) in - let uu____17632 = + let uu____17572 = mk (FStar_Syntax_Syntax.Tm_match (scrutinee, branches1)) r in - rebuild cfg env1 stack1 uu____17632) in + rebuild cfg env1 stack1 uu____17572) in let rec is_cons head1 = match head1.FStar_Syntax_Syntax.n with - | FStar_Syntax_Syntax.Tm_uinst (h,uu____17642) -> + | FStar_Syntax_Syntax.Tm_uinst (h,uu____17582) -> is_cons h - | FStar_Syntax_Syntax.Tm_constant uu____17647 -> true + | FStar_Syntax_Syntax.Tm_constant uu____17587 -> true | FStar_Syntax_Syntax.Tm_fvar - { FStar_Syntax_Syntax.fv_name = uu____17648; - FStar_Syntax_Syntax.fv_delta = uu____17649; + { FStar_Syntax_Syntax.fv_name = uu____17588; + FStar_Syntax_Syntax.fv_delta = uu____17589; FStar_Syntax_Syntax.fv_qual = FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Data_ctor );_} -> true | FStar_Syntax_Syntax.Tm_fvar - { FStar_Syntax_Syntax.fv_name = uu____17650; - FStar_Syntax_Syntax.fv_delta = uu____17651; + { FStar_Syntax_Syntax.fv_name = uu____17590; + FStar_Syntax_Syntax.fv_delta = uu____17591; FStar_Syntax_Syntax.fv_qual = FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.Record_ctor uu____17652);_} + (FStar_Syntax_Syntax.Record_ctor uu____17592);_} -> true - | uu____17659 -> false in + | uu____17599 -> false in let guard_when_clause wopt b rest = match wopt with | FStar_Pervasives_Native.None -> b @@ -5064,107 +4995,107 @@ and rebuild: else_branch in let rec matches_pat scrutinee_orig p = let scrutinee1 = FStar_Syntax_Util.unmeta scrutinee_orig in - let uu____17804 = + let uu____17744 = FStar_Syntax_Util.head_and_args scrutinee1 in - match uu____17804 with + match uu____17744 with | (head1,args) -> (match p.FStar_Syntax_Syntax.v with | FStar_Syntax_Syntax.Pat_var bv -> FStar_Util.Inl [(bv, scrutinee_orig)] | FStar_Syntax_Syntax.Pat_wild bv -> FStar_Util.Inl [(bv, scrutinee_orig)] - | FStar_Syntax_Syntax.Pat_dot_term uu____17891 -> + | FStar_Syntax_Syntax.Pat_dot_term uu____17831 -> FStar_Util.Inl [] | FStar_Syntax_Syntax.Pat_constant s -> (match scrutinee1.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Tm_constant s' when FStar_Const.eq_const s s' -> FStar_Util.Inl [] - | uu____17930 -> - let uu____17931 = - let uu____17932 = is_cons head1 in - Prims.op_Negation uu____17932 in - FStar_Util.Inr uu____17931) + | uu____17870 -> + let uu____17871 = + let uu____17872 = is_cons head1 in + Prims.op_Negation uu____17872 in + FStar_Util.Inr uu____17871) | FStar_Syntax_Syntax.Pat_cons (fv,arg_pats) -> - let uu____17957 = - let uu____17958 = + let uu____17897 = + let uu____17898 = FStar_Syntax_Util.un_uinst head1 in - uu____17958.FStar_Syntax_Syntax.n in - (match uu____17957 with + uu____17898.FStar_Syntax_Syntax.n in + (match uu____17897 with | FStar_Syntax_Syntax.Tm_fvar fv' when FStar_Syntax_Syntax.fv_eq fv fv' -> matches_args [] args arg_pats - | uu____17976 -> - let uu____17977 = - let uu____17978 = is_cons head1 in - Prims.op_Negation uu____17978 in - FStar_Util.Inr uu____17977)) + | uu____17916 -> + let uu____17917 = + let uu____17918 = is_cons head1 in + Prims.op_Negation uu____17918 in + FStar_Util.Inr uu____17917)) and matches_args out a p = match (a, p) with | ([],[]) -> FStar_Util.Inl out - | ((t1,uu____18047)::rest_a,(p1,uu____18050)::rest_p) -> - let uu____18094 = matches_pat t1 p1 in - (match uu____18094 with + | ((t1,uu____17987)::rest_a,(p1,uu____17990)::rest_p) -> + let uu____18034 = matches_pat t1 p1 in + (match uu____18034 with | FStar_Util.Inl s -> matches_args (FStar_List.append out s) rest_a rest_p | m -> m) - | uu____18143 -> FStar_Util.Inr false in + | uu____18083 -> FStar_Util.Inr false in let rec matches scrutinee1 p = match p with | [] -> norm_and_rebuild_match () | (p1,wopt,b)::rest -> - let uu____18249 = matches_pat scrutinee1 p1 in - (match uu____18249 with + let uu____18189 = matches_pat scrutinee1 p1 in + (match uu____18189 with | FStar_Util.Inr (false ) -> matches scrutinee1 rest | FStar_Util.Inr (true ) -> norm_and_rebuild_match () | FStar_Util.Inl s -> (log cfg - (fun uu____18289 -> - let uu____18290 = + (fun uu____18229 -> + let uu____18230 = FStar_Syntax_Print.pat_to_string p1 in - let uu____18291 = - let uu____18292 = + let uu____18231 = + let uu____18232 = FStar_List.map - (fun uu____18302 -> - match uu____18302 with - | (uu____18307,t1) -> + (fun uu____18242 -> + match uu____18242 with + | (uu____18247,t1) -> FStar_Syntax_Print.term_to_string t1) s in - FStar_All.pipe_right uu____18292 + FStar_All.pipe_right uu____18232 (FStar_String.concat "; ") in FStar_Util.print2 "Matches pattern %s with subst = %s\n" - uu____18290 uu____18291); + uu____18230 uu____18231); (let env2 = FStar_List.fold_left (fun env2 -> - fun uu____18338 -> - match uu____18338 with + fun uu____18278 -> + match uu____18278 with | (bv,t1) -> - let uu____18361 = - let uu____18368 = - let uu____18371 = + let uu____18301 = + let uu____18308 = + let uu____18311 = FStar_Syntax_Syntax.mk_binder bv in FStar_Pervasives_Native.Some - uu____18371 in - let uu____18372 = - let uu____18373 = - let uu____18404 = + uu____18311 in + let uu____18312 = + let uu____18313 = + let uu____18344 = FStar_Util.mk_ref (FStar_Pervasives_Native.Some ([], t1)) in - ([], t1, uu____18404, false) in - Clos uu____18373 in - (uu____18368, uu____18372) in - uu____18361 :: env2) env1 s in - let uu____18521 = guard_when_clause wopt b rest in - norm cfg env2 stack1 uu____18521))) in - let uu____18522 = + ([], t1, uu____18344, false) in + Clos uu____18313 in + (uu____18308, uu____18312) in + uu____18301 :: env2) env1 s in + let uu____18461 = guard_when_clause wopt b rest in + norm cfg env2 stack1 uu____18461))) in + let uu____18462 = FStar_All.pipe_right cfg.steps (FStar_List.contains (Exclude Iota)) in - if uu____18522 + if uu____18462 then norm_and_rebuild_match () else matches scrutinee branches))) let config: step Prims.list -> FStar_TypeChecker_Env.env -> cfg = @@ -5173,24 +5104,25 @@ let config: step Prims.list -> FStar_TypeChecker_Env.env -> cfg = let d = FStar_All.pipe_right s (FStar_List.collect - (fun uu___86_18543 -> - match uu___86_18543 with + (fun uu___86_18483 -> + match uu___86_18483 with | UnfoldUntil k -> [FStar_TypeChecker_Env.Unfold k] | Eager_unfolding -> [FStar_TypeChecker_Env.Eager_unfolding_only] | Inlining -> [FStar_TypeChecker_Env.Inlining] | UnfoldTac -> [FStar_TypeChecker_Env.UnfoldTac] - | uu____18547 -> [])) in + | uu____18487 -> [])) in let d1 = match d with | [] -> [FStar_TypeChecker_Env.NoDelta] - | uu____18553 -> d in + | uu____18493 -> d in { steps = s; tcenv = e; delta_level = d1; primitive_steps = built_in_primitive_steps; - strong = false + strong = false; + memoize_lazy = true } let normalize_with_primitive_steps: primitive_step Prims.list -> @@ -5204,13 +5136,14 @@ let normalize_with_primitive_steps: fun t -> let c = config s e in let c1 = - let uu___154_18578 = config s e in + let uu___149_18518 = config s e in { - steps = (uu___154_18578.steps); - tcenv = (uu___154_18578.tcenv); - delta_level = (uu___154_18578.delta_level); + steps = (uu___149_18518.steps); + tcenv = (uu___149_18518.tcenv); + delta_level = (uu___149_18518.delta_level); primitive_steps = (FStar_List.append c.primitive_steps ps); - strong = (uu___154_18578.strong) + strong = (uu___149_18518.strong); + memoize_lazy = (uu___149_18518.memoize_lazy) } in norm c1 [] [] t let normalize: @@ -5225,21 +5158,97 @@ let normalize_comp: = fun s -> fun e -> - fun t -> let uu____18603 = config s e in norm_comp uu____18603 [] t + fun t -> let uu____18543 = config s e in norm_comp uu____18543 [] t let normalize_universe: FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.universe -> FStar_Syntax_Syntax.universe = fun env -> fun u -> - let uu____18616 = config [] env in norm_universe uu____18616 [] u + let uu____18556 = config [] env in norm_universe uu____18556 [] u let ghost_to_pure: FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.comp -> FStar_Syntax_Syntax.comp = fun env -> fun c -> - let uu____18629 = config [] env in ghost_to_pure_aux uu____18629 [] c + let cfg = + config + [UnfoldUntil FStar_Syntax_Syntax.Delta_constant; + AllowUnboundUniverses; + EraseUniverses] env in + let non_info t = + let uu____18574 = norm cfg [] [] t in + FStar_Syntax_Util.non_informative uu____18574 in + match c.FStar_Syntax_Syntax.n with + | FStar_Syntax_Syntax.Total uu____18581 -> c + | FStar_Syntax_Syntax.GTotal (t,uopt) when non_info t -> + let uu___150_18600 = c in + { + FStar_Syntax_Syntax.n = (FStar_Syntax_Syntax.Total (t, uopt)); + FStar_Syntax_Syntax.pos = + (uu___150_18600.FStar_Syntax_Syntax.pos); + FStar_Syntax_Syntax.vars = + (uu___150_18600.FStar_Syntax_Syntax.vars) + } + | FStar_Syntax_Syntax.Comp ct -> + let l = + FStar_TypeChecker_Env.norm_eff_name cfg.tcenv + ct.FStar_Syntax_Syntax.effect_name in + let uu____18607 = + (FStar_Syntax_Util.is_ghost_effect l) && + (non_info ct.FStar_Syntax_Syntax.result_typ) in + if uu____18607 + then + let ct1 = + match downgrade_ghost_effect_name + ct.FStar_Syntax_Syntax.effect_name + with + | FStar_Pervasives_Native.Some pure_eff -> + let flags1 = + if + FStar_Ident.lid_equals pure_eff + FStar_Parser_Const.effect_Tot_lid + then FStar_Syntax_Syntax.TOTAL :: + (ct.FStar_Syntax_Syntax.flags) + else ct.FStar_Syntax_Syntax.flags in + let uu___151_18616 = ct in + { + FStar_Syntax_Syntax.comp_univs = + (uu___151_18616.FStar_Syntax_Syntax.comp_univs); + FStar_Syntax_Syntax.effect_name = pure_eff; + FStar_Syntax_Syntax.result_typ = + (uu___151_18616.FStar_Syntax_Syntax.result_typ); + FStar_Syntax_Syntax.effect_args = + (uu___151_18616.FStar_Syntax_Syntax.effect_args); + FStar_Syntax_Syntax.flags = flags1 + } + | FStar_Pervasives_Native.None -> + let ct1 = + FStar_TypeChecker_Env.unfold_effect_abbrev cfg.tcenv c in + let uu___152_18618 = ct1 in + { + FStar_Syntax_Syntax.comp_univs = + (uu___152_18618.FStar_Syntax_Syntax.comp_univs); + FStar_Syntax_Syntax.effect_name = + FStar_Parser_Const.effect_PURE_lid; + FStar_Syntax_Syntax.result_typ = + (uu___152_18618.FStar_Syntax_Syntax.result_typ); + FStar_Syntax_Syntax.effect_args = + (uu___152_18618.FStar_Syntax_Syntax.effect_args); + FStar_Syntax_Syntax.flags = + (uu___152_18618.FStar_Syntax_Syntax.flags) + } in + let uu___153_18619 = c in + { + FStar_Syntax_Syntax.n = (FStar_Syntax_Syntax.Comp ct1); + FStar_Syntax_Syntax.pos = + (uu___153_18619.FStar_Syntax_Syntax.pos); + FStar_Syntax_Syntax.vars = + (uu___153_18619.FStar_Syntax_Syntax.vars) + } + else c + | uu____18621 -> c let ghost_to_pure_lcomp: FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.lcomp -> FStar_Syntax_Syntax.lcomp @@ -5253,28 +5262,21 @@ let ghost_to_pure_lcomp: EraseUniverses; AllowUnboundUniverses] env in let non_info t = - let uu____18647 = norm cfg [] [] t in - FStar_Syntax_Util.non_informative uu____18647 in - let uu____18654 = + let uu____18633 = norm cfg [] [] t in + FStar_Syntax_Util.non_informative uu____18633 in + let uu____18640 = (FStar_Syntax_Util.is_ghost_effect lc.FStar_Syntax_Syntax.eff_name) && (non_info lc.FStar_Syntax_Syntax.res_typ) in - if uu____18654 + if uu____18640 then match downgrade_ghost_effect_name lc.FStar_Syntax_Syntax.eff_name with | FStar_Pervasives_Native.Some pure_eff -> - let uu___155_18656 = lc in - { - FStar_Syntax_Syntax.eff_name = pure_eff; - FStar_Syntax_Syntax.res_typ = - (uu___155_18656.FStar_Syntax_Syntax.res_typ); - FStar_Syntax_Syntax.cflags = - (uu___155_18656.FStar_Syntax_Syntax.cflags); - FStar_Syntax_Syntax.comp = - ((fun uu____18659 -> - let uu____18660 = lc.FStar_Syntax_Syntax.comp () in - ghost_to_pure env uu____18660)) - } + FStar_Syntax_Syntax.mk_lcomp pure_eff + lc.FStar_Syntax_Syntax.res_typ lc.FStar_Syntax_Syntax.cflags + (fun uu____18644 -> + let uu____18645 = FStar_Syntax_Syntax.lcomp_comp lc in + ghost_to_pure env uu____18645) | FStar_Pervasives_Native.None -> lc else lc let term_to_string: @@ -5285,13 +5287,13 @@ let term_to_string: try normalize [AllowUnboundUniverses] env t with | e -> - ((let uu____18677 = - let uu____18682 = - let uu____18683 = FStar_Util.message_of_exn e in + ((let uu____18662 = + let uu____18667 = + let uu____18668 = FStar_Util.message_of_exn e in FStar_Util.format1 "Normalization failed with error %s\n" - uu____18683 in - (FStar_Errors.Warning_NormalizationFailure, uu____18682) in - FStar_Errors.log_issue t.FStar_Syntax_Syntax.pos uu____18677); + uu____18668 in + (FStar_Errors.Warning_NormalizationFailure, uu____18667) in + FStar_Errors.log_issue t.FStar_Syntax_Syntax.pos uu____18662); t) in FStar_Syntax_Print.term_to_string t1 let comp_to_string: @@ -5300,17 +5302,17 @@ let comp_to_string: fun c -> let c1 = try - let uu____18694 = config [AllowUnboundUniverses] env in - norm_comp uu____18694 [] c + let uu____18679 = config [AllowUnboundUniverses] env in + norm_comp uu____18679 [] c with | e -> - ((let uu____18707 = - let uu____18712 = - let uu____18713 = FStar_Util.message_of_exn e in + ((let uu____18692 = + let uu____18697 = + let uu____18698 = FStar_Util.message_of_exn e in FStar_Util.format1 "Normalization failed with error %s\n" - uu____18713 in - (FStar_Errors.Warning_NormalizationFailure, uu____18712) in - FStar_Errors.log_issue c.FStar_Syntax_Syntax.pos uu____18707); + uu____18698 in + (FStar_Errors.Warning_NormalizationFailure, uu____18697) in + FStar_Errors.log_issue c.FStar_Syntax_Syntax.pos uu____18692); c) in FStar_Syntax_Print.comp_to_string c1 let normalize_refinement: @@ -5329,14 +5331,14 @@ let normalize_refinement: let t01 = aux x.FStar_Syntax_Syntax.sort in (match t01.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Tm_refine (y,phi1) -> - let uu____18750 = - let uu____18751 = - let uu____18758 = FStar_Syntax_Util.mk_conj phi1 phi in - (y, uu____18758) in - FStar_Syntax_Syntax.Tm_refine uu____18751 in - mk uu____18750 t01.FStar_Syntax_Syntax.pos - | uu____18763 -> t2) - | uu____18764 -> t2 in + let uu____18735 = + let uu____18736 = + let uu____18743 = FStar_Syntax_Util.mk_conj phi1 phi in + (y, uu____18743) in + FStar_Syntax_Syntax.Tm_refine uu____18736 in + mk uu____18735 t01.FStar_Syntax_Syntax.pos + | uu____18748 -> t2) + | uu____18749 -> t2 in aux t let unfold_whnf: FStar_TypeChecker_Env.env -> @@ -5379,30 +5381,30 @@ let eta_expand_with_type: fun env -> fun e -> fun t_e -> - let uu____18804 = FStar_Syntax_Util.arrow_formals_comp t_e in - match uu____18804 with + let uu____18789 = FStar_Syntax_Util.arrow_formals_comp t_e in + match uu____18789 with | (formals,c) -> (match formals with | [] -> e - | uu____18833 -> - let uu____18840 = FStar_Syntax_Util.abs_formals e in - (match uu____18840 with - | (actuals,uu____18850,uu____18851) -> + | uu____18818 -> + let uu____18825 = FStar_Syntax_Util.abs_formals e in + (match uu____18825 with + | (actuals,uu____18835,uu____18836) -> if (FStar_List.length actuals) = (FStar_List.length formals) then e else - (let uu____18865 = + (let uu____18850 = FStar_All.pipe_right formals FStar_Syntax_Util.args_of_binders in - match uu____18865 with + match uu____18850 with | (binders,args) -> - let uu____18882 = + let uu____18867 = FStar_Syntax_Syntax.mk_Tm_app e args FStar_Pervasives_Native.None e.FStar_Syntax_Syntax.pos in - FStar_Syntax_Util.abs binders uu____18882 + FStar_Syntax_Util.abs binders uu____18867 (FStar_Pervasives_Native.Some (FStar_Syntax_Util.residual_comp_of_comp c))))) let eta_expand: @@ -5414,171 +5416,171 @@ let eta_expand: match t.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Tm_name x -> eta_expand_with_type env t x.FStar_Syntax_Syntax.sort - | uu____18890 -> - let uu____18891 = FStar_Syntax_Util.head_and_args t in - (match uu____18891 with + | uu____18875 -> + let uu____18876 = FStar_Syntax_Util.head_and_args t in + (match uu____18876 with | (head1,args) -> - let uu____18928 = - let uu____18929 = FStar_Syntax_Subst.compress head1 in - uu____18929.FStar_Syntax_Syntax.n in - (match uu____18928 with - | FStar_Syntax_Syntax.Tm_uvar (uu____18932,thead) -> - let uu____18958 = FStar_Syntax_Util.arrow_formals thead in - (match uu____18958 with + let uu____18913 = + let uu____18914 = FStar_Syntax_Subst.compress head1 in + uu____18914.FStar_Syntax_Syntax.n in + (match uu____18913 with + | FStar_Syntax_Syntax.Tm_uvar (uu____18917,thead) -> + let uu____18943 = FStar_Syntax_Util.arrow_formals thead in + (match uu____18943 with | (formals,tres) -> if (FStar_List.length formals) = (FStar_List.length args) then t else - (let uu____19000 = + (let uu____18985 = env.FStar_TypeChecker_Env.type_of - (let uu___160_19008 = env in + (let uu___158_18993 = env in { FStar_TypeChecker_Env.solver = - (uu___160_19008.FStar_TypeChecker_Env.solver); + (uu___158_18993.FStar_TypeChecker_Env.solver); FStar_TypeChecker_Env.range = - (uu___160_19008.FStar_TypeChecker_Env.range); + (uu___158_18993.FStar_TypeChecker_Env.range); FStar_TypeChecker_Env.curmodule = - (uu___160_19008.FStar_TypeChecker_Env.curmodule); + (uu___158_18993.FStar_TypeChecker_Env.curmodule); FStar_TypeChecker_Env.gamma = - (uu___160_19008.FStar_TypeChecker_Env.gamma); + (uu___158_18993.FStar_TypeChecker_Env.gamma); FStar_TypeChecker_Env.gamma_cache = - (uu___160_19008.FStar_TypeChecker_Env.gamma_cache); + (uu___158_18993.FStar_TypeChecker_Env.gamma_cache); FStar_TypeChecker_Env.modules = - (uu___160_19008.FStar_TypeChecker_Env.modules); + (uu___158_18993.FStar_TypeChecker_Env.modules); FStar_TypeChecker_Env.expected_typ = FStar_Pervasives_Native.None; FStar_TypeChecker_Env.sigtab = - (uu___160_19008.FStar_TypeChecker_Env.sigtab); + (uu___158_18993.FStar_TypeChecker_Env.sigtab); FStar_TypeChecker_Env.is_pattern = - (uu___160_19008.FStar_TypeChecker_Env.is_pattern); + (uu___158_18993.FStar_TypeChecker_Env.is_pattern); FStar_TypeChecker_Env.instantiate_imp = - (uu___160_19008.FStar_TypeChecker_Env.instantiate_imp); + (uu___158_18993.FStar_TypeChecker_Env.instantiate_imp); FStar_TypeChecker_Env.effects = - (uu___160_19008.FStar_TypeChecker_Env.effects); + (uu___158_18993.FStar_TypeChecker_Env.effects); FStar_TypeChecker_Env.generalize = - (uu___160_19008.FStar_TypeChecker_Env.generalize); + (uu___158_18993.FStar_TypeChecker_Env.generalize); FStar_TypeChecker_Env.letrecs = - (uu___160_19008.FStar_TypeChecker_Env.letrecs); + (uu___158_18993.FStar_TypeChecker_Env.letrecs); FStar_TypeChecker_Env.top_level = - (uu___160_19008.FStar_TypeChecker_Env.top_level); + (uu___158_18993.FStar_TypeChecker_Env.top_level); FStar_TypeChecker_Env.check_uvars = - (uu___160_19008.FStar_TypeChecker_Env.check_uvars); + (uu___158_18993.FStar_TypeChecker_Env.check_uvars); FStar_TypeChecker_Env.use_eq = - (uu___160_19008.FStar_TypeChecker_Env.use_eq); + (uu___158_18993.FStar_TypeChecker_Env.use_eq); FStar_TypeChecker_Env.is_iface = - (uu___160_19008.FStar_TypeChecker_Env.is_iface); + (uu___158_18993.FStar_TypeChecker_Env.is_iface); FStar_TypeChecker_Env.admit = - (uu___160_19008.FStar_TypeChecker_Env.admit); + (uu___158_18993.FStar_TypeChecker_Env.admit); FStar_TypeChecker_Env.lax = true; FStar_TypeChecker_Env.lax_universes = - (uu___160_19008.FStar_TypeChecker_Env.lax_universes); + (uu___158_18993.FStar_TypeChecker_Env.lax_universes); FStar_TypeChecker_Env.failhard = - (uu___160_19008.FStar_TypeChecker_Env.failhard); + (uu___158_18993.FStar_TypeChecker_Env.failhard); FStar_TypeChecker_Env.nosynth = - (uu___160_19008.FStar_TypeChecker_Env.nosynth); + (uu___158_18993.FStar_TypeChecker_Env.nosynth); FStar_TypeChecker_Env.tc_term = - (uu___160_19008.FStar_TypeChecker_Env.tc_term); + (uu___158_18993.FStar_TypeChecker_Env.tc_term); FStar_TypeChecker_Env.type_of = - (uu___160_19008.FStar_TypeChecker_Env.type_of); + (uu___158_18993.FStar_TypeChecker_Env.type_of); FStar_TypeChecker_Env.universe_of = - (uu___160_19008.FStar_TypeChecker_Env.universe_of); + (uu___158_18993.FStar_TypeChecker_Env.universe_of); FStar_TypeChecker_Env.use_bv_sorts = true; FStar_TypeChecker_Env.qname_and_index = - (uu___160_19008.FStar_TypeChecker_Env.qname_and_index); + (uu___158_18993.FStar_TypeChecker_Env.qname_and_index); FStar_TypeChecker_Env.proof_ns = - (uu___160_19008.FStar_TypeChecker_Env.proof_ns); + (uu___158_18993.FStar_TypeChecker_Env.proof_ns); FStar_TypeChecker_Env.synth = - (uu___160_19008.FStar_TypeChecker_Env.synth); + (uu___158_18993.FStar_TypeChecker_Env.synth); FStar_TypeChecker_Env.is_native_tactic = - (uu___160_19008.FStar_TypeChecker_Env.is_native_tactic); + (uu___158_18993.FStar_TypeChecker_Env.is_native_tactic); FStar_TypeChecker_Env.identifier_info = - (uu___160_19008.FStar_TypeChecker_Env.identifier_info); + (uu___158_18993.FStar_TypeChecker_Env.identifier_info); FStar_TypeChecker_Env.tc_hooks = - (uu___160_19008.FStar_TypeChecker_Env.tc_hooks); + (uu___158_18993.FStar_TypeChecker_Env.tc_hooks); FStar_TypeChecker_Env.dsenv = - (uu___160_19008.FStar_TypeChecker_Env.dsenv); + (uu___158_18993.FStar_TypeChecker_Env.dsenv); FStar_TypeChecker_Env.dep_graph = - (uu___160_19008.FStar_TypeChecker_Env.dep_graph) + (uu___158_18993.FStar_TypeChecker_Env.dep_graph) }) t in - match uu____19000 with - | (uu____19009,ty,uu____19011) -> + match uu____18985 with + | (uu____18994,ty,uu____18996) -> eta_expand_with_type env t ty)) - | uu____19012 -> - let uu____19013 = + | uu____18997 -> + let uu____18998 = env.FStar_TypeChecker_Env.type_of - (let uu___161_19021 = env in + (let uu___159_19006 = env in { FStar_TypeChecker_Env.solver = - (uu___161_19021.FStar_TypeChecker_Env.solver); + (uu___159_19006.FStar_TypeChecker_Env.solver); FStar_TypeChecker_Env.range = - (uu___161_19021.FStar_TypeChecker_Env.range); + (uu___159_19006.FStar_TypeChecker_Env.range); FStar_TypeChecker_Env.curmodule = - (uu___161_19021.FStar_TypeChecker_Env.curmodule); + (uu___159_19006.FStar_TypeChecker_Env.curmodule); FStar_TypeChecker_Env.gamma = - (uu___161_19021.FStar_TypeChecker_Env.gamma); + (uu___159_19006.FStar_TypeChecker_Env.gamma); FStar_TypeChecker_Env.gamma_cache = - (uu___161_19021.FStar_TypeChecker_Env.gamma_cache); + (uu___159_19006.FStar_TypeChecker_Env.gamma_cache); FStar_TypeChecker_Env.modules = - (uu___161_19021.FStar_TypeChecker_Env.modules); + (uu___159_19006.FStar_TypeChecker_Env.modules); FStar_TypeChecker_Env.expected_typ = FStar_Pervasives_Native.None; FStar_TypeChecker_Env.sigtab = - (uu___161_19021.FStar_TypeChecker_Env.sigtab); + (uu___159_19006.FStar_TypeChecker_Env.sigtab); FStar_TypeChecker_Env.is_pattern = - (uu___161_19021.FStar_TypeChecker_Env.is_pattern); + (uu___159_19006.FStar_TypeChecker_Env.is_pattern); FStar_TypeChecker_Env.instantiate_imp = - (uu___161_19021.FStar_TypeChecker_Env.instantiate_imp); + (uu___159_19006.FStar_TypeChecker_Env.instantiate_imp); FStar_TypeChecker_Env.effects = - (uu___161_19021.FStar_TypeChecker_Env.effects); + (uu___159_19006.FStar_TypeChecker_Env.effects); FStar_TypeChecker_Env.generalize = - (uu___161_19021.FStar_TypeChecker_Env.generalize); + (uu___159_19006.FStar_TypeChecker_Env.generalize); FStar_TypeChecker_Env.letrecs = - (uu___161_19021.FStar_TypeChecker_Env.letrecs); + (uu___159_19006.FStar_TypeChecker_Env.letrecs); FStar_TypeChecker_Env.top_level = - (uu___161_19021.FStar_TypeChecker_Env.top_level); + (uu___159_19006.FStar_TypeChecker_Env.top_level); FStar_TypeChecker_Env.check_uvars = - (uu___161_19021.FStar_TypeChecker_Env.check_uvars); + (uu___159_19006.FStar_TypeChecker_Env.check_uvars); FStar_TypeChecker_Env.use_eq = - (uu___161_19021.FStar_TypeChecker_Env.use_eq); + (uu___159_19006.FStar_TypeChecker_Env.use_eq); FStar_TypeChecker_Env.is_iface = - (uu___161_19021.FStar_TypeChecker_Env.is_iface); + (uu___159_19006.FStar_TypeChecker_Env.is_iface); FStar_TypeChecker_Env.admit = - (uu___161_19021.FStar_TypeChecker_Env.admit); + (uu___159_19006.FStar_TypeChecker_Env.admit); FStar_TypeChecker_Env.lax = true; FStar_TypeChecker_Env.lax_universes = - (uu___161_19021.FStar_TypeChecker_Env.lax_universes); + (uu___159_19006.FStar_TypeChecker_Env.lax_universes); FStar_TypeChecker_Env.failhard = - (uu___161_19021.FStar_TypeChecker_Env.failhard); + (uu___159_19006.FStar_TypeChecker_Env.failhard); FStar_TypeChecker_Env.nosynth = - (uu___161_19021.FStar_TypeChecker_Env.nosynth); + (uu___159_19006.FStar_TypeChecker_Env.nosynth); FStar_TypeChecker_Env.tc_term = - (uu___161_19021.FStar_TypeChecker_Env.tc_term); + (uu___159_19006.FStar_TypeChecker_Env.tc_term); FStar_TypeChecker_Env.type_of = - (uu___161_19021.FStar_TypeChecker_Env.type_of); + (uu___159_19006.FStar_TypeChecker_Env.type_of); FStar_TypeChecker_Env.universe_of = - (uu___161_19021.FStar_TypeChecker_Env.universe_of); + (uu___159_19006.FStar_TypeChecker_Env.universe_of); FStar_TypeChecker_Env.use_bv_sorts = true; FStar_TypeChecker_Env.qname_and_index = - (uu___161_19021.FStar_TypeChecker_Env.qname_and_index); + (uu___159_19006.FStar_TypeChecker_Env.qname_and_index); FStar_TypeChecker_Env.proof_ns = - (uu___161_19021.FStar_TypeChecker_Env.proof_ns); + (uu___159_19006.FStar_TypeChecker_Env.proof_ns); FStar_TypeChecker_Env.synth = - (uu___161_19021.FStar_TypeChecker_Env.synth); + (uu___159_19006.FStar_TypeChecker_Env.synth); FStar_TypeChecker_Env.is_native_tactic = - (uu___161_19021.FStar_TypeChecker_Env.is_native_tactic); + (uu___159_19006.FStar_TypeChecker_Env.is_native_tactic); FStar_TypeChecker_Env.identifier_info = - (uu___161_19021.FStar_TypeChecker_Env.identifier_info); + (uu___159_19006.FStar_TypeChecker_Env.identifier_info); FStar_TypeChecker_Env.tc_hooks = - (uu___161_19021.FStar_TypeChecker_Env.tc_hooks); + (uu___159_19006.FStar_TypeChecker_Env.tc_hooks); FStar_TypeChecker_Env.dsenv = - (uu___161_19021.FStar_TypeChecker_Env.dsenv); + (uu___159_19006.FStar_TypeChecker_Env.dsenv); FStar_TypeChecker_Env.dep_graph = - (uu___161_19021.FStar_TypeChecker_Env.dep_graph) + (uu___159_19006.FStar_TypeChecker_Env.dep_graph) }) t in - (match uu____19013 with - | (uu____19022,ty,uu____19024) -> + (match uu____18998 with + | (uu____19007,ty,uu____19009) -> eta_expand_with_type env t ty))) let elim_uvars_aux_tc: FStar_TypeChecker_Env.env -> @@ -5603,46 +5605,46 @@ let elim_uvars_aux_tc: | ([],FStar_Util.Inl t) -> t | ([],FStar_Util.Inr c) -> failwith "Impossible: empty bindes with a comp" - | (uu____19098,FStar_Util.Inr c) -> + | (uu____19083,FStar_Util.Inr c) -> FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_arrow (binders, c)) FStar_Pervasives_Native.None c.FStar_Syntax_Syntax.pos - | (uu____19104,FStar_Util.Inl t) -> - let uu____19110 = - let uu____19113 = - let uu____19114 = - let uu____19127 = FStar_Syntax_Syntax.mk_Total t in - (binders, uu____19127) in - FStar_Syntax_Syntax.Tm_arrow uu____19114 in - FStar_Syntax_Syntax.mk uu____19113 in - uu____19110 FStar_Pervasives_Native.None + | (uu____19089,FStar_Util.Inl t) -> + let uu____19095 = + let uu____19098 = + let uu____19099 = + let uu____19112 = FStar_Syntax_Syntax.mk_Total t in + (binders, uu____19112) in + FStar_Syntax_Syntax.Tm_arrow uu____19099 in + FStar_Syntax_Syntax.mk uu____19098 in + uu____19095 FStar_Pervasives_Native.None t.FStar_Syntax_Syntax.pos in - let uu____19131 = FStar_Syntax_Subst.open_univ_vars univ_names t in - match uu____19131 with + let uu____19116 = FStar_Syntax_Subst.open_univ_vars univ_names t in + match uu____19116 with | (univ_names1,t1) -> let t2 = remove_uvar_solutions env t1 in let t3 = FStar_Syntax_Subst.close_univ_vars univ_names1 t2 in - let uu____19158 = + let uu____19143 = match binders with | [] -> ([], (FStar_Util.Inl t3)) - | uu____19213 -> - let uu____19214 = - let uu____19223 = - let uu____19224 = FStar_Syntax_Subst.compress t3 in - uu____19224.FStar_Syntax_Syntax.n in - (uu____19223, tc) in - (match uu____19214 with + | uu____19198 -> + let uu____19199 = + let uu____19208 = + let uu____19209 = FStar_Syntax_Subst.compress t3 in + uu____19209.FStar_Syntax_Syntax.n in + (uu____19208, tc) in + (match uu____19199 with | (FStar_Syntax_Syntax.Tm_arrow - (binders1,c),FStar_Util.Inr uu____19249) -> + (binders1,c),FStar_Util.Inr uu____19234) -> (binders1, (FStar_Util.Inr c)) | (FStar_Syntax_Syntax.Tm_arrow - (binders1,c),FStar_Util.Inl uu____19286) -> + (binders1,c),FStar_Util.Inl uu____19271) -> (binders1, (FStar_Util.Inl (FStar_Syntax_Util.comp_result c))) - | (uu____19325,FStar_Util.Inl uu____19326) -> + | (uu____19310,FStar_Util.Inl uu____19311) -> ([], (FStar_Util.Inl t3)) - | uu____19349 -> failwith "Impossible") in - (match uu____19158 with + | uu____19334 -> failwith "Impossible") in + (match uu____19143 with | (binders1,tc1) -> (univ_names1, binders1, tc1)) let elim_uvars_aux_t: FStar_TypeChecker_Env.env -> @@ -5658,12 +5660,12 @@ let elim_uvars_aux_t: fun univ_names -> fun binders -> fun t -> - let uu____19454 = + let uu____19439 = elim_uvars_aux_tc env univ_names binders (FStar_Util.Inl t) in - match uu____19454 with + match uu____19439 with | (univ_names1,binders1,tc) -> - let uu____19512 = FStar_Util.left tc in - (univ_names1, binders1, uu____19512) + let uu____19497 = FStar_Util.left tc in + (univ_names1, binders1, uu____19497) let elim_uvars_aux_c: FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.univ_names -> @@ -5679,12 +5681,12 @@ let elim_uvars_aux_c: fun univ_names -> fun binders -> fun c -> - let uu____19547 = + let uu____19532 = elim_uvars_aux_tc env univ_names binders (FStar_Util.Inr c) in - match uu____19547 with + match uu____19532 with | (univ_names1,binders1,tc) -> - let uu____19607 = FStar_Util.right tc in - (univ_names1, binders1, uu____19607) + let uu____19592 = FStar_Util.right tc in + (univ_names1, binders1, uu____19592) let rec elim_uvars: FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.sigelt -> FStar_Syntax_Syntax.sigelt @@ -5694,243 +5696,243 @@ let rec elim_uvars: match s.FStar_Syntax_Syntax.sigel with | FStar_Syntax_Syntax.Sig_inductive_typ (lid,univ_names,binders,typ,lids,lids') -> - let uu____19640 = elim_uvars_aux_t env univ_names binders typ in - (match uu____19640 with + let uu____19625 = elim_uvars_aux_t env univ_names binders typ in + (match uu____19625 with | (univ_names1,binders1,typ1) -> - let uu___162_19668 = s in + let uu___160_19653 = s in { FStar_Syntax_Syntax.sigel = (FStar_Syntax_Syntax.Sig_inductive_typ (lid, univ_names1, binders1, typ1, lids, lids')); FStar_Syntax_Syntax.sigrng = - (uu___162_19668.FStar_Syntax_Syntax.sigrng); + (uu___160_19653.FStar_Syntax_Syntax.sigrng); FStar_Syntax_Syntax.sigquals = - (uu___162_19668.FStar_Syntax_Syntax.sigquals); + (uu___160_19653.FStar_Syntax_Syntax.sigquals); FStar_Syntax_Syntax.sigmeta = - (uu___162_19668.FStar_Syntax_Syntax.sigmeta); + (uu___160_19653.FStar_Syntax_Syntax.sigmeta); FStar_Syntax_Syntax.sigattrs = - (uu___162_19668.FStar_Syntax_Syntax.sigattrs) + (uu___160_19653.FStar_Syntax_Syntax.sigattrs) }) | FStar_Syntax_Syntax.Sig_bundle (sigs,lids) -> - let uu___163_19689 = s in - let uu____19690 = - let uu____19691 = - let uu____19700 = FStar_List.map (elim_uvars env) sigs in - (uu____19700, lids) in - FStar_Syntax_Syntax.Sig_bundle uu____19691 in + let uu___161_19674 = s in + let uu____19675 = + let uu____19676 = + let uu____19685 = FStar_List.map (elim_uvars env) sigs in + (uu____19685, lids) in + FStar_Syntax_Syntax.Sig_bundle uu____19676 in { - FStar_Syntax_Syntax.sigel = uu____19690; + FStar_Syntax_Syntax.sigel = uu____19675; FStar_Syntax_Syntax.sigrng = - (uu___163_19689.FStar_Syntax_Syntax.sigrng); + (uu___161_19674.FStar_Syntax_Syntax.sigrng); FStar_Syntax_Syntax.sigquals = - (uu___163_19689.FStar_Syntax_Syntax.sigquals); + (uu___161_19674.FStar_Syntax_Syntax.sigquals); FStar_Syntax_Syntax.sigmeta = - (uu___163_19689.FStar_Syntax_Syntax.sigmeta); + (uu___161_19674.FStar_Syntax_Syntax.sigmeta); FStar_Syntax_Syntax.sigattrs = - (uu___163_19689.FStar_Syntax_Syntax.sigattrs) + (uu___161_19674.FStar_Syntax_Syntax.sigattrs) } | FStar_Syntax_Syntax.Sig_datacon (lid,univ_names,typ,lident,i,lids) -> - let uu____19717 = elim_uvars_aux_t env univ_names [] typ in - (match uu____19717 with - | (univ_names1,uu____19735,typ1) -> - let uu___164_19749 = s in + let uu____19702 = elim_uvars_aux_t env univ_names [] typ in + (match uu____19702 with + | (univ_names1,uu____19720,typ1) -> + let uu___162_19734 = s in { FStar_Syntax_Syntax.sigel = (FStar_Syntax_Syntax.Sig_datacon (lid, univ_names1, typ1, lident, i, lids)); FStar_Syntax_Syntax.sigrng = - (uu___164_19749.FStar_Syntax_Syntax.sigrng); + (uu___162_19734.FStar_Syntax_Syntax.sigrng); FStar_Syntax_Syntax.sigquals = - (uu___164_19749.FStar_Syntax_Syntax.sigquals); + (uu___162_19734.FStar_Syntax_Syntax.sigquals); FStar_Syntax_Syntax.sigmeta = - (uu___164_19749.FStar_Syntax_Syntax.sigmeta); + (uu___162_19734.FStar_Syntax_Syntax.sigmeta); FStar_Syntax_Syntax.sigattrs = - (uu___164_19749.FStar_Syntax_Syntax.sigattrs) + (uu___162_19734.FStar_Syntax_Syntax.sigattrs) }) | FStar_Syntax_Syntax.Sig_declare_typ (lid,univ_names,typ) -> - let uu____19755 = elim_uvars_aux_t env univ_names [] typ in - (match uu____19755 with - | (univ_names1,uu____19773,typ1) -> - let uu___165_19787 = s in + let uu____19740 = elim_uvars_aux_t env univ_names [] typ in + (match uu____19740 with + | (univ_names1,uu____19758,typ1) -> + let uu___163_19772 = s in { FStar_Syntax_Syntax.sigel = (FStar_Syntax_Syntax.Sig_declare_typ (lid, univ_names1, typ1)); FStar_Syntax_Syntax.sigrng = - (uu___165_19787.FStar_Syntax_Syntax.sigrng); + (uu___163_19772.FStar_Syntax_Syntax.sigrng); FStar_Syntax_Syntax.sigquals = - (uu___165_19787.FStar_Syntax_Syntax.sigquals); + (uu___163_19772.FStar_Syntax_Syntax.sigquals); FStar_Syntax_Syntax.sigmeta = - (uu___165_19787.FStar_Syntax_Syntax.sigmeta); + (uu___163_19772.FStar_Syntax_Syntax.sigmeta); FStar_Syntax_Syntax.sigattrs = - (uu___165_19787.FStar_Syntax_Syntax.sigattrs) + (uu___163_19772.FStar_Syntax_Syntax.sigattrs) }) | FStar_Syntax_Syntax.Sig_let ((b,lbs),lids) -> let lbs1 = FStar_All.pipe_right lbs (FStar_List.map (fun lb -> - let uu____19821 = + let uu____19806 = FStar_Syntax_Subst.univ_var_opening lb.FStar_Syntax_Syntax.lbunivs in - match uu____19821 with + match uu____19806 with | (opening,lbunivs) -> let elim t = - let uu____19844 = - let uu____19845 = + let uu____19829 = + let uu____19830 = FStar_Syntax_Subst.subst opening t in - remove_uvar_solutions env uu____19845 in + remove_uvar_solutions env uu____19830 in FStar_Syntax_Subst.close_univ_vars lbunivs - uu____19844 in + uu____19829 in let lbtyp = elim lb.FStar_Syntax_Syntax.lbtyp in let lbdef = elim lb.FStar_Syntax_Syntax.lbdef in - let uu___166_19848 = lb in + let uu___164_19833 = lb in { FStar_Syntax_Syntax.lbname = - (uu___166_19848.FStar_Syntax_Syntax.lbname); + (uu___164_19833.FStar_Syntax_Syntax.lbname); FStar_Syntax_Syntax.lbunivs = lbunivs; FStar_Syntax_Syntax.lbtyp = lbtyp; FStar_Syntax_Syntax.lbeff = - (uu___166_19848.FStar_Syntax_Syntax.lbeff); + (uu___164_19833.FStar_Syntax_Syntax.lbeff); FStar_Syntax_Syntax.lbdef = lbdef })) in - let uu___167_19849 = s in + let uu___165_19834 = s in { FStar_Syntax_Syntax.sigel = (FStar_Syntax_Syntax.Sig_let ((b, lbs1), lids)); FStar_Syntax_Syntax.sigrng = - (uu___167_19849.FStar_Syntax_Syntax.sigrng); + (uu___165_19834.FStar_Syntax_Syntax.sigrng); FStar_Syntax_Syntax.sigquals = - (uu___167_19849.FStar_Syntax_Syntax.sigquals); + (uu___165_19834.FStar_Syntax_Syntax.sigquals); FStar_Syntax_Syntax.sigmeta = - (uu___167_19849.FStar_Syntax_Syntax.sigmeta); + (uu___165_19834.FStar_Syntax_Syntax.sigmeta); FStar_Syntax_Syntax.sigattrs = - (uu___167_19849.FStar_Syntax_Syntax.sigattrs) + (uu___165_19834.FStar_Syntax_Syntax.sigattrs) } | FStar_Syntax_Syntax.Sig_main t -> - let uu___168_19861 = s in - let uu____19862 = - let uu____19863 = remove_uvar_solutions env t in - FStar_Syntax_Syntax.Sig_main uu____19863 in + let uu___166_19846 = s in + let uu____19847 = + let uu____19848 = remove_uvar_solutions env t in + FStar_Syntax_Syntax.Sig_main uu____19848 in { - FStar_Syntax_Syntax.sigel = uu____19862; + FStar_Syntax_Syntax.sigel = uu____19847; FStar_Syntax_Syntax.sigrng = - (uu___168_19861.FStar_Syntax_Syntax.sigrng); + (uu___166_19846.FStar_Syntax_Syntax.sigrng); FStar_Syntax_Syntax.sigquals = - (uu___168_19861.FStar_Syntax_Syntax.sigquals); + (uu___166_19846.FStar_Syntax_Syntax.sigquals); FStar_Syntax_Syntax.sigmeta = - (uu___168_19861.FStar_Syntax_Syntax.sigmeta); + (uu___166_19846.FStar_Syntax_Syntax.sigmeta); FStar_Syntax_Syntax.sigattrs = - (uu___168_19861.FStar_Syntax_Syntax.sigattrs) + (uu___166_19846.FStar_Syntax_Syntax.sigattrs) } | FStar_Syntax_Syntax.Sig_assume (l,us,t) -> - let uu____19867 = elim_uvars_aux_t env us [] t in - (match uu____19867 with - | (us1,uu____19885,t1) -> - let uu___169_19899 = s in + let uu____19852 = elim_uvars_aux_t env us [] t in + (match uu____19852 with + | (us1,uu____19870,t1) -> + let uu___167_19884 = s in { FStar_Syntax_Syntax.sigel = (FStar_Syntax_Syntax.Sig_assume (l, us1, t1)); FStar_Syntax_Syntax.sigrng = - (uu___169_19899.FStar_Syntax_Syntax.sigrng); + (uu___167_19884.FStar_Syntax_Syntax.sigrng); FStar_Syntax_Syntax.sigquals = - (uu___169_19899.FStar_Syntax_Syntax.sigquals); + (uu___167_19884.FStar_Syntax_Syntax.sigquals); FStar_Syntax_Syntax.sigmeta = - (uu___169_19899.FStar_Syntax_Syntax.sigmeta); + (uu___167_19884.FStar_Syntax_Syntax.sigmeta); FStar_Syntax_Syntax.sigattrs = - (uu___169_19899.FStar_Syntax_Syntax.sigattrs) + (uu___167_19884.FStar_Syntax_Syntax.sigattrs) }) - | FStar_Syntax_Syntax.Sig_new_effect_for_free uu____19900 -> + | FStar_Syntax_Syntax.Sig_new_effect_for_free uu____19885 -> failwith "Impossible: should have been desugared already" | FStar_Syntax_Syntax.Sig_new_effect ed -> - let uu____19902 = + let uu____19887 = elim_uvars_aux_t env ed.FStar_Syntax_Syntax.univs ed.FStar_Syntax_Syntax.binders ed.FStar_Syntax_Syntax.signature in - (match uu____19902 with + (match uu____19887 with | (univs1,binders,signature) -> - let uu____19930 = - let uu____19939 = FStar_Syntax_Subst.univ_var_opening univs1 in - match uu____19939 with + let uu____19915 = + let uu____19924 = FStar_Syntax_Subst.univ_var_opening univs1 in + match uu____19924 with | (univs_opening,univs2) -> - let uu____19966 = + let uu____19951 = FStar_Syntax_Subst.univ_var_closing univs2 in - (univs_opening, uu____19966) in - (match uu____19930 with + (univs_opening, uu____19951) in + (match uu____19915 with | (univs_opening,univs_closing) -> - let uu____19983 = + let uu____19968 = let binders1 = FStar_Syntax_Subst.open_binders binders in - let uu____19989 = + let uu____19974 = FStar_Syntax_Subst.opening_of_binders binders1 in - let uu____19990 = + let uu____19975 = FStar_Syntax_Subst.closing_of_binders binders1 in - (uu____19989, uu____19990) in - (match uu____19983 with + (uu____19974, uu____19975) in + (match uu____19968 with | (b_opening,b_closing) -> let n1 = FStar_List.length univs1 in let n_binders = FStar_List.length binders in - let elim_tscheme uu____20012 = - match uu____20012 with + let elim_tscheme uu____19997 = + match uu____19997 with | (us,t) -> let n_us = FStar_List.length us in - let uu____20030 = + let uu____20015 = FStar_Syntax_Subst.open_univ_vars us t in - (match uu____20030 with + (match uu____20015 with | (us1,t1) -> - let uu____20041 = - let uu____20046 = + let uu____20026 = + let uu____20031 = FStar_All.pipe_right b_opening (FStar_Syntax_Subst.shift_subst n_us) in - let uu____20053 = + let uu____20038 = FStar_All.pipe_right b_closing (FStar_Syntax_Subst.shift_subst n_us) in - (uu____20046, uu____20053) in - (match uu____20041 with + (uu____20031, uu____20038) in + (match uu____20026 with | (b_opening1,b_closing1) -> - let uu____20066 = - let uu____20071 = + let uu____20051 = + let uu____20056 = FStar_All.pipe_right univs_opening (FStar_Syntax_Subst.shift_subst n_us) in - let uu____20080 = + let uu____20065 = FStar_All.pipe_right univs_closing (FStar_Syntax_Subst.shift_subst n_us) in - (uu____20071, uu____20080) in - (match uu____20066 with + (uu____20056, uu____20065) in + (match uu____20051 with | (univs_opening1,univs_closing1) -> let t2 = - let uu____20096 = + let uu____20081 = FStar_Syntax_Subst.subst b_opening1 t1 in FStar_Syntax_Subst.subst - univs_opening1 uu____20096 in - let uu____20097 = + univs_opening1 uu____20081 in + let uu____20082 = elim_uvars_aux_t env [] [] t2 in - (match uu____20097 with - | (uu____20118,uu____20119,t3) + (match uu____20082 with + | (uu____20103,uu____20104,t3) -> let t4 = - let uu____20134 = - let uu____20135 = + let uu____20119 = + let uu____20120 = FStar_Syntax_Subst.close_univ_vars us1 t3 in FStar_Syntax_Subst.subst b_closing1 - uu____20135 in + uu____20120 in FStar_Syntax_Subst.subst univs_closing1 - uu____20134 in + uu____20119 in (us1, t4))))) in let elim_term t = - let uu____20140 = + let uu____20125 = elim_uvars_aux_t env univs1 binders t in - match uu____20140 with - | (uu____20153,uu____20154,t1) -> t1 in + match uu____20125 with + | (uu____20138,uu____20139,t1) -> t1 in let elim_action a = let action_typ_templ = let body = @@ -5945,7 +5947,7 @@ let rec elim_uvars: (a.FStar_Syntax_Syntax.action_defn).FStar_Syntax_Syntax.pos in match a.FStar_Syntax_Syntax.action_params with | [] -> body - | uu____20214 -> + | uu____20199 -> FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_abs ((a.FStar_Syntax_Syntax.action_params), @@ -5953,49 +5955,49 @@ let rec elim_uvars: FStar_Pervasives_Native.None (a.FStar_Syntax_Syntax.action_defn).FStar_Syntax_Syntax.pos in let destruct_action_body body = - let uu____20231 = - let uu____20232 = + let uu____20216 = + let uu____20217 = FStar_Syntax_Subst.compress body in - uu____20232.FStar_Syntax_Syntax.n in - match uu____20231 with + uu____20217.FStar_Syntax_Syntax.n in + match uu____20216 with | FStar_Syntax_Syntax.Tm_ascribed (defn,(FStar_Util.Inl typ,FStar_Pervasives_Native.None ),FStar_Pervasives_Native.None ) -> (defn, typ) - | uu____20291 -> failwith "Impossible" in + | uu____20276 -> failwith "Impossible" in let destruct_action_typ_templ t = - let uu____20320 = - let uu____20321 = + let uu____20305 = + let uu____20306 = FStar_Syntax_Subst.compress t in - uu____20321.FStar_Syntax_Syntax.n in - match uu____20320 with + uu____20306.FStar_Syntax_Syntax.n in + match uu____20305 with | FStar_Syntax_Syntax.Tm_abs - (pars,body,uu____20342) -> - let uu____20363 = destruct_action_body body in - (match uu____20363 with + (pars,body,uu____20327) -> + let uu____20348 = destruct_action_body body in + (match uu____20348 with | (defn,typ) -> (pars, defn, typ)) - | uu____20408 -> - let uu____20409 = destruct_action_body t in - (match uu____20409 with + | uu____20393 -> + let uu____20394 = destruct_action_body t in + (match uu____20394 with | (defn,typ) -> ([], defn, typ)) in - let uu____20458 = + let uu____20443 = elim_tscheme ((a.FStar_Syntax_Syntax.action_univs), action_typ_templ) in - match uu____20458 with + match uu____20443 with | (action_univs,t) -> - let uu____20467 = destruct_action_typ_templ t in - (match uu____20467 with + let uu____20452 = destruct_action_typ_templ t in + (match uu____20452 with | (action_params,action_defn,action_typ) -> let a' = - let uu___170_20508 = a in + let uu___168_20493 = a in { FStar_Syntax_Syntax.action_name = - (uu___170_20508.FStar_Syntax_Syntax.action_name); + (uu___168_20493.FStar_Syntax_Syntax.action_name); FStar_Syntax_Syntax.action_unqualified_name = - (uu___170_20508.FStar_Syntax_Syntax.action_unqualified_name); + (uu___168_20493.FStar_Syntax_Syntax.action_unqualified_name); FStar_Syntax_Syntax.action_univs = action_univs; FStar_Syntax_Syntax.action_params = @@ -6007,128 +6009,128 @@ let rec elim_uvars: } in a') in let ed1 = - let uu___171_20510 = ed in - let uu____20511 = + let uu___169_20495 = ed in + let uu____20496 = elim_tscheme ed.FStar_Syntax_Syntax.ret_wp in - let uu____20512 = + let uu____20497 = elim_tscheme ed.FStar_Syntax_Syntax.bind_wp in - let uu____20513 = + let uu____20498 = elim_tscheme ed.FStar_Syntax_Syntax.if_then_else in - let uu____20514 = + let uu____20499 = elim_tscheme ed.FStar_Syntax_Syntax.ite_wp in - let uu____20515 = + let uu____20500 = elim_tscheme ed.FStar_Syntax_Syntax.stronger in - let uu____20516 = + let uu____20501 = elim_tscheme ed.FStar_Syntax_Syntax.close_wp in - let uu____20517 = + let uu____20502 = elim_tscheme ed.FStar_Syntax_Syntax.assert_p in - let uu____20518 = + let uu____20503 = elim_tscheme ed.FStar_Syntax_Syntax.assume_p in - let uu____20519 = + let uu____20504 = elim_tscheme ed.FStar_Syntax_Syntax.null_wp in - let uu____20520 = + let uu____20505 = elim_tscheme ed.FStar_Syntax_Syntax.trivial in - let uu____20521 = + let uu____20506 = elim_term ed.FStar_Syntax_Syntax.repr in - let uu____20522 = + let uu____20507 = elim_tscheme ed.FStar_Syntax_Syntax.return_repr in - let uu____20523 = + let uu____20508 = elim_tscheme ed.FStar_Syntax_Syntax.bind_repr in - let uu____20524 = + let uu____20509 = FStar_List.map elim_action ed.FStar_Syntax_Syntax.actions in { FStar_Syntax_Syntax.cattributes = - (uu___171_20510.FStar_Syntax_Syntax.cattributes); + (uu___169_20495.FStar_Syntax_Syntax.cattributes); FStar_Syntax_Syntax.mname = - (uu___171_20510.FStar_Syntax_Syntax.mname); + (uu___169_20495.FStar_Syntax_Syntax.mname); FStar_Syntax_Syntax.univs = univs1; FStar_Syntax_Syntax.binders = binders; FStar_Syntax_Syntax.signature = signature; - FStar_Syntax_Syntax.ret_wp = uu____20511; - FStar_Syntax_Syntax.bind_wp = uu____20512; - FStar_Syntax_Syntax.if_then_else = uu____20513; - FStar_Syntax_Syntax.ite_wp = uu____20514; - FStar_Syntax_Syntax.stronger = uu____20515; - FStar_Syntax_Syntax.close_wp = uu____20516; - FStar_Syntax_Syntax.assert_p = uu____20517; - FStar_Syntax_Syntax.assume_p = uu____20518; - FStar_Syntax_Syntax.null_wp = uu____20519; - FStar_Syntax_Syntax.trivial = uu____20520; - FStar_Syntax_Syntax.repr = uu____20521; - FStar_Syntax_Syntax.return_repr = uu____20522; - FStar_Syntax_Syntax.bind_repr = uu____20523; - FStar_Syntax_Syntax.actions = uu____20524 + FStar_Syntax_Syntax.ret_wp = uu____20496; + FStar_Syntax_Syntax.bind_wp = uu____20497; + FStar_Syntax_Syntax.if_then_else = uu____20498; + FStar_Syntax_Syntax.ite_wp = uu____20499; + FStar_Syntax_Syntax.stronger = uu____20500; + FStar_Syntax_Syntax.close_wp = uu____20501; + FStar_Syntax_Syntax.assert_p = uu____20502; + FStar_Syntax_Syntax.assume_p = uu____20503; + FStar_Syntax_Syntax.null_wp = uu____20504; + FStar_Syntax_Syntax.trivial = uu____20505; + FStar_Syntax_Syntax.repr = uu____20506; + FStar_Syntax_Syntax.return_repr = uu____20507; + FStar_Syntax_Syntax.bind_repr = uu____20508; + FStar_Syntax_Syntax.actions = uu____20509 } in - let uu___172_20527 = s in + let uu___170_20512 = s in { FStar_Syntax_Syntax.sigel = (FStar_Syntax_Syntax.Sig_new_effect ed1); FStar_Syntax_Syntax.sigrng = - (uu___172_20527.FStar_Syntax_Syntax.sigrng); + (uu___170_20512.FStar_Syntax_Syntax.sigrng); FStar_Syntax_Syntax.sigquals = - (uu___172_20527.FStar_Syntax_Syntax.sigquals); + (uu___170_20512.FStar_Syntax_Syntax.sigquals); FStar_Syntax_Syntax.sigmeta = - (uu___172_20527.FStar_Syntax_Syntax.sigmeta); + (uu___170_20512.FStar_Syntax_Syntax.sigmeta); FStar_Syntax_Syntax.sigattrs = - (uu___172_20527.FStar_Syntax_Syntax.sigattrs) + (uu___170_20512.FStar_Syntax_Syntax.sigattrs) }))) | FStar_Syntax_Syntax.Sig_sub_effect sub_eff -> - let elim_tscheme_opt uu___87_20544 = - match uu___87_20544 with + let elim_tscheme_opt uu___87_20529 = + match uu___87_20529 with | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None | FStar_Pervasives_Native.Some (us,t) -> - let uu____20571 = elim_uvars_aux_t env us [] t in - (match uu____20571 with - | (us1,uu____20595,t1) -> + let uu____20556 = elim_uvars_aux_t env us [] t in + (match uu____20556 with + | (us1,uu____20580,t1) -> FStar_Pervasives_Native.Some (us1, t1)) in let sub_eff1 = - let uu___173_20614 = sub_eff in - let uu____20615 = + let uu___171_20599 = sub_eff in + let uu____20600 = elim_tscheme_opt sub_eff.FStar_Syntax_Syntax.lift_wp in - let uu____20618 = + let uu____20603 = elim_tscheme_opt sub_eff.FStar_Syntax_Syntax.lift in { FStar_Syntax_Syntax.source = - (uu___173_20614.FStar_Syntax_Syntax.source); + (uu___171_20599.FStar_Syntax_Syntax.source); FStar_Syntax_Syntax.target = - (uu___173_20614.FStar_Syntax_Syntax.target); - FStar_Syntax_Syntax.lift_wp = uu____20615; - FStar_Syntax_Syntax.lift = uu____20618 + (uu___171_20599.FStar_Syntax_Syntax.target); + FStar_Syntax_Syntax.lift_wp = uu____20600; + FStar_Syntax_Syntax.lift = uu____20603 } in - let uu___174_20621 = s in + let uu___172_20606 = s in { FStar_Syntax_Syntax.sigel = (FStar_Syntax_Syntax.Sig_sub_effect sub_eff1); FStar_Syntax_Syntax.sigrng = - (uu___174_20621.FStar_Syntax_Syntax.sigrng); + (uu___172_20606.FStar_Syntax_Syntax.sigrng); FStar_Syntax_Syntax.sigquals = - (uu___174_20621.FStar_Syntax_Syntax.sigquals); + (uu___172_20606.FStar_Syntax_Syntax.sigquals); FStar_Syntax_Syntax.sigmeta = - (uu___174_20621.FStar_Syntax_Syntax.sigmeta); + (uu___172_20606.FStar_Syntax_Syntax.sigmeta); FStar_Syntax_Syntax.sigattrs = - (uu___174_20621.FStar_Syntax_Syntax.sigattrs) + (uu___172_20606.FStar_Syntax_Syntax.sigattrs) } | FStar_Syntax_Syntax.Sig_effect_abbrev (lid,univ_names,binders,comp,flags1) -> - let uu____20631 = elim_uvars_aux_c env univ_names binders comp in - (match uu____20631 with + let uu____20616 = elim_uvars_aux_c env univ_names binders comp in + (match uu____20616 with | (univ_names1,binders1,comp1) -> - let uu___175_20665 = s in + let uu___173_20650 = s in { FStar_Syntax_Syntax.sigel = (FStar_Syntax_Syntax.Sig_effect_abbrev (lid, univ_names1, binders1, comp1, flags1)); FStar_Syntax_Syntax.sigrng = - (uu___175_20665.FStar_Syntax_Syntax.sigrng); + (uu___173_20650.FStar_Syntax_Syntax.sigrng); FStar_Syntax_Syntax.sigquals = - (uu___175_20665.FStar_Syntax_Syntax.sigquals); + (uu___173_20650.FStar_Syntax_Syntax.sigquals); FStar_Syntax_Syntax.sigmeta = - (uu___175_20665.FStar_Syntax_Syntax.sigmeta); + (uu___173_20650.FStar_Syntax_Syntax.sigmeta); FStar_Syntax_Syntax.sigattrs = - (uu___175_20665.FStar_Syntax_Syntax.sigattrs) + (uu___173_20650.FStar_Syntax_Syntax.sigattrs) }) - | FStar_Syntax_Syntax.Sig_pragma uu____20676 -> s + | FStar_Syntax_Syntax.Sig_pragma uu____20661 -> s let erase_universes: FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term diff --git a/src/ocaml-output/FStar_TypeChecker_Rel.ml b/src/ocaml-output/FStar_TypeChecker_Rel.ml index d9146798e39..7f2295538bd 100644 --- a/src/ocaml-output/FStar_TypeChecker_Rel.ml +++ b/src/ocaml-output/FStar_TypeChecker_Rel.ml @@ -7912,57 +7912,28 @@ and solve_c: match uu____21476 with | FStar_Pervasives_Native.None -> let uu____21479 = - ((FStar_Syntax_Util.is_ghost_effect - c12.FStar_Syntax_Syntax.effect_name) - && - (FStar_Syntax_Util.is_pure_effect - c22.FStar_Syntax_Syntax.effect_name)) - && - (let uu____21481 = - FStar_TypeChecker_Normalize.normalize - [FStar_TypeChecker_Normalize.Eager_unfolding; - FStar_TypeChecker_Normalize.UnfoldUntil - FStar_Syntax_Syntax.Delta_constant] - env - c22.FStar_Syntax_Syntax.result_typ in - FStar_Syntax_Util.non_informative - uu____21481) in - if uu____21479 - then - let edge = - { - FStar_TypeChecker_Env.msource = - (c12.FStar_Syntax_Syntax.effect_name); - FStar_TypeChecker_Env.mtarget = - (c22.FStar_Syntax_Syntax.effect_name); - FStar_TypeChecker_Env.mlift = - FStar_TypeChecker_Env.identity_mlift - } in - solve_sub c12 edge c22 - else - (let uu____21484 = - let uu____21485 = - FStar_Syntax_Print.lid_to_string - c12.FStar_Syntax_Syntax.effect_name in - let uu____21486 = - FStar_Syntax_Print.lid_to_string - c22.FStar_Syntax_Syntax.effect_name in - FStar_Util.format2 - "incompatible monad ordering: %s solve_sub c12 edge c22)))))) let print_pending_implicits: FStar_TypeChecker_Env.guard_t -> Prims.string = fun g -> - let uu____21491 = + let uu____21486 = FStar_All.pipe_right g.FStar_TypeChecker_Env.implicits (FStar_List.map - (fun uu____21529 -> - match uu____21529 with - | (uu____21542,uu____21543,u,uu____21545,uu____21546,uu____21547) + (fun uu____21524 -> + match uu____21524 with + | (uu____21537,uu____21538,u,uu____21540,uu____21541,uu____21542) -> FStar_Syntax_Print.uvar_to_string u)) in - FStar_All.pipe_right uu____21491 (FStar_String.concat ", ") + FStar_All.pipe_right uu____21486 (FStar_String.concat ", ") let ineqs_to_string: (FStar_Syntax_Syntax.universe Prims.list,(FStar_Syntax_Syntax.universe, FStar_Syntax_Syntax.universe) @@ -7972,21 +7943,21 @@ let ineqs_to_string: = fun ineqs -> let vars = - let uu____21578 = + let uu____21573 = FStar_All.pipe_right (FStar_Pervasives_Native.fst ineqs) (FStar_List.map FStar_Syntax_Print.univ_to_string) in - FStar_All.pipe_right uu____21578 (FStar_String.concat ", ") in + FStar_All.pipe_right uu____21573 (FStar_String.concat ", ") in let ineqs1 = - let uu____21596 = + let uu____21591 = FStar_All.pipe_right (FStar_Pervasives_Native.snd ineqs) (FStar_List.map - (fun uu____21624 -> - match uu____21624 with + (fun uu____21619 -> + match uu____21619 with | (u1,u2) -> - let uu____21631 = FStar_Syntax_Print.univ_to_string u1 in - let uu____21632 = FStar_Syntax_Print.univ_to_string u2 in - FStar_Util.format2 "%s < %s" uu____21631 uu____21632)) in - FStar_All.pipe_right uu____21596 (FStar_String.concat ", ") in + let uu____21626 = FStar_Syntax_Print.univ_to_string u1 in + let uu____21627 = FStar_Syntax_Print.univ_to_string u2 in + FStar_Util.format2 "%s < %s" uu____21626 uu____21627)) in + FStar_All.pipe_right uu____21591 (FStar_String.concat ", ") in FStar_Util.format2 "Solving for {%s}; inequalities are {%s}" vars ineqs1 let guard_to_string: FStar_TypeChecker_Env.env -> FStar_TypeChecker_Env.guard_t -> Prims.string @@ -7997,13 +7968,13 @@ let guard_to_string: (g.FStar_TypeChecker_Env.deferred), (g.FStar_TypeChecker_Env.univ_ineqs)) with - | (FStar_TypeChecker_Common.Trivial ,[],(uu____21649,[])) -> "{}" - | uu____21674 -> + | (FStar_TypeChecker_Common.Trivial ,[],(uu____21644,[])) -> "{}" + | uu____21669 -> let form = match g.FStar_TypeChecker_Env.guard_f with | FStar_TypeChecker_Common.Trivial -> "trivial" | FStar_TypeChecker_Common.NonTrivial f -> - let uu____21691 = + let uu____21686 = ((FStar_All.pipe_left (FStar_TypeChecker_Env.debug env) (FStar_Options.Other "Rel")) || @@ -8012,32 +7983,32 @@ let guard_to_string: || (FStar_All.pipe_left (FStar_TypeChecker_Env.debug env) FStar_Options.Extreme) in - if uu____21691 + if uu____21686 then FStar_TypeChecker_Normalize.term_to_string env f else "non-trivial" in let carry = - let uu____21694 = + let uu____21689 = FStar_List.map - (fun uu____21704 -> - match uu____21704 with - | (uu____21709,x) -> prob_to_string env x) + (fun uu____21699 -> + match uu____21699 with + | (uu____21704,x) -> prob_to_string env x) g.FStar_TypeChecker_Env.deferred in - FStar_All.pipe_right uu____21694 (FStar_String.concat ",\n") in + FStar_All.pipe_right uu____21689 (FStar_String.concat ",\n") in let imps = print_pending_implicits g in - let uu____21714 = + let uu____21709 = ineqs_to_string g.FStar_TypeChecker_Env.univ_ineqs in FStar_Util.format4 "\n\t{guard_f=%s;\n\t deferred={\n%s};\n\t univ_ineqs={%s};\n\t implicits={%s}}\n" - form carry uu____21714 imps + form carry uu____21709 imps let new_t_problem: - 'Auu____21722 . + 'Auu____21717 . FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.term -> FStar_TypeChecker_Common.rel -> FStar_Syntax_Syntax.term -> - 'Auu____21722 FStar_Pervasives_Native.option -> + 'Auu____21717 FStar_Pervasives_Native.option -> FStar_Range.range -> - (FStar_Syntax_Syntax.term,'Auu____21722) + (FStar_Syntax_Syntax.term,'Auu____21717) FStar_TypeChecker_Common.problem = fun env -> @@ -8047,17 +8018,17 @@ let new_t_problem: fun elt -> fun loc -> let reason = - let uu____21756 = + let uu____21751 = FStar_All.pipe_left (FStar_TypeChecker_Env.debug env) (FStar_Options.Other "ExplainRel") in - if uu____21756 + if uu____21751 then - let uu____21757 = + let uu____21752 = FStar_TypeChecker_Normalize.term_to_string env lhs in - let uu____21758 = + let uu____21753 = FStar_TypeChecker_Normalize.term_to_string env rhs in - FStar_Util.format3 "Top-level:\n%s\n\t%s\n%s" uu____21757 - (rel_to_string rel) uu____21758 + FStar_Util.format3 "Top-level:\n%s\n\t%s\n%s" uu____21752 + (rel_to_string rel) uu____21753 else "TOP" in let p = new_problem env lhs rel rhs elt loc reason in p let new_t_prob: @@ -8073,21 +8044,21 @@ let new_t_prob: fun rel -> fun t2 -> let x = - let uu____21782 = - let uu____21785 = FStar_TypeChecker_Env.get_range env in + let uu____21777 = + let uu____21780 = FStar_TypeChecker_Env.get_range env in FStar_All.pipe_left (fun _0_91 -> FStar_Pervasives_Native.Some _0_91) - uu____21785 in - FStar_Syntax_Syntax.new_bv uu____21782 t1 in + uu____21780 in + FStar_Syntax_Syntax.new_bv uu____21777 t1 in let env1 = FStar_TypeChecker_Env.push_bv env x in let p = - let uu____21794 = - let uu____21797 = FStar_Syntax_Syntax.bv_to_name x in + let uu____21789 = + let uu____21792 = FStar_Syntax_Syntax.bv_to_name x in FStar_All.pipe_left (fun _0_92 -> FStar_Pervasives_Native.Some _0_92) - uu____21797 in - let uu____21800 = FStar_TypeChecker_Env.get_range env1 in - new_t_problem env1 t1 rel t2 uu____21794 uu____21800 in + uu____21792 in + let uu____21795 = FStar_TypeChecker_Env.get_range env1 in + new_t_problem env1 t1 rel t2 uu____21789 uu____21795 in ((FStar_TypeChecker_Common.TProb p), x) let solve_and_commit: FStar_TypeChecker_Env.env -> @@ -8101,17 +8072,17 @@ let solve_and_commit: fun probs -> fun err -> let probs1 = - let uu____21830 = FStar_Options.eager_inference () in - if uu____21830 + let uu____21825 = FStar_Options.eager_inference () in + if uu____21825 then - let uu___160_21831 = probs in + let uu___160_21826 = probs in { - attempting = (uu___160_21831.attempting); - wl_deferred = (uu___160_21831.wl_deferred); - ctr = (uu___160_21831.ctr); + attempting = (uu___160_21826.attempting); + wl_deferred = (uu___160_21826.wl_deferred); + ctr = (uu___160_21826.ctr); defer_ok = false; - smt_ok = (uu___160_21831.smt_ok); - tcenv = (uu___160_21831.tcenv) + smt_ok = (uu___160_21826.smt_ok); + tcenv = (uu___160_21826.tcenv) } else probs in let tx = FStar_Syntax_Unionfind.new_transaction () in @@ -8121,13 +8092,13 @@ let solve_and_commit: (FStar_Syntax_Unionfind.commit tx; FStar_Pervasives_Native.Some deferred) | Failed (d,s) -> - ((let uu____21842 = + ((let uu____21837 = FStar_All.pipe_left (FStar_TypeChecker_Env.debug env) (FStar_Options.Other "ExplainRel") in - if uu____21842 + if uu____21837 then - let uu____21843 = explain env d s in - FStar_All.pipe_left FStar_Util.print_string uu____21843 + let uu____21838 = explain env d s in + FStar_All.pipe_left FStar_Util.print_string uu____21838 else ()); (let result = err (d, s) in FStar_Syntax_Unionfind.rollback tx; result)) @@ -8140,13 +8111,13 @@ let simplify_guard: match g.FStar_TypeChecker_Env.guard_f with | FStar_TypeChecker_Common.Trivial -> g | FStar_TypeChecker_Common.NonTrivial f -> - ((let uu____21857 = + ((let uu____21852 = FStar_All.pipe_left (FStar_TypeChecker_Env.debug env) (FStar_Options.Other "Simplification") in - if uu____21857 + if uu____21852 then - let uu____21858 = FStar_Syntax_Print.term_to_string f in - FStar_Util.print1 "Simplifying guard %s\n" uu____21858 + let uu____21853 = FStar_Syntax_Print.term_to_string f in + FStar_Util.print1 "Simplifying guard %s\n" uu____21853 else ()); (let f1 = FStar_TypeChecker_Normalize.normalize @@ -8155,33 +8126,33 @@ let simplify_guard: FStar_TypeChecker_Normalize.Simplify; FStar_TypeChecker_Normalize.Primops; FStar_TypeChecker_Normalize.NoFullNorm] env f in - (let uu____21862 = + (let uu____21857 = FStar_All.pipe_left (FStar_TypeChecker_Env.debug env) (FStar_Options.Other "Simplification") in - if uu____21862 + if uu____21857 then - let uu____21863 = FStar_Syntax_Print.term_to_string f1 in - FStar_Util.print1 "Simplified guard to %s\n" uu____21863 + let uu____21858 = FStar_Syntax_Print.term_to_string f1 in + FStar_Util.print1 "Simplified guard to %s\n" uu____21858 else ()); (let f2 = - let uu____21866 = - let uu____21867 = FStar_Syntax_Util.unmeta f1 in - uu____21867.FStar_Syntax_Syntax.n in - match uu____21866 with + let uu____21861 = + let uu____21862 = FStar_Syntax_Util.unmeta f1 in + uu____21862.FStar_Syntax_Syntax.n in + match uu____21861 with | FStar_Syntax_Syntax.Tm_fvar fv when FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.true_lid -> FStar_TypeChecker_Common.Trivial - | uu____21871 -> FStar_TypeChecker_Common.NonTrivial f1 in - let uu___161_21872 = g in + | uu____21866 -> FStar_TypeChecker_Common.NonTrivial f1 in + let uu___161_21867 = g in { FStar_TypeChecker_Env.guard_f = f2; FStar_TypeChecker_Env.deferred = - (uu___161_21872.FStar_TypeChecker_Env.deferred); + (uu___161_21867.FStar_TypeChecker_Env.deferred); FStar_TypeChecker_Env.univ_ineqs = - (uu___161_21872.FStar_TypeChecker_Env.univ_ineqs); + (uu___161_21867.FStar_TypeChecker_Env.univ_ineqs); FStar_TypeChecker_Env.implicits = - (uu___161_21872.FStar_TypeChecker_Env.implicits) + (uu___161_21867.FStar_TypeChecker_Env.implicits) }))) let with_guard: FStar_TypeChecker_Env.env -> @@ -8195,26 +8166,26 @@ let with_guard: match dopt with | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None | FStar_Pervasives_Native.Some d -> - let uu____21891 = - let uu____21892 = - let uu____21893 = - let uu____21894 = + let uu____21886 = + let uu____21887 = + let uu____21888 = + let uu____21889 = FStar_All.pipe_right (p_guard prob) FStar_Pervasives_Native.fst in - FStar_All.pipe_right uu____21894 + FStar_All.pipe_right uu____21889 (fun _0_93 -> FStar_TypeChecker_Common.NonTrivial _0_93) in { - FStar_TypeChecker_Env.guard_f = uu____21893; + FStar_TypeChecker_Env.guard_f = uu____21888; FStar_TypeChecker_Env.deferred = d; FStar_TypeChecker_Env.univ_ineqs = ([], []); FStar_TypeChecker_Env.implicits = [] } in - simplify_guard env uu____21892 in + simplify_guard env uu____21887 in FStar_All.pipe_left - (fun _0_94 -> FStar_Pervasives_Native.Some _0_94) uu____21891 + (fun _0_94 -> FStar_Pervasives_Native.Some _0_94) uu____21886 let with_guard_no_simp: - 'Auu____21921 . - 'Auu____21921 -> + 'Auu____21916 . + 'Auu____21916 -> FStar_TypeChecker_Common.prob -> FStar_TypeChecker_Common.deferred FStar_Pervasives_Native.option -> FStar_TypeChecker_Env.guard_t FStar_Pervasives_Native.option @@ -8225,20 +8196,20 @@ let with_guard_no_simp: match dopt with | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None | FStar_Pervasives_Native.Some d -> - let uu____21941 = - let uu____21942 = - let uu____21943 = + let uu____21936 = + let uu____21937 = + let uu____21938 = FStar_All.pipe_right (p_guard prob) FStar_Pervasives_Native.fst in - FStar_All.pipe_right uu____21943 + FStar_All.pipe_right uu____21938 (fun _0_95 -> FStar_TypeChecker_Common.NonTrivial _0_95) in { - FStar_TypeChecker_Env.guard_f = uu____21942; + FStar_TypeChecker_Env.guard_f = uu____21937; FStar_TypeChecker_Env.deferred = d; FStar_TypeChecker_Env.univ_ineqs = ([], []); FStar_TypeChecker_Env.implicits = [] } in - FStar_Pervasives_Native.Some uu____21941 + FStar_Pervasives_Native.Some uu____21936 let try_teq: Prims.bool -> FStar_TypeChecker_Env.env -> @@ -8250,30 +8221,30 @@ let try_teq: fun env -> fun t1 -> fun t2 -> - (let uu____21981 = + (let uu____21976 = FStar_All.pipe_left (FStar_TypeChecker_Env.debug env) (FStar_Options.Other "Rel") in - if uu____21981 + if uu____21976 then - let uu____21982 = FStar_Syntax_Print.term_to_string t1 in - let uu____21983 = FStar_Syntax_Print.term_to_string t2 in - FStar_Util.print2 "try_teq of %s and %s\n" uu____21982 - uu____21983 + let uu____21977 = FStar_Syntax_Print.term_to_string t1 in + let uu____21978 = FStar_Syntax_Print.term_to_string t2 in + FStar_Util.print2 "try_teq of %s and %s\n" uu____21977 + uu____21978 else ()); (let prob = - let uu____21986 = - let uu____21991 = FStar_TypeChecker_Env.get_range env in + let uu____21981 = + let uu____21986 = FStar_TypeChecker_Env.get_range env in new_t_problem env t1 FStar_TypeChecker_Common.EQ t2 - FStar_Pervasives_Native.None uu____21991 in + FStar_Pervasives_Native.None uu____21986 in FStar_All.pipe_left (fun _0_96 -> FStar_TypeChecker_Common.TProb _0_96) - uu____21986 in + uu____21981 in let g = - let uu____21999 = - let uu____22002 = singleton' env prob smt_ok in - solve_and_commit env uu____22002 - (fun uu____22004 -> FStar_Pervasives_Native.None) in - FStar_All.pipe_left (with_guard env prob) uu____21999 in + let uu____21994 = + let uu____21997 = singleton' env prob smt_ok in + solve_and_commit env uu____21997 + (fun uu____21999 -> FStar_Pervasives_Native.None) in + FStar_All.pipe_left (with_guard env prob) uu____21994 in g) let teq: FStar_TypeChecker_Env.env -> @@ -8283,27 +8254,27 @@ let teq: fun env -> fun t1 -> fun t2 -> - let uu____22022 = try_teq true env t1 t2 in - match uu____22022 with + let uu____22017 = try_teq true env t1 t2 in + match uu____22017 with | FStar_Pervasives_Native.None -> - ((let uu____22026 = FStar_TypeChecker_Env.get_range env in - let uu____22027 = + ((let uu____22021 = FStar_TypeChecker_Env.get_range env in + let uu____22022 = FStar_TypeChecker_Err.basic_type_error env FStar_Pervasives_Native.None t2 t1 in - FStar_Errors.log_issue uu____22026 uu____22027); + FStar_Errors.log_issue uu____22021 uu____22022); trivial_guard) | FStar_Pervasives_Native.Some g -> - ((let uu____22034 = + ((let uu____22029 = FStar_All.pipe_left (FStar_TypeChecker_Env.debug env) (FStar_Options.Other "Rel") in - if uu____22034 + if uu____22029 then - let uu____22035 = FStar_Syntax_Print.term_to_string t1 in - let uu____22036 = FStar_Syntax_Print.term_to_string t2 in - let uu____22037 = guard_to_string env g in + let uu____22030 = FStar_Syntax_Print.term_to_string t1 in + let uu____22031 = FStar_Syntax_Print.term_to_string t2 in + let uu____22032 = guard_to_string env g in FStar_Util.print3 - "teq of %s and %s succeeded with guard %s\n" uu____22035 - uu____22036 uu____22037 + "teq of %s and %s succeeded with guard %s\n" uu____22030 + uu____22031 uu____22032 else ()); g) let subtype_fail: @@ -8315,11 +8286,11 @@ let subtype_fail: fun e -> fun t1 -> fun t2 -> - let uu____22051 = FStar_TypeChecker_Env.get_range env in - let uu____22052 = + let uu____22046 = FStar_TypeChecker_Env.get_range env in + let uu____22047 = FStar_TypeChecker_Err.basic_type_error env (FStar_Pervasives_Native.Some e) t2 t1 in - FStar_Errors.log_issue uu____22051 uu____22052 + FStar_Errors.log_issue uu____22046 uu____22047 let sub_comp: FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.comp -> @@ -8329,32 +8300,32 @@ let sub_comp: fun env -> fun c1 -> fun c2 -> - (let uu____22069 = + (let uu____22064 = FStar_All.pipe_left (FStar_TypeChecker_Env.debug env) (FStar_Options.Other "Rel") in - if uu____22069 + if uu____22064 then - let uu____22070 = FStar_Syntax_Print.comp_to_string c1 in - let uu____22071 = FStar_Syntax_Print.comp_to_string c2 in - FStar_Util.print2 "sub_comp of %s and %s\n" uu____22070 - uu____22071 + let uu____22065 = FStar_Syntax_Print.comp_to_string c1 in + let uu____22066 = FStar_Syntax_Print.comp_to_string c2 in + FStar_Util.print2 "sub_comp of %s and %s\n" uu____22065 + uu____22066 else ()); (let rel = if env.FStar_TypeChecker_Env.use_eq then FStar_TypeChecker_Common.EQ else FStar_TypeChecker_Common.SUB in let prob = - let uu____22076 = - let uu____22081 = FStar_TypeChecker_Env.get_range env in + let uu____22071 = + let uu____22076 = FStar_TypeChecker_Env.get_range env in new_problem env c1 rel c2 FStar_Pervasives_Native.None - uu____22081 "sub_comp" in + uu____22076 "sub_comp" in FStar_All.pipe_left - (fun _0_97 -> FStar_TypeChecker_Common.CProb _0_97) uu____22076 in - let uu____22086 = - let uu____22089 = singleton env prob in - solve_and_commit env uu____22089 - (fun uu____22091 -> FStar_Pervasives_Native.None) in - FStar_All.pipe_left (with_guard env prob) uu____22086) + (fun _0_97 -> FStar_TypeChecker_Common.CProb _0_97) uu____22071 in + let uu____22081 = + let uu____22084 = singleton env prob in + solve_and_commit env uu____22084 + (fun uu____22086 -> FStar_Pervasives_Native.None) in + FStar_All.pipe_left (with_guard env prob) uu____22081) let solve_universe_inequalities': FStar_Syntax_Unionfind.tx -> FStar_TypeChecker_Env.env -> @@ -8366,87 +8337,87 @@ let solve_universe_inequalities': = fun tx -> fun env -> - fun uu____22120 -> - match uu____22120 with + fun uu____22115 -> + match uu____22115 with | (variables,ineqs) -> let fail u1 u2 = FStar_Syntax_Unionfind.rollback tx; - (let uu____22159 = - let uu____22164 = - let uu____22165 = FStar_Syntax_Print.univ_to_string u1 in - let uu____22166 = FStar_Syntax_Print.univ_to_string u2 in + (let uu____22154 = + let uu____22159 = + let uu____22160 = FStar_Syntax_Print.univ_to_string u1 in + let uu____22161 = FStar_Syntax_Print.univ_to_string u2 in FStar_Util.format2 "Universe %s and %s are incompatible" - uu____22165 uu____22166 in - (FStar_Errors.Fatal_IncompatibleUniverse, uu____22164) in - let uu____22167 = FStar_TypeChecker_Env.get_range env in - FStar_Errors.raise_error uu____22159 uu____22167) in + uu____22160 uu____22161 in + (FStar_Errors.Fatal_IncompatibleUniverse, uu____22159) in + let uu____22162 = FStar_TypeChecker_Env.get_range env in + FStar_Errors.raise_error uu____22154 uu____22162) in let equiv1 v1 v' = - let uu____22175 = - let uu____22180 = FStar_Syntax_Subst.compress_univ v1 in - let uu____22181 = FStar_Syntax_Subst.compress_univ v' in - (uu____22180, uu____22181) in - match uu____22175 with + let uu____22170 = + let uu____22175 = FStar_Syntax_Subst.compress_univ v1 in + let uu____22176 = FStar_Syntax_Subst.compress_univ v' in + (uu____22175, uu____22176) in + match uu____22170 with | (FStar_Syntax_Syntax.U_unif v0,FStar_Syntax_Syntax.U_unif v0') -> FStar_Syntax_Unionfind.univ_equiv v0 v0' - | uu____22200 -> false in + | uu____22195 -> false in let sols = FStar_All.pipe_right variables (FStar_List.collect (fun v1 -> - let uu____22230 = FStar_Syntax_Subst.compress_univ v1 in - match uu____22230 with - | FStar_Syntax_Syntax.U_unif uu____22237 -> + let uu____22225 = FStar_Syntax_Subst.compress_univ v1 in + match uu____22225 with + | FStar_Syntax_Syntax.U_unif uu____22232 -> let lower_bounds_of_v = FStar_All.pipe_right ineqs (FStar_List.collect - (fun uu____22266 -> - match uu____22266 with + (fun uu____22261 -> + match uu____22261 with | (u,v') -> - let uu____22275 = equiv1 v1 v' in - if uu____22275 + let uu____22270 = equiv1 v1 v' in + if uu____22270 then - let uu____22278 = + let uu____22273 = FStar_All.pipe_right variables (FStar_Util.for_some (equiv1 u)) in - (if uu____22278 then [] else [u]) + (if uu____22273 then [] else [u]) else [])) in let lb = FStar_TypeChecker_Normalize.normalize_universe env (FStar_Syntax_Syntax.U_max lower_bounds_of_v) in [(lb, v1)] - | uu____22294 -> [])) in - let uu____22299 = + | uu____22289 -> [])) in + let uu____22294 = let wl = - let uu___162_22303 = empty_worklist env in + let uu___162_22298 = empty_worklist env in { - attempting = (uu___162_22303.attempting); - wl_deferred = (uu___162_22303.wl_deferred); - ctr = (uu___162_22303.ctr); + attempting = (uu___162_22298.attempting); + wl_deferred = (uu___162_22298.wl_deferred); + ctr = (uu___162_22298.ctr); defer_ok = false; - smt_ok = (uu___162_22303.smt_ok); - tcenv = (uu___162_22303.tcenv) + smt_ok = (uu___162_22298.smt_ok); + tcenv = (uu___162_22298.tcenv) } in FStar_All.pipe_right sols (FStar_List.map - (fun uu____22321 -> - match uu____22321 with + (fun uu____22316 -> + match uu____22316 with | (lb,v1) -> - let uu____22328 = + let uu____22323 = solve_universe_eq (- (Prims.parse_int "1")) wl lb v1 in - (match uu____22328 with + (match uu____22323 with | USolved wl1 -> () - | uu____22330 -> fail lb v1))) in - let rec check_ineq uu____22338 = - match uu____22338 with + | uu____22325 -> fail lb v1))) in + let rec check_ineq uu____22333 = + match uu____22333 with | (u,v1) -> let u1 = FStar_TypeChecker_Normalize.normalize_universe env u in let v2 = FStar_TypeChecker_Normalize.normalize_universe env v1 in (match (u1, v2) with - | (FStar_Syntax_Syntax.U_zero ,uu____22347) -> true + | (FStar_Syntax_Syntax.U_zero ,uu____22342) -> true | (FStar_Syntax_Syntax.U_succ u0,FStar_Syntax_Syntax.U_succ v0) -> check_ineq (u0, v0) @@ -8457,66 +8428,66 @@ let solve_universe_inequalities': u0,FStar_Syntax_Syntax.U_unif v0) -> FStar_Syntax_Unionfind.univ_equiv u0 v0 | (FStar_Syntax_Syntax.U_name - uu____22370,FStar_Syntax_Syntax.U_succ v0) -> + uu____22365,FStar_Syntax_Syntax.U_succ v0) -> check_ineq (u1, v0) | (FStar_Syntax_Syntax.U_unif - uu____22372,FStar_Syntax_Syntax.U_succ v0) -> + uu____22367,FStar_Syntax_Syntax.U_succ v0) -> check_ineq (u1, v0) - | (FStar_Syntax_Syntax.U_max us,uu____22383) -> + | (FStar_Syntax_Syntax.U_max us,uu____22378) -> FStar_All.pipe_right us (FStar_Util.for_all (fun u2 -> check_ineq (u2, v2))) - | (uu____22390,FStar_Syntax_Syntax.U_max vs) -> + | (uu____22385,FStar_Syntax_Syntax.U_max vs) -> FStar_All.pipe_right vs (FStar_Util.for_some (fun v3 -> check_ineq (u1, v3))) - | uu____22398 -> false) in - let uu____22403 = + | uu____22393 -> false) in + let uu____22398 = FStar_All.pipe_right ineqs (FStar_Util.for_all - (fun uu____22418 -> - match uu____22418 with + (fun uu____22413 -> + match uu____22413 with | (u,v1) -> - let uu____22425 = check_ineq (u, v1) in - if uu____22425 + let uu____22420 = check_ineq (u, v1) in + if uu____22420 then true else - ((let uu____22428 = + ((let uu____22423 = FStar_All.pipe_left (FStar_TypeChecker_Env.debug env) (FStar_Options.Other "GenUniverses") in - if uu____22428 + if uu____22423 then - let uu____22429 = + let uu____22424 = FStar_Syntax_Print.univ_to_string u in - let uu____22430 = + let uu____22425 = FStar_Syntax_Print.univ_to_string v1 in - FStar_Util.print2 "%s (FStar_Syntax_Syntax.universe Prims.list,(FStar_Syntax_Syntax.universe, @@ -8536,53 +8507,53 @@ let rec solve_deferred_constraints: = fun env -> fun g -> - let fail uu____22504 = - match uu____22504 with + let fail uu____22499 = + match uu____22499 with | (d,s) -> let msg = explain env d s in FStar_Errors.raise_error (FStar_Errors.Fatal_ErrorInSolveDeferredConstraints, msg) (p_loc d) in let wl = wl_of_guard env g.FStar_TypeChecker_Env.deferred in - (let uu____22518 = + (let uu____22513 = FStar_All.pipe_left (FStar_TypeChecker_Env.debug env) (FStar_Options.Other "RelCheck") in - if uu____22518 + if uu____22513 then - let uu____22519 = wl_to_string wl in - let uu____22520 = + let uu____22514 = wl_to_string wl in + let uu____22515 = FStar_Util.string_of_int (FStar_List.length g.FStar_TypeChecker_Env.implicits) in FStar_Util.print2 "Trying to solve carried problems: begin\n\t%s\nend\n and %s implicits\n" - uu____22519 uu____22520 + uu____22514 uu____22515 else ()); (let g1 = - let uu____22535 = solve_and_commit env wl fail in - match uu____22535 with + let uu____22530 = solve_and_commit env wl fail in + match uu____22530 with | FStar_Pervasives_Native.Some [] -> - let uu___163_22548 = g in + let uu___163_22543 = g in { FStar_TypeChecker_Env.guard_f = - (uu___163_22548.FStar_TypeChecker_Env.guard_f); + (uu___163_22543.FStar_TypeChecker_Env.guard_f); FStar_TypeChecker_Env.deferred = []; FStar_TypeChecker_Env.univ_ineqs = - (uu___163_22548.FStar_TypeChecker_Env.univ_ineqs); + (uu___163_22543.FStar_TypeChecker_Env.univ_ineqs); FStar_TypeChecker_Env.implicits = - (uu___163_22548.FStar_TypeChecker_Env.implicits) + (uu___163_22543.FStar_TypeChecker_Env.implicits) } - | uu____22553 -> + | uu____22548 -> failwith "impossible: Unexpected deferred constraints remain" in solve_universe_inequalities env g1.FStar_TypeChecker_Env.univ_ineqs; - (let uu___164_22557 = g1 in + (let uu___164_22552 = g1 in { FStar_TypeChecker_Env.guard_f = - (uu___164_22557.FStar_TypeChecker_Env.guard_f); + (uu___164_22552.FStar_TypeChecker_Env.guard_f); FStar_TypeChecker_Env.deferred = - (uu___164_22557.FStar_TypeChecker_Env.deferred); + (uu___164_22552.FStar_TypeChecker_Env.deferred); FStar_TypeChecker_Env.univ_ineqs = ([], []); FStar_TypeChecker_Env.implicits = - (uu___164_22557.FStar_TypeChecker_Env.implicits) + (uu___164_22552.FStar_TypeChecker_Env.implicits) })) let last_proof_ns: FStar_TypeChecker_Env.proof_namespace FStar_Pervasives_Native.option @@ -8591,8 +8562,8 @@ let last_proof_ns: let maybe_update_proof_ns: FStar_TypeChecker_Env.env -> Prims.unit = fun env -> let pns = env.FStar_TypeChecker_Env.proof_ns in - let uu____22583 = FStar_ST.op_Bang last_proof_ns in - match uu____22583 with + let uu____22578 = FStar_ST.op_Bang last_proof_ns in + match uu____22578 with | FStar_Pervasives_Native.None -> FStar_ST.op_Colon_Equals last_proof_ns (FStar_Pervasives_Native.Some pns) @@ -8626,21 +8597,21 @@ let discharge_guard': (FStar_Options.Other "Tac")) in let g1 = solve_deferred_constraints env g in let ret_g = - let uu___165_22773 = g1 in + let uu___165_22768 = g1 in { FStar_TypeChecker_Env.guard_f = FStar_TypeChecker_Common.Trivial; FStar_TypeChecker_Env.deferred = - (uu___165_22773.FStar_TypeChecker_Env.deferred); + (uu___165_22768.FStar_TypeChecker_Env.deferred); FStar_TypeChecker_Env.univ_ineqs = - (uu___165_22773.FStar_TypeChecker_Env.univ_ineqs); + (uu___165_22768.FStar_TypeChecker_Env.univ_ineqs); FStar_TypeChecker_Env.implicits = - (uu___165_22773.FStar_TypeChecker_Env.implicits) + (uu___165_22768.FStar_TypeChecker_Env.implicits) } in - let uu____22774 = - let uu____22775 = FStar_TypeChecker_Env.should_verify env in - Prims.op_Negation uu____22775 in - if uu____22774 + let uu____22769 = + let uu____22770 = FStar_TypeChecker_Env.should_verify env in + Prims.op_Negation uu____22770 in + if uu____22769 then FStar_Pervasives_Native.Some ret_g else (match g1.FStar_TypeChecker_Env.guard_f with @@ -8649,12 +8620,12 @@ let discharge_guard': | FStar_TypeChecker_Common.NonTrivial vc -> (if debug1 then - (let uu____22783 = FStar_TypeChecker_Env.get_range env in - let uu____22784 = - let uu____22785 = FStar_Syntax_Print.term_to_string vc in + (let uu____22778 = FStar_TypeChecker_Env.get_range env in + let uu____22779 = + let uu____22780 = FStar_Syntax_Print.term_to_string vc in FStar_Util.format1 "Before normalization VC=\n%s\n" - uu____22785 in - FStar_Errors.diag uu____22783 uu____22784) + uu____22780 in + FStar_Errors.diag uu____22778 uu____22779) else (); (let vc1 = FStar_TypeChecker_Normalize.normalize @@ -8663,16 +8634,16 @@ let discharge_guard': FStar_TypeChecker_Normalize.Primops] env vc in if debug1 then - (let uu____22789 = FStar_TypeChecker_Env.get_range env in - let uu____22790 = - let uu____22791 = + (let uu____22784 = FStar_TypeChecker_Env.get_range env in + let uu____22785 = + let uu____22786 = FStar_Syntax_Print.term_to_string vc1 in FStar_Util.format1 "After normalization VC=\n%s\n" - uu____22791 in - FStar_Errors.diag uu____22789 uu____22790) + uu____22786 in + FStar_Errors.diag uu____22784 uu____22785) else (); - (let uu____22793 = check_trivial vc1 in - match uu____22793 with + (let uu____22788 = check_trivial vc1 in + match uu____22788 with | FStar_TypeChecker_Common.Trivial -> FStar_Pervasives_Native.Some ret_g | FStar_TypeChecker_Common.NonTrivial vc2 -> @@ -8680,59 +8651,59 @@ let discharge_guard': then (if debug1 then - (let uu____22800 = + (let uu____22795 = FStar_TypeChecker_Env.get_range env in - let uu____22801 = - let uu____22802 = + let uu____22796 = + let uu____22797 = FStar_Syntax_Print.term_to_string vc2 in FStar_Util.format1 "Cannot solve without SMT : %s\n" - uu____22802 in - FStar_Errors.diag uu____22800 uu____22801) + uu____22797 in + FStar_Errors.diag uu____22795 uu____22796) else (); FStar_Pervasives_Native.None) else (if debug1 then - (let uu____22807 = + (let uu____22802 = FStar_TypeChecker_Env.get_range env in - let uu____22808 = - let uu____22809 = + let uu____22803 = + let uu____22804 = FStar_Syntax_Print.term_to_string vc2 in FStar_Util.format1 "Checking VC=\n%s\n" - uu____22809 in - FStar_Errors.diag uu____22807 uu____22808) + uu____22804 in + FStar_Errors.diag uu____22802 uu____22803) else (); (let vcs = - let uu____22820 = FStar_Options.use_tactics () in - if uu____22820 + let uu____22815 = FStar_Options.use_tactics () in + if uu____22815 then FStar_Options.with_saved_options - (fun uu____22839 -> - (let uu____22841 = + (fun uu____22834 -> + (let uu____22836 = FStar_Options.set_options FStar_Options.Set "--no_tactics" in FStar_All.pipe_left - FStar_Pervasives.ignore uu____22841); + FStar_Pervasives.ignore uu____22836); (env.FStar_TypeChecker_Env.solver).FStar_TypeChecker_Env.preprocess env vc2) else - (let uu____22843 = - let uu____22850 = FStar_Options.peek () in - (env, vc2, uu____22850) in - [uu____22843]) in + (let uu____22838 = + let uu____22845 = FStar_Options.peek () in + (env, vc2, uu____22845) in + [uu____22838]) in FStar_All.pipe_right vcs (FStar_List.iter - (fun uu____22884 -> - match uu____22884 with + (fun uu____22879 -> + match uu____22879 with | (env1,goal,opts) -> let goal1 = FStar_TypeChecker_Normalize.normalize [FStar_TypeChecker_Normalize.Simplify; FStar_TypeChecker_Normalize.Primops] env1 goal in - let uu____22895 = check_trivial goal1 in - (match uu____22895 with + let uu____22890 = check_trivial goal1 in + (match uu____22890 with | FStar_TypeChecker_Common.Trivial -> if debug1 @@ -8747,36 +8718,36 @@ let discharge_guard': maybe_update_proof_ns env1; if debug1 then - (let uu____22903 = + (let uu____22898 = FStar_TypeChecker_Env.get_range env1 in - let uu____22904 = - let uu____22905 = + let uu____22899 = + let uu____22900 = FStar_Syntax_Print.term_to_string goal2 in - let uu____22906 = + let uu____22901 = FStar_TypeChecker_Env.string_of_proof_ns env1 in FStar_Util.format2 "Trying to solve:\n> %s\nWith proof_ns:\n %s\n" - uu____22905 uu____22906 in + uu____22900 uu____22901 in FStar_Errors.diag - uu____22903 uu____22904) + uu____22898 uu____22899) else (); if debug1 then - (let uu____22909 = + (let uu____22904 = FStar_TypeChecker_Env.get_range env1 in - let uu____22910 = - let uu____22911 = + let uu____22905 = + let uu____22906 = FStar_Syntax_Print.term_to_string goal2 in FStar_Util.format1 "Before calling solver VC=\n%s\n" - uu____22911 in + uu____22906 in FStar_Errors.diag - uu____22909 uu____22910) + uu____22904 uu____22905) else (); (env1.FStar_TypeChecker_Env.solver).FStar_TypeChecker_Env.solve use_env_range_msg env1 goal2; @@ -8788,24 +8759,24 @@ let discharge_guard_no_smt: = fun env -> fun g -> - let uu____22921 = + let uu____22916 = discharge_guard' FStar_Pervasives_Native.None env g false in - match uu____22921 with + match uu____22916 with | FStar_Pervasives_Native.Some g1 -> g1 | FStar_Pervasives_Native.None -> - let uu____22927 = FStar_TypeChecker_Env.get_range env in + let uu____22922 = FStar_TypeChecker_Env.get_range env in FStar_Errors.raise_error (FStar_Errors.Fatal_ExpectTrivialPreCondition, - "Expected a trivial pre-condition") uu____22927 + "Expected a trivial pre-condition") uu____22922 let discharge_guard: FStar_TypeChecker_Env.env -> FStar_TypeChecker_Env.guard_t -> FStar_TypeChecker_Env.guard_t = fun env -> fun g -> - let uu____22934 = + let uu____22929 = discharge_guard' FStar_Pervasives_Native.None env g true in - match uu____22934 with + match uu____22929 with | FStar_Pervasives_Native.Some g1 -> g1 | FStar_Pervasives_Native.None -> failwith @@ -8819,13 +8790,13 @@ let resolve_implicits': fun forcelax -> fun g -> let unresolved u = - let uu____22953 = FStar_Syntax_Unionfind.find u in - match uu____22953 with + let uu____22948 = FStar_Syntax_Unionfind.find u in + match uu____22948 with | FStar_Pervasives_Native.None -> true - | uu____22956 -> false in + | uu____22951 -> false in let rec until_fixpoint acc implicits = - let uu____22974 = acc in - match uu____22974 with + let uu____22969 = acc in + match uu____22969 with | (out,changed) -> (match implicits with | [] -> @@ -8833,11 +8804,11 @@ let resolve_implicits': then out else until_fixpoint ([], false) out | hd1::tl1 -> - let uu____23060 = hd1 in - (match uu____23060 with - | (uu____23073,env,u,tm,k,r) -> - let uu____23079 = unresolved u in - if uu____23079 + let uu____23055 = hd1 in + (match uu____23055 with + | (uu____23068,env,u,tm,k,r) -> + let uu____23074 = unresolved u in + if uu____23074 then until_fixpoint ((hd1 :: out), changed) tl1 else (let env1 = @@ -8845,304 +8816,304 @@ let resolve_implicits': let tm1 = FStar_TypeChecker_Normalize.normalize [FStar_TypeChecker_Normalize.Beta] env1 tm in - (let uu____23110 = + (let uu____23105 = FStar_All.pipe_left (FStar_TypeChecker_Env.debug env1) (FStar_Options.Other "RelCheck") in - if uu____23110 + if uu____23105 then - let uu____23111 = + let uu____23106 = FStar_Syntax_Print.uvar_to_string u in - let uu____23112 = + let uu____23107 = FStar_Syntax_Print.term_to_string tm1 in - let uu____23113 = + let uu____23108 = FStar_Syntax_Print.term_to_string k in FStar_Util.print3 "Checking uvar %s resolved to %s at type %s\n" - uu____23111 uu____23112 uu____23113 + uu____23106 uu____23107 uu____23108 else ()); (let env2 = if forcelax then - let uu___166_23116 = env1 in + let uu___166_23111 = env1 in { FStar_TypeChecker_Env.solver = - (uu___166_23116.FStar_TypeChecker_Env.solver); + (uu___166_23111.FStar_TypeChecker_Env.solver); FStar_TypeChecker_Env.range = - (uu___166_23116.FStar_TypeChecker_Env.range); + (uu___166_23111.FStar_TypeChecker_Env.range); FStar_TypeChecker_Env.curmodule = - (uu___166_23116.FStar_TypeChecker_Env.curmodule); + (uu___166_23111.FStar_TypeChecker_Env.curmodule); FStar_TypeChecker_Env.gamma = - (uu___166_23116.FStar_TypeChecker_Env.gamma); + (uu___166_23111.FStar_TypeChecker_Env.gamma); FStar_TypeChecker_Env.gamma_cache = - (uu___166_23116.FStar_TypeChecker_Env.gamma_cache); + (uu___166_23111.FStar_TypeChecker_Env.gamma_cache); FStar_TypeChecker_Env.modules = - (uu___166_23116.FStar_TypeChecker_Env.modules); + (uu___166_23111.FStar_TypeChecker_Env.modules); FStar_TypeChecker_Env.expected_typ = - (uu___166_23116.FStar_TypeChecker_Env.expected_typ); + (uu___166_23111.FStar_TypeChecker_Env.expected_typ); FStar_TypeChecker_Env.sigtab = - (uu___166_23116.FStar_TypeChecker_Env.sigtab); + (uu___166_23111.FStar_TypeChecker_Env.sigtab); FStar_TypeChecker_Env.is_pattern = - (uu___166_23116.FStar_TypeChecker_Env.is_pattern); + (uu___166_23111.FStar_TypeChecker_Env.is_pattern); FStar_TypeChecker_Env.instantiate_imp = - (uu___166_23116.FStar_TypeChecker_Env.instantiate_imp); + (uu___166_23111.FStar_TypeChecker_Env.instantiate_imp); FStar_TypeChecker_Env.effects = - (uu___166_23116.FStar_TypeChecker_Env.effects); + (uu___166_23111.FStar_TypeChecker_Env.effects); FStar_TypeChecker_Env.generalize = - (uu___166_23116.FStar_TypeChecker_Env.generalize); + (uu___166_23111.FStar_TypeChecker_Env.generalize); FStar_TypeChecker_Env.letrecs = - (uu___166_23116.FStar_TypeChecker_Env.letrecs); + (uu___166_23111.FStar_TypeChecker_Env.letrecs); FStar_TypeChecker_Env.top_level = - (uu___166_23116.FStar_TypeChecker_Env.top_level); + (uu___166_23111.FStar_TypeChecker_Env.top_level); FStar_TypeChecker_Env.check_uvars = - (uu___166_23116.FStar_TypeChecker_Env.check_uvars); + (uu___166_23111.FStar_TypeChecker_Env.check_uvars); FStar_TypeChecker_Env.use_eq = - (uu___166_23116.FStar_TypeChecker_Env.use_eq); + (uu___166_23111.FStar_TypeChecker_Env.use_eq); FStar_TypeChecker_Env.is_iface = - (uu___166_23116.FStar_TypeChecker_Env.is_iface); + (uu___166_23111.FStar_TypeChecker_Env.is_iface); FStar_TypeChecker_Env.admit = - (uu___166_23116.FStar_TypeChecker_Env.admit); + (uu___166_23111.FStar_TypeChecker_Env.admit); FStar_TypeChecker_Env.lax = true; FStar_TypeChecker_Env.lax_universes = - (uu___166_23116.FStar_TypeChecker_Env.lax_universes); + (uu___166_23111.FStar_TypeChecker_Env.lax_universes); FStar_TypeChecker_Env.failhard = - (uu___166_23116.FStar_TypeChecker_Env.failhard); + (uu___166_23111.FStar_TypeChecker_Env.failhard); FStar_TypeChecker_Env.nosynth = - (uu___166_23116.FStar_TypeChecker_Env.nosynth); + (uu___166_23111.FStar_TypeChecker_Env.nosynth); FStar_TypeChecker_Env.tc_term = - (uu___166_23116.FStar_TypeChecker_Env.tc_term); + (uu___166_23111.FStar_TypeChecker_Env.tc_term); FStar_TypeChecker_Env.type_of = - (uu___166_23116.FStar_TypeChecker_Env.type_of); + (uu___166_23111.FStar_TypeChecker_Env.type_of); FStar_TypeChecker_Env.universe_of = - (uu___166_23116.FStar_TypeChecker_Env.universe_of); + (uu___166_23111.FStar_TypeChecker_Env.universe_of); FStar_TypeChecker_Env.use_bv_sorts = - (uu___166_23116.FStar_TypeChecker_Env.use_bv_sorts); + (uu___166_23111.FStar_TypeChecker_Env.use_bv_sorts); FStar_TypeChecker_Env.qname_and_index = - (uu___166_23116.FStar_TypeChecker_Env.qname_and_index); + (uu___166_23111.FStar_TypeChecker_Env.qname_and_index); FStar_TypeChecker_Env.proof_ns = - (uu___166_23116.FStar_TypeChecker_Env.proof_ns); + (uu___166_23111.FStar_TypeChecker_Env.proof_ns); FStar_TypeChecker_Env.synth = - (uu___166_23116.FStar_TypeChecker_Env.synth); + (uu___166_23111.FStar_TypeChecker_Env.synth); FStar_TypeChecker_Env.is_native_tactic = - (uu___166_23116.FStar_TypeChecker_Env.is_native_tactic); + (uu___166_23111.FStar_TypeChecker_Env.is_native_tactic); FStar_TypeChecker_Env.identifier_info = - (uu___166_23116.FStar_TypeChecker_Env.identifier_info); + (uu___166_23111.FStar_TypeChecker_Env.identifier_info); FStar_TypeChecker_Env.tc_hooks = - (uu___166_23116.FStar_TypeChecker_Env.tc_hooks); + (uu___166_23111.FStar_TypeChecker_Env.tc_hooks); FStar_TypeChecker_Env.dsenv = - (uu___166_23116.FStar_TypeChecker_Env.dsenv); + (uu___166_23111.FStar_TypeChecker_Env.dsenv); FStar_TypeChecker_Env.dep_graph = - (uu___166_23116.FStar_TypeChecker_Env.dep_graph) + (uu___166_23111.FStar_TypeChecker_Env.dep_graph) } else env1 in let g1 = try if must_total then - let uu____23125 = + let uu____23120 = env2.FStar_TypeChecker_Env.type_of - (let uu___169_23133 = env2 in + (let uu___169_23128 = env2 in { FStar_TypeChecker_Env.solver = - (uu___169_23133.FStar_TypeChecker_Env.solver); + (uu___169_23128.FStar_TypeChecker_Env.solver); FStar_TypeChecker_Env.range = - (uu___169_23133.FStar_TypeChecker_Env.range); + (uu___169_23128.FStar_TypeChecker_Env.range); FStar_TypeChecker_Env.curmodule = - (uu___169_23133.FStar_TypeChecker_Env.curmodule); + (uu___169_23128.FStar_TypeChecker_Env.curmodule); FStar_TypeChecker_Env.gamma = - (uu___169_23133.FStar_TypeChecker_Env.gamma); + (uu___169_23128.FStar_TypeChecker_Env.gamma); FStar_TypeChecker_Env.gamma_cache = - (uu___169_23133.FStar_TypeChecker_Env.gamma_cache); + (uu___169_23128.FStar_TypeChecker_Env.gamma_cache); FStar_TypeChecker_Env.modules = - (uu___169_23133.FStar_TypeChecker_Env.modules); + (uu___169_23128.FStar_TypeChecker_Env.modules); FStar_TypeChecker_Env.expected_typ = - (uu___169_23133.FStar_TypeChecker_Env.expected_typ); + (uu___169_23128.FStar_TypeChecker_Env.expected_typ); FStar_TypeChecker_Env.sigtab = - (uu___169_23133.FStar_TypeChecker_Env.sigtab); + (uu___169_23128.FStar_TypeChecker_Env.sigtab); FStar_TypeChecker_Env.is_pattern = - (uu___169_23133.FStar_TypeChecker_Env.is_pattern); + (uu___169_23128.FStar_TypeChecker_Env.is_pattern); FStar_TypeChecker_Env.instantiate_imp = - (uu___169_23133.FStar_TypeChecker_Env.instantiate_imp); + (uu___169_23128.FStar_TypeChecker_Env.instantiate_imp); FStar_TypeChecker_Env.effects = - (uu___169_23133.FStar_TypeChecker_Env.effects); + (uu___169_23128.FStar_TypeChecker_Env.effects); FStar_TypeChecker_Env.generalize = - (uu___169_23133.FStar_TypeChecker_Env.generalize); + (uu___169_23128.FStar_TypeChecker_Env.generalize); FStar_TypeChecker_Env.letrecs = - (uu___169_23133.FStar_TypeChecker_Env.letrecs); + (uu___169_23128.FStar_TypeChecker_Env.letrecs); FStar_TypeChecker_Env.top_level = - (uu___169_23133.FStar_TypeChecker_Env.top_level); + (uu___169_23128.FStar_TypeChecker_Env.top_level); FStar_TypeChecker_Env.check_uvars = - (uu___169_23133.FStar_TypeChecker_Env.check_uvars); + (uu___169_23128.FStar_TypeChecker_Env.check_uvars); FStar_TypeChecker_Env.use_eq = - (uu___169_23133.FStar_TypeChecker_Env.use_eq); + (uu___169_23128.FStar_TypeChecker_Env.use_eq); FStar_TypeChecker_Env.is_iface = - (uu___169_23133.FStar_TypeChecker_Env.is_iface); + (uu___169_23128.FStar_TypeChecker_Env.is_iface); FStar_TypeChecker_Env.admit = - (uu___169_23133.FStar_TypeChecker_Env.admit); + (uu___169_23128.FStar_TypeChecker_Env.admit); FStar_TypeChecker_Env.lax = - (uu___169_23133.FStar_TypeChecker_Env.lax); + (uu___169_23128.FStar_TypeChecker_Env.lax); FStar_TypeChecker_Env.lax_universes = - (uu___169_23133.FStar_TypeChecker_Env.lax_universes); + (uu___169_23128.FStar_TypeChecker_Env.lax_universes); FStar_TypeChecker_Env.failhard = - (uu___169_23133.FStar_TypeChecker_Env.failhard); + (uu___169_23128.FStar_TypeChecker_Env.failhard); FStar_TypeChecker_Env.nosynth = - (uu___169_23133.FStar_TypeChecker_Env.nosynth); + (uu___169_23128.FStar_TypeChecker_Env.nosynth); FStar_TypeChecker_Env.tc_term = - (uu___169_23133.FStar_TypeChecker_Env.tc_term); + (uu___169_23128.FStar_TypeChecker_Env.tc_term); FStar_TypeChecker_Env.type_of = - (uu___169_23133.FStar_TypeChecker_Env.type_of); + (uu___169_23128.FStar_TypeChecker_Env.type_of); FStar_TypeChecker_Env.universe_of = - (uu___169_23133.FStar_TypeChecker_Env.universe_of); + (uu___169_23128.FStar_TypeChecker_Env.universe_of); FStar_TypeChecker_Env.use_bv_sorts = true; FStar_TypeChecker_Env.qname_and_index = - (uu___169_23133.FStar_TypeChecker_Env.qname_and_index); + (uu___169_23128.FStar_TypeChecker_Env.qname_and_index); FStar_TypeChecker_Env.proof_ns = - (uu___169_23133.FStar_TypeChecker_Env.proof_ns); + (uu___169_23128.FStar_TypeChecker_Env.proof_ns); FStar_TypeChecker_Env.synth = - (uu___169_23133.FStar_TypeChecker_Env.synth); + (uu___169_23128.FStar_TypeChecker_Env.synth); FStar_TypeChecker_Env.is_native_tactic = - (uu___169_23133.FStar_TypeChecker_Env.is_native_tactic); + (uu___169_23128.FStar_TypeChecker_Env.is_native_tactic); FStar_TypeChecker_Env.identifier_info = - (uu___169_23133.FStar_TypeChecker_Env.identifier_info); + (uu___169_23128.FStar_TypeChecker_Env.identifier_info); FStar_TypeChecker_Env.tc_hooks = - (uu___169_23133.FStar_TypeChecker_Env.tc_hooks); + (uu___169_23128.FStar_TypeChecker_Env.tc_hooks); FStar_TypeChecker_Env.dsenv = - (uu___169_23133.FStar_TypeChecker_Env.dsenv); + (uu___169_23128.FStar_TypeChecker_Env.dsenv); FStar_TypeChecker_Env.dep_graph = - (uu___169_23133.FStar_TypeChecker_Env.dep_graph) + (uu___169_23128.FStar_TypeChecker_Env.dep_graph) }) tm1 in - match uu____23125 with - | (uu____23134,uu____23135,g1) -> g1 + match uu____23120 with + | (uu____23129,uu____23130,g1) -> g1 else - (let uu____23138 = + (let uu____23133 = env2.FStar_TypeChecker_Env.tc_term - (let uu___170_23146 = env2 in + (let uu___170_23141 = env2 in { FStar_TypeChecker_Env.solver = - (uu___170_23146.FStar_TypeChecker_Env.solver); + (uu___170_23141.FStar_TypeChecker_Env.solver); FStar_TypeChecker_Env.range = - (uu___170_23146.FStar_TypeChecker_Env.range); + (uu___170_23141.FStar_TypeChecker_Env.range); FStar_TypeChecker_Env.curmodule = - (uu___170_23146.FStar_TypeChecker_Env.curmodule); + (uu___170_23141.FStar_TypeChecker_Env.curmodule); FStar_TypeChecker_Env.gamma = - (uu___170_23146.FStar_TypeChecker_Env.gamma); + (uu___170_23141.FStar_TypeChecker_Env.gamma); FStar_TypeChecker_Env.gamma_cache = - (uu___170_23146.FStar_TypeChecker_Env.gamma_cache); + (uu___170_23141.FStar_TypeChecker_Env.gamma_cache); FStar_TypeChecker_Env.modules = - (uu___170_23146.FStar_TypeChecker_Env.modules); + (uu___170_23141.FStar_TypeChecker_Env.modules); FStar_TypeChecker_Env.expected_typ = - (uu___170_23146.FStar_TypeChecker_Env.expected_typ); + (uu___170_23141.FStar_TypeChecker_Env.expected_typ); FStar_TypeChecker_Env.sigtab = - (uu___170_23146.FStar_TypeChecker_Env.sigtab); + (uu___170_23141.FStar_TypeChecker_Env.sigtab); FStar_TypeChecker_Env.is_pattern = - (uu___170_23146.FStar_TypeChecker_Env.is_pattern); + (uu___170_23141.FStar_TypeChecker_Env.is_pattern); FStar_TypeChecker_Env.instantiate_imp = - (uu___170_23146.FStar_TypeChecker_Env.instantiate_imp); + (uu___170_23141.FStar_TypeChecker_Env.instantiate_imp); FStar_TypeChecker_Env.effects = - (uu___170_23146.FStar_TypeChecker_Env.effects); + (uu___170_23141.FStar_TypeChecker_Env.effects); FStar_TypeChecker_Env.generalize = - (uu___170_23146.FStar_TypeChecker_Env.generalize); + (uu___170_23141.FStar_TypeChecker_Env.generalize); FStar_TypeChecker_Env.letrecs = - (uu___170_23146.FStar_TypeChecker_Env.letrecs); + (uu___170_23141.FStar_TypeChecker_Env.letrecs); FStar_TypeChecker_Env.top_level = - (uu___170_23146.FStar_TypeChecker_Env.top_level); + (uu___170_23141.FStar_TypeChecker_Env.top_level); FStar_TypeChecker_Env.check_uvars = - (uu___170_23146.FStar_TypeChecker_Env.check_uvars); + (uu___170_23141.FStar_TypeChecker_Env.check_uvars); FStar_TypeChecker_Env.use_eq = - (uu___170_23146.FStar_TypeChecker_Env.use_eq); + (uu___170_23141.FStar_TypeChecker_Env.use_eq); FStar_TypeChecker_Env.is_iface = - (uu___170_23146.FStar_TypeChecker_Env.is_iface); + (uu___170_23141.FStar_TypeChecker_Env.is_iface); FStar_TypeChecker_Env.admit = - (uu___170_23146.FStar_TypeChecker_Env.admit); + (uu___170_23141.FStar_TypeChecker_Env.admit); FStar_TypeChecker_Env.lax = - (uu___170_23146.FStar_TypeChecker_Env.lax); + (uu___170_23141.FStar_TypeChecker_Env.lax); FStar_TypeChecker_Env.lax_universes = - (uu___170_23146.FStar_TypeChecker_Env.lax_universes); + (uu___170_23141.FStar_TypeChecker_Env.lax_universes); FStar_TypeChecker_Env.failhard = - (uu___170_23146.FStar_TypeChecker_Env.failhard); + (uu___170_23141.FStar_TypeChecker_Env.failhard); FStar_TypeChecker_Env.nosynth = - (uu___170_23146.FStar_TypeChecker_Env.nosynth); + (uu___170_23141.FStar_TypeChecker_Env.nosynth); FStar_TypeChecker_Env.tc_term = - (uu___170_23146.FStar_TypeChecker_Env.tc_term); + (uu___170_23141.FStar_TypeChecker_Env.tc_term); FStar_TypeChecker_Env.type_of = - (uu___170_23146.FStar_TypeChecker_Env.type_of); + (uu___170_23141.FStar_TypeChecker_Env.type_of); FStar_TypeChecker_Env.universe_of = - (uu___170_23146.FStar_TypeChecker_Env.universe_of); + (uu___170_23141.FStar_TypeChecker_Env.universe_of); FStar_TypeChecker_Env.use_bv_sorts = true; FStar_TypeChecker_Env.qname_and_index = - (uu___170_23146.FStar_TypeChecker_Env.qname_and_index); + (uu___170_23141.FStar_TypeChecker_Env.qname_and_index); FStar_TypeChecker_Env.proof_ns = - (uu___170_23146.FStar_TypeChecker_Env.proof_ns); + (uu___170_23141.FStar_TypeChecker_Env.proof_ns); FStar_TypeChecker_Env.synth = - (uu___170_23146.FStar_TypeChecker_Env.synth); + (uu___170_23141.FStar_TypeChecker_Env.synth); FStar_TypeChecker_Env.is_native_tactic = - (uu___170_23146.FStar_TypeChecker_Env.is_native_tactic); + (uu___170_23141.FStar_TypeChecker_Env.is_native_tactic); FStar_TypeChecker_Env.identifier_info = - (uu___170_23146.FStar_TypeChecker_Env.identifier_info); + (uu___170_23141.FStar_TypeChecker_Env.identifier_info); FStar_TypeChecker_Env.tc_hooks = - (uu___170_23146.FStar_TypeChecker_Env.tc_hooks); + (uu___170_23141.FStar_TypeChecker_Env.tc_hooks); FStar_TypeChecker_Env.dsenv = - (uu___170_23146.FStar_TypeChecker_Env.dsenv); + (uu___170_23141.FStar_TypeChecker_Env.dsenv); FStar_TypeChecker_Env.dep_graph = - (uu___170_23146.FStar_TypeChecker_Env.dep_graph) + (uu___170_23141.FStar_TypeChecker_Env.dep_graph) }) tm1 in - match uu____23138 with - | (uu____23147,uu____23148,g1) -> g1) + match uu____23133 with + | (uu____23142,uu____23143,g1) -> g1) with | e -> - ((let uu____23156 = - let uu____23165 = - let uu____23172 = - let uu____23173 = + ((let uu____23151 = + let uu____23160 = + let uu____23167 = + let uu____23168 = FStar_Syntax_Print.uvar_to_string u in - let uu____23174 = + let uu____23169 = FStar_TypeChecker_Normalize.term_to_string env2 tm1 in FStar_Util.format2 "Failed while checking implicit %s set to %s" - uu____23173 uu____23174 in + uu____23168 uu____23169 in (FStar_Errors.Error_BadImplicit, - uu____23172, r) in - [uu____23165] in - FStar_Errors.add_errors uu____23156); + uu____23167, r) in + [uu____23160] in + FStar_Errors.add_errors uu____23151); FStar_Exn.raise e) in let g2 = if env2.FStar_TypeChecker_Env.is_pattern then - let uu___171_23188 = g1 in + let uu___171_23183 = g1 in { FStar_TypeChecker_Env.guard_f = FStar_TypeChecker_Common.Trivial; FStar_TypeChecker_Env.deferred = - (uu___171_23188.FStar_TypeChecker_Env.deferred); + (uu___171_23183.FStar_TypeChecker_Env.deferred); FStar_TypeChecker_Env.univ_ineqs = - (uu___171_23188.FStar_TypeChecker_Env.univ_ineqs); + (uu___171_23183.FStar_TypeChecker_Env.univ_ineqs); FStar_TypeChecker_Env.implicits = - (uu___171_23188.FStar_TypeChecker_Env.implicits) + (uu___171_23183.FStar_TypeChecker_Env.implicits) } else g1 in let g' = - let uu____23191 = + let uu____23186 = discharge_guard' (FStar_Pervasives_Native.Some - (fun uu____23197 -> + (fun uu____23192 -> FStar_Syntax_Print.term_to_string tm1)) env2 g2 true in - match uu____23191 with + match uu____23186 with | FStar_Pervasives_Native.Some g3 -> g3 | FStar_Pervasives_Native.None -> failwith @@ -9151,17 +9122,17 @@ let resolve_implicits': ((FStar_List.append g'.FStar_TypeChecker_Env.implicits out), true) tl1)))) in - let uu___172_23225 = g in - let uu____23226 = + let uu___172_23220 = g in + let uu____23221 = until_fixpoint ([], false) g.FStar_TypeChecker_Env.implicits in { FStar_TypeChecker_Env.guard_f = - (uu___172_23225.FStar_TypeChecker_Env.guard_f); + (uu___172_23220.FStar_TypeChecker_Env.guard_f); FStar_TypeChecker_Env.deferred = - (uu___172_23225.FStar_TypeChecker_Env.deferred); + (uu___172_23220.FStar_TypeChecker_Env.deferred); FStar_TypeChecker_Env.univ_ineqs = - (uu___172_23225.FStar_TypeChecker_Env.univ_ineqs); - FStar_TypeChecker_Env.implicits = uu____23226 + (uu___172_23220.FStar_TypeChecker_Env.univ_ineqs); + FStar_TypeChecker_Env.implicits = uu____23221 } let resolve_implicits: FStar_TypeChecker_Env.guard_t -> FStar_TypeChecker_Env.guard_t = @@ -9174,46 +9145,46 @@ let force_trivial_guard: fun env -> fun g -> let g1 = - let uu____23280 = solve_deferred_constraints env g in - FStar_All.pipe_right uu____23280 resolve_implicits in + let uu____23275 = solve_deferred_constraints env g in + FStar_All.pipe_right uu____23275 resolve_implicits in match g1.FStar_TypeChecker_Env.implicits with | [] -> - let uu____23293 = discharge_guard env g1 in - FStar_All.pipe_left FStar_Pervasives.ignore uu____23293 - | (reason,uu____23295,uu____23296,e,t,r)::uu____23300 -> - let uu____23327 = - let uu____23332 = - let uu____23333 = FStar_Syntax_Print.term_to_string t in - let uu____23334 = FStar_Syntax_Print.term_to_string e in + let uu____23288 = discharge_guard env g1 in + FStar_All.pipe_left FStar_Pervasives.ignore uu____23288 + | (reason,uu____23290,uu____23291,e,t,r)::uu____23295 -> + let uu____23322 = + let uu____23327 = + let uu____23328 = FStar_Syntax_Print.term_to_string t in + let uu____23329 = FStar_Syntax_Print.term_to_string e in FStar_Util.format2 "Failed to resolve implicit argument of type '%s' introduced in %s" - uu____23333 uu____23334 in - (FStar_Errors.Fatal_FailToResolveImplicitArgument, uu____23332) in - FStar_Errors.raise_error uu____23327 r + uu____23328 uu____23329 in + (FStar_Errors.Fatal_FailToResolveImplicitArgument, uu____23327) in + FStar_Errors.raise_error uu____23322 r let universe_inequality: FStar_Syntax_Syntax.universe -> FStar_Syntax_Syntax.universe -> FStar_TypeChecker_Env.guard_t = fun u1 -> fun u2 -> - let uu___173_23341 = trivial_guard in + let uu___173_23336 = trivial_guard in { FStar_TypeChecker_Env.guard_f = - (uu___173_23341.FStar_TypeChecker_Env.guard_f); + (uu___173_23336.FStar_TypeChecker_Env.guard_f); FStar_TypeChecker_Env.deferred = - (uu___173_23341.FStar_TypeChecker_Env.deferred); + (uu___173_23336.FStar_TypeChecker_Env.deferred); FStar_TypeChecker_Env.univ_ineqs = ([], [(u1, u2)]); FStar_TypeChecker_Env.implicits = - (uu___173_23341.FStar_TypeChecker_Env.implicits) + (uu___173_23336.FStar_TypeChecker_Env.implicits) } let discharge_guard_nosmt: FStar_TypeChecker_Env.env -> FStar_TypeChecker_Env.guard_t -> Prims.bool = fun env -> fun g -> - let uu____23364 = + let uu____23359 = discharge_guard' FStar_Pervasives_Native.None env g false in - match uu____23364 with - | FStar_Pervasives_Native.Some uu____23369 -> true + match uu____23359 with + | FStar_Pervasives_Native.Some uu____23364 -> true | FStar_Pervasives_Native.None -> false let teq_nosmt: FStar_TypeChecker_Env.env -> @@ -9222,8 +9193,8 @@ let teq_nosmt: fun env -> fun t1 -> fun t2 -> - let uu____23379 = try_teq false env t1 t2 in - match uu____23379 with + let uu____23374 = try_teq false env t1 t2 in + match uu____23374 with | FStar_Pervasives_Native.None -> false | FStar_Pervasives_Native.Some g -> discharge_guard_nosmt env g let check_subtyping: @@ -9236,43 +9207,43 @@ let check_subtyping: fun env -> fun t1 -> fun t2 -> - (let uu____23399 = + (let uu____23394 = FStar_All.pipe_left (FStar_TypeChecker_Env.debug env) (FStar_Options.Other "Rel") in - if uu____23399 + if uu____23394 then - let uu____23400 = + let uu____23395 = FStar_TypeChecker_Normalize.term_to_string env t1 in - let uu____23401 = + let uu____23396 = FStar_TypeChecker_Normalize.term_to_string env t2 in - FStar_Util.print2 "check_subtyping of %s and %s\n" uu____23400 - uu____23401 + FStar_Util.print2 "check_subtyping of %s and %s\n" uu____23395 + uu____23396 else ()); - (let uu____23403 = new_t_prob env t1 FStar_TypeChecker_Common.SUB t2 in - match uu____23403 with + (let uu____23398 = new_t_prob env t1 FStar_TypeChecker_Common.SUB t2 in + match uu____23398 with | (prob,x) -> let g = - let uu____23419 = - let uu____23422 = singleton' env prob true in - solve_and_commit env uu____23422 - (fun uu____23424 -> FStar_Pervasives_Native.None) in - FStar_All.pipe_left (with_guard env prob) uu____23419 in - ((let uu____23434 = + let uu____23414 = + let uu____23417 = singleton' env prob true in + solve_and_commit env uu____23417 + (fun uu____23419 -> FStar_Pervasives_Native.None) in + FStar_All.pipe_left (with_guard env prob) uu____23414 in + ((let uu____23429 = (FStar_All.pipe_left (FStar_TypeChecker_Env.debug env) (FStar_Options.Other "Rel")) && (FStar_Util.is_some g) in - if uu____23434 + if uu____23429 then - let uu____23435 = + let uu____23430 = FStar_TypeChecker_Normalize.term_to_string env t1 in - let uu____23436 = + let uu____23431 = FStar_TypeChecker_Normalize.term_to_string env t2 in - let uu____23437 = - let uu____23438 = FStar_Util.must g in - guard_to_string env uu____23438 in + let uu____23432 = + let uu____23433 = FStar_Util.must g in + guard_to_string env uu____23433 in FStar_Util.print3 "check_subtyping succeeded: %s <: %s\n\tguard is %s\n" - uu____23435 uu____23436 uu____23437 + uu____23430 uu____23431 uu____23432 else ()); (match g with | FStar_Pervasives_Native.None -> @@ -9288,14 +9259,14 @@ let get_subtyping_predicate: fun env -> fun t1 -> fun t2 -> - let uu____23466 = check_subtyping env t1 t2 in - match uu____23466 with + let uu____23461 = check_subtyping env t1 t2 in + match uu____23461 with | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None | FStar_Pervasives_Native.Some (x,g) -> - let uu____23485 = - let uu____23486 = FStar_Syntax_Syntax.mk_binder x in - abstract_guard uu____23486 g in - FStar_Pervasives_Native.Some uu____23485 + let uu____23480 = + let uu____23481 = FStar_Syntax_Syntax.mk_binder x in + abstract_guard uu____23481 g in + FStar_Pervasives_Native.Some uu____23480 let get_subtyping_prop: FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.typ -> @@ -9305,16 +9276,16 @@ let get_subtyping_prop: fun env -> fun t1 -> fun t2 -> - let uu____23498 = check_subtyping env t1 t2 in - match uu____23498 with + let uu____23493 = check_subtyping env t1 t2 in + match uu____23493 with | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None | FStar_Pervasives_Native.Some (x,g) -> - let uu____23517 = - let uu____23518 = - let uu____23519 = FStar_Syntax_Syntax.mk_binder x in - [uu____23519] in - close_guard env uu____23518 g in - FStar_Pervasives_Native.Some uu____23517 + let uu____23512 = + let uu____23513 = + let uu____23514 = FStar_Syntax_Syntax.mk_binder x in + [uu____23514] in + close_guard env uu____23513 g in + FStar_Pervasives_Native.Some uu____23512 let subtype_nosmt: FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.typ -> FStar_Syntax_Syntax.typ -> Prims.bool @@ -9322,33 +9293,33 @@ let subtype_nosmt: fun env -> fun t1 -> fun t2 -> - (let uu____23530 = + (let uu____23525 = FStar_All.pipe_left (FStar_TypeChecker_Env.debug env) (FStar_Options.Other "Rel") in - if uu____23530 + if uu____23525 then - let uu____23531 = + let uu____23526 = FStar_TypeChecker_Normalize.term_to_string env t1 in - let uu____23532 = + let uu____23527 = FStar_TypeChecker_Normalize.term_to_string env t2 in - FStar_Util.print2 "try_subtype_no_smt of %s and %s\n" uu____23531 - uu____23532 + FStar_Util.print2 "try_subtype_no_smt of %s and %s\n" uu____23526 + uu____23527 else ()); - (let uu____23534 = new_t_prob env t1 FStar_TypeChecker_Common.SUB t2 in - match uu____23534 with + (let uu____23529 = new_t_prob env t1 FStar_TypeChecker_Common.SUB t2 in + match uu____23529 with | (prob,x) -> let g = - let uu____23544 = - let uu____23547 = singleton' env prob false in - solve_and_commit env uu____23547 - (fun uu____23549 -> FStar_Pervasives_Native.None) in - FStar_All.pipe_left (with_guard env prob) uu____23544 in + let uu____23539 = + let uu____23542 = singleton' env prob false in + solve_and_commit env uu____23542 + (fun uu____23544 -> FStar_Pervasives_Native.None) in + FStar_All.pipe_left (with_guard env prob) uu____23539 in (match g with | FStar_Pervasives_Native.None -> false | FStar_Pervasives_Native.Some g1 -> let g2 = - let uu____23560 = - let uu____23561 = FStar_Syntax_Syntax.mk_binder x in - [uu____23561] in - close_guard env uu____23560 g1 in + let uu____23555 = + let uu____23556 = FStar_Syntax_Syntax.mk_binder x in + [uu____23556] in + close_guard env uu____23555 g1 in discharge_guard_nosmt env g2)) \ No newline at end of file diff --git a/src/ocaml-output/FStar_TypeChecker_Tc.ml b/src/ocaml-output/FStar_TypeChecker_Tc.ml index b7956c81b8f..eb963182ac0 100644 --- a/src/ocaml-output/FStar_TypeChecker_Tc.ml +++ b/src/ocaml-output/FStar_TypeChecker_Tc.ml @@ -4124,28 +4124,28 @@ let tc_decl: FStar_Syntax_Util.ml_comp FStar_Syntax_Syntax.t_unit r in FStar_Pervasives_Native.Some uu____5959 in let uu____5960 = - let uu____5965 = c.FStar_Syntax_Syntax.comp () in + let uu____5965 = FStar_Syntax_Syntax.lcomp_comp c in (e1, uu____5965) in FStar_TypeChecker_TcTerm.check_expected_effect env3 uu____5956 uu____5960 in (match uu____5949 with - | (e2,uu____5979,g) -> - ((let uu____5982 = FStar_TypeChecker_Rel.conj_guard g1 g in + | (e2,uu____5975,g) -> + ((let uu____5978 = FStar_TypeChecker_Rel.conj_guard g1 g in FStar_TypeChecker_Rel.force_trivial_guard env3 - uu____5982); + uu____5978); (let se1 = - let uu___81_5984 = se in + let uu___81_5980 = se in { FStar_Syntax_Syntax.sigel = (FStar_Syntax_Syntax.Sig_main e2); FStar_Syntax_Syntax.sigrng = - (uu___81_5984.FStar_Syntax_Syntax.sigrng); + (uu___81_5980.FStar_Syntax_Syntax.sigrng); FStar_Syntax_Syntax.sigquals = - (uu___81_5984.FStar_Syntax_Syntax.sigquals); + (uu___81_5980.FStar_Syntax_Syntax.sigquals); FStar_Syntax_Syntax.sigmeta = - (uu___81_5984.FStar_Syntax_Syntax.sigmeta); + (uu___81_5980.FStar_Syntax_Syntax.sigmeta); FStar_Syntax_Syntax.sigattrs = - (uu___81_5984.FStar_Syntax_Syntax.sigattrs) + (uu___81_5980.FStar_Syntax_Syntax.sigattrs) } in ([se1], []))))) | FStar_Syntax_Syntax.Sig_let (lbs,lids) -> @@ -4155,113 +4155,113 @@ let tc_decl: | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.Some q | FStar_Pervasives_Native.Some q' -> - let uu____6035 = + let uu____6031 = ((FStar_List.length q) = (FStar_List.length q')) && (FStar_List.forall2 FStar_Syntax_Util.qualifier_equal q q') in - if uu____6035 + if uu____6031 then FStar_Pervasives_Native.Some q else - (let uu____6043 = - let uu____6048 = - let uu____6049 = FStar_Syntax_Print.lid_to_string l in - let uu____6050 = FStar_Syntax_Print.quals_to_string q in - let uu____6051 = + (let uu____6039 = + let uu____6044 = + let uu____6045 = FStar_Syntax_Print.lid_to_string l in + let uu____6046 = FStar_Syntax_Print.quals_to_string q in + let uu____6047 = FStar_Syntax_Print.quals_to_string q' in FStar_Util.format3 "Inconsistent qualifier annotations on %s; Expected {%s}, got {%s}" - uu____6049 uu____6050 uu____6051 in + uu____6045 uu____6046 uu____6047 in (FStar_Errors.Fatal_InconsistentQualifierAnnotation, - uu____6048) in - FStar_Errors.raise_error uu____6043 r) in + uu____6044) in + FStar_Errors.raise_error uu____6039 r) in let rename_parameters lb = let rename_in_typ def typ = let typ1 = FStar_Syntax_Subst.compress typ in let def_bs = - let uu____6077 = - let uu____6078 = FStar_Syntax_Subst.compress def in - uu____6078.FStar_Syntax_Syntax.n in - match uu____6077 with - | FStar_Syntax_Syntax.Tm_abs (binders,uu____6088,uu____6089) + let uu____6073 = + let uu____6074 = FStar_Syntax_Subst.compress def in + uu____6074.FStar_Syntax_Syntax.n in + match uu____6073 with + | FStar_Syntax_Syntax.Tm_abs (binders,uu____6084,uu____6085) -> binders - | uu____6110 -> [] in + | uu____6106 -> [] in match typ1 with | { FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_arrow (val_bs,c); FStar_Syntax_Syntax.pos = r1; - FStar_Syntax_Syntax.vars = uu____6120;_} -> + FStar_Syntax_Syntax.vars = uu____6116;_} -> let has_auto_name bv = FStar_Util.starts_with (bv.FStar_Syntax_Syntax.ppname).FStar_Ident.idText FStar_Ident.reserved_prefix in let rec rename_binders1 def_bs1 val_bs1 = match (def_bs1, val_bs1) with - | ([],uu____6198) -> val_bs1 - | (uu____6221,[]) -> val_bs1 - | ((body_bv,uu____6245)::bt,(val_bv,aqual)::vt) -> - let uu____6282 = rename_binders1 bt vt in + | ([],uu____6194) -> val_bs1 + | (uu____6217,[]) -> val_bs1 + | ((body_bv,uu____6241)::bt,(val_bv,aqual)::vt) -> + let uu____6278 = rename_binders1 bt vt in ((match ((has_auto_name body_bv), (has_auto_name val_bv)) with - | (true ,uu____6298) -> (val_bv, aqual) + | (true ,uu____6294) -> (val_bv, aqual) | (false ,true ) -> - ((let uu___82_6300 = val_bv in + ((let uu___82_6296 = val_bv in { FStar_Syntax_Syntax.ppname = - (let uu___83_6303 = + (let uu___83_6299 = val_bv.FStar_Syntax_Syntax.ppname in { FStar_Ident.idText = ((body_bv.FStar_Syntax_Syntax.ppname).FStar_Ident.idText); FStar_Ident.idRange = - (uu___83_6303.FStar_Ident.idRange) + (uu___83_6299.FStar_Ident.idRange) }); FStar_Syntax_Syntax.index = - (uu___82_6300.FStar_Syntax_Syntax.index); + (uu___82_6296.FStar_Syntax_Syntax.index); FStar_Syntax_Syntax.sort = - (uu___82_6300.FStar_Syntax_Syntax.sort) + (uu___82_6296.FStar_Syntax_Syntax.sort) }), aqual) | (false ,false ) -> (val_bv, aqual))) :: - uu____6282 in - let uu____6304 = - let uu____6307 = - let uu____6308 = - let uu____6321 = rename_binders1 def_bs val_bs in - (uu____6321, c) in - FStar_Syntax_Syntax.Tm_arrow uu____6308 in - FStar_Syntax_Syntax.mk uu____6307 in - uu____6304 FStar_Pervasives_Native.None r1 - | uu____6339 -> typ1 in - let uu___84_6340 = lb in - let uu____6341 = + uu____6278 in + let uu____6300 = + let uu____6303 = + let uu____6304 = + let uu____6317 = rename_binders1 def_bs val_bs in + (uu____6317, c) in + FStar_Syntax_Syntax.Tm_arrow uu____6304 in + FStar_Syntax_Syntax.mk uu____6303 in + uu____6300 FStar_Pervasives_Native.None r1 + | uu____6335 -> typ1 in + let uu___84_6336 = lb in + let uu____6337 = rename_in_typ lb.FStar_Syntax_Syntax.lbdef lb.FStar_Syntax_Syntax.lbtyp in { FStar_Syntax_Syntax.lbname = - (uu___84_6340.FStar_Syntax_Syntax.lbname); + (uu___84_6336.FStar_Syntax_Syntax.lbname); FStar_Syntax_Syntax.lbunivs = - (uu___84_6340.FStar_Syntax_Syntax.lbunivs); - FStar_Syntax_Syntax.lbtyp = uu____6341; + (uu___84_6336.FStar_Syntax_Syntax.lbunivs); + FStar_Syntax_Syntax.lbtyp = uu____6337; FStar_Syntax_Syntax.lbeff = - (uu___84_6340.FStar_Syntax_Syntax.lbeff); + (uu___84_6336.FStar_Syntax_Syntax.lbeff); FStar_Syntax_Syntax.lbdef = - (uu___84_6340.FStar_Syntax_Syntax.lbdef) + (uu___84_6336.FStar_Syntax_Syntax.lbdef) } in - let uu____6344 = + let uu____6340 = FStar_All.pipe_right (FStar_Pervasives_Native.snd lbs) (FStar_List.fold_left - (fun uu____6395 -> + (fun uu____6391 -> fun lb -> - match uu____6395 with + match uu____6391 with | (gen1,lbs1,quals_opt) -> let lbname = FStar_Util.right lb.FStar_Syntax_Syntax.lbname in - let uu____6437 = - let uu____6448 = + let uu____6433 = + let uu____6444 = FStar_TypeChecker_Env.try_lookup_val_decl env2 (lbname.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in - match uu____6448 with + match uu____6444 with | FStar_Pervasives_Native.None -> if lb.FStar_Syntax_Syntax.lbunivs <> [] then (false, lb, quals_opt) @@ -4277,7 +4277,7 @@ let tc_decl: with | FStar_Syntax_Syntax.Tm_unknown -> lb.FStar_Syntax_Syntax.lbdef - | uu____6533 -> + | uu____6529 -> FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_ascribed ((lb.FStar_Syntax_Syntax.lbdef), @@ -4298,13 +4298,13 @@ let tc_decl: "Inline universes are incoherent with annotation from val declaration") r else (); - (let uu____6576 = + (let uu____6572 = FStar_Syntax_Syntax.mk_lb ((FStar_Util.Inr lbname), uvs, FStar_Parser_Const.effect_ALL_lid, tval, def) in - (false, uu____6576, quals_opt1))) in - (match uu____6437 with + (false, uu____6572, quals_opt1))) in + (match uu____6433 with | (gen2,lb1,quals_opt1) -> (gen2, (lb1 :: lbs1), quals_opt1))) (true, [], @@ -4313,150 +4313,150 @@ let tc_decl: else FStar_Pervasives_Native.Some (se.FStar_Syntax_Syntax.sigquals)))) in - (match uu____6344 with + (match uu____6340 with | (should_generalize,lbs',quals_opt) -> let quals = match quals_opt with | FStar_Pervasives_Native.None -> [FStar_Syntax_Syntax.Visible_default] | FStar_Pervasives_Native.Some q -> - let uu____6670 = + let uu____6666 = FStar_All.pipe_right q (FStar_Util.for_some - (fun uu___55_6674 -> - match uu___55_6674 with + (fun uu___55_6670 -> + match uu___55_6670 with | FStar_Syntax_Syntax.Irreducible -> true | FStar_Syntax_Syntax.Visible_default -> true | FStar_Syntax_Syntax.Unfold_for_unification_and_vcgen -> true - | uu____6675 -> false)) in - if uu____6670 + | uu____6671 -> false)) in + if uu____6666 then q else FStar_Syntax_Syntax.Visible_default :: q in let lbs'1 = FStar_List.rev lbs' in let e = - let uu____6685 = - let uu____6688 = - let uu____6689 = - let uu____6702 = + let uu____6681 = + let uu____6684 = + let uu____6685 = + let uu____6698 = FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_constant FStar_Const.Const_unit) FStar_Pervasives_Native.None r in (((FStar_Pervasives_Native.fst lbs), lbs'1), - uu____6702) in - FStar_Syntax_Syntax.Tm_let uu____6689 in - FStar_Syntax_Syntax.mk uu____6688 in - uu____6685 FStar_Pervasives_Native.None r in - let uu____6720 = - let uu____6731 = + uu____6698) in + FStar_Syntax_Syntax.Tm_let uu____6685 in + FStar_Syntax_Syntax.mk uu____6684 in + uu____6681 FStar_Pervasives_Native.None r in + let uu____6716 = + let uu____6727 = FStar_TypeChecker_TcTerm.tc_maybe_toplevel_term - (let uu___85_6740 = env2 in + (let uu___85_6736 = env2 in { FStar_TypeChecker_Env.solver = - (uu___85_6740.FStar_TypeChecker_Env.solver); + (uu___85_6736.FStar_TypeChecker_Env.solver); FStar_TypeChecker_Env.range = - (uu___85_6740.FStar_TypeChecker_Env.range); + (uu___85_6736.FStar_TypeChecker_Env.range); FStar_TypeChecker_Env.curmodule = - (uu___85_6740.FStar_TypeChecker_Env.curmodule); + (uu___85_6736.FStar_TypeChecker_Env.curmodule); FStar_TypeChecker_Env.gamma = - (uu___85_6740.FStar_TypeChecker_Env.gamma); + (uu___85_6736.FStar_TypeChecker_Env.gamma); FStar_TypeChecker_Env.gamma_cache = - (uu___85_6740.FStar_TypeChecker_Env.gamma_cache); + (uu___85_6736.FStar_TypeChecker_Env.gamma_cache); FStar_TypeChecker_Env.modules = - (uu___85_6740.FStar_TypeChecker_Env.modules); + (uu___85_6736.FStar_TypeChecker_Env.modules); FStar_TypeChecker_Env.expected_typ = - (uu___85_6740.FStar_TypeChecker_Env.expected_typ); + (uu___85_6736.FStar_TypeChecker_Env.expected_typ); FStar_TypeChecker_Env.sigtab = - (uu___85_6740.FStar_TypeChecker_Env.sigtab); + (uu___85_6736.FStar_TypeChecker_Env.sigtab); FStar_TypeChecker_Env.is_pattern = - (uu___85_6740.FStar_TypeChecker_Env.is_pattern); + (uu___85_6736.FStar_TypeChecker_Env.is_pattern); FStar_TypeChecker_Env.instantiate_imp = - (uu___85_6740.FStar_TypeChecker_Env.instantiate_imp); + (uu___85_6736.FStar_TypeChecker_Env.instantiate_imp); FStar_TypeChecker_Env.effects = - (uu___85_6740.FStar_TypeChecker_Env.effects); + (uu___85_6736.FStar_TypeChecker_Env.effects); FStar_TypeChecker_Env.generalize = should_generalize; FStar_TypeChecker_Env.letrecs = - (uu___85_6740.FStar_TypeChecker_Env.letrecs); + (uu___85_6736.FStar_TypeChecker_Env.letrecs); FStar_TypeChecker_Env.top_level = true; FStar_TypeChecker_Env.check_uvars = - (uu___85_6740.FStar_TypeChecker_Env.check_uvars); + (uu___85_6736.FStar_TypeChecker_Env.check_uvars); FStar_TypeChecker_Env.use_eq = - (uu___85_6740.FStar_TypeChecker_Env.use_eq); + (uu___85_6736.FStar_TypeChecker_Env.use_eq); FStar_TypeChecker_Env.is_iface = - (uu___85_6740.FStar_TypeChecker_Env.is_iface); + (uu___85_6736.FStar_TypeChecker_Env.is_iface); FStar_TypeChecker_Env.admit = - (uu___85_6740.FStar_TypeChecker_Env.admit); + (uu___85_6736.FStar_TypeChecker_Env.admit); FStar_TypeChecker_Env.lax = - (uu___85_6740.FStar_TypeChecker_Env.lax); + (uu___85_6736.FStar_TypeChecker_Env.lax); FStar_TypeChecker_Env.lax_universes = - (uu___85_6740.FStar_TypeChecker_Env.lax_universes); + (uu___85_6736.FStar_TypeChecker_Env.lax_universes); FStar_TypeChecker_Env.failhard = - (uu___85_6740.FStar_TypeChecker_Env.failhard); + (uu___85_6736.FStar_TypeChecker_Env.failhard); FStar_TypeChecker_Env.nosynth = - (uu___85_6740.FStar_TypeChecker_Env.nosynth); + (uu___85_6736.FStar_TypeChecker_Env.nosynth); FStar_TypeChecker_Env.tc_term = - (uu___85_6740.FStar_TypeChecker_Env.tc_term); + (uu___85_6736.FStar_TypeChecker_Env.tc_term); FStar_TypeChecker_Env.type_of = - (uu___85_6740.FStar_TypeChecker_Env.type_of); + (uu___85_6736.FStar_TypeChecker_Env.type_of); FStar_TypeChecker_Env.universe_of = - (uu___85_6740.FStar_TypeChecker_Env.universe_of); + (uu___85_6736.FStar_TypeChecker_Env.universe_of); FStar_TypeChecker_Env.use_bv_sorts = - (uu___85_6740.FStar_TypeChecker_Env.use_bv_sorts); + (uu___85_6736.FStar_TypeChecker_Env.use_bv_sorts); FStar_TypeChecker_Env.qname_and_index = - (uu___85_6740.FStar_TypeChecker_Env.qname_and_index); + (uu___85_6736.FStar_TypeChecker_Env.qname_and_index); FStar_TypeChecker_Env.proof_ns = - (uu___85_6740.FStar_TypeChecker_Env.proof_ns); + (uu___85_6736.FStar_TypeChecker_Env.proof_ns); FStar_TypeChecker_Env.synth = - (uu___85_6740.FStar_TypeChecker_Env.synth); + (uu___85_6736.FStar_TypeChecker_Env.synth); FStar_TypeChecker_Env.is_native_tactic = - (uu___85_6740.FStar_TypeChecker_Env.is_native_tactic); + (uu___85_6736.FStar_TypeChecker_Env.is_native_tactic); FStar_TypeChecker_Env.identifier_info = - (uu___85_6740.FStar_TypeChecker_Env.identifier_info); + (uu___85_6736.FStar_TypeChecker_Env.identifier_info); FStar_TypeChecker_Env.tc_hooks = - (uu___85_6740.FStar_TypeChecker_Env.tc_hooks); + (uu___85_6736.FStar_TypeChecker_Env.tc_hooks); FStar_TypeChecker_Env.dsenv = - (uu___85_6740.FStar_TypeChecker_Env.dsenv); + (uu___85_6736.FStar_TypeChecker_Env.dsenv); FStar_TypeChecker_Env.dep_graph = - (uu___85_6740.FStar_TypeChecker_Env.dep_graph) + (uu___85_6736.FStar_TypeChecker_Env.dep_graph) }) e in - match uu____6731 with + match uu____6727 with | ({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_let (lbs1,e1); - FStar_Syntax_Syntax.pos = uu____6753; - FStar_Syntax_Syntax.vars = uu____6754;_},uu____6755,g) + FStar_Syntax_Syntax.pos = uu____6749; + FStar_Syntax_Syntax.vars = uu____6750;_},uu____6751,g) when FStar_TypeChecker_Rel.is_trivial g -> let lbs2 = - let uu____6784 = + let uu____6780 = FStar_All.pipe_right (FStar_Pervasives_Native.snd lbs1) (FStar_List.map rename_parameters) in - ((FStar_Pervasives_Native.fst lbs1), uu____6784) in + ((FStar_Pervasives_Native.fst lbs1), uu____6780) in let quals1 = match e1.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Tm_meta - (uu____6802,FStar_Syntax_Syntax.Meta_desugared + (uu____6798,FStar_Syntax_Syntax.Meta_desugared (FStar_Syntax_Syntax.Masked_effect )) -> FStar_Syntax_Syntax.HasMaskedEffect :: quals - | uu____6807 -> quals in - ((let uu___86_6815 = se in + | uu____6803 -> quals in + ((let uu___86_6811 = se in { FStar_Syntax_Syntax.sigel = (FStar_Syntax_Syntax.Sig_let (lbs2, lids)); FStar_Syntax_Syntax.sigrng = - (uu___86_6815.FStar_Syntax_Syntax.sigrng); + (uu___86_6811.FStar_Syntax_Syntax.sigrng); FStar_Syntax_Syntax.sigquals = quals1; FStar_Syntax_Syntax.sigmeta = - (uu___86_6815.FStar_Syntax_Syntax.sigmeta); + (uu___86_6811.FStar_Syntax_Syntax.sigmeta); FStar_Syntax_Syntax.sigattrs = - (uu___86_6815.FStar_Syntax_Syntax.sigattrs) + (uu___86_6811.FStar_Syntax_Syntax.sigattrs) }), lbs2) - | uu____6824 -> + | uu____6820 -> failwith "impossible (typechecking should preserve Tm_let)" in - (match uu____6720 with + (match uu____6716 with | (se1,lbs1) -> (FStar_All.pipe_right (FStar_Pervasives_Native.snd lbs1) (FStar_List.iter @@ -4466,138 +4466,138 @@ let tc_decl: lb.FStar_Syntax_Syntax.lbname in FStar_TypeChecker_Env.insert_fv_info env2 fv lb.FStar_Syntax_Syntax.lbtyp)); - (let uu____6873 = log env2 in - if uu____6873 + (let uu____6869 = log env2 in + if uu____6869 then - let uu____6874 = - let uu____6875 = + let uu____6870 = + let uu____6871 = FStar_All.pipe_right (FStar_Pervasives_Native.snd lbs1) (FStar_List.map (fun lb -> let should_log = - let uu____6890 = - let uu____6899 = - let uu____6900 = - let uu____6903 = + let uu____6886 = + let uu____6895 = + let uu____6896 = + let uu____6899 = FStar_Util.right lb.FStar_Syntax_Syntax.lbname in - uu____6903.FStar_Syntax_Syntax.fv_name in - uu____6900.FStar_Syntax_Syntax.v in + uu____6899.FStar_Syntax_Syntax.fv_name in + uu____6896.FStar_Syntax_Syntax.v in FStar_TypeChecker_Env.try_lookup_val_decl - env2 uu____6899 in - match uu____6890 with + env2 uu____6895 in + match uu____6886 with | FStar_Pervasives_Native.None -> true - | uu____6910 -> false in + | uu____6906 -> false in if should_log then - let uu____6919 = + let uu____6915 = FStar_Syntax_Print.lbname_to_string lb.FStar_Syntax_Syntax.lbname in - let uu____6920 = + let uu____6916 = FStar_Syntax_Print.term_to_string lb.FStar_Syntax_Syntax.lbtyp in FStar_Util.format2 "let %s : %s" - uu____6919 uu____6920 + uu____6915 uu____6916 else "")) in - FStar_All.pipe_right uu____6875 + FStar_All.pipe_right uu____6871 (FStar_String.concat "\n") in - FStar_Util.print1 "%s\n" uu____6874 + FStar_Util.print1 "%s\n" uu____6870 else ()); (let reified_tactic_type l t = let t1 = FStar_Syntax_Subst.compress t in match t1.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Tm_arrow (bs,c) -> - let uu____6951 = + let uu____6947 = FStar_Syntax_Subst.open_comp bs c in - (match uu____6951 with + (match uu____6947 with | (bs1,c1) -> - let uu____6958 = + let uu____6954 = FStar_Syntax_Util.is_total_comp c1 in - if uu____6958 + if uu____6954 then let c' = match c1.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Total (t',u) -> - let uu____6970 = - let uu____6971 = + let uu____6966 = + let uu____6967 = FStar_Syntax_Subst.compress t' in - uu____6971.FStar_Syntax_Syntax.n in - (match uu____6970 with + uu____6967.FStar_Syntax_Syntax.n in + (match uu____6966 with | FStar_Syntax_Syntax.Tm_app (h,args) -> - let uu____6996 = - let uu____6997 = + let uu____6992 = + let uu____6993 = FStar_Syntax_Subst.compress h in - uu____6997.FStar_Syntax_Syntax.n in - (match uu____6996 with + uu____6993.FStar_Syntax_Syntax.n in + (match uu____6992 with | FStar_Syntax_Syntax.Tm_uinst (h',u') -> let h'' = - let uu____7007 = + let uu____7003 = FStar_Syntax_Syntax.lid_as_fv FStar_Parser_Const.u_tac_lid FStar_Syntax_Syntax.Delta_constant FStar_Pervasives_Native.None in FStar_All.pipe_left FStar_Syntax_Syntax.fv_to_tm - uu____7007 in - let uu____7008 = - let uu____7009 = - let uu____7010 = + uu____7003 in + let uu____7004 = + let uu____7005 = + let uu____7006 = FStar_Syntax_Syntax.mk_Tm_uinst h'' u' in FStar_Syntax_Syntax.mk_Tm_app - uu____7010 args in - uu____7009 + uu____7006 args in + uu____7005 FStar_Pervasives_Native.None t'.FStar_Syntax_Syntax.pos in FStar_Syntax_Syntax.mk_Total' - uu____7008 u - | uu____7013 -> c1) - | uu____7014 -> c1) - | uu____7015 -> c1 in - let uu___87_7016 = t1 in - let uu____7017 = - let uu____7018 = - let uu____7031 = + uu____7004 u + | uu____7009 -> c1) + | uu____7010 -> c1) + | uu____7011 -> c1 in + let uu___87_7012 = t1 in + let uu____7013 = + let uu____7014 = + let uu____7027 = FStar_Syntax_Subst.close_comp bs1 c' in - (bs1, uu____7031) in - FStar_Syntax_Syntax.Tm_arrow uu____7018 in + (bs1, uu____7027) in + FStar_Syntax_Syntax.Tm_arrow uu____7014 in { - FStar_Syntax_Syntax.n = uu____7017; + FStar_Syntax_Syntax.n = uu____7013; FStar_Syntax_Syntax.pos = - (uu___87_7016.FStar_Syntax_Syntax.pos); + (uu___87_7012.FStar_Syntax_Syntax.pos); FStar_Syntax_Syntax.vars = - (uu___87_7016.FStar_Syntax_Syntax.vars) + (uu___87_7012.FStar_Syntax_Syntax.vars) } else t1) | FStar_Syntax_Syntax.Tm_app (h,args) -> - let uu____7055 = - let uu____7056 = FStar_Syntax_Subst.compress h in - uu____7056.FStar_Syntax_Syntax.n in - (match uu____7055 with + let uu____7051 = + let uu____7052 = FStar_Syntax_Subst.compress h in + uu____7052.FStar_Syntax_Syntax.n in + (match uu____7051 with | FStar_Syntax_Syntax.Tm_uinst (h',u') -> let h'' = - let uu____7066 = + let uu____7062 = FStar_Syntax_Syntax.lid_as_fv FStar_Parser_Const.u_tac_lid FStar_Syntax_Syntax.Delta_constant FStar_Pervasives_Native.None in FStar_All.pipe_left - FStar_Syntax_Syntax.fv_to_tm uu____7066 in - let uu____7067 = - let uu____7068 = + FStar_Syntax_Syntax.fv_to_tm uu____7062 in + let uu____7063 = + let uu____7064 = FStar_Syntax_Syntax.mk_Tm_uinst h'' u' in - FStar_Syntax_Syntax.mk_Tm_app uu____7068 + FStar_Syntax_Syntax.mk_Tm_app uu____7064 args in - uu____7067 FStar_Pervasives_Native.None + uu____7063 FStar_Pervasives_Native.None t1.FStar_Syntax_Syntax.pos - | uu____7071 -> t1) - | uu____7072 -> t1 in + | uu____7067 -> t1) + | uu____7068 -> t1 in let reified_tactic_decl assm_lid lb = let t = reified_tactic_type assm_lid @@ -4617,19 +4617,19 @@ let tc_decl: } in let reflected_tactic_decl b lb bs assm_lid comp = let reified_tac = - let uu____7100 = + let uu____7096 = FStar_Syntax_Syntax.lid_as_fv assm_lid FStar_Syntax_Syntax.Delta_constant FStar_Pervasives_Native.None in FStar_All.pipe_left FStar_Syntax_Syntax.fv_to_tm - uu____7100 in + uu____7096 in let tac_args = FStar_List.map (fun x -> - let uu____7117 = + let uu____7113 = FStar_Syntax_Syntax.bv_to_name (FStar_Pervasives_Native.fst x) in - (uu____7117, (FStar_Pervasives_Native.snd x))) + (uu____7113, (FStar_Pervasives_Native.snd x))) bs in let reflect_head = FStar_Syntax_Syntax.mk @@ -4648,12 +4648,12 @@ let tc_decl: FStar_Pervasives_Native.None FStar_Range.dummyRange in let unit_binder = - let uu____7148 = + let uu____7144 = FStar_Syntax_Syntax.new_bv FStar_Pervasives_Native.None FStar_Syntax_Syntax.t_unit in FStar_All.pipe_left FStar_Syntax_Syntax.mk_binder - uu____7148 in + uu____7144 in let body = FStar_All.pipe_left (FStar_Syntax_Util.abs [unit_binder] app) @@ -4664,85 +4664,85 @@ let tc_decl: (FStar_Syntax_Util.abs bs body) (FStar_Pervasives_Native.Some (FStar_Syntax_Util.residual_comp_of_comp comp)) in - let uu___88_7155 = se1 in + let uu___88_7151 = se1 in { FStar_Syntax_Syntax.sigel = (FStar_Syntax_Syntax.Sig_let ((b, - [(let uu___89_7167 = lb in + [(let uu___89_7163 = lb in { FStar_Syntax_Syntax.lbname = - (uu___89_7167.FStar_Syntax_Syntax.lbname); + (uu___89_7163.FStar_Syntax_Syntax.lbname); FStar_Syntax_Syntax.lbunivs = - (uu___89_7167.FStar_Syntax_Syntax.lbunivs); + (uu___89_7163.FStar_Syntax_Syntax.lbunivs); FStar_Syntax_Syntax.lbtyp = - (uu___89_7167.FStar_Syntax_Syntax.lbtyp); + (uu___89_7163.FStar_Syntax_Syntax.lbtyp); FStar_Syntax_Syntax.lbeff = - (uu___89_7167.FStar_Syntax_Syntax.lbeff); + (uu___89_7163.FStar_Syntax_Syntax.lbeff); FStar_Syntax_Syntax.lbdef = func })]), lids)); FStar_Syntax_Syntax.sigrng = - (uu___88_7155.FStar_Syntax_Syntax.sigrng); + (uu___88_7151.FStar_Syntax_Syntax.sigrng); FStar_Syntax_Syntax.sigquals = - (uu___88_7155.FStar_Syntax_Syntax.sigquals); + (uu___88_7151.FStar_Syntax_Syntax.sigquals); FStar_Syntax_Syntax.sigmeta = - (uu___88_7155.FStar_Syntax_Syntax.sigmeta); + (uu___88_7151.FStar_Syntax_Syntax.sigmeta); FStar_Syntax_Syntax.sigattrs = - (uu___88_7155.FStar_Syntax_Syntax.sigattrs) + (uu___88_7151.FStar_Syntax_Syntax.sigattrs) } in let tactic_decls = match FStar_Pervasives_Native.snd lbs1 with | hd1::[] -> - let uu____7184 = + let uu____7180 = FStar_Syntax_Util.arrow_formals_comp hd1.FStar_Syntax_Syntax.lbtyp in - (match uu____7184 with + (match uu____7180 with | (bs,comp) -> let t = FStar_Syntax_Util.comp_result comp in - let uu____7218 = - let uu____7219 = + let uu____7214 = + let uu____7215 = FStar_Syntax_Subst.compress t in - uu____7219.FStar_Syntax_Syntax.n in - (match uu____7218 with + uu____7215.FStar_Syntax_Syntax.n in + (match uu____7214 with | FStar_Syntax_Syntax.Tm_app (h,args) -> let h1 = FStar_Syntax_Subst.compress h in let tac_lid = - let uu____7252 = - let uu____7255 = + let uu____7248 = + let uu____7251 = FStar_Util.right hd1.FStar_Syntax_Syntax.lbname in - uu____7255.FStar_Syntax_Syntax.fv_name in - uu____7252.FStar_Syntax_Syntax.v in + uu____7251.FStar_Syntax_Syntax.fv_name in + uu____7248.FStar_Syntax_Syntax.v in let assm_lid = - let uu____7257 = + let uu____7253 = FStar_All.pipe_left FStar_Ident.id_of_text (Prims.strcat "__" (tac_lid.FStar_Ident.ident).FStar_Ident.idText) in FStar_Ident.lid_of_ns_and_id - tac_lid.FStar_Ident.ns uu____7257 in - let uu____7258 = + tac_lid.FStar_Ident.ns uu____7253 in + let uu____7254 = get_tactic_fv env2 assm_lid h1 in - (match uu____7258 with + (match uu____7254 with | FStar_Pervasives_Native.Some fv -> - let uu____7268 = - let uu____7269 = - let uu____7270 = + let uu____7264 = + let uu____7265 = + let uu____7266 = FStar_TypeChecker_Env.try_lookup_val_decl env2 tac_lid in FStar_All.pipe_left FStar_Util.is_some - uu____7270 in - Prims.op_Negation uu____7269 in - if uu____7268 + uu____7266 in + Prims.op_Negation uu____7265 in + if uu____7264 then - ((let uu____7300 = - let uu____7301 = + ((let uu____7296 = + let uu____7297 = is_builtin_tactic env2.FStar_TypeChecker_Env.curmodule in Prims.op_Negation - uu____7301 in - if uu____7300 + uu____7297 in + if uu____7296 then let added_modules = FStar_ST.op_Bang @@ -4763,10 +4763,10 @@ let tc_decl: [module_name]) else ()) else ()); - (let uu____7412 = + (let uu____7408 = env2.FStar_TypeChecker_Env.is_native_tactic assm_lid in - if uu____7412 + if uu____7408 then let se_assm = reified_tactic_decl @@ -4783,23 +4783,23 @@ let tc_decl: else FStar_Pervasives_Native.None | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None) - | uu____7441 -> + | uu____7437 -> FStar_Pervasives_Native.None)) - | uu____7446 -> FStar_Pervasives_Native.None in + | uu____7442 -> FStar_Pervasives_Native.None in match tactic_decls with | FStar_Pervasives_Native.Some (se_assm,se_refl) -> - ((let uu____7468 = + ((let uu____7464 = FStar_TypeChecker_Env.debug env2 (FStar_Options.Other "NativeTactics") in - if uu____7468 + if uu____7464 then - let uu____7469 = + let uu____7465 = FStar_Syntax_Print.sigelt_to_string se_assm in - let uu____7470 = + let uu____7466 = FStar_Syntax_Print.sigelt_to_string se_refl in FStar_Util.print2 "Native tactic declarations: \n%s\n%s\n" - uu____7469 uu____7470 + uu____7465 uu____7466 else ()); ([se_assm; se_refl], [])) | FStar_Pervasives_Native.None -> ([se1], [])))))) @@ -4814,128 +4814,128 @@ let for_export: let is_abstract quals = FStar_All.pipe_right quals (FStar_Util.for_some - (fun uu___56_7521 -> - match uu___56_7521 with + (fun uu___56_7517 -> + match uu___56_7517 with | FStar_Syntax_Syntax.Abstract -> true - | uu____7522 -> false)) in + | uu____7518 -> false)) in let is_hidden_proj_or_disc q = match q with - | FStar_Syntax_Syntax.Projector (l,uu____7528) -> + | FStar_Syntax_Syntax.Projector (l,uu____7524) -> FStar_All.pipe_right hidden (FStar_Util.for_some (FStar_Ident.lid_equals l)) | FStar_Syntax_Syntax.Discriminator l -> FStar_All.pipe_right hidden (FStar_Util.for_some (FStar_Ident.lid_equals l)) - | uu____7534 -> false in + | uu____7530 -> false in match se.FStar_Syntax_Syntax.sigel with - | FStar_Syntax_Syntax.Sig_pragma uu____7543 -> ([], hidden) - | FStar_Syntax_Syntax.Sig_inductive_typ uu____7548 -> + | FStar_Syntax_Syntax.Sig_pragma uu____7539 -> ([], hidden) + | FStar_Syntax_Syntax.Sig_inductive_typ uu____7544 -> failwith "Impossible (Already handled)" - | FStar_Syntax_Syntax.Sig_datacon uu____7573 -> + | FStar_Syntax_Syntax.Sig_datacon uu____7569 -> failwith "Impossible (Already handled)" - | FStar_Syntax_Syntax.Sig_bundle (ses,uu____7597) -> - let uu____7606 = is_abstract se.FStar_Syntax_Syntax.sigquals in - if uu____7606 + | FStar_Syntax_Syntax.Sig_bundle (ses,uu____7593) -> + let uu____7602 = is_abstract se.FStar_Syntax_Syntax.sigquals in + if uu____7602 then - let for_export_bundle se1 uu____7637 = - match uu____7637 with + let for_export_bundle se1 uu____7633 = + match uu____7633 with | (out,hidden1) -> (match se1.FStar_Syntax_Syntax.sigel with | FStar_Syntax_Syntax.Sig_inductive_typ - (l,us,bs,t,uu____7676,uu____7677) -> + (l,us,bs,t,uu____7672,uu____7673) -> let dec = - let uu___90_7687 = se1 in - let uu____7688 = - let uu____7689 = - let uu____7696 = - let uu____7699 = + let uu___90_7683 = se1 in + let uu____7684 = + let uu____7685 = + let uu____7692 = + let uu____7695 = FStar_Syntax_Syntax.mk_Total t in - FStar_Syntax_Util.arrow bs uu____7699 in - (l, us, uu____7696) in - FStar_Syntax_Syntax.Sig_declare_typ uu____7689 in + FStar_Syntax_Util.arrow bs uu____7695 in + (l, us, uu____7692) in + FStar_Syntax_Syntax.Sig_declare_typ uu____7685 in { - FStar_Syntax_Syntax.sigel = uu____7688; + FStar_Syntax_Syntax.sigel = uu____7684; FStar_Syntax_Syntax.sigrng = - (uu___90_7687.FStar_Syntax_Syntax.sigrng); + (uu___90_7683.FStar_Syntax_Syntax.sigrng); FStar_Syntax_Syntax.sigquals = (FStar_Syntax_Syntax.Assumption :: FStar_Syntax_Syntax.New :: (se1.FStar_Syntax_Syntax.sigquals)); FStar_Syntax_Syntax.sigmeta = - (uu___90_7687.FStar_Syntax_Syntax.sigmeta); + (uu___90_7683.FStar_Syntax_Syntax.sigmeta); FStar_Syntax_Syntax.sigattrs = - (uu___90_7687.FStar_Syntax_Syntax.sigattrs) + (uu___90_7683.FStar_Syntax_Syntax.sigattrs) } in ((dec :: out), hidden1) | FStar_Syntax_Syntax.Sig_datacon - (l,us,t,uu____7711,uu____7712,uu____7713) -> + (l,us,t,uu____7707,uu____7708,uu____7709) -> let dec = - let uu___91_7719 = se1 in + let uu___91_7715 = se1 in { FStar_Syntax_Syntax.sigel = (FStar_Syntax_Syntax.Sig_declare_typ (l, us, t)); FStar_Syntax_Syntax.sigrng = - (uu___91_7719.FStar_Syntax_Syntax.sigrng); + (uu___91_7715.FStar_Syntax_Syntax.sigrng); FStar_Syntax_Syntax.sigquals = [FStar_Syntax_Syntax.Assumption]; FStar_Syntax_Syntax.sigmeta = - (uu___91_7719.FStar_Syntax_Syntax.sigmeta); + (uu___91_7715.FStar_Syntax_Syntax.sigmeta); FStar_Syntax_Syntax.sigattrs = - (uu___91_7719.FStar_Syntax_Syntax.sigattrs) + (uu___91_7715.FStar_Syntax_Syntax.sigattrs) } in ((dec :: out), (l :: hidden1)) - | uu____7724 -> (out, hidden1)) in + | uu____7720 -> (out, hidden1)) in FStar_List.fold_right for_export_bundle ses ([], hidden) else ([se], hidden) - | FStar_Syntax_Syntax.Sig_assume (uu____7746,uu____7747,uu____7748) -> - let uu____7749 = is_abstract se.FStar_Syntax_Syntax.sigquals in - if uu____7749 then ([], hidden) else ([se], hidden) + | FStar_Syntax_Syntax.Sig_assume (uu____7742,uu____7743,uu____7744) -> + let uu____7745 = is_abstract se.FStar_Syntax_Syntax.sigquals in + if uu____7745 then ([], hidden) else ([se], hidden) | FStar_Syntax_Syntax.Sig_declare_typ (l,us,t) -> - let uu____7770 = + let uu____7766 = FStar_All.pipe_right se.FStar_Syntax_Syntax.sigquals (FStar_Util.for_some is_hidden_proj_or_disc) in - if uu____7770 + if uu____7766 then - ([(let uu___92_7786 = se in + ([(let uu___92_7782 = se in { FStar_Syntax_Syntax.sigel = (FStar_Syntax_Syntax.Sig_declare_typ (l, us, t)); FStar_Syntax_Syntax.sigrng = - (uu___92_7786.FStar_Syntax_Syntax.sigrng); + (uu___92_7782.FStar_Syntax_Syntax.sigrng); FStar_Syntax_Syntax.sigquals = [FStar_Syntax_Syntax.Assumption]; FStar_Syntax_Syntax.sigmeta = - (uu___92_7786.FStar_Syntax_Syntax.sigmeta); + (uu___92_7782.FStar_Syntax_Syntax.sigmeta); FStar_Syntax_Syntax.sigattrs = - (uu___92_7786.FStar_Syntax_Syntax.sigattrs) + (uu___92_7782.FStar_Syntax_Syntax.sigattrs) })], (l :: hidden)) else - (let uu____7788 = + (let uu____7784 = FStar_All.pipe_right se.FStar_Syntax_Syntax.sigquals (FStar_Util.for_some - (fun uu___57_7792 -> - match uu___57_7792 with + (fun uu___57_7788 -> + match uu___57_7788 with | FStar_Syntax_Syntax.Assumption -> true - | FStar_Syntax_Syntax.Projector uu____7793 -> true - | FStar_Syntax_Syntax.Discriminator uu____7798 -> true - | uu____7799 -> false)) in - if uu____7788 then ([se], hidden) else ([], hidden)) - | FStar_Syntax_Syntax.Sig_main uu____7817 -> ([], hidden) - | FStar_Syntax_Syntax.Sig_new_effect uu____7822 -> ([se], hidden) - | FStar_Syntax_Syntax.Sig_new_effect_for_free uu____7827 -> + | FStar_Syntax_Syntax.Projector uu____7789 -> true + | FStar_Syntax_Syntax.Discriminator uu____7794 -> true + | uu____7795 -> false)) in + if uu____7784 then ([se], hidden) else ([], hidden)) + | FStar_Syntax_Syntax.Sig_main uu____7813 -> ([], hidden) + | FStar_Syntax_Syntax.Sig_new_effect uu____7818 -> ([se], hidden) + | FStar_Syntax_Syntax.Sig_new_effect_for_free uu____7823 -> ([se], hidden) - | FStar_Syntax_Syntax.Sig_sub_effect uu____7832 -> ([se], hidden) - | FStar_Syntax_Syntax.Sig_effect_abbrev uu____7837 -> ([se], hidden) - | FStar_Syntax_Syntax.Sig_let ((false ,lb::[]),uu____7855) when + | FStar_Syntax_Syntax.Sig_sub_effect uu____7828 -> ([se], hidden) + | FStar_Syntax_Syntax.Sig_effect_abbrev uu____7833 -> ([se], hidden) + | FStar_Syntax_Syntax.Sig_let ((false ,lb::[]),uu____7851) when FStar_All.pipe_right se.FStar_Syntax_Syntax.sigquals (FStar_Util.for_some is_hidden_proj_or_disc) -> let fv = FStar_Util.right lb.FStar_Syntax_Syntax.lbname in let lid = (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in - let uu____7872 = + let uu____7868 = FStar_All.pipe_right hidden (FStar_Util.for_some (FStar_Syntax_Syntax.fv_eq_lid fv)) in - if uu____7872 + if uu____7868 then ([], hidden) else (let dec = @@ -4954,39 +4954,39 @@ let for_export: } in ([dec], (lid :: hidden))) | FStar_Syntax_Syntax.Sig_let (lbs,l) -> - let uu____7903 = is_abstract se.FStar_Syntax_Syntax.sigquals in - if uu____7903 + let uu____7899 = is_abstract se.FStar_Syntax_Syntax.sigquals in + if uu____7899 then - let uu____7912 = + let uu____7908 = FStar_All.pipe_right (FStar_Pervasives_Native.snd lbs) (FStar_List.map (fun lb -> - let uu___93_7925 = se in - let uu____7926 = - let uu____7927 = - let uu____7934 = - let uu____7935 = - let uu____7938 = + let uu___93_7921 = se in + let uu____7922 = + let uu____7923 = + let uu____7930 = + let uu____7931 = + let uu____7934 = FStar_Util.right lb.FStar_Syntax_Syntax.lbname in - uu____7938.FStar_Syntax_Syntax.fv_name in - uu____7935.FStar_Syntax_Syntax.v in - (uu____7934, (lb.FStar_Syntax_Syntax.lbunivs), + uu____7934.FStar_Syntax_Syntax.fv_name in + uu____7931.FStar_Syntax_Syntax.v in + (uu____7930, (lb.FStar_Syntax_Syntax.lbunivs), (lb.FStar_Syntax_Syntax.lbtyp)) in - FStar_Syntax_Syntax.Sig_declare_typ uu____7927 in + FStar_Syntax_Syntax.Sig_declare_typ uu____7923 in { - FStar_Syntax_Syntax.sigel = uu____7926; + FStar_Syntax_Syntax.sigel = uu____7922; FStar_Syntax_Syntax.sigrng = - (uu___93_7925.FStar_Syntax_Syntax.sigrng); + (uu___93_7921.FStar_Syntax_Syntax.sigrng); FStar_Syntax_Syntax.sigquals = (FStar_Syntax_Syntax.Assumption :: (se.FStar_Syntax_Syntax.sigquals)); FStar_Syntax_Syntax.sigmeta = - (uu___93_7925.FStar_Syntax_Syntax.sigmeta); + (uu___93_7921.FStar_Syntax_Syntax.sigmeta); FStar_Syntax_Syntax.sigattrs = - (uu___93_7925.FStar_Syntax_Syntax.sigattrs) + (uu___93_7921.FStar_Syntax_Syntax.sigattrs) })) in - (uu____7912, hidden) + (uu____7908, hidden) else ([se], hidden) let add_sigelt_to_env: FStar_TypeChecker_Env.env -> @@ -4995,48 +4995,48 @@ let add_sigelt_to_env: fun env -> fun se -> match se.FStar_Syntax_Syntax.sigel with - | FStar_Syntax_Syntax.Sig_inductive_typ uu____7958 -> + | FStar_Syntax_Syntax.Sig_inductive_typ uu____7954 -> failwith "add_sigelt_to_env: Impossible, bare data constructor" - | FStar_Syntax_Syntax.Sig_datacon uu____7975 -> + | FStar_Syntax_Syntax.Sig_datacon uu____7971 -> failwith "add_sigelt_to_env: Impossible, bare data constructor" | FStar_Syntax_Syntax.Sig_pragma (FStar_Syntax_Syntax.ResetOptions - uu____7990) -> + uu____7986) -> let env1 = - let uu____7994 = FStar_Options.using_facts_from () in - FStar_TypeChecker_Env.set_proof_ns uu____7994 env in + let uu____7990 = FStar_Options.using_facts_from () in + FStar_TypeChecker_Env.set_proof_ns uu____7990 env in ((env1.FStar_TypeChecker_Env.solver).FStar_TypeChecker_Env.refresh (); env1) - | FStar_Syntax_Syntax.Sig_pragma uu____7996 -> env - | FStar_Syntax_Syntax.Sig_new_effect_for_free uu____7997 -> env + | FStar_Syntax_Syntax.Sig_pragma uu____7992 -> env + | FStar_Syntax_Syntax.Sig_new_effect_for_free uu____7993 -> env | FStar_Syntax_Syntax.Sig_new_effect ne -> let env1 = FStar_TypeChecker_Env.push_sigelt env se in FStar_All.pipe_right ne.FStar_Syntax_Syntax.actions (FStar_List.fold_left (fun env2 -> fun a -> - let uu____8007 = + let uu____8003 = FStar_Syntax_Util.action_as_lb ne.FStar_Syntax_Syntax.mname a in - FStar_TypeChecker_Env.push_sigelt env2 uu____8007) env1) + FStar_TypeChecker_Env.push_sigelt env2 uu____8003) env1) | FStar_Syntax_Syntax.Sig_declare_typ - (uu____8008,uu____8009,uu____8010) when + (uu____8004,uu____8005,uu____8006) when FStar_All.pipe_right se.FStar_Syntax_Syntax.sigquals (FStar_Util.for_some - (fun uu___58_8014 -> - match uu___58_8014 with + (fun uu___58_8010 -> + match uu___58_8010 with | FStar_Syntax_Syntax.OnlyName -> true - | uu____8015 -> false)) + | uu____8011 -> false)) -> env - | FStar_Syntax_Syntax.Sig_let (uu____8016,uu____8017) when + | FStar_Syntax_Syntax.Sig_let (uu____8012,uu____8013) when FStar_All.pipe_right se.FStar_Syntax_Syntax.sigquals (FStar_Util.for_some - (fun uu___58_8025 -> - match uu___58_8025 with + (fun uu___58_8021 -> + match uu___58_8021 with | FStar_Syntax_Syntax.OnlyName -> true - | uu____8026 -> false)) + | uu____8022 -> false)) -> env - | uu____8027 -> FStar_TypeChecker_Env.push_sigelt env se + | uu____8023 -> FStar_TypeChecker_Env.push_sigelt env se let tc_decls: FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.sigelt Prims.list -> @@ -5046,33 +5046,33 @@ let tc_decls: = fun env -> fun ses -> - let rec process_one_decl uu____8087 se = - match uu____8087 with + let rec process_one_decl uu____8083 se = + match uu____8083 with | (ses1,exports,env1,hidden) -> - ((let uu____8140 = + ((let uu____8136 = FStar_TypeChecker_Env.debug env1 FStar_Options.Low in - if uu____8140 + if uu____8136 then - let uu____8141 = FStar_Syntax_Print.sigelt_to_string se in + let uu____8137 = FStar_Syntax_Print.sigelt_to_string se in FStar_Util.print1 - ">>>>>>>>>>>>>>Checking top-level decl %s\n" uu____8141 + ">>>>>>>>>>>>>>Checking top-level decl %s\n" uu____8137 else ()); - (let uu____8143 = tc_decl env1 se in - match uu____8143 with + (let uu____8139 = tc_decl env1 se in + match uu____8139 with | (ses',ses_elaborated) -> let ses'1 = FStar_All.pipe_right ses' (FStar_List.map (fun se1 -> - (let uu____8193 = + (let uu____8189 = FStar_TypeChecker_Env.debug env1 (FStar_Options.Other "UF") in - if uu____8193 + if uu____8189 then - let uu____8194 = + let uu____8190 = FStar_Syntax_Print.sigelt_to_string se1 in FStar_Util.print1 "About to elim vars from %s" - uu____8194 + uu____8190 else ()); FStar_TypeChecker_Normalize.elim_uvars env1 se1)) in let ses_elaborated1 = @@ -5099,84 +5099,84 @@ let tc_decls: (fun env2 -> fun se1 -> add_sigelt_to_env env2 se1) env1) in FStar_Syntax_Unionfind.reset (); - (let uu____8217 = + (let uu____8213 = (FStar_Options.log_types ()) || (FStar_All.pipe_left (FStar_TypeChecker_Env.debug env2) (FStar_Options.Other "LogTypes")) in - if uu____8217 + if uu____8213 then - let uu____8218 = + let uu____8214 = FStar_List.fold_left (fun s -> fun se1 -> - let uu____8224 = - let uu____8225 = + let uu____8220 = + let uu____8221 = FStar_Syntax_Print.sigelt_to_string se1 in - Prims.strcat uu____8225 "\n" in - Prims.strcat s uu____8224) "" ses'1 in - FStar_Util.print1 "Checked: %s\n" uu____8218 + Prims.strcat uu____8221 "\n" in + Prims.strcat s uu____8220) "" ses'1 in + FStar_Util.print1 "Checked: %s\n" uu____8214 else ()); FStar_List.iter (fun se1 -> (env2.FStar_TypeChecker_Env.solver).FStar_TypeChecker_Env.encode_sig env2 se1) ses'1; - (let uu____8230 = - let accum_exports_hidden uu____8260 se1 = - match uu____8260 with + (let uu____8226 = + let accum_exports_hidden uu____8256 se1 = + match uu____8256 with | (exports1,hidden1) -> - let uu____8288 = for_export hidden1 se1 in - (match uu____8288 with + let uu____8284 = for_export hidden1 se1 in + (match uu____8284 with | (se_exported,hidden2) -> ((FStar_List.rev_append se_exported exports1), hidden2)) in FStar_List.fold_left accum_exports_hidden (exports, hidden) ses'1 in - match uu____8230 with + match uu____8226 with | (exports1,hidden1) -> let ses'2 = FStar_List.map (fun s -> - let uu___94_8367 = s in + let uu___94_8363 = s in { FStar_Syntax_Syntax.sigel = - (uu___94_8367.FStar_Syntax_Syntax.sigel); + (uu___94_8363.FStar_Syntax_Syntax.sigel); FStar_Syntax_Syntax.sigrng = - (uu___94_8367.FStar_Syntax_Syntax.sigrng); + (uu___94_8363.FStar_Syntax_Syntax.sigrng); FStar_Syntax_Syntax.sigquals = - (uu___94_8367.FStar_Syntax_Syntax.sigquals); + (uu___94_8363.FStar_Syntax_Syntax.sigquals); FStar_Syntax_Syntax.sigmeta = - (uu___94_8367.FStar_Syntax_Syntax.sigmeta); + (uu___94_8363.FStar_Syntax_Syntax.sigmeta); FStar_Syntax_Syntax.sigattrs = (se.FStar_Syntax_Syntax.sigattrs) }) ses'1 in (((FStar_List.rev_append ses'2 ses1), exports1, env2, hidden1), ses_elaborated1)))))) in let process_one_decl_timed acc se = - let uu____8445 = acc in - match uu____8445 with - | (uu____8480,uu____8481,env1,uu____8483) -> - let uu____8496 = + let uu____8441 = acc in + match uu____8441 with + | (uu____8476,uu____8477,env1,uu____8479) -> + let uu____8492 = FStar_Util.record_time - (fun uu____8542 -> process_one_decl acc se) in - (match uu____8496 with + (fun uu____8538 -> process_one_decl acc se) in + (match uu____8492 with | (r,ms_elapsed) -> - ((let uu____8606 = + ((let uu____8602 = FStar_TypeChecker_Env.debug env1 (FStar_Options.Other "TCDeclTime") in - if uu____8606 + if uu____8602 then - let uu____8607 = + let uu____8603 = FStar_Syntax_Print.sigelt_to_string_short se in - let uu____8608 = FStar_Util.string_of_int ms_elapsed in + let uu____8604 = FStar_Util.string_of_int ms_elapsed in FStar_Util.print2 "Checked %s in %s milliseconds\n" - uu____8607 uu____8608 + uu____8603 uu____8604 else ()); r)) in - let uu____8610 = + let uu____8606 = FStar_Util.fold_flatten process_one_decl_timed ([], [], env, []) ses in - match uu____8610 with - | (ses1,exports,env1,uu____8658) -> + match uu____8606 with + | (ses1,exports,env1,uu____8654) -> ((FStar_List.rev_append ses1 []), (FStar_List.rev_append exports []), env1) let tc_partial_modul: @@ -5197,8 +5197,8 @@ let tc_partial_modul: if modul.FStar_Syntax_Syntax.is_interface then "interface" else "implementation" in - (let uu____8698 = FStar_Options.debug_any () in - if uu____8698 + (let uu____8694 = FStar_Options.debug_any () in + if uu____8694 then FStar_Util.print3 "%s %s of %s\n" action label1 (modul.FStar_Syntax_Syntax.name).FStar_Ident.str @@ -5210,75 +5210,75 @@ let tc_partial_modul: else "module") (modul.FStar_Syntax_Syntax.name).FStar_Ident.str in let msg = Prims.strcat "Internals for " name in let env1 = - let uu___95_8704 = env in + let uu___95_8700 = env in { FStar_TypeChecker_Env.solver = - (uu___95_8704.FStar_TypeChecker_Env.solver); + (uu___95_8700.FStar_TypeChecker_Env.solver); FStar_TypeChecker_Env.range = - (uu___95_8704.FStar_TypeChecker_Env.range); + (uu___95_8700.FStar_TypeChecker_Env.range); FStar_TypeChecker_Env.curmodule = - (uu___95_8704.FStar_TypeChecker_Env.curmodule); + (uu___95_8700.FStar_TypeChecker_Env.curmodule); FStar_TypeChecker_Env.gamma = - (uu___95_8704.FStar_TypeChecker_Env.gamma); + (uu___95_8700.FStar_TypeChecker_Env.gamma); FStar_TypeChecker_Env.gamma_cache = - (uu___95_8704.FStar_TypeChecker_Env.gamma_cache); + (uu___95_8700.FStar_TypeChecker_Env.gamma_cache); FStar_TypeChecker_Env.modules = - (uu___95_8704.FStar_TypeChecker_Env.modules); + (uu___95_8700.FStar_TypeChecker_Env.modules); FStar_TypeChecker_Env.expected_typ = - (uu___95_8704.FStar_TypeChecker_Env.expected_typ); + (uu___95_8700.FStar_TypeChecker_Env.expected_typ); FStar_TypeChecker_Env.sigtab = - (uu___95_8704.FStar_TypeChecker_Env.sigtab); + (uu___95_8700.FStar_TypeChecker_Env.sigtab); FStar_TypeChecker_Env.is_pattern = - (uu___95_8704.FStar_TypeChecker_Env.is_pattern); + (uu___95_8700.FStar_TypeChecker_Env.is_pattern); FStar_TypeChecker_Env.instantiate_imp = - (uu___95_8704.FStar_TypeChecker_Env.instantiate_imp); + (uu___95_8700.FStar_TypeChecker_Env.instantiate_imp); FStar_TypeChecker_Env.effects = - (uu___95_8704.FStar_TypeChecker_Env.effects); + (uu___95_8700.FStar_TypeChecker_Env.effects); FStar_TypeChecker_Env.generalize = - (uu___95_8704.FStar_TypeChecker_Env.generalize); + (uu___95_8700.FStar_TypeChecker_Env.generalize); FStar_TypeChecker_Env.letrecs = - (uu___95_8704.FStar_TypeChecker_Env.letrecs); + (uu___95_8700.FStar_TypeChecker_Env.letrecs); FStar_TypeChecker_Env.top_level = - (uu___95_8704.FStar_TypeChecker_Env.top_level); + (uu___95_8700.FStar_TypeChecker_Env.top_level); FStar_TypeChecker_Env.check_uvars = - (uu___95_8704.FStar_TypeChecker_Env.check_uvars); + (uu___95_8700.FStar_TypeChecker_Env.check_uvars); FStar_TypeChecker_Env.use_eq = - (uu___95_8704.FStar_TypeChecker_Env.use_eq); + (uu___95_8700.FStar_TypeChecker_Env.use_eq); FStar_TypeChecker_Env.is_iface = (modul.FStar_Syntax_Syntax.is_interface); FStar_TypeChecker_Env.admit = (Prims.op_Negation verify); FStar_TypeChecker_Env.lax = - (uu___95_8704.FStar_TypeChecker_Env.lax); + (uu___95_8700.FStar_TypeChecker_Env.lax); FStar_TypeChecker_Env.lax_universes = - (uu___95_8704.FStar_TypeChecker_Env.lax_universes); + (uu___95_8700.FStar_TypeChecker_Env.lax_universes); FStar_TypeChecker_Env.failhard = - (uu___95_8704.FStar_TypeChecker_Env.failhard); + (uu___95_8700.FStar_TypeChecker_Env.failhard); FStar_TypeChecker_Env.nosynth = - (uu___95_8704.FStar_TypeChecker_Env.nosynth); + (uu___95_8700.FStar_TypeChecker_Env.nosynth); FStar_TypeChecker_Env.tc_term = - (uu___95_8704.FStar_TypeChecker_Env.tc_term); + (uu___95_8700.FStar_TypeChecker_Env.tc_term); FStar_TypeChecker_Env.type_of = - (uu___95_8704.FStar_TypeChecker_Env.type_of); + (uu___95_8700.FStar_TypeChecker_Env.type_of); FStar_TypeChecker_Env.universe_of = - (uu___95_8704.FStar_TypeChecker_Env.universe_of); + (uu___95_8700.FStar_TypeChecker_Env.universe_of); FStar_TypeChecker_Env.use_bv_sorts = - (uu___95_8704.FStar_TypeChecker_Env.use_bv_sorts); + (uu___95_8700.FStar_TypeChecker_Env.use_bv_sorts); FStar_TypeChecker_Env.qname_and_index = - (uu___95_8704.FStar_TypeChecker_Env.qname_and_index); + (uu___95_8700.FStar_TypeChecker_Env.qname_and_index); FStar_TypeChecker_Env.proof_ns = - (uu___95_8704.FStar_TypeChecker_Env.proof_ns); + (uu___95_8700.FStar_TypeChecker_Env.proof_ns); FStar_TypeChecker_Env.synth = - (uu___95_8704.FStar_TypeChecker_Env.synth); + (uu___95_8700.FStar_TypeChecker_Env.synth); FStar_TypeChecker_Env.is_native_tactic = - (uu___95_8704.FStar_TypeChecker_Env.is_native_tactic); + (uu___95_8700.FStar_TypeChecker_Env.is_native_tactic); FStar_TypeChecker_Env.identifier_info = - (uu___95_8704.FStar_TypeChecker_Env.identifier_info); + (uu___95_8700.FStar_TypeChecker_Env.identifier_info); FStar_TypeChecker_Env.tc_hooks = - (uu___95_8704.FStar_TypeChecker_Env.tc_hooks); + (uu___95_8700.FStar_TypeChecker_Env.tc_hooks); FStar_TypeChecker_Env.dsenv = - (uu___95_8704.FStar_TypeChecker_Env.dsenv); + (uu___95_8700.FStar_TypeChecker_Env.dsenv); FStar_TypeChecker_Env.dep_graph = - (uu___95_8704.FStar_TypeChecker_Env.dep_graph) + (uu___95_8700.FStar_TypeChecker_Env.dep_graph) } in if push_before_typechecking then @@ -5287,19 +5287,19 @@ let tc_partial_modul: (let env2 = FStar_TypeChecker_Env.set_current_module env1 modul.FStar_Syntax_Syntax.name in - let uu____8708 = + let uu____8704 = tc_decls env2 modul.FStar_Syntax_Syntax.declarations in - match uu____8708 with + match uu____8704 with | (ses,exports,env3) -> - ((let uu___96_8741 = modul in + ((let uu___96_8737 = modul in { FStar_Syntax_Syntax.name = - (uu___96_8741.FStar_Syntax_Syntax.name); + (uu___96_8737.FStar_Syntax_Syntax.name); FStar_Syntax_Syntax.declarations = ses; FStar_Syntax_Syntax.exports = - (uu___96_8741.FStar_Syntax_Syntax.exports); + (uu___96_8737.FStar_Syntax_Syntax.exports); FStar_Syntax_Syntax.is_interface = - (uu___96_8741.FStar_Syntax_Syntax.is_interface) + (uu___96_8737.FStar_Syntax_Syntax.is_interface) }), exports, env3))) let tc_more_partial_modul: FStar_TypeChecker_Env.env -> @@ -5311,21 +5311,21 @@ let tc_more_partial_modul: fun env -> fun modul -> fun decls -> - let uu____8763 = tc_decls env decls in - match uu____8763 with + let uu____8759 = tc_decls env decls in + match uu____8759 with | (ses,exports,env1) -> let modul1 = - let uu___97_8794 = modul in + let uu___97_8790 = modul in { FStar_Syntax_Syntax.name = - (uu___97_8794.FStar_Syntax_Syntax.name); + (uu___97_8790.FStar_Syntax_Syntax.name); FStar_Syntax_Syntax.declarations = (FStar_List.append modul.FStar_Syntax_Syntax.declarations ses); FStar_Syntax_Syntax.exports = - (uu___97_8794.FStar_Syntax_Syntax.exports); + (uu___97_8790.FStar_Syntax_Syntax.exports); FStar_Syntax_Syntax.is_interface = - (uu___97_8794.FStar_Syntax_Syntax.is_interface) + (uu___97_8790.FStar_Syntax_Syntax.is_interface) } in (modul1, exports, env1) let check_exports: @@ -5337,159 +5337,159 @@ let check_exports: fun modul -> fun exports -> let env1 = - let uu___98_8811 = env in + let uu___98_8807 = env in { FStar_TypeChecker_Env.solver = - (uu___98_8811.FStar_TypeChecker_Env.solver); + (uu___98_8807.FStar_TypeChecker_Env.solver); FStar_TypeChecker_Env.range = - (uu___98_8811.FStar_TypeChecker_Env.range); + (uu___98_8807.FStar_TypeChecker_Env.range); FStar_TypeChecker_Env.curmodule = - (uu___98_8811.FStar_TypeChecker_Env.curmodule); + (uu___98_8807.FStar_TypeChecker_Env.curmodule); FStar_TypeChecker_Env.gamma = - (uu___98_8811.FStar_TypeChecker_Env.gamma); + (uu___98_8807.FStar_TypeChecker_Env.gamma); FStar_TypeChecker_Env.gamma_cache = - (uu___98_8811.FStar_TypeChecker_Env.gamma_cache); + (uu___98_8807.FStar_TypeChecker_Env.gamma_cache); FStar_TypeChecker_Env.modules = - (uu___98_8811.FStar_TypeChecker_Env.modules); + (uu___98_8807.FStar_TypeChecker_Env.modules); FStar_TypeChecker_Env.expected_typ = - (uu___98_8811.FStar_TypeChecker_Env.expected_typ); + (uu___98_8807.FStar_TypeChecker_Env.expected_typ); FStar_TypeChecker_Env.sigtab = - (uu___98_8811.FStar_TypeChecker_Env.sigtab); + (uu___98_8807.FStar_TypeChecker_Env.sigtab); FStar_TypeChecker_Env.is_pattern = - (uu___98_8811.FStar_TypeChecker_Env.is_pattern); + (uu___98_8807.FStar_TypeChecker_Env.is_pattern); FStar_TypeChecker_Env.instantiate_imp = - (uu___98_8811.FStar_TypeChecker_Env.instantiate_imp); + (uu___98_8807.FStar_TypeChecker_Env.instantiate_imp); FStar_TypeChecker_Env.effects = - (uu___98_8811.FStar_TypeChecker_Env.effects); + (uu___98_8807.FStar_TypeChecker_Env.effects); FStar_TypeChecker_Env.generalize = - (uu___98_8811.FStar_TypeChecker_Env.generalize); + (uu___98_8807.FStar_TypeChecker_Env.generalize); FStar_TypeChecker_Env.letrecs = - (uu___98_8811.FStar_TypeChecker_Env.letrecs); + (uu___98_8807.FStar_TypeChecker_Env.letrecs); FStar_TypeChecker_Env.top_level = true; FStar_TypeChecker_Env.check_uvars = - (uu___98_8811.FStar_TypeChecker_Env.check_uvars); + (uu___98_8807.FStar_TypeChecker_Env.check_uvars); FStar_TypeChecker_Env.use_eq = - (uu___98_8811.FStar_TypeChecker_Env.use_eq); + (uu___98_8807.FStar_TypeChecker_Env.use_eq); FStar_TypeChecker_Env.is_iface = - (uu___98_8811.FStar_TypeChecker_Env.is_iface); + (uu___98_8807.FStar_TypeChecker_Env.is_iface); FStar_TypeChecker_Env.admit = - (uu___98_8811.FStar_TypeChecker_Env.admit); + (uu___98_8807.FStar_TypeChecker_Env.admit); FStar_TypeChecker_Env.lax = true; FStar_TypeChecker_Env.lax_universes = true; FStar_TypeChecker_Env.failhard = - (uu___98_8811.FStar_TypeChecker_Env.failhard); + (uu___98_8807.FStar_TypeChecker_Env.failhard); FStar_TypeChecker_Env.nosynth = - (uu___98_8811.FStar_TypeChecker_Env.nosynth); + (uu___98_8807.FStar_TypeChecker_Env.nosynth); FStar_TypeChecker_Env.tc_term = - (uu___98_8811.FStar_TypeChecker_Env.tc_term); + (uu___98_8807.FStar_TypeChecker_Env.tc_term); FStar_TypeChecker_Env.type_of = - (uu___98_8811.FStar_TypeChecker_Env.type_of); + (uu___98_8807.FStar_TypeChecker_Env.type_of); FStar_TypeChecker_Env.universe_of = - (uu___98_8811.FStar_TypeChecker_Env.universe_of); + (uu___98_8807.FStar_TypeChecker_Env.universe_of); FStar_TypeChecker_Env.use_bv_sorts = - (uu___98_8811.FStar_TypeChecker_Env.use_bv_sorts); + (uu___98_8807.FStar_TypeChecker_Env.use_bv_sorts); FStar_TypeChecker_Env.qname_and_index = - (uu___98_8811.FStar_TypeChecker_Env.qname_and_index); + (uu___98_8807.FStar_TypeChecker_Env.qname_and_index); FStar_TypeChecker_Env.proof_ns = - (uu___98_8811.FStar_TypeChecker_Env.proof_ns); + (uu___98_8807.FStar_TypeChecker_Env.proof_ns); FStar_TypeChecker_Env.synth = - (uu___98_8811.FStar_TypeChecker_Env.synth); + (uu___98_8807.FStar_TypeChecker_Env.synth); FStar_TypeChecker_Env.is_native_tactic = - (uu___98_8811.FStar_TypeChecker_Env.is_native_tactic); + (uu___98_8807.FStar_TypeChecker_Env.is_native_tactic); FStar_TypeChecker_Env.identifier_info = - (uu___98_8811.FStar_TypeChecker_Env.identifier_info); + (uu___98_8807.FStar_TypeChecker_Env.identifier_info); FStar_TypeChecker_Env.tc_hooks = - (uu___98_8811.FStar_TypeChecker_Env.tc_hooks); + (uu___98_8807.FStar_TypeChecker_Env.tc_hooks); FStar_TypeChecker_Env.dsenv = - (uu___98_8811.FStar_TypeChecker_Env.dsenv); + (uu___98_8807.FStar_TypeChecker_Env.dsenv); FStar_TypeChecker_Env.dep_graph = - (uu___98_8811.FStar_TypeChecker_Env.dep_graph) + (uu___98_8807.FStar_TypeChecker_Env.dep_graph) } in let check_term1 lid univs1 t = - let uu____8822 = FStar_Syntax_Subst.open_univ_vars univs1 t in - match uu____8822 with + let uu____8818 = FStar_Syntax_Subst.open_univ_vars univs1 t in + match uu____8818 with | (univs2,t1) -> - ((let uu____8830 = - let uu____8831 = - let uu____8834 = + ((let uu____8826 = + let uu____8827 = + let uu____8830 = FStar_TypeChecker_Env.set_current_module env1 modul.FStar_Syntax_Syntax.name in - FStar_TypeChecker_Env.debug uu____8834 in - FStar_All.pipe_left uu____8831 + FStar_TypeChecker_Env.debug uu____8830 in + FStar_All.pipe_left uu____8827 (FStar_Options.Other "Exports") in - if uu____8830 + if uu____8826 then - let uu____8835 = FStar_Syntax_Print.lid_to_string lid in - let uu____8836 = - let uu____8837 = + let uu____8831 = FStar_Syntax_Print.lid_to_string lid in + let uu____8832 = + let uu____8833 = FStar_All.pipe_right univs2 (FStar_List.map (fun x -> FStar_Syntax_Print.univ_to_string (FStar_Syntax_Syntax.U_name x))) in - FStar_All.pipe_right uu____8837 + FStar_All.pipe_right uu____8833 (FStar_String.concat ", ") in - let uu____8846 = FStar_Syntax_Print.term_to_string t1 in + let uu____8842 = FStar_Syntax_Print.term_to_string t1 in FStar_Util.print3 "Checking for export %s <%s> : %s\n" - uu____8835 uu____8836 uu____8846 + uu____8831 uu____8832 uu____8842 else ()); (let env2 = FStar_TypeChecker_Env.push_univ_vars env1 univs2 in - let uu____8849 = + let uu____8845 = FStar_TypeChecker_TcTerm.tc_trivial_guard env2 t1 in - FStar_All.pipe_right uu____8849 FStar_Pervasives.ignore)) in + FStar_All.pipe_right uu____8845 FStar_Pervasives.ignore)) in let check_term2 lid univs1 t = - (let uu____8873 = - let uu____8874 = + (let uu____8869 = + let uu____8870 = FStar_Syntax_Print.lid_to_string modul.FStar_Syntax_Syntax.name in - let uu____8875 = FStar_Syntax_Print.lid_to_string lid in + let uu____8871 = FStar_Syntax_Print.lid_to_string lid in FStar_Util.format2 "Interface of %s violates its abstraction (add a 'private' qualifier to '%s'?)" - uu____8874 uu____8875 in - FStar_Errors.message_prefix.FStar_Errors.set_prefix uu____8873); + uu____8870 uu____8871 in + FStar_Errors.message_prefix.FStar_Errors.set_prefix uu____8869); check_term1 lid univs1 t; FStar_Errors.message_prefix.FStar_Errors.clear_prefix () in let rec check_sigelt se = match se.FStar_Syntax_Syntax.sigel with - | FStar_Syntax_Syntax.Sig_bundle (ses,uu____8882) -> - let uu____8891 = - let uu____8892 = + | FStar_Syntax_Syntax.Sig_bundle (ses,uu____8878) -> + let uu____8887 = + let uu____8888 = FStar_All.pipe_right se.FStar_Syntax_Syntax.sigquals (FStar_List.contains FStar_Syntax_Syntax.Private) in - Prims.op_Negation uu____8892 in - if uu____8891 + Prims.op_Negation uu____8888 in + if uu____8887 then FStar_All.pipe_right ses (FStar_List.iter check_sigelt) else () | FStar_Syntax_Syntax.Sig_inductive_typ - (l,univs1,binders,typ,uu____8902,uu____8903) -> + (l,univs1,binders,typ,uu____8898,uu____8899) -> let t = - let uu____8915 = - let uu____8918 = - let uu____8919 = - let uu____8932 = FStar_Syntax_Syntax.mk_Total typ in - (binders, uu____8932) in - FStar_Syntax_Syntax.Tm_arrow uu____8919 in - FStar_Syntax_Syntax.mk uu____8918 in - uu____8915 FStar_Pervasives_Native.None + let uu____8911 = + let uu____8914 = + let uu____8915 = + let uu____8928 = FStar_Syntax_Syntax.mk_Total typ in + (binders, uu____8928) in + FStar_Syntax_Syntax.Tm_arrow uu____8915 in + FStar_Syntax_Syntax.mk uu____8914 in + uu____8911 FStar_Pervasives_Native.None se.FStar_Syntax_Syntax.sigrng in check_term2 l univs1 t | FStar_Syntax_Syntax.Sig_datacon - (l,univs1,t,uu____8939,uu____8940,uu____8941) -> + (l,univs1,t,uu____8935,uu____8936,uu____8937) -> check_term2 l univs1 t | FStar_Syntax_Syntax.Sig_declare_typ (l,univs1,t) -> - let uu____8949 = - let uu____8950 = + let uu____8945 = + let uu____8946 = FStar_All.pipe_right se.FStar_Syntax_Syntax.sigquals (FStar_List.contains FStar_Syntax_Syntax.Private) in - Prims.op_Negation uu____8950 in - if uu____8949 then check_term2 l univs1 t else () - | FStar_Syntax_Syntax.Sig_let ((uu____8954,lbs),uu____8956) -> - let uu____8971 = - let uu____8972 = + Prims.op_Negation uu____8946 in + if uu____8945 then check_term2 l univs1 t else () + | FStar_Syntax_Syntax.Sig_let ((uu____8950,lbs),uu____8952) -> + let uu____8967 = + let uu____8968 = FStar_All.pipe_right se.FStar_Syntax_Syntax.sigquals (FStar_List.contains FStar_Syntax_Syntax.Private) in - Prims.op_Negation uu____8972 in - if uu____8971 + Prims.op_Negation uu____8968 in + if uu____8967 then FStar_All.pipe_right lbs (FStar_List.iter @@ -5503,12 +5503,12 @@ let check_exports: else () | FStar_Syntax_Syntax.Sig_effect_abbrev (l,univs1,binders,comp,flags1) -> - let uu____8991 = - let uu____8992 = + let uu____8987 = + let uu____8988 = FStar_All.pipe_right se.FStar_Syntax_Syntax.sigquals (FStar_List.contains FStar_Syntax_Syntax.Private) in - Prims.op_Negation uu____8992 in - if uu____8991 + Prims.op_Negation uu____8988 in + if uu____8987 then let arrow1 = FStar_Syntax_Syntax.mk @@ -5517,12 +5517,12 @@ let check_exports: se.FStar_Syntax_Syntax.sigrng in check_term2 l univs1 arrow1 else () - | FStar_Syntax_Syntax.Sig_main uu____8999 -> () - | FStar_Syntax_Syntax.Sig_assume uu____9000 -> () - | FStar_Syntax_Syntax.Sig_new_effect uu____9007 -> () - | FStar_Syntax_Syntax.Sig_new_effect_for_free uu____9008 -> () - | FStar_Syntax_Syntax.Sig_sub_effect uu____9009 -> () - | FStar_Syntax_Syntax.Sig_pragma uu____9010 -> () in + | FStar_Syntax_Syntax.Sig_main uu____8995 -> () + | FStar_Syntax_Syntax.Sig_assume uu____8996 -> () + | FStar_Syntax_Syntax.Sig_new_effect uu____9003 -> () + | FStar_Syntax_Syntax.Sig_new_effect_for_free uu____9004 -> () + | FStar_Syntax_Syntax.Sig_sub_effect uu____9005 -> () + | FStar_Syntax_Syntax.Sig_pragma uu____9006 -> () in if FStar_Ident.lid_equals modul.FStar_Syntax_Syntax.name FStar_Parser_Const.prims_lid @@ -5541,21 +5541,21 @@ let finish_partial_modul: fun modul -> fun exports -> let modul1 = - let uu___99_9029 = modul in + let uu___99_9025 = modul in { FStar_Syntax_Syntax.name = - (uu___99_9029.FStar_Syntax_Syntax.name); + (uu___99_9025.FStar_Syntax_Syntax.name); FStar_Syntax_Syntax.declarations = - (uu___99_9029.FStar_Syntax_Syntax.declarations); + (uu___99_9025.FStar_Syntax_Syntax.declarations); FStar_Syntax_Syntax.exports = exports; FStar_Syntax_Syntax.is_interface = (modul.FStar_Syntax_Syntax.is_interface) } in let env1 = FStar_TypeChecker_Env.finish_module env modul1 in - (let uu____9032 = - (let uu____9035 = FStar_Options.lax () in - Prims.op_Negation uu____9035) && must_check_exports in - if uu____9032 then check_exports env1 modul1 exports else ()); + (let uu____9028 = + (let uu____9031 = FStar_Options.lax () in + Prims.op_Negation uu____9031) && must_check_exports in + if uu____9028 then check_exports env1 modul1 exports else ()); (env1.FStar_TypeChecker_Env.solver).FStar_TypeChecker_Env.pop (Prims.strcat "Ending modul " (modul1.FStar_Syntax_Syntax.name).FStar_Ident.str); @@ -5563,13 +5563,13 @@ let finish_partial_modul: env1 modul1; (env1.FStar_TypeChecker_Env.solver).FStar_TypeChecker_Env.refresh (); - (let uu____9041 = - let uu____9042 = FStar_Options.interactive () in - Prims.op_Negation uu____9042 in - if uu____9041 + (let uu____9037 = + let uu____9038 = FStar_Options.interactive () in + Prims.op_Negation uu____9038 in + if uu____9037 then - let uu____9043 = FStar_Options.restore_cmd_line_options true in - FStar_All.pipe_right uu____9043 FStar_Pervasives.ignore + let uu____9039 = FStar_Options.restore_cmd_line_options true in + FStar_All.pipe_right uu____9039 FStar_Pervasives.ignore else ()); (modul1, env1) let load_checked_module: @@ -5581,12 +5581,12 @@ let load_checked_module: let env1 = FStar_TypeChecker_Env.set_current_module env modul.FStar_Syntax_Syntax.name in - (let uu____9053 = - let uu____9054 = + (let uu____9049 = + let uu____9050 = FStar_Ident.string_of_lid modul.FStar_Syntax_Syntax.name in - Prims.strcat "Internals for " uu____9054 in + Prims.strcat "Internals for " uu____9050 in (env1.FStar_TypeChecker_Env.solver).FStar_TypeChecker_Env.push - uu____9053); + uu____9049); (let env2 = FStar_List.fold_left (fun env2 -> @@ -5596,14 +5596,14 @@ let load_checked_module: FStar_All.pipe_right lids (FStar_List.iter (fun lid -> - let uu____9073 = + let uu____9069 = FStar_TypeChecker_Env.try_lookup_lid env3 lid in ())); env3) env1 modul.FStar_Syntax_Syntax.declarations in - let uu____9094 = + let uu____9090 = finish_partial_modul false env2 modul modul.FStar_Syntax_Syntax.exports in - FStar_Pervasives_Native.snd uu____9094) + FStar_Pervasives_Native.snd uu____9090) let tc_modul: FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.modul -> @@ -5612,8 +5612,8 @@ let tc_modul: = fun env -> fun modul -> - let uu____9109 = tc_partial_modul env modul true in - match uu____9109 with + let uu____9105 = tc_partial_modul env modul true in + match uu____9105 with | (modul1,non_private_decls,env1) -> finish_partial_modul true env1 modul1 non_private_decls let check_module: @@ -5624,110 +5624,110 @@ let check_module: = fun env -> fun m -> - (let uu____9140 = FStar_Options.debug_any () in - if uu____9140 + (let uu____9136 = FStar_Options.debug_any () in + if uu____9136 then - let uu____9141 = + let uu____9137 = FStar_Syntax_Print.lid_to_string m.FStar_Syntax_Syntax.name in FStar_Util.print2 "Checking %s: %s\n" (if m.FStar_Syntax_Syntax.is_interface then "i'face" else "module") - uu____9141 + uu____9137 else ()); (let env1 = - let uu___100_9145 = env in - let uu____9146 = - let uu____9147 = + let uu___100_9141 = env in + let uu____9142 = + let uu____9143 = FStar_Options.should_verify (m.FStar_Syntax_Syntax.name).FStar_Ident.str in - Prims.op_Negation uu____9147 in + Prims.op_Negation uu____9143 in { FStar_TypeChecker_Env.solver = - (uu___100_9145.FStar_TypeChecker_Env.solver); + (uu___100_9141.FStar_TypeChecker_Env.solver); FStar_TypeChecker_Env.range = - (uu___100_9145.FStar_TypeChecker_Env.range); + (uu___100_9141.FStar_TypeChecker_Env.range); FStar_TypeChecker_Env.curmodule = - (uu___100_9145.FStar_TypeChecker_Env.curmodule); + (uu___100_9141.FStar_TypeChecker_Env.curmodule); FStar_TypeChecker_Env.gamma = - (uu___100_9145.FStar_TypeChecker_Env.gamma); + (uu___100_9141.FStar_TypeChecker_Env.gamma); FStar_TypeChecker_Env.gamma_cache = - (uu___100_9145.FStar_TypeChecker_Env.gamma_cache); + (uu___100_9141.FStar_TypeChecker_Env.gamma_cache); FStar_TypeChecker_Env.modules = - (uu___100_9145.FStar_TypeChecker_Env.modules); + (uu___100_9141.FStar_TypeChecker_Env.modules); FStar_TypeChecker_Env.expected_typ = - (uu___100_9145.FStar_TypeChecker_Env.expected_typ); + (uu___100_9141.FStar_TypeChecker_Env.expected_typ); FStar_TypeChecker_Env.sigtab = - (uu___100_9145.FStar_TypeChecker_Env.sigtab); + (uu___100_9141.FStar_TypeChecker_Env.sigtab); FStar_TypeChecker_Env.is_pattern = - (uu___100_9145.FStar_TypeChecker_Env.is_pattern); + (uu___100_9141.FStar_TypeChecker_Env.is_pattern); FStar_TypeChecker_Env.instantiate_imp = - (uu___100_9145.FStar_TypeChecker_Env.instantiate_imp); + (uu___100_9141.FStar_TypeChecker_Env.instantiate_imp); FStar_TypeChecker_Env.effects = - (uu___100_9145.FStar_TypeChecker_Env.effects); + (uu___100_9141.FStar_TypeChecker_Env.effects); FStar_TypeChecker_Env.generalize = - (uu___100_9145.FStar_TypeChecker_Env.generalize); + (uu___100_9141.FStar_TypeChecker_Env.generalize); FStar_TypeChecker_Env.letrecs = - (uu___100_9145.FStar_TypeChecker_Env.letrecs); + (uu___100_9141.FStar_TypeChecker_Env.letrecs); FStar_TypeChecker_Env.top_level = - (uu___100_9145.FStar_TypeChecker_Env.top_level); + (uu___100_9141.FStar_TypeChecker_Env.top_level); FStar_TypeChecker_Env.check_uvars = - (uu___100_9145.FStar_TypeChecker_Env.check_uvars); + (uu___100_9141.FStar_TypeChecker_Env.check_uvars); FStar_TypeChecker_Env.use_eq = - (uu___100_9145.FStar_TypeChecker_Env.use_eq); + (uu___100_9141.FStar_TypeChecker_Env.use_eq); FStar_TypeChecker_Env.is_iface = - (uu___100_9145.FStar_TypeChecker_Env.is_iface); + (uu___100_9141.FStar_TypeChecker_Env.is_iface); FStar_TypeChecker_Env.admit = - (uu___100_9145.FStar_TypeChecker_Env.admit); - FStar_TypeChecker_Env.lax = uu____9146; + (uu___100_9141.FStar_TypeChecker_Env.admit); + FStar_TypeChecker_Env.lax = uu____9142; FStar_TypeChecker_Env.lax_universes = - (uu___100_9145.FStar_TypeChecker_Env.lax_universes); + (uu___100_9141.FStar_TypeChecker_Env.lax_universes); FStar_TypeChecker_Env.failhard = - (uu___100_9145.FStar_TypeChecker_Env.failhard); + (uu___100_9141.FStar_TypeChecker_Env.failhard); FStar_TypeChecker_Env.nosynth = - (uu___100_9145.FStar_TypeChecker_Env.nosynth); + (uu___100_9141.FStar_TypeChecker_Env.nosynth); FStar_TypeChecker_Env.tc_term = - (uu___100_9145.FStar_TypeChecker_Env.tc_term); + (uu___100_9141.FStar_TypeChecker_Env.tc_term); FStar_TypeChecker_Env.type_of = - (uu___100_9145.FStar_TypeChecker_Env.type_of); + (uu___100_9141.FStar_TypeChecker_Env.type_of); FStar_TypeChecker_Env.universe_of = - (uu___100_9145.FStar_TypeChecker_Env.universe_of); + (uu___100_9141.FStar_TypeChecker_Env.universe_of); FStar_TypeChecker_Env.use_bv_sorts = - (uu___100_9145.FStar_TypeChecker_Env.use_bv_sorts); + (uu___100_9141.FStar_TypeChecker_Env.use_bv_sorts); FStar_TypeChecker_Env.qname_and_index = - (uu___100_9145.FStar_TypeChecker_Env.qname_and_index); + (uu___100_9141.FStar_TypeChecker_Env.qname_and_index); FStar_TypeChecker_Env.proof_ns = - (uu___100_9145.FStar_TypeChecker_Env.proof_ns); + (uu___100_9141.FStar_TypeChecker_Env.proof_ns); FStar_TypeChecker_Env.synth = - (uu___100_9145.FStar_TypeChecker_Env.synth); + (uu___100_9141.FStar_TypeChecker_Env.synth); FStar_TypeChecker_Env.is_native_tactic = - (uu___100_9145.FStar_TypeChecker_Env.is_native_tactic); + (uu___100_9141.FStar_TypeChecker_Env.is_native_tactic); FStar_TypeChecker_Env.identifier_info = - (uu___100_9145.FStar_TypeChecker_Env.identifier_info); + (uu___100_9141.FStar_TypeChecker_Env.identifier_info); FStar_TypeChecker_Env.tc_hooks = - (uu___100_9145.FStar_TypeChecker_Env.tc_hooks); + (uu___100_9141.FStar_TypeChecker_Env.tc_hooks); FStar_TypeChecker_Env.dsenv = - (uu___100_9145.FStar_TypeChecker_Env.dsenv); + (uu___100_9141.FStar_TypeChecker_Env.dsenv); FStar_TypeChecker_Env.dep_graph = - (uu___100_9145.FStar_TypeChecker_Env.dep_graph) + (uu___100_9141.FStar_TypeChecker_Env.dep_graph) } in - let uu____9148 = tc_modul env1 m in - match uu____9148 with + let uu____9144 = tc_modul env1 m in + match uu____9144 with | (m1,env2) -> - ((let uu____9160 = + ((let uu____9156 = FStar_Options.dump_module (m1.FStar_Syntax_Syntax.name).FStar_Ident.str in - if uu____9160 + if uu____9156 then - let uu____9161 = FStar_Syntax_Print.modul_to_string m1 in - FStar_Util.print1 "%s\n" uu____9161 + let uu____9157 = FStar_Syntax_Print.modul_to_string m1 in + FStar_Util.print1 "%s\n" uu____9157 else ()); - (let uu____9164 = + (let uu____9160 = (FStar_Options.dump_module (m1.FStar_Syntax_Syntax.name).FStar_Ident.str) && (FStar_Options.debug_at_level (m1.FStar_Syntax_Syntax.name).FStar_Ident.str (FStar_Options.Other "Normalize")) in - if uu____9164 + if uu____9160 then let normalize_toplevel_lets se = match se.FStar_Syntax_Syntax.sigel with @@ -5743,65 +5743,65 @@ let check_module: FStar_Syntax_Syntax.Delta_constant; FStar_TypeChecker_Normalize.AllowUnboundUniverses] in let update lb = - let uu____9195 = + let uu____9191 = FStar_Syntax_Subst.open_univ_vars lb.FStar_Syntax_Syntax.lbunivs lb.FStar_Syntax_Syntax.lbdef in - match uu____9195 with + match uu____9191 with | (univnames1,e) -> - let uu___101_9202 = lb in - let uu____9203 = - let uu____9206 = + let uu___101_9198 = lb in + let uu____9199 = + let uu____9202 = FStar_TypeChecker_Env.push_univ_vars env2 univnames1 in - n1 uu____9206 e in + n1 uu____9202 e in { FStar_Syntax_Syntax.lbname = - (uu___101_9202.FStar_Syntax_Syntax.lbname); + (uu___101_9198.FStar_Syntax_Syntax.lbname); FStar_Syntax_Syntax.lbunivs = - (uu___101_9202.FStar_Syntax_Syntax.lbunivs); + (uu___101_9198.FStar_Syntax_Syntax.lbunivs); FStar_Syntax_Syntax.lbtyp = - (uu___101_9202.FStar_Syntax_Syntax.lbtyp); + (uu___101_9198.FStar_Syntax_Syntax.lbtyp); FStar_Syntax_Syntax.lbeff = - (uu___101_9202.FStar_Syntax_Syntax.lbeff); - FStar_Syntax_Syntax.lbdef = uu____9203 + (uu___101_9198.FStar_Syntax_Syntax.lbeff); + FStar_Syntax_Syntax.lbdef = uu____9199 } in - let uu___102_9207 = se in - let uu____9208 = - let uu____9209 = - let uu____9216 = - let uu____9223 = FStar_List.map update lbs in - (b, uu____9223) in - (uu____9216, ids) in - FStar_Syntax_Syntax.Sig_let uu____9209 in + let uu___102_9203 = se in + let uu____9204 = + let uu____9205 = + let uu____9212 = + let uu____9219 = FStar_List.map update lbs in + (b, uu____9219) in + (uu____9212, ids) in + FStar_Syntax_Syntax.Sig_let uu____9205 in { - FStar_Syntax_Syntax.sigel = uu____9208; + FStar_Syntax_Syntax.sigel = uu____9204; FStar_Syntax_Syntax.sigrng = - (uu___102_9207.FStar_Syntax_Syntax.sigrng); + (uu___102_9203.FStar_Syntax_Syntax.sigrng); FStar_Syntax_Syntax.sigquals = - (uu___102_9207.FStar_Syntax_Syntax.sigquals); + (uu___102_9203.FStar_Syntax_Syntax.sigquals); FStar_Syntax_Syntax.sigmeta = - (uu___102_9207.FStar_Syntax_Syntax.sigmeta); + (uu___102_9203.FStar_Syntax_Syntax.sigmeta); FStar_Syntax_Syntax.sigattrs = - (uu___102_9207.FStar_Syntax_Syntax.sigattrs) + (uu___102_9203.FStar_Syntax_Syntax.sigattrs) } - | uu____9236 -> se in + | uu____9232 -> se in let normalized_module = - let uu___103_9238 = m1 in - let uu____9239 = + let uu___103_9234 = m1 in + let uu____9235 = FStar_List.map normalize_toplevel_lets m1.FStar_Syntax_Syntax.declarations in { FStar_Syntax_Syntax.name = - (uu___103_9238.FStar_Syntax_Syntax.name); - FStar_Syntax_Syntax.declarations = uu____9239; + (uu___103_9234.FStar_Syntax_Syntax.name); + FStar_Syntax_Syntax.declarations = uu____9235; FStar_Syntax_Syntax.exports = - (uu___103_9238.FStar_Syntax_Syntax.exports); + (uu___103_9234.FStar_Syntax_Syntax.exports); FStar_Syntax_Syntax.is_interface = - (uu___103_9238.FStar_Syntax_Syntax.is_interface) + (uu___103_9234.FStar_Syntax_Syntax.is_interface) } in - let uu____9240 = + let uu____9236 = FStar_Syntax_Print.modul_to_string normalized_module in - FStar_Util.print1 "%s\n" uu____9240 + FStar_Util.print1 "%s\n" uu____9236 else ()); (m1, env2))) \ No newline at end of file diff --git a/src/ocaml-output/FStar_TypeChecker_TcTerm.ml b/src/ocaml-output/FStar_TypeChecker_TcTerm.ml index 66a66301bb9..b462b8c2e4c 100644 --- a/src/ocaml-output/FStar_TypeChecker_TcTerm.ml +++ b/src/ocaml-output/FStar_TypeChecker_TcTerm.ml @@ -261,22 +261,15 @@ let maybe_extend_subst: :: s let set_lcomp_result: FStar_Syntax_Syntax.lcomp -> - FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax -> - FStar_Syntax_Syntax.lcomp + FStar_Syntax_Syntax.typ -> FStar_Syntax_Syntax.lcomp = fun lc -> fun t -> - let uu___66_198 = lc in - { - FStar_Syntax_Syntax.eff_name = - (uu___66_198.FStar_Syntax_Syntax.eff_name); - FStar_Syntax_Syntax.res_typ = t; - FStar_Syntax_Syntax.cflags = (uu___66_198.FStar_Syntax_Syntax.cflags); - FStar_Syntax_Syntax.comp = - (fun uu____201 -> - let uu____202 = lc.FStar_Syntax_Syntax.comp () in - FStar_Syntax_Util.set_result_typ uu____202 t) - } + FStar_Syntax_Syntax.mk_lcomp lc.FStar_Syntax_Syntax.eff_name t + lc.FStar_Syntax_Syntax.cflags + (fun uu____196 -> + let uu____197 = FStar_Syntax_Syntax.lcomp_comp lc in + FStar_Syntax_Util.set_result_typ uu____197 t) let memo_tk: FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.typ -> FStar_Syntax_Syntax.term @@ -294,122 +287,66 @@ let value_check_expected_typ: fun e -> fun tlc -> fun guard -> - let e0 = e in - let should_return t = - let uu____248 = - let uu____249 = FStar_Syntax_Subst.compress t in - uu____249.FStar_Syntax_Syntax.n in - match uu____248 with - | FStar_Syntax_Syntax.Tm_arrow (uu____252,c) -> - let uu____270 = - FStar_TypeChecker_Util.is_pure_or_ghost_effect env - (FStar_Syntax_Util.comp_effect_name c) in - if uu____270 - then - let t1 = - FStar_All.pipe_left FStar_Syntax_Util.unrefine - (FStar_Syntax_Util.comp_result c) in - let uu____272 = - let uu____273 = FStar_Syntax_Subst.compress t1 in - uu____273.FStar_Syntax_Syntax.n in - (match uu____272 with - | FStar_Syntax_Syntax.Tm_constant uu____276 -> false - | uu____277 -> - let uu____278 = FStar_Syntax_Util.is_unit t1 in - Prims.op_Negation uu____278) - else false - | uu____280 -> - let uu____281 = FStar_Syntax_Util.is_unit t in - Prims.op_Negation uu____281 in let lc = match tlc with | FStar_Util.Inl t -> - let uu____284 = - let uu____287 = - (let uu____290 = should_return t in - Prims.op_Negation uu____290) || - (let uu____292 = - FStar_TypeChecker_Env.should_verify env in - Prims.op_Negation uu____292) in - if uu____287 - then FStar_Syntax_Syntax.mk_Total t - else FStar_TypeChecker_Util.return_value env t e in - FStar_Syntax_Util.lcomp_of_comp uu____284 + let uu____240 = FStar_Syntax_Syntax.mk_Total t in + FStar_All.pipe_left FStar_Syntax_Util.lcomp_of_comp uu____240 | FStar_Util.Inr lc -> lc in let t = lc.FStar_Syntax_Syntax.res_typ in - let uu____300 = - let uu____307 = FStar_TypeChecker_Env.expected_typ env in - match uu____307 with + let uu____249 = + let uu____256 = FStar_TypeChecker_Env.expected_typ env in + match uu____256 with | FStar_Pervasives_Native.None -> ((memo_tk e t), lc, guard) | FStar_Pervasives_Native.Some t' -> - ((let uu____318 = - FStar_TypeChecker_Env.debug env FStar_Options.High in - if uu____318 - then - let uu____319 = FStar_Syntax_Print.term_to_string t in - let uu____320 = FStar_Syntax_Print.term_to_string t' in - FStar_Util.print2 - "Computed return type %s; expected type %s\n" uu____319 - uu____320 - else ()); - (let uu____322 = - FStar_TypeChecker_Util.maybe_coerce_bool_to_type env e lc - t' in - match uu____322 with - | (e1,lc1) -> - let t1 = lc1.FStar_Syntax_Syntax.res_typ in - let uu____338 = - FStar_TypeChecker_Util.check_and_ascribe env e1 t1 t' in - (match uu____338 with - | (e2,g) -> - ((let uu____352 = - FStar_TypeChecker_Env.debug env - FStar_Options.High in - if uu____352 - then - let uu____353 = - FStar_Syntax_Print.term_to_string t1 in - let uu____354 = - FStar_Syntax_Print.term_to_string t' in - let uu____355 = - FStar_TypeChecker_Rel.guard_to_string env g in - let uu____356 = - FStar_TypeChecker_Rel.guard_to_string env - guard in - FStar_Util.print4 - "check_and_ascribe: type is %s<:%s \tguard is %s, %s\n" - uu____353 uu____354 uu____355 uu____356 - else ()); - (let msg = - let uu____363 = - FStar_TypeChecker_Rel.is_trivial g in - if uu____363 - then FStar_Pervasives_Native.None - else - FStar_All.pipe_left - (fun _0_40 -> - FStar_Pervasives_Native.Some _0_40) - (FStar_TypeChecker_Err.subtyping_failed - env t1 t') in - let g1 = - FStar_TypeChecker_Rel.conj_guard g guard in - let uu____380 = - FStar_TypeChecker_Util.strengthen_precondition - msg env e2 lc1 g1 in - match uu____380 with - | (lc2,g2) -> - ((memo_tk e2 t'), (set_lcomp_result lc2 t'), - g2)))))) in - match uu____300 with - | (e1,lc1,g) -> - ((let uu____403 = - FStar_TypeChecker_Env.debug env FStar_Options.Low in - if uu____403 - then - let uu____404 = FStar_Syntax_Print.lcomp_to_string lc1 in - FStar_Util.print1 "Return comp type is %s\n" uu____404 - else ()); - (e1, lc1, g)) + let uu____266 = + FStar_TypeChecker_Util.maybe_coerce_bool_to_type env e lc + t' in + (match uu____266 with + | (e1,lc1) -> + let t1 = lc1.FStar_Syntax_Syntax.res_typ in + let uu____282 = + FStar_TypeChecker_Util.check_and_ascribe env e1 t1 t' in + (match uu____282 with + | (e2,g) -> + ((let uu____296 = + FStar_TypeChecker_Env.debug env + FStar_Options.High in + if uu____296 + then + let uu____297 = + FStar_Syntax_Print.term_to_string t1 in + let uu____298 = + FStar_Syntax_Print.term_to_string t' in + let uu____299 = + FStar_TypeChecker_Rel.guard_to_string env g in + let uu____300 = + FStar_TypeChecker_Rel.guard_to_string env + guard in + FStar_Util.print4 + "check_and_ascribe: type is %s<:%s \tguard is %s, %s\n" + uu____297 uu____298 uu____299 uu____300 + else ()); + (let msg = + let uu____307 = + FStar_TypeChecker_Rel.is_trivial g in + if uu____307 + then FStar_Pervasives_Native.None + else + FStar_All.pipe_left + (fun _0_40 -> + FStar_Pervasives_Native.Some _0_40) + (FStar_TypeChecker_Err.subtyping_failed env + t1 t') in + let g1 = FStar_TypeChecker_Rel.conj_guard g guard in + let uu____324 = + FStar_TypeChecker_Util.strengthen_precondition + msg env e2 lc1 g1 in + match uu____324 with + | (lc2,g2) -> + let uu____337 = set_lcomp_result lc2 t' in + ((memo_tk e2 t'), uu____337, g2))))) in + match uu____249 with | (e1,lc1,g) -> (e1, lc1, g) let comp_check_expected_typ: FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.term -> @@ -420,14 +357,14 @@ let comp_check_expected_typ: fun env -> fun e -> fun lc -> - let uu____427 = FStar_TypeChecker_Env.expected_typ env in - match uu____427 with + let uu____368 = FStar_TypeChecker_Env.expected_typ env in + match uu____368 with | FStar_Pervasives_Native.None -> (e, lc, FStar_TypeChecker_Rel.trivial_guard) | FStar_Pervasives_Native.Some t -> - let uu____437 = + let uu____378 = FStar_TypeChecker_Util.maybe_coerce_bool_to_type env e lc t in - (match uu____437 with + (match uu____378 with | (e1,lc1) -> FStar_TypeChecker_Util.weaken_result_typ env e1 lc1 t) let check_expected_effect: @@ -440,27 +377,27 @@ let check_expected_effect: = fun env -> fun copt -> - fun uu____470 -> - match uu____470 with + fun uu____411 -> + match uu____411 with | (e,c) -> let tot_or_gtot c1 = - let uu____499 = FStar_Syntax_Util.is_pure_comp c1 in - if uu____499 + let uu____440 = FStar_Syntax_Util.is_pure_comp c1 in + if uu____440 then FStar_Syntax_Syntax.mk_Total (FStar_Syntax_Util.comp_result c1) else - (let uu____501 = FStar_Syntax_Util.is_pure_or_ghost_comp c1 in - if uu____501 + (let uu____442 = FStar_Syntax_Util.is_pure_or_ghost_comp c1 in + if uu____442 then FStar_Syntax_Syntax.mk_GTotal (FStar_Syntax_Util.comp_result c1) else failwith "Impossible: Expected pure_or_ghost comp") in - let uu____503 = + let uu____444 = match copt with - | FStar_Pervasives_Native.Some uu____516 -> (copt, c) + | FStar_Pervasives_Native.Some uu____457 -> (copt, c) | FStar_Pervasives_Native.None -> - let uu____519 = + let uu____460 = ((FStar_Options.ml_ish ()) && (FStar_Ident.lid_equals FStar_Parser_Const.effect_ALL_lid @@ -469,101 +406,106 @@ let check_expected_effect: (((FStar_Options.ml_ish ()) && env.FStar_TypeChecker_Env.lax) && - (let uu____521 = + (let uu____462 = FStar_Syntax_Util.is_pure_or_ghost_comp c in - Prims.op_Negation uu____521)) in - if uu____519 + Prims.op_Negation uu____462)) in + if uu____460 then - let uu____528 = - let uu____531 = + let uu____469 = + let uu____472 = FStar_Syntax_Util.ml_comp (FStar_Syntax_Util.comp_result c) e.FStar_Syntax_Syntax.pos in - FStar_Pervasives_Native.Some uu____531 in - (uu____528, c) + FStar_Pervasives_Native.Some uu____472 in + (uu____469, c) else - (let uu____535 = FStar_Syntax_Util.is_tot_or_gtot_comp c in - if uu____535 + (let uu____476 = FStar_Syntax_Util.is_tot_or_gtot_comp c in + if uu____476 then - let uu____542 = tot_or_gtot c in - (FStar_Pervasives_Native.None, uu____542) + let uu____483 = tot_or_gtot c in + (FStar_Pervasives_Native.None, uu____483) else - (let uu____546 = + (let uu____487 = FStar_Syntax_Util.is_pure_or_ghost_comp c in - if uu____546 + if uu____487 then - let uu____553 = - let uu____556 = tot_or_gtot c in - FStar_Pervasives_Native.Some uu____556 in - (uu____553, c) + let uu____494 = + let uu____497 = tot_or_gtot c in + FStar_Pervasives_Native.Some uu____497 in + (uu____494, c) else (FStar_Pervasives_Native.None, c))) in - (match uu____503 with + (match uu____444 with | (expected_c_opt,c1) -> let c2 = norm_c env c1 in (match expected_c_opt with | FStar_Pervasives_Native.None -> (e, c2, FStar_TypeChecker_Rel.trivial_guard) | FStar_Pervasives_Native.Some expected_c -> - let uu____582 = - FStar_TypeChecker_Util.check_comp env e c2 expected_c in - (match uu____582 with - | (e1,uu____596,g) -> + let c3 = + let uu____524 = FStar_Syntax_Util.lcomp_of_comp c2 in + FStar_TypeChecker_Util.maybe_assume_result_eq_pure_term + env e uu____524 in + let c4 = FStar_Syntax_Syntax.lcomp_comp c3 in + let uu____526 = + FStar_TypeChecker_Util.check_comp env e c4 expected_c in + (match uu____526 with + | (e1,uu____540,g) -> let g1 = - let uu____599 = + let uu____543 = FStar_TypeChecker_Env.get_range env in - FStar_TypeChecker_Util.label_guard uu____599 + FStar_TypeChecker_Util.label_guard uu____543 "could not prove post-condition" g in - ((let uu____601 = + ((let uu____545 = FStar_TypeChecker_Env.debug env FStar_Options.Low in - if uu____601 + if uu____545 then - let uu____602 = + let uu____546 = FStar_Range.string_of_range e1.FStar_Syntax_Syntax.pos in - let uu____603 = + let uu____547 = FStar_TypeChecker_Rel.guard_to_string env g1 in FStar_Util.print2 "(%s) DONE check_expected_effect; guard is: %s\n" - uu____602 uu____603 + uu____546 uu____547 else ()); (let e2 = FStar_TypeChecker_Util.maybe_lift env e1 - (FStar_Syntax_Util.comp_effect_name c2) + (FStar_Syntax_Util.comp_effect_name c4) (FStar_Syntax_Util.comp_effect_name expected_c) - (FStar_Syntax_Util.comp_result c2) in + (FStar_Syntax_Util.comp_result c4) in (e2, expected_c, g1)))))) let no_logical_guard: - 'Auu____610 'Auu____611 . + 'Auu____554 'Auu____555 . FStar_TypeChecker_Env.env -> - ('Auu____611,'Auu____610,FStar_TypeChecker_Env.guard_t) + ('Auu____555,'Auu____554,FStar_TypeChecker_Env.guard_t) FStar_Pervasives_Native.tuple3 -> - ('Auu____611,'Auu____610,FStar_TypeChecker_Env.guard_t) + ('Auu____555,'Auu____554,FStar_TypeChecker_Env.guard_t) FStar_Pervasives_Native.tuple3 = fun env -> - fun uu____631 -> - match uu____631 with + fun uu____575 -> + match uu____575 with | (te,kt,f) -> - let uu____641 = FStar_TypeChecker_Rel.guard_form f in - (match uu____641 with + let uu____585 = FStar_TypeChecker_Rel.guard_form f in + (match uu____585 with | FStar_TypeChecker_Common.Trivial -> (te, kt, f) | FStar_TypeChecker_Common.NonTrivial f1 -> - let uu____649 = + let uu____593 = FStar_TypeChecker_Err.unexpected_non_trivial_precondition_on_term env f1 in - let uu____654 = FStar_TypeChecker_Env.get_range env in - FStar_Errors.raise_error uu____649 uu____654) + let uu____598 = FStar_TypeChecker_Env.get_range env in + FStar_Errors.raise_error uu____593 uu____598) let print_expected_ty: FStar_TypeChecker_Env.env -> Prims.unit = fun env -> - let uu____664 = FStar_TypeChecker_Env.expected_typ env in - match uu____664 with + let uu____608 = FStar_TypeChecker_Env.expected_typ env in + match uu____608 with | FStar_Pervasives_Native.None -> FStar_Util.print_string "Expected type is None\n" | FStar_Pervasives_Native.Some t -> - let uu____668 = FStar_Syntax_Print.term_to_string t in - FStar_Util.print1 "Expected type is %s" uu____668 + let uu____612 = FStar_Syntax_Print.term_to_string t in + FStar_Util.print1 "Expected type is %s" uu____612 let rec get_pat_vars: FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.bv FStar_Util.set -> @@ -572,21 +514,21 @@ let rec get_pat_vars: fun pats -> fun acc -> let pats1 = FStar_Syntax_Util.unmeta pats in - let uu____692 = FStar_Syntax_Util.head_and_args pats1 in - match uu____692 with + let uu____636 = FStar_Syntax_Util.head_and_args pats1 in + match uu____636 with | (head1,args) -> - let uu____731 = - let uu____732 = FStar_Syntax_Util.un_uinst head1 in - uu____732.FStar_Syntax_Syntax.n in - (match uu____731 with + let uu____675 = + let uu____676 = FStar_Syntax_Util.un_uinst head1 in + uu____676.FStar_Syntax_Syntax.n in + (match uu____675 with | FStar_Syntax_Syntax.Tm_fvar fv when FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.nil_lid -> acc | FStar_Syntax_Syntax.Tm_fvar fv when FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.smtpat_lid -> - let uu____739 = FStar_List.tl args in - get_pat_vars_args uu____739 acc + let uu____683 = FStar_List.tl args in + get_pat_vars_args uu____683 acc | FStar_Syntax_Syntax.Tm_fvar fv when FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.smtpatOr_lid @@ -594,9 +536,9 @@ let rec get_pat_vars: | FStar_Syntax_Syntax.Tm_fvar fv when FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.cons_lid -> get_pat_vars_args args acc - | uu____748 -> - let uu____749 = FStar_Syntax_Free.names pats1 in - FStar_Util.set_union acc uu____749) + | uu____692 -> + let uu____693 = FStar_Syntax_Free.names pats1 in + FStar_Util.set_union acc uu____693) and get_pat_vars_args: FStar_Syntax_Syntax.args -> FStar_Syntax_Syntax.bv FStar_Util.set -> @@ -609,10 +551,10 @@ and get_pat_vars_args: fun arg -> get_pat_vars (FStar_Pervasives_Native.fst arg) s) acc args let check_smt_pat: - 'Auu____779 . + 'Auu____723 . FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.term -> - (FStar_Syntax_Syntax.bv,'Auu____779) FStar_Pervasives_Native.tuple2 + (FStar_Syntax_Syntax.bv,'Auu____723) FStar_Pervasives_Native.tuple2 Prims.list -> FStar_Syntax_Syntax.comp' FStar_Syntax_Syntax.syntax -> Prims.unit = @@ -620,47 +562,47 @@ let check_smt_pat: fun t -> fun bs -> fun c -> - let uu____812 = FStar_Syntax_Util.is_smt_lemma t in - if uu____812 + let uu____756 = FStar_Syntax_Util.is_smt_lemma t in + if uu____756 then match c.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Comp - { FStar_Syntax_Syntax.comp_univs = uu____813; - FStar_Syntax_Syntax.effect_name = uu____814; - FStar_Syntax_Syntax.result_typ = uu____815; + { FStar_Syntax_Syntax.comp_univs = uu____757; + FStar_Syntax_Syntax.effect_name = uu____758; + FStar_Syntax_Syntax.result_typ = uu____759; FStar_Syntax_Syntax.effect_args = - _pre::_post::(pats,uu____819)::[]; - FStar_Syntax_Syntax.flags = uu____820;_} + _pre::_post::(pats,uu____763)::[]; + FStar_Syntax_Syntax.flags = uu____764;_} -> let pat_vars = - let uu____868 = + let uu____812 = FStar_TypeChecker_Normalize.normalize [FStar_TypeChecker_Normalize.Beta] env pats in - let uu____869 = + let uu____813 = FStar_Util.new_set FStar_Syntax_Syntax.order_bv in - get_pat_vars uu____868 uu____869 in - let uu____872 = + get_pat_vars uu____812 uu____813 in + let uu____816 = FStar_All.pipe_right bs (FStar_Util.find_opt - (fun uu____899 -> - match uu____899 with - | (b,uu____905) -> - let uu____906 = FStar_Util.set_mem b pat_vars in - Prims.op_Negation uu____906)) in - (match uu____872 with + (fun uu____843 -> + match uu____843 with + | (b,uu____849) -> + let uu____850 = FStar_Util.set_mem b pat_vars in + Prims.op_Negation uu____850)) in + (match uu____816 with | FStar_Pervasives_Native.None -> () - | FStar_Pervasives_Native.Some (x,uu____912) -> - let uu____917 = - let uu____922 = - let uu____923 = FStar_Syntax_Print.bv_to_string x in + | FStar_Pervasives_Native.Some (x,uu____856) -> + let uu____861 = + let uu____866 = + let uu____867 = FStar_Syntax_Print.bv_to_string x in FStar_Util.format1 "Pattern misses at least one bound variable: %s" - uu____923 in + uu____867 in (FStar_Errors.Warning_PatternMissingBoundVar, - uu____922) in + uu____866) in FStar_Errors.log_issue t.FStar_Syntax_Syntax.pos - uu____917) - | uu____924 -> failwith "Impossible" + uu____861) + | uu____868 -> failwith "Impossible" else () let guard_letrecs: FStar_TypeChecker_Env.env -> @@ -677,218 +619,218 @@ let guard_letrecs: | letrecs -> let r = FStar_TypeChecker_Env.get_range env in let env1 = - let uu___67_974 = env in + let uu___66_918 = env in { FStar_TypeChecker_Env.solver = - (uu___67_974.FStar_TypeChecker_Env.solver); + (uu___66_918.FStar_TypeChecker_Env.solver); FStar_TypeChecker_Env.range = - (uu___67_974.FStar_TypeChecker_Env.range); + (uu___66_918.FStar_TypeChecker_Env.range); FStar_TypeChecker_Env.curmodule = - (uu___67_974.FStar_TypeChecker_Env.curmodule); + (uu___66_918.FStar_TypeChecker_Env.curmodule); FStar_TypeChecker_Env.gamma = - (uu___67_974.FStar_TypeChecker_Env.gamma); + (uu___66_918.FStar_TypeChecker_Env.gamma); FStar_TypeChecker_Env.gamma_cache = - (uu___67_974.FStar_TypeChecker_Env.gamma_cache); + (uu___66_918.FStar_TypeChecker_Env.gamma_cache); FStar_TypeChecker_Env.modules = - (uu___67_974.FStar_TypeChecker_Env.modules); + (uu___66_918.FStar_TypeChecker_Env.modules); FStar_TypeChecker_Env.expected_typ = - (uu___67_974.FStar_TypeChecker_Env.expected_typ); + (uu___66_918.FStar_TypeChecker_Env.expected_typ); FStar_TypeChecker_Env.sigtab = - (uu___67_974.FStar_TypeChecker_Env.sigtab); + (uu___66_918.FStar_TypeChecker_Env.sigtab); FStar_TypeChecker_Env.is_pattern = - (uu___67_974.FStar_TypeChecker_Env.is_pattern); + (uu___66_918.FStar_TypeChecker_Env.is_pattern); FStar_TypeChecker_Env.instantiate_imp = - (uu___67_974.FStar_TypeChecker_Env.instantiate_imp); + (uu___66_918.FStar_TypeChecker_Env.instantiate_imp); FStar_TypeChecker_Env.effects = - (uu___67_974.FStar_TypeChecker_Env.effects); + (uu___66_918.FStar_TypeChecker_Env.effects); FStar_TypeChecker_Env.generalize = - (uu___67_974.FStar_TypeChecker_Env.generalize); + (uu___66_918.FStar_TypeChecker_Env.generalize); FStar_TypeChecker_Env.letrecs = []; FStar_TypeChecker_Env.top_level = - (uu___67_974.FStar_TypeChecker_Env.top_level); + (uu___66_918.FStar_TypeChecker_Env.top_level); FStar_TypeChecker_Env.check_uvars = - (uu___67_974.FStar_TypeChecker_Env.check_uvars); + (uu___66_918.FStar_TypeChecker_Env.check_uvars); FStar_TypeChecker_Env.use_eq = - (uu___67_974.FStar_TypeChecker_Env.use_eq); + (uu___66_918.FStar_TypeChecker_Env.use_eq); FStar_TypeChecker_Env.is_iface = - (uu___67_974.FStar_TypeChecker_Env.is_iface); + (uu___66_918.FStar_TypeChecker_Env.is_iface); FStar_TypeChecker_Env.admit = - (uu___67_974.FStar_TypeChecker_Env.admit); + (uu___66_918.FStar_TypeChecker_Env.admit); FStar_TypeChecker_Env.lax = - (uu___67_974.FStar_TypeChecker_Env.lax); + (uu___66_918.FStar_TypeChecker_Env.lax); FStar_TypeChecker_Env.lax_universes = - (uu___67_974.FStar_TypeChecker_Env.lax_universes); + (uu___66_918.FStar_TypeChecker_Env.lax_universes); FStar_TypeChecker_Env.failhard = - (uu___67_974.FStar_TypeChecker_Env.failhard); + (uu___66_918.FStar_TypeChecker_Env.failhard); FStar_TypeChecker_Env.nosynth = - (uu___67_974.FStar_TypeChecker_Env.nosynth); + (uu___66_918.FStar_TypeChecker_Env.nosynth); FStar_TypeChecker_Env.tc_term = - (uu___67_974.FStar_TypeChecker_Env.tc_term); + (uu___66_918.FStar_TypeChecker_Env.tc_term); FStar_TypeChecker_Env.type_of = - (uu___67_974.FStar_TypeChecker_Env.type_of); + (uu___66_918.FStar_TypeChecker_Env.type_of); FStar_TypeChecker_Env.universe_of = - (uu___67_974.FStar_TypeChecker_Env.universe_of); + (uu___66_918.FStar_TypeChecker_Env.universe_of); FStar_TypeChecker_Env.use_bv_sorts = - (uu___67_974.FStar_TypeChecker_Env.use_bv_sorts); + (uu___66_918.FStar_TypeChecker_Env.use_bv_sorts); FStar_TypeChecker_Env.qname_and_index = - (uu___67_974.FStar_TypeChecker_Env.qname_and_index); + (uu___66_918.FStar_TypeChecker_Env.qname_and_index); FStar_TypeChecker_Env.proof_ns = - (uu___67_974.FStar_TypeChecker_Env.proof_ns); + (uu___66_918.FStar_TypeChecker_Env.proof_ns); FStar_TypeChecker_Env.synth = - (uu___67_974.FStar_TypeChecker_Env.synth); + (uu___66_918.FStar_TypeChecker_Env.synth); FStar_TypeChecker_Env.is_native_tactic = - (uu___67_974.FStar_TypeChecker_Env.is_native_tactic); + (uu___66_918.FStar_TypeChecker_Env.is_native_tactic); FStar_TypeChecker_Env.identifier_info = - (uu___67_974.FStar_TypeChecker_Env.identifier_info); + (uu___66_918.FStar_TypeChecker_Env.identifier_info); FStar_TypeChecker_Env.tc_hooks = - (uu___67_974.FStar_TypeChecker_Env.tc_hooks); + (uu___66_918.FStar_TypeChecker_Env.tc_hooks); FStar_TypeChecker_Env.dsenv = - (uu___67_974.FStar_TypeChecker_Env.dsenv); + (uu___66_918.FStar_TypeChecker_Env.dsenv); FStar_TypeChecker_Env.dep_graph = - (uu___67_974.FStar_TypeChecker_Env.dep_graph) + (uu___66_918.FStar_TypeChecker_Env.dep_graph) } in let precedes = FStar_TypeChecker_Util.fvar_const env1 FStar_Parser_Const.precedes_lid in let decreases_clause bs c = - (let uu____990 = + (let uu____934 = FStar_TypeChecker_Env.debug env1 FStar_Options.Low in - if uu____990 + if uu____934 then - let uu____991 = FStar_Syntax_Print.binders_to_string ", " bs in - let uu____992 = FStar_Syntax_Print.comp_to_string c in + let uu____935 = FStar_Syntax_Print.binders_to_string ", " bs in + let uu____936 = FStar_Syntax_Print.comp_to_string c in FStar_Util.print2 - "Building a decreases clause over (%s) and %s\n" uu____991 - uu____992 + "Building a decreases clause over (%s) and %s\n" uu____935 + uu____936 else ()); (let filter_types_and_functions bs1 = FStar_All.pipe_right bs1 (FStar_List.collect - (fun uu____1011 -> - match uu____1011 with - | (b,uu____1019) -> + (fun uu____955 -> + match uu____955 with + | (b,uu____963) -> let t = - let uu____1021 = + let uu____965 = FStar_Syntax_Util.unrefine b.FStar_Syntax_Syntax.sort in FStar_TypeChecker_Normalize.unfold_whnf env1 - uu____1021 in + uu____965 in (match t.FStar_Syntax_Syntax.n with - | FStar_Syntax_Syntax.Tm_type uu____1024 -> [] - | FStar_Syntax_Syntax.Tm_arrow uu____1025 -> [] - | uu____1038 -> - let uu____1039 = + | FStar_Syntax_Syntax.Tm_type uu____968 -> [] + | FStar_Syntax_Syntax.Tm_arrow uu____969 -> [] + | uu____982 -> + let uu____983 = FStar_Syntax_Syntax.bv_to_name b in - [uu____1039]))) in + [uu____983]))) in let as_lex_list dec = - let uu____1044 = FStar_Syntax_Util.head_and_args dec in - match uu____1044 with - | (head1,uu____1060) -> + let uu____988 = FStar_Syntax_Util.head_and_args dec in + match uu____988 with + | (head1,uu____1004) -> (match head1.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Tm_fvar fv when FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.lexcons_lid -> dec - | uu____1082 -> mk_lex_list [dec]) in + | uu____1026 -> mk_lex_list [dec]) in let cflags = FStar_Syntax_Util.comp_flags c in - let uu____1086 = + let uu____1030 = FStar_All.pipe_right cflags (FStar_List.tryFind - (fun uu___60_1095 -> - match uu___60_1095 with - | FStar_Syntax_Syntax.DECREASES uu____1096 -> true - | uu____1099 -> false)) in - match uu____1086 with + (fun uu___60_1039 -> + match uu___60_1039 with + | FStar_Syntax_Syntax.DECREASES uu____1040 -> true + | uu____1043 -> false)) in + match uu____1030 with | FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.DECREASES dec) -> as_lex_list dec - | uu____1103 -> + | uu____1047 -> let xs = FStar_All.pipe_right bs filter_types_and_functions in - (match xs with | x::[] -> x | uu____1112 -> mk_lex_list xs)) in + (match xs with | x::[] -> x | uu____1056 -> mk_lex_list xs)) in let previous_dec = decreases_clause actuals expected_c in - let guard_one_letrec uu____1133 = - match uu____1133 with + let guard_one_letrec uu____1077 = + match uu____1077 with | (l,t,u_names) -> - let uu____1151 = - let uu____1152 = FStar_Syntax_Subst.compress t in - uu____1152.FStar_Syntax_Syntax.n in - (match uu____1151 with + let uu____1095 = + let uu____1096 = FStar_Syntax_Subst.compress t in + uu____1096.FStar_Syntax_Syntax.n in + (match uu____1095 with | FStar_Syntax_Syntax.Tm_arrow (formals,c) -> let formals1 = FStar_All.pipe_right formals (FStar_List.map - (fun uu____1213 -> - match uu____1213 with + (fun uu____1157 -> + match uu____1157 with | (x,imp) -> - let uu____1224 = + let uu____1168 = FStar_Syntax_Syntax.is_null_bv x in - if uu____1224 + if uu____1168 then - let uu____1229 = - let uu____1230 = - let uu____1233 = + let uu____1173 = + let uu____1174 = + let uu____1177 = FStar_Syntax_Syntax.range_of_bv x in FStar_Pervasives_Native.Some - uu____1233 in + uu____1177 in FStar_Syntax_Syntax.new_bv - uu____1230 + uu____1174 x.FStar_Syntax_Syntax.sort in - (uu____1229, imp) + (uu____1173, imp) else (x, imp))) in - let uu____1235 = + let uu____1179 = FStar_Syntax_Subst.open_comp formals1 c in - (match uu____1235 with + (match uu____1179 with | (formals2,c1) -> let dec = decreases_clause formals2 c1 in let precedes1 = - let uu____1254 = - let uu____1255 = - let uu____1256 = + let uu____1198 = + let uu____1199 = + let uu____1200 = FStar_Syntax_Syntax.as_arg dec in - let uu____1257 = - let uu____1260 = + let uu____1201 = + let uu____1204 = FStar_Syntax_Syntax.as_arg previous_dec in - [uu____1260] in - uu____1256 :: uu____1257 in + [uu____1204] in + uu____1200 :: uu____1201 in FStar_Syntax_Syntax.mk_Tm_app precedes - uu____1255 in - uu____1254 FStar_Pervasives_Native.None r in - let uu____1263 = FStar_Util.prefix formals2 in - (match uu____1263 with + uu____1199 in + uu____1198 FStar_Pervasives_Native.None r in + let uu____1207 = FStar_Util.prefix formals2 in + (match uu____1207 with | (bs,(last1,imp)) -> let last2 = - let uu___68_1310 = last1 in - let uu____1311 = + let uu___67_1254 = last1 in + let uu____1255 = FStar_Syntax_Util.refine last1 precedes1 in { FStar_Syntax_Syntax.ppname = - (uu___68_1310.FStar_Syntax_Syntax.ppname); + (uu___67_1254.FStar_Syntax_Syntax.ppname); FStar_Syntax_Syntax.index = - (uu___68_1310.FStar_Syntax_Syntax.index); - FStar_Syntax_Syntax.sort = uu____1311 + (uu___67_1254.FStar_Syntax_Syntax.index); + FStar_Syntax_Syntax.sort = uu____1255 } in let refined_formals = FStar_List.append bs [(last2, imp)] in let t' = FStar_Syntax_Util.arrow refined_formals c1 in - ((let uu____1337 = + ((let uu____1281 = FStar_TypeChecker_Env.debug env1 FStar_Options.Low in - if uu____1337 + if uu____1281 then - let uu____1338 = + let uu____1282 = FStar_Syntax_Print.lbname_to_string l in - let uu____1339 = + let uu____1283 = FStar_Syntax_Print.term_to_string t in - let uu____1340 = + let uu____1284 = FStar_Syntax_Print.term_to_string t' in FStar_Util.print3 "Refined let rec %s\n\tfrom type %s\n\tto type %s\n" - uu____1338 uu____1339 uu____1340 + uu____1282 uu____1283 uu____1284 else ()); (l, t', u_names)))) - | uu____1344 -> + | uu____1288 -> FStar_Errors.raise_error (FStar_Errors.Fatal_ExpectedArrowAnnotatedType, "Annotated type of 'let rec' must be an arrow") @@ -903,75 +845,75 @@ let rec tc_term: fun env -> fun e -> tc_maybe_toplevel_term - (let uu___69_1787 = env in + (let uu___68_1739 = env in { FStar_TypeChecker_Env.solver = - (uu___69_1787.FStar_TypeChecker_Env.solver); + (uu___68_1739.FStar_TypeChecker_Env.solver); FStar_TypeChecker_Env.range = - (uu___69_1787.FStar_TypeChecker_Env.range); + (uu___68_1739.FStar_TypeChecker_Env.range); FStar_TypeChecker_Env.curmodule = - (uu___69_1787.FStar_TypeChecker_Env.curmodule); + (uu___68_1739.FStar_TypeChecker_Env.curmodule); FStar_TypeChecker_Env.gamma = - (uu___69_1787.FStar_TypeChecker_Env.gamma); + (uu___68_1739.FStar_TypeChecker_Env.gamma); FStar_TypeChecker_Env.gamma_cache = - (uu___69_1787.FStar_TypeChecker_Env.gamma_cache); + (uu___68_1739.FStar_TypeChecker_Env.gamma_cache); FStar_TypeChecker_Env.modules = - (uu___69_1787.FStar_TypeChecker_Env.modules); + (uu___68_1739.FStar_TypeChecker_Env.modules); FStar_TypeChecker_Env.expected_typ = - (uu___69_1787.FStar_TypeChecker_Env.expected_typ); + (uu___68_1739.FStar_TypeChecker_Env.expected_typ); FStar_TypeChecker_Env.sigtab = - (uu___69_1787.FStar_TypeChecker_Env.sigtab); + (uu___68_1739.FStar_TypeChecker_Env.sigtab); FStar_TypeChecker_Env.is_pattern = - (uu___69_1787.FStar_TypeChecker_Env.is_pattern); + (uu___68_1739.FStar_TypeChecker_Env.is_pattern); FStar_TypeChecker_Env.instantiate_imp = - (uu___69_1787.FStar_TypeChecker_Env.instantiate_imp); + (uu___68_1739.FStar_TypeChecker_Env.instantiate_imp); FStar_TypeChecker_Env.effects = - (uu___69_1787.FStar_TypeChecker_Env.effects); + (uu___68_1739.FStar_TypeChecker_Env.effects); FStar_TypeChecker_Env.generalize = - (uu___69_1787.FStar_TypeChecker_Env.generalize); + (uu___68_1739.FStar_TypeChecker_Env.generalize); FStar_TypeChecker_Env.letrecs = - (uu___69_1787.FStar_TypeChecker_Env.letrecs); + (uu___68_1739.FStar_TypeChecker_Env.letrecs); FStar_TypeChecker_Env.top_level = false; FStar_TypeChecker_Env.check_uvars = - (uu___69_1787.FStar_TypeChecker_Env.check_uvars); + (uu___68_1739.FStar_TypeChecker_Env.check_uvars); FStar_TypeChecker_Env.use_eq = - (uu___69_1787.FStar_TypeChecker_Env.use_eq); + (uu___68_1739.FStar_TypeChecker_Env.use_eq); FStar_TypeChecker_Env.is_iface = - (uu___69_1787.FStar_TypeChecker_Env.is_iface); + (uu___68_1739.FStar_TypeChecker_Env.is_iface); FStar_TypeChecker_Env.admit = - (uu___69_1787.FStar_TypeChecker_Env.admit); + (uu___68_1739.FStar_TypeChecker_Env.admit); FStar_TypeChecker_Env.lax = - (uu___69_1787.FStar_TypeChecker_Env.lax); + (uu___68_1739.FStar_TypeChecker_Env.lax); FStar_TypeChecker_Env.lax_universes = - (uu___69_1787.FStar_TypeChecker_Env.lax_universes); + (uu___68_1739.FStar_TypeChecker_Env.lax_universes); FStar_TypeChecker_Env.failhard = - (uu___69_1787.FStar_TypeChecker_Env.failhard); + (uu___68_1739.FStar_TypeChecker_Env.failhard); FStar_TypeChecker_Env.nosynth = - (uu___69_1787.FStar_TypeChecker_Env.nosynth); + (uu___68_1739.FStar_TypeChecker_Env.nosynth); FStar_TypeChecker_Env.tc_term = - (uu___69_1787.FStar_TypeChecker_Env.tc_term); + (uu___68_1739.FStar_TypeChecker_Env.tc_term); FStar_TypeChecker_Env.type_of = - (uu___69_1787.FStar_TypeChecker_Env.type_of); + (uu___68_1739.FStar_TypeChecker_Env.type_of); FStar_TypeChecker_Env.universe_of = - (uu___69_1787.FStar_TypeChecker_Env.universe_of); + (uu___68_1739.FStar_TypeChecker_Env.universe_of); FStar_TypeChecker_Env.use_bv_sorts = - (uu___69_1787.FStar_TypeChecker_Env.use_bv_sorts); + (uu___68_1739.FStar_TypeChecker_Env.use_bv_sorts); FStar_TypeChecker_Env.qname_and_index = - (uu___69_1787.FStar_TypeChecker_Env.qname_and_index); + (uu___68_1739.FStar_TypeChecker_Env.qname_and_index); FStar_TypeChecker_Env.proof_ns = - (uu___69_1787.FStar_TypeChecker_Env.proof_ns); + (uu___68_1739.FStar_TypeChecker_Env.proof_ns); FStar_TypeChecker_Env.synth = - (uu___69_1787.FStar_TypeChecker_Env.synth); + (uu___68_1739.FStar_TypeChecker_Env.synth); FStar_TypeChecker_Env.is_native_tactic = - (uu___69_1787.FStar_TypeChecker_Env.is_native_tactic); + (uu___68_1739.FStar_TypeChecker_Env.is_native_tactic); FStar_TypeChecker_Env.identifier_info = - (uu___69_1787.FStar_TypeChecker_Env.identifier_info); + (uu___68_1739.FStar_TypeChecker_Env.identifier_info); FStar_TypeChecker_Env.tc_hooks = - (uu___69_1787.FStar_TypeChecker_Env.tc_hooks); + (uu___68_1739.FStar_TypeChecker_Env.tc_hooks); FStar_TypeChecker_Env.dsenv = - (uu___69_1787.FStar_TypeChecker_Env.dsenv); + (uu___68_1739.FStar_TypeChecker_Env.dsenv); FStar_TypeChecker_Env.dep_graph = - (uu___69_1787.FStar_TypeChecker_Env.dep_graph) + (uu___68_1739.FStar_TypeChecker_Env.dep_graph) }) e and tc_maybe_toplevel_term: FStar_TypeChecker_Env.env -> @@ -985,132 +927,132 @@ and tc_maybe_toplevel_term: if e.FStar_Syntax_Syntax.pos = FStar_Range.dummyRange then env else FStar_TypeChecker_Env.set_range env e.FStar_Syntax_Syntax.pos in - (let uu____1799 = FStar_TypeChecker_Env.debug env1 FStar_Options.Low in - if uu____1799 + (let uu____1751 = FStar_TypeChecker_Env.debug env1 FStar_Options.Low in + if uu____1751 then - let uu____1800 = - let uu____1801 = FStar_TypeChecker_Env.get_range env1 in - FStar_All.pipe_left FStar_Range.string_of_range uu____1801 in - let uu____1802 = FStar_Syntax_Print.tag_of_term e in - FStar_Util.print2 "%s (%s)\n" uu____1800 uu____1802 + let uu____1752 = + let uu____1753 = FStar_TypeChecker_Env.get_range env1 in + FStar_All.pipe_left FStar_Range.string_of_range uu____1753 in + let uu____1754 = FStar_Syntax_Print.tag_of_term e in + FStar_Util.print2 "%s (%s)\n" uu____1752 uu____1754 else ()); (let top = FStar_Syntax_Subst.compress e in match top.FStar_Syntax_Syntax.n with - | FStar_Syntax_Syntax.Tm_delayed uu____1811 -> failwith "Impossible" - | FStar_Syntax_Syntax.Tm_uinst uu____1842 -> tc_value env1 e - | FStar_Syntax_Syntax.Tm_uvar uu____1849 -> tc_value env1 e - | FStar_Syntax_Syntax.Tm_bvar uu____1866 -> tc_value env1 e - | FStar_Syntax_Syntax.Tm_name uu____1867 -> tc_value env1 e - | FStar_Syntax_Syntax.Tm_fvar uu____1868 -> tc_value env1 e - | FStar_Syntax_Syntax.Tm_constant uu____1869 -> tc_value env1 e - | FStar_Syntax_Syntax.Tm_abs uu____1870 -> tc_value env1 e - | FStar_Syntax_Syntax.Tm_arrow uu____1887 -> tc_value env1 e - | FStar_Syntax_Syntax.Tm_refine uu____1900 -> tc_value env1 e - | FStar_Syntax_Syntax.Tm_type uu____1907 -> tc_value env1 e + | FStar_Syntax_Syntax.Tm_delayed uu____1763 -> failwith "Impossible" + | FStar_Syntax_Syntax.Tm_uinst uu____1794 -> tc_value env1 e + | FStar_Syntax_Syntax.Tm_uvar uu____1801 -> tc_value env1 e + | FStar_Syntax_Syntax.Tm_bvar uu____1818 -> tc_value env1 e + | FStar_Syntax_Syntax.Tm_name uu____1819 -> tc_value env1 e + | FStar_Syntax_Syntax.Tm_fvar uu____1820 -> tc_value env1 e + | FStar_Syntax_Syntax.Tm_constant uu____1821 -> tc_value env1 e + | FStar_Syntax_Syntax.Tm_abs uu____1822 -> tc_value env1 e + | FStar_Syntax_Syntax.Tm_arrow uu____1839 -> tc_value env1 e + | FStar_Syntax_Syntax.Tm_refine uu____1852 -> tc_value env1 e + | FStar_Syntax_Syntax.Tm_type uu____1859 -> tc_value env1 e | FStar_Syntax_Syntax.Tm_unknown -> tc_value env1 e | FStar_Syntax_Syntax.Tm_meta ({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_unknown ; - FStar_Syntax_Syntax.pos = uu____1908; - FStar_Syntax_Syntax.vars = uu____1909;_},FStar_Syntax_Syntax.Meta_alien - (uu____1910,uu____1911,ty)) + FStar_Syntax_Syntax.pos = uu____1860; + FStar_Syntax_Syntax.vars = uu____1861;_},FStar_Syntax_Syntax.Meta_alien + (uu____1862,uu____1863,ty)) -> - let uu____1921 = - let uu____1922 = FStar_Syntax_Syntax.mk_Total ty in - FStar_All.pipe_right uu____1922 FStar_Syntax_Util.lcomp_of_comp in - (top, uu____1921, FStar_TypeChecker_Rel.trivial_guard) + let uu____1873 = + let uu____1874 = FStar_Syntax_Syntax.mk_Total ty in + FStar_All.pipe_right uu____1874 FStar_Syntax_Util.lcomp_of_comp in + (top, uu____1873, FStar_TypeChecker_Rel.trivial_guard) | FStar_Syntax_Syntax.Tm_meta (e1,FStar_Syntax_Syntax.Meta_desugared (FStar_Syntax_Syntax.Meta_smt_pat )) -> - let uu____1928 = tc_tot_or_gtot_term env1 e1 in - (match uu____1928 with + let uu____1880 = tc_tot_or_gtot_term env1 e1 in + (match uu____1880 with | (e2,c,g) -> let g1 = - let uu___70_1945 = g in + let uu___69_1897 = g in { FStar_TypeChecker_Env.guard_f = FStar_TypeChecker_Common.Trivial; FStar_TypeChecker_Env.deferred = - (uu___70_1945.FStar_TypeChecker_Env.deferred); + (uu___69_1897.FStar_TypeChecker_Env.deferred); FStar_TypeChecker_Env.univ_ineqs = - (uu___70_1945.FStar_TypeChecker_Env.univ_ineqs); + (uu___69_1897.FStar_TypeChecker_Env.univ_ineqs); FStar_TypeChecker_Env.implicits = - (uu___70_1945.FStar_TypeChecker_Env.implicits) + (uu___69_1897.FStar_TypeChecker_Env.implicits) } in - let uu____1946 = + let uu____1898 = FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_meta (e2, (FStar_Syntax_Syntax.Meta_desugared FStar_Syntax_Syntax.Meta_smt_pat))) FStar_Pervasives_Native.None top.FStar_Syntax_Syntax.pos in - (uu____1946, c, g1)) + (uu____1898, c, g1)) | FStar_Syntax_Syntax.Tm_meta (e1,FStar_Syntax_Syntax.Meta_pattern pats) -> - let uu____1967 = FStar_Syntax_Util.type_u () in - (match uu____1967 with + let uu____1919 = FStar_Syntax_Util.type_u () in + (match uu____1919 with | (t,u) -> - let uu____1980 = tc_check_tot_or_gtot_term env1 e1 t in - (match uu____1980 with + let uu____1932 = tc_check_tot_or_gtot_term env1 e1 t in + (match uu____1932 with | (e2,c,g) -> - let uu____1996 = - let uu____2011 = + let uu____1948 = + let uu____1963 = FStar_TypeChecker_Env.clear_expected_typ env1 in - match uu____2011 with - | (env2,uu____2033) -> tc_pats env2 pats in - (match uu____1996 with + match uu____1963 with + | (env2,uu____1985) -> tc_pats env2 pats in + (match uu____1948 with | (pats1,g') -> let g'1 = - let uu___71_2067 = g' in + let uu___70_2019 = g' in { FStar_TypeChecker_Env.guard_f = FStar_TypeChecker_Common.Trivial; FStar_TypeChecker_Env.deferred = - (uu___71_2067.FStar_TypeChecker_Env.deferred); + (uu___70_2019.FStar_TypeChecker_Env.deferred); FStar_TypeChecker_Env.univ_ineqs = - (uu___71_2067.FStar_TypeChecker_Env.univ_ineqs); + (uu___70_2019.FStar_TypeChecker_Env.univ_ineqs); FStar_TypeChecker_Env.implicits = - (uu___71_2067.FStar_TypeChecker_Env.implicits) + (uu___70_2019.FStar_TypeChecker_Env.implicits) } in - let uu____2068 = + let uu____2020 = FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_meta (e2, (FStar_Syntax_Syntax.Meta_pattern pats1))) FStar_Pervasives_Native.None top.FStar_Syntax_Syntax.pos in - let uu____2071 = + let uu____2023 = FStar_TypeChecker_Rel.conj_guard g g'1 in - (uu____2068, c, uu____2071)))) + (uu____2020, c, uu____2023)))) | FStar_Syntax_Syntax.Tm_meta (e1,FStar_Syntax_Syntax.Meta_desugared (FStar_Syntax_Syntax.Sequence )) -> - let uu____2079 = - let uu____2080 = FStar_Syntax_Subst.compress e1 in - uu____2080.FStar_Syntax_Syntax.n in - (match uu____2079 with + let uu____2031 = + let uu____2032 = FStar_Syntax_Subst.compress e1 in + uu____2032.FStar_Syntax_Syntax.n in + (match uu____2031 with | FStar_Syntax_Syntax.Tm_let - ((uu____2089,{ FStar_Syntax_Syntax.lbname = x; - FStar_Syntax_Syntax.lbunivs = uu____2091; - FStar_Syntax_Syntax.lbtyp = uu____2092; - FStar_Syntax_Syntax.lbeff = uu____2093; + ((uu____2041,{ FStar_Syntax_Syntax.lbname = x; + FStar_Syntax_Syntax.lbunivs = uu____2043; + FStar_Syntax_Syntax.lbtyp = uu____2044; + FStar_Syntax_Syntax.lbeff = uu____2045; FStar_Syntax_Syntax.lbdef = e11;_}::[]),e2) -> - let uu____2118 = - let uu____2125 = + let uu____2070 = + let uu____2077 = FStar_TypeChecker_Env.set_expected_typ env1 FStar_Syntax_Syntax.t_unit in - tc_term uu____2125 e11 in - (match uu____2118 with + tc_term uu____2077 e11 in + (match uu____2070 with | (e12,c1,g1) -> - let uu____2135 = tc_term env1 e2 in - (match uu____2135 with + let uu____2087 = tc_term env1 e2 in + (match uu____2087 with | (e21,c2,g2) -> let c = - FStar_TypeChecker_Util.bind + FStar_TypeChecker_Util.maybe_return_e2_and_bind e12.FStar_Syntax_Syntax.pos env1 - (FStar_Pervasives_Native.Some e12) c1 + (FStar_Pervasives_Native.Some e12) c1 e21 (FStar_Pervasives_Native.None, c2) in let e13 = FStar_TypeChecker_Util.maybe_lift env1 e12 @@ -1123,22 +1065,22 @@ and tc_maybe_toplevel_term: c.FStar_Syntax_Syntax.eff_name c2.FStar_Syntax_Syntax.res_typ in let e3 = - let uu____2159 = - let uu____2162 = - let uu____2163 = - let uu____2176 = - let uu____2183 = - let uu____2186 = + let uu____2111 = + let uu____2114 = + let uu____2115 = + let uu____2128 = + let uu____2135 = + let uu____2138 = FStar_Syntax_Syntax.mk_lb (x, [], (c1.FStar_Syntax_Syntax.eff_name), FStar_Syntax_Syntax.t_unit, e13) in - [uu____2186] in - (false, uu____2183) in - (uu____2176, e22) in - FStar_Syntax_Syntax.Tm_let uu____2163 in - FStar_Syntax_Syntax.mk uu____2162 in - uu____2159 FStar_Pervasives_Native.None + [uu____2138] in + (false, uu____2135) in + (uu____2128, e22) in + FStar_Syntax_Syntax.Tm_let uu____2115 in + FStar_Syntax_Syntax.mk uu____2114 in + uu____2111 FStar_Pervasives_Native.None e1.FStar_Syntax_Syntax.pos in let e4 = FStar_TypeChecker_Util.maybe_monadic env1 e3 @@ -1152,12 +1094,12 @@ and tc_maybe_toplevel_term: FStar_Syntax_Syntax.Sequence))) FStar_Pervasives_Native.None top.FStar_Syntax_Syntax.pos in - let uu____2208 = + let uu____2160 = FStar_TypeChecker_Rel.conj_guard g1 g2 in - (e5, c, uu____2208))) - | uu____2211 -> - let uu____2212 = tc_term env1 e1 in - (match uu____2212 with + (e5, c, uu____2160))) + | uu____2163 -> + let uu____2164 = tc_term env1 e1 in + (match uu____2164 with | (e2,c,g) -> let e3 = FStar_Syntax_Syntax.mk @@ -1169,14 +1111,14 @@ and tc_maybe_toplevel_term: top.FStar_Syntax_Syntax.pos in (e3, c, g))) | FStar_Syntax_Syntax.Tm_meta - (e1,FStar_Syntax_Syntax.Meta_monadic uu____2234) -> + (e1,FStar_Syntax_Syntax.Meta_monadic uu____2186) -> tc_term env1 e1 | FStar_Syntax_Syntax.Tm_meta - (e1,FStar_Syntax_Syntax.Meta_monadic_lift uu____2246) -> + (e1,FStar_Syntax_Syntax.Meta_monadic_lift uu____2198) -> tc_term env1 e1 | FStar_Syntax_Syntax.Tm_meta (e1,m) -> - let uu____2265 = tc_term env1 e1 in - (match uu____2265 with + let uu____2217 = tc_term env1 e1 in + (match uu____2217 with | (e2,c,g) -> let e3 = FStar_Syntax_Syntax.mk @@ -1184,28 +1126,29 @@ and tc_maybe_toplevel_term: FStar_Pervasives_Native.None top.FStar_Syntax_Syntax.pos in (e3, c, g)) | FStar_Syntax_Syntax.Tm_ascribed - (e1,(FStar_Util.Inr expected_c,topt),uu____2289) -> - let uu____2336 = FStar_TypeChecker_Env.clear_expected_typ env1 in - (match uu____2336 with - | (env0,uu____2350) -> - let uu____2355 = tc_comp env0 expected_c in - (match uu____2355 with - | (expected_c1,uu____2369,g) -> + (e1,(FStar_Util.Inr expected_c,topt),uu____2241) -> + let uu____2288 = FStar_TypeChecker_Env.clear_expected_typ env1 in + (match uu____2288 with + | (env0,uu____2302) -> + let uu____2307 = tc_comp env0 expected_c in + (match uu____2307 with + | (expected_c1,uu____2321,g) -> let t_res = FStar_Syntax_Util.comp_result expected_c1 in - let uu____2374 = - let uu____2381 = + let uu____2326 = + let uu____2333 = FStar_TypeChecker_Env.set_expected_typ env0 t_res in - tc_term uu____2381 e1 in - (match uu____2374 with + tc_term uu____2333 e1 in + (match uu____2326 with | (e2,c',g') -> - let uu____2391 = - let uu____2398 = - let uu____2403 = c'.FStar_Syntax_Syntax.comp () in - (e2, uu____2403) in + let uu____2343 = + let uu____2350 = + let uu____2355 = + FStar_Syntax_Syntax.lcomp_comp c' in + (e2, uu____2355) in check_expected_effect env0 (FStar_Pervasives_Native.Some expected_c1) - uu____2398 in - (match uu____2391 with + uu____2350 in + (match uu____2343 with | (e3,expected_c2,g'') -> let e4 = FStar_Syntax_Syntax.mk @@ -1221,10 +1164,10 @@ and tc_maybe_toplevel_term: let lc = FStar_Syntax_Util.lcomp_of_comp expected_c2 in let f = - let uu____2452 = + let uu____2400 = FStar_TypeChecker_Rel.conj_guard g' g'' in FStar_TypeChecker_Rel.conj_guard g - uu____2452 in + uu____2400 in let topt1 = tc_tactic_opt env0 topt in let f1 = match topt1 with @@ -1232,46 +1175,46 @@ and tc_maybe_toplevel_term: | FStar_Pervasives_Native.Some tactic -> FStar_TypeChecker_Rel.map_guard f (fun f1 -> - let uu____2461 = + let uu____2409 = FStar_Syntax_Util.mk_squash FStar_Syntax_Syntax.U_zero f1 in FStar_TypeChecker_Common.mk_by_tactic - tactic uu____2461) in - let uu____2462 = + tactic uu____2409) in + let uu____2410 = comp_check_expected_typ env1 e4 lc in - (match uu____2462 with + (match uu____2410 with | (e5,c,f2) -> let final_guard = FStar_TypeChecker_Rel.conj_guard f1 f2 in (e5, c, final_guard)))))) | FStar_Syntax_Syntax.Tm_ascribed - (e1,(FStar_Util.Inl t,topt),uu____2482) -> - let uu____2529 = FStar_Syntax_Util.type_u () in - (match uu____2529 with + (e1,(FStar_Util.Inl t,topt),uu____2430) -> + let uu____2477 = FStar_Syntax_Util.type_u () in + (match uu____2477 with | (k,u) -> - let uu____2542 = tc_check_tot_or_gtot_term env1 t k in - (match uu____2542 with - | (t1,uu____2556,f) -> - let uu____2558 = - let uu____2565 = + let uu____2490 = tc_check_tot_or_gtot_term env1 t k in + (match uu____2490 with + | (t1,uu____2504,f) -> + let uu____2506 = + let uu____2513 = FStar_TypeChecker_Env.set_expected_typ env1 t1 in - tc_term uu____2565 e1 in - (match uu____2558 with + tc_term uu____2513 e1 in + (match uu____2506 with | (e2,c,g) -> - let uu____2575 = - let uu____2580 = + let uu____2523 = + let uu____2528 = FStar_TypeChecker_Env.set_range env1 t1.FStar_Syntax_Syntax.pos in FStar_TypeChecker_Util.strengthen_precondition (FStar_Pervasives_Native.Some - (fun uu____2584 -> + (fun uu____2532 -> FStar_Util.return_all FStar_TypeChecker_Err.ill_kinded_type)) - uu____2580 e2 c f in - (match uu____2575 with + uu____2528 e2 c f in + (match uu____2523 with | (c1,f1) -> - let uu____2593 = - let uu____2600 = + let uu____2541 = + let uu____2548 = FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_ascribed (e2, @@ -1281,33 +1224,33 @@ and tc_maybe_toplevel_term: (c1.FStar_Syntax_Syntax.eff_name)))) FStar_Pervasives_Native.None top.FStar_Syntax_Syntax.pos in - comp_check_expected_typ env1 uu____2600 c1 in - (match uu____2593 with + comp_check_expected_typ env1 uu____2548 c1 in + (match uu____2541 with | (e3,c2,f2) -> - let uu____2640 = - let uu____2641 = + let uu____2588 = + let uu____2589 = FStar_TypeChecker_Rel.conj_guard g f2 in FStar_TypeChecker_Rel.conj_guard f1 - uu____2641 in - (e3, c2, uu____2640)))))) + uu____2589 in + (e3, c2, uu____2588)))))) | FStar_Syntax_Syntax.Tm_app ({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_range_of ); - FStar_Syntax_Syntax.pos = uu____2642; - FStar_Syntax_Syntax.vars = uu____2643;_},a::hd1::rest) + FStar_Syntax_Syntax.pos = uu____2590; + FStar_Syntax_Syntax.vars = uu____2591;_},a::hd1::rest) -> let rest1 = hd1 :: rest in - let uu____2706 = FStar_Syntax_Util.head_and_args top in - (match uu____2706 with - | (unary_op,uu____2728) -> + let uu____2654 = FStar_Syntax_Util.head_and_args top in + (match uu____2654 with + | (unary_op,uu____2676) -> let head1 = - let uu____2752 = + let uu____2700 = FStar_Range.union_ranges unary_op.FStar_Syntax_Syntax.pos (FStar_Pervasives_Native.fst a).FStar_Syntax_Syntax.pos in FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_app (unary_op, [a])) - FStar_Pervasives_Native.None uu____2752 in + FStar_Pervasives_Native.None uu____2700 in let t = FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_app (head1, rest1)) @@ -1317,20 +1260,20 @@ and tc_maybe_toplevel_term: ({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_reify ); - FStar_Syntax_Syntax.pos = uu____2790; - FStar_Syntax_Syntax.vars = uu____2791;_},a::hd1::rest) + FStar_Syntax_Syntax.pos = uu____2738; + FStar_Syntax_Syntax.vars = uu____2739;_},a::hd1::rest) -> let rest1 = hd1 :: rest in - let uu____2854 = FStar_Syntax_Util.head_and_args top in - (match uu____2854 with - | (unary_op,uu____2876) -> + let uu____2802 = FStar_Syntax_Util.head_and_args top in + (match uu____2802 with + | (unary_op,uu____2824) -> let head1 = - let uu____2900 = + let uu____2848 = FStar_Range.union_ranges unary_op.FStar_Syntax_Syntax.pos (FStar_Pervasives_Native.fst a).FStar_Syntax_Syntax.pos in FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_app (unary_op, [a])) - FStar_Pervasives_Native.None uu____2900 in + FStar_Pervasives_Native.None uu____2848 in let t = FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_app (head1, rest1)) @@ -1339,21 +1282,21 @@ and tc_maybe_toplevel_term: | FStar_Syntax_Syntax.Tm_app ({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_constant - (FStar_Const.Const_reflect uu____2938); - FStar_Syntax_Syntax.pos = uu____2939; - FStar_Syntax_Syntax.vars = uu____2940;_},a::hd1::rest) + (FStar_Const.Const_reflect uu____2886); + FStar_Syntax_Syntax.pos = uu____2887; + FStar_Syntax_Syntax.vars = uu____2888;_},a::hd1::rest) -> let rest1 = hd1 :: rest in - let uu____3003 = FStar_Syntax_Util.head_and_args top in - (match uu____3003 with - | (unary_op,uu____3025) -> + let uu____2951 = FStar_Syntax_Util.head_and_args top in + (match uu____2951 with + | (unary_op,uu____2973) -> let head1 = - let uu____3049 = + let uu____2997 = FStar_Range.union_ranges unary_op.FStar_Syntax_Syntax.pos (FStar_Pervasives_Native.fst a).FStar_Syntax_Syntax.pos in FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_app (unary_op, [a])) - FStar_Pervasives_Native.None uu____3049 in + FStar_Pervasives_Native.None uu____2997 in let t = FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_app (head1, rest1)) @@ -1363,20 +1306,20 @@ and tc_maybe_toplevel_term: ({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_set_range_of ); - FStar_Syntax_Syntax.pos = uu____3087; - FStar_Syntax_Syntax.vars = uu____3088;_},a1::a2::hd1::rest) + FStar_Syntax_Syntax.pos = uu____3035; + FStar_Syntax_Syntax.vars = uu____3036;_},a1::a2::hd1::rest) -> let rest1 = hd1 :: rest in - let uu____3164 = FStar_Syntax_Util.head_and_args top in - (match uu____3164 with - | (unary_op,uu____3186) -> + let uu____3112 = FStar_Syntax_Util.head_and_args top in + (match uu____3112 with + | (unary_op,uu____3134) -> let head1 = - let uu____3210 = + let uu____3158 = FStar_Range.union_ranges unary_op.FStar_Syntax_Syntax.pos (FStar_Pervasives_Native.fst a1).FStar_Syntax_Syntax.pos in FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_app (unary_op, [a1; a2])) - FStar_Pervasives_Native.None uu____3210 in + FStar_Pervasives_Native.None uu____3158 in let t = FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_app (head1, rest1)) @@ -1386,104 +1329,104 @@ and tc_maybe_toplevel_term: ({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_range_of ); - FStar_Syntax_Syntax.pos = uu____3254; - FStar_Syntax_Syntax.vars = uu____3255;_},(e1,FStar_Pervasives_Native.None + FStar_Syntax_Syntax.pos = uu____3202; + FStar_Syntax_Syntax.vars = uu____3203;_},(e1,FStar_Pervasives_Native.None )::[]) -> - let uu____3293 = - let uu____3300 = - let uu____3301 = FStar_TypeChecker_Env.clear_expected_typ env1 in - FStar_All.pipe_left FStar_Pervasives_Native.fst uu____3301 in - tc_term uu____3300 e1 in - (match uu____3293 with + let uu____3241 = + let uu____3248 = + let uu____3249 = FStar_TypeChecker_Env.clear_expected_typ env1 in + FStar_All.pipe_left FStar_Pervasives_Native.fst uu____3249 in + tc_term uu____3248 e1 in + (match uu____3241 with | (e2,c,g) -> - let uu____3325 = FStar_Syntax_Util.head_and_args top in - (match uu____3325 with - | (head1,uu____3347) -> - let uu____3368 = + let uu____3273 = FStar_Syntax_Util.head_and_args top in + (match uu____3273 with + | (head1,uu____3295) -> + let uu____3316 = FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_app (head1, [(e2, FStar_Pervasives_Native.None)])) FStar_Pervasives_Native.None top.FStar_Syntax_Syntax.pos in - let uu____3395 = - let uu____3396 = - let uu____3399 = + let uu____3343 = + let uu____3344 = + let uu____3347 = FStar_Syntax_Syntax.tabbrev FStar_Parser_Const.range_lid in - FStar_Syntax_Syntax.mk_Total uu____3399 in + FStar_Syntax_Syntax.mk_Total uu____3347 in FStar_All.pipe_left FStar_Syntax_Util.lcomp_of_comp - uu____3396 in - (uu____3368, uu____3395, g))) + uu____3344 in + (uu____3316, uu____3343, g))) | FStar_Syntax_Syntax.Tm_app ({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_set_range_of ); - FStar_Syntax_Syntax.pos = uu____3404; - FStar_Syntax_Syntax.vars = uu____3405;_},(t,FStar_Pervasives_Native.None + FStar_Syntax_Syntax.pos = uu____3352; + FStar_Syntax_Syntax.vars = uu____3353;_},(t,FStar_Pervasives_Native.None )::(r,FStar_Pervasives_Native.None )::[]) -> - let uu____3458 = FStar_Syntax_Util.head_and_args top in - (match uu____3458 with - | (head1,uu____3480) -> + let uu____3406 = FStar_Syntax_Util.head_and_args top in + (match uu____3406 with + | (head1,uu____3428) -> let env' = - let uu____3502 = + let uu____3450 = FStar_Syntax_Syntax.tabbrev FStar_Parser_Const.range_lid in - FStar_TypeChecker_Env.set_expected_typ env1 uu____3502 in - let uu____3503 = tc_term env' r in - (match uu____3503 with - | (er,uu____3517,gr) -> - let uu____3519 = tc_term env1 t in - (match uu____3519 with + FStar_TypeChecker_Env.set_expected_typ env1 uu____3450 in + let uu____3451 = tc_term env' r in + (match uu____3451 with + | (er,uu____3465,gr) -> + let uu____3467 = tc_term env1 t in + (match uu____3467 with | (t1,tt,gt1) -> let g = FStar_TypeChecker_Rel.conj_guard gr gt1 in - let uu____3536 = - let uu____3539 = - let uu____3540 = - let uu____3541 = + let uu____3484 = + let uu____3487 = + let uu____3488 = + let uu____3489 = FStar_Syntax_Syntax.as_arg t1 in - let uu____3542 = - let uu____3545 = + let uu____3490 = + let uu____3493 = FStar_Syntax_Syntax.as_arg r in - [uu____3545] in - uu____3541 :: uu____3542 in - FStar_Syntax_Syntax.mk_Tm_app head1 uu____3540 in - uu____3539 FStar_Pervasives_Native.None + [uu____3493] in + uu____3489 :: uu____3490 in + FStar_Syntax_Syntax.mk_Tm_app head1 uu____3488 in + uu____3487 FStar_Pervasives_Native.None top.FStar_Syntax_Syntax.pos in - (uu____3536, tt, g)))) + (uu____3484, tt, g)))) | FStar_Syntax_Syntax.Tm_app ({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_range_of ); - FStar_Syntax_Syntax.pos = uu____3550; - FStar_Syntax_Syntax.vars = uu____3551;_},uu____3552) + FStar_Syntax_Syntax.pos = uu____3498; + FStar_Syntax_Syntax.vars = uu____3499;_},uu____3500) -> - let uu____3573 = - let uu____3578 = - let uu____3579 = FStar_Syntax_Print.term_to_string top in - FStar_Util.format1 "Ill-applied constant %s" uu____3579 in - (FStar_Errors.Fatal_IllAppliedConstant, uu____3578) in - FStar_Errors.raise_error uu____3573 e.FStar_Syntax_Syntax.pos + let uu____3521 = + let uu____3526 = + let uu____3527 = FStar_Syntax_Print.term_to_string top in + FStar_Util.format1 "Ill-applied constant %s" uu____3527 in + (FStar_Errors.Fatal_IllAppliedConstant, uu____3526) in + FStar_Errors.raise_error uu____3521 e.FStar_Syntax_Syntax.pos | FStar_Syntax_Syntax.Tm_app ({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_set_range_of ); - FStar_Syntax_Syntax.pos = uu____3586; - FStar_Syntax_Syntax.vars = uu____3587;_},uu____3588) + FStar_Syntax_Syntax.pos = uu____3534; + FStar_Syntax_Syntax.vars = uu____3535;_},uu____3536) -> - let uu____3609 = - let uu____3614 = - let uu____3615 = FStar_Syntax_Print.term_to_string top in - FStar_Util.format1 "Ill-applied constant %s" uu____3615 in - (FStar_Errors.Fatal_IllAppliedConstant, uu____3614) in - FStar_Errors.raise_error uu____3609 e.FStar_Syntax_Syntax.pos + let uu____3557 = + let uu____3562 = + let uu____3563 = FStar_Syntax_Print.term_to_string top in + FStar_Util.format1 "Ill-applied constant %s" uu____3563 in + (FStar_Errors.Fatal_IllAppliedConstant, uu____3562) in + FStar_Errors.raise_error uu____3557 e.FStar_Syntax_Syntax.pos | FStar_Syntax_Syntax.Tm_app ({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_reify ); - FStar_Syntax_Syntax.pos = uu____3622; - FStar_Syntax_Syntax.vars = uu____3623;_},(e1,aqual)::[]) + FStar_Syntax_Syntax.pos = uu____3570; + FStar_Syntax_Syntax.vars = uu____3571;_},(e1,aqual)::[]) -> (if FStar_Option.isSome aqual then @@ -1491,31 +1434,31 @@ and tc_maybe_toplevel_term: (FStar_Errors.Warning_IrrelevantQualifierOnArgumentToReify, "Qualifier on argument to reify is irrelevant and will be ignored") else (); - (let uu____3656 = FStar_TypeChecker_Env.clear_expected_typ env1 in - match uu____3656 with - | (env0,uu____3670) -> - let uu____3675 = tc_term env0 e1 in - (match uu____3675 with + (let uu____3604 = FStar_TypeChecker_Env.clear_expected_typ env1 in + match uu____3604 with + | (env0,uu____3618) -> + let uu____3623 = tc_term env0 e1 in + (match uu____3623 with | (e2,c,g) -> - let uu____3691 = FStar_Syntax_Util.head_and_args top in - (match uu____3691 with - | (reify_op,uu____3713) -> + let uu____3639 = FStar_Syntax_Util.head_and_args top in + (match uu____3639 with + | (reify_op,uu____3661) -> let u_c = - let uu____3735 = + let uu____3683 = tc_term env0 c.FStar_Syntax_Syntax.res_typ in - match uu____3735 with - | (uu____3742,c',uu____3744) -> - let uu____3745 = - let uu____3746 = + match uu____3683 with + | (uu____3690,c',uu____3692) -> + let uu____3693 = + let uu____3694 = FStar_Syntax_Subst.compress c'.FStar_Syntax_Syntax.res_typ in - uu____3746.FStar_Syntax_Syntax.n in - (match uu____3745 with + uu____3694.FStar_Syntax_Syntax.n in + (match uu____3693 with | FStar_Syntax_Syntax.Tm_type u -> u - | uu____3750 -> - let uu____3751 = + | uu____3698 -> + let uu____3699 = FStar_Syntax_Util.type_u () in - (match uu____3751 with + (match uu____3699 with | (t,u) -> let g_opt = FStar_TypeChecker_Rel.try_teq @@ -1529,25 +1472,26 @@ and tc_maybe_toplevel_term: env1 g' | FStar_Pervasives_Native.None -> - let uu____3763 = - let uu____3764 = + let uu____3711 = + let uu____3712 = FStar_Syntax_Print.lcomp_to_string c' in - let uu____3765 = + let uu____3713 = FStar_Syntax_Print.term_to_string c.FStar_Syntax_Syntax.res_typ in - let uu____3766 = + let uu____3714 = FStar_Syntax_Print.term_to_string c'.FStar_Syntax_Syntax.res_typ in FStar_Util.format3 "Unexpected result type of computation. The computation type %s of the term %s should have type Type n for some level n but has type %s" - uu____3764 uu____3765 - uu____3766 in - failwith uu____3763); + uu____3712 uu____3713 + uu____3714 in + failwith uu____3711); u))) in let repr = - let uu____3768 = c.FStar_Syntax_Syntax.comp () in - FStar_TypeChecker_Env.reify_comp env1 uu____3768 + let uu____3716 = + FStar_Syntax_Syntax.lcomp_comp c in + FStar_TypeChecker_Env.reify_comp env1 uu____3716 u_c in let e3 = FStar_Syntax_Syntax.mk @@ -1556,23 +1500,23 @@ and tc_maybe_toplevel_term: FStar_Pervasives_Native.None top.FStar_Syntax_Syntax.pos in let c1 = - let uu____3789 = + let uu____3737 = FStar_Syntax_Syntax.mk_Total repr in - FStar_All.pipe_right uu____3789 + FStar_All.pipe_right uu____3737 FStar_Syntax_Util.lcomp_of_comp in - let uu____3790 = + let uu____3738 = comp_check_expected_typ env1 e3 c1 in - (match uu____3790 with + (match uu____3738 with | (e4,c2,g') -> - let uu____3806 = + let uu____3754 = FStar_TypeChecker_Rel.conj_guard g g' in - (e4, c2, uu____3806)))))) + (e4, c2, uu____3754)))))) | FStar_Syntax_Syntax.Tm_app ({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_reflect l); - FStar_Syntax_Syntax.pos = uu____3808; - FStar_Syntax_Syntax.vars = uu____3809;_},(e1,aqual)::[]) + FStar_Syntax_Syntax.pos = uu____3756; + FStar_Syntax_Syntax.vars = uu____3757;_},(e1,aqual)::[]) -> (if FStar_Option.isSome aqual then @@ -1580,92 +1524,92 @@ and tc_maybe_toplevel_term: (FStar_Errors.Warning_IrrelevantQualifierOnArgumentToReflect, "Qualifier on argument to reflect is irrelevant and will be ignored") else (); - (let no_reflect uu____3851 = - let uu____3852 = - let uu____3857 = + (let no_reflect uu____3799 = + let uu____3800 = + let uu____3805 = FStar_Util.format1 "Effect %s cannot be reified" l.FStar_Ident.str in - (FStar_Errors.Fatal_EffectCannotBeReified, uu____3857) in - FStar_Errors.raise_error uu____3852 e1.FStar_Syntax_Syntax.pos in - let uu____3864 = FStar_Syntax_Util.head_and_args top in - match uu____3864 with - | (reflect_op,uu____3886) -> - let uu____3907 = + (FStar_Errors.Fatal_EffectCannotBeReified, uu____3805) in + FStar_Errors.raise_error uu____3800 e1.FStar_Syntax_Syntax.pos in + let uu____3812 = FStar_Syntax_Util.head_and_args top in + match uu____3812 with + | (reflect_op,uu____3834) -> + let uu____3855 = FStar_TypeChecker_Env.effect_decl_opt env1 l in - (match uu____3907 with + (match uu____3855 with | FStar_Pervasives_Native.None -> no_reflect () | FStar_Pervasives_Native.Some (ed,qualifiers) -> - let uu____3940 = - let uu____3941 = + let uu____3888 = + let uu____3889 = FStar_All.pipe_right qualifiers FStar_Syntax_Syntax.contains_reflectable in - Prims.op_Negation uu____3941 in - if uu____3940 + Prims.op_Negation uu____3889 in + if uu____3888 then no_reflect () else - (let uu____3951 = + (let uu____3899 = FStar_TypeChecker_Env.clear_expected_typ env1 in - match uu____3951 with + match uu____3899 with | (env_no_ex,topt) -> - let uu____3970 = + let uu____3918 = let u = FStar_TypeChecker_Env.new_u_univ () in let repr = FStar_TypeChecker_Env.inst_effect_fun_with [u] env1 ed ([], (ed.FStar_Syntax_Syntax.repr)) in let t = - let uu____3990 = - let uu____3993 = - let uu____3994 = - let uu____4009 = - let uu____4012 = + let uu____3938 = + let uu____3941 = + let uu____3942 = + let uu____3957 = + let uu____3960 = FStar_Syntax_Syntax.as_arg FStar_Syntax_Syntax.tun in - let uu____4013 = - let uu____4016 = + let uu____3961 = + let uu____3964 = FStar_Syntax_Syntax.as_arg FStar_Syntax_Syntax.tun in - [uu____4016] in - uu____4012 :: uu____4013 in - (repr, uu____4009) in - FStar_Syntax_Syntax.Tm_app uu____3994 in - FStar_Syntax_Syntax.mk uu____3993 in - uu____3990 FStar_Pervasives_Native.None + [uu____3964] in + uu____3960 :: uu____3961 in + (repr, uu____3957) in + FStar_Syntax_Syntax.Tm_app uu____3942 in + FStar_Syntax_Syntax.mk uu____3941 in + uu____3938 FStar_Pervasives_Native.None top.FStar_Syntax_Syntax.pos in - let uu____4022 = - let uu____4029 = - let uu____4030 = + let uu____3970 = + let uu____3977 = + let uu____3978 = FStar_TypeChecker_Env.clear_expected_typ env1 in - FStar_All.pipe_right uu____4030 + FStar_All.pipe_right uu____3978 FStar_Pervasives_Native.fst in - tc_tot_or_gtot_term uu____4029 t in - match uu____4022 with - | (t1,uu____4058,g) -> - let uu____4060 = - let uu____4061 = + tc_tot_or_gtot_term uu____3977 t in + match uu____3970 with + | (t1,uu____4006,g) -> + let uu____4008 = + let uu____4009 = FStar_Syntax_Subst.compress t1 in - uu____4061.FStar_Syntax_Syntax.n in - (match uu____4060 with + uu____4009.FStar_Syntax_Syntax.n in + (match uu____4008 with | FStar_Syntax_Syntax.Tm_app - (uu____4076,(res,uu____4078):: - (wp,uu____4080)::[]) + (uu____4024,(res,uu____4026):: + (wp,uu____4028)::[]) -> (t1, res, wp, g) - | uu____4123 -> failwith "Impossible") in - (match uu____3970 with + | uu____4071 -> failwith "Impossible") in + (match uu____3918 with | (expected_repr_typ,res_typ,wp,g0) -> - let uu____4154 = - let uu____4159 = + let uu____4102 = + let uu____4107 = tc_tot_or_gtot_term env_no_ex e1 in - match uu____4159 with + match uu____4107 with | (e2,c,g) -> - ((let uu____4174 = - let uu____4175 = + ((let uu____4122 = + let uu____4123 = FStar_Syntax_Util.is_total_lcomp c in FStar_All.pipe_left - Prims.op_Negation uu____4175 in - if uu____4174 + Prims.op_Negation uu____4123 in + if uu____4122 then FStar_TypeChecker_Err.add_errors env1 @@ -1673,74 +1617,74 @@ and tc_maybe_toplevel_term: "Expected Tot, got a GTot computation", (e2.FStar_Syntax_Syntax.pos))] else ()); - (let uu____4189 = + (let uu____4137 = FStar_TypeChecker_Rel.try_teq true env_no_ex c.FStar_Syntax_Syntax.res_typ expected_repr_typ in - match uu____4189 with + match uu____4137 with | FStar_Pervasives_Native.None -> - ((let uu____4197 = - let uu____4206 = - let uu____4213 = - let uu____4214 = + ((let uu____4145 = + let uu____4154 = + let uu____4161 = + let uu____4162 = FStar_Syntax_Print.term_to_string ed.FStar_Syntax_Syntax.repr in - let uu____4215 = + let uu____4163 = FStar_Syntax_Print.term_to_string c.FStar_Syntax_Syntax.res_typ in FStar_Util.format2 "Expected an instance of %s; got %s" - uu____4214 uu____4215 in + uu____4162 uu____4163 in (FStar_Errors.Error_UnexpectedInstance, - uu____4213, + uu____4161, (e2.FStar_Syntax_Syntax.pos)) in - [uu____4206] in + [uu____4154] in FStar_TypeChecker_Err.add_errors - env1 uu____4197); - (let uu____4228 = + env1 uu____4145); + (let uu____4176 = FStar_TypeChecker_Rel.conj_guard g g0 in - (e2, uu____4228))) + (e2, uu____4176))) | FStar_Pervasives_Native.Some g' -> - let uu____4230 = - let uu____4231 = + let uu____4178 = + let uu____4179 = FStar_TypeChecker_Rel.conj_guard g g0 in FStar_TypeChecker_Rel.conj_guard - g' uu____4231 in - (e2, uu____4230))) in - (match uu____4154 with + g' uu____4179 in + (e2, uu____4178))) in + (match uu____4102 with | (e2,g) -> let c = - let uu____4241 = - let uu____4242 = - let uu____4243 = - let uu____4244 = + let uu____4189 = + let uu____4190 = + let uu____4191 = + let uu____4192 = env1.FStar_TypeChecker_Env.universe_of env1 res_typ in - [uu____4244] in - let uu____4245 = - let uu____4254 = + [uu____4192] in + let uu____4193 = + let uu____4202 = FStar_Syntax_Syntax.as_arg wp in - [uu____4254] in + [uu____4202] in { FStar_Syntax_Syntax.comp_univs - = uu____4243; + = uu____4191; FStar_Syntax_Syntax.effect_name = (ed.FStar_Syntax_Syntax.mname); FStar_Syntax_Syntax.result_typ = res_typ; FStar_Syntax_Syntax.effect_args - = uu____4245; + = uu____4193; FStar_Syntax_Syntax.flags = [] } in FStar_Syntax_Syntax.mk_Comp - uu____4242 in - FStar_All.pipe_right uu____4241 + uu____4190 in + FStar_All.pipe_right uu____4189 FStar_Syntax_Util.lcomp_of_comp in let e3 = FStar_Syntax_Syntax.mk @@ -1748,177 +1692,161 @@ and tc_maybe_toplevel_term: (reflect_op, [(e2, aqual)])) FStar_Pervasives_Native.None top.FStar_Syntax_Syntax.pos in - let uu____4274 = + let uu____4222 = comp_check_expected_typ env1 e3 c in - (match uu____4274 with + (match uu____4222 with | (e4,c1,g') -> - let uu____4290 = + let uu____4238 = FStar_TypeChecker_Rel.conj_guard g' g in - (e4, c1, uu____4290)))))))) + (e4, c1, uu____4238)))))))) | FStar_Syntax_Syntax.Tm_app (head1,args) when FStar_Syntax_Util.is_synth_by_tactic head1 -> tc_synth env1 args top.FStar_Syntax_Syntax.pos | FStar_Syntax_Syntax.Tm_app (head1,args) -> let env0 = env1 in let env2 = - let uu____4337 = - let uu____4338 = FStar_TypeChecker_Env.clear_expected_typ env1 in - FStar_All.pipe_right uu____4338 FStar_Pervasives_Native.fst in - FStar_All.pipe_right uu____4337 instantiate_both in - ((let uu____4354 = + let uu____4285 = + let uu____4286 = FStar_TypeChecker_Env.clear_expected_typ env1 in + FStar_All.pipe_right uu____4286 FStar_Pervasives_Native.fst in + FStar_All.pipe_right uu____4285 instantiate_both in + ((let uu____4302 = FStar_TypeChecker_Env.debug env2 FStar_Options.High in - if uu____4354 + if uu____4302 then - let uu____4355 = + let uu____4303 = FStar_Range.string_of_range top.FStar_Syntax_Syntax.pos in - let uu____4356 = FStar_Syntax_Print.term_to_string top in - FStar_Util.print2 "(%s) Checking app %s\n" uu____4355 - uu____4356 + let uu____4304 = FStar_Syntax_Print.term_to_string top in + FStar_Util.print2 "(%s) Checking app %s\n" uu____4303 + uu____4304 else ()); (let isquote = - let uu____4359 = FStar_Syntax_Util.head_and_args head1 in - match uu____4359 with - | (head2,uu____4375) -> - let uu____4396 = - let uu____4397 = FStar_Syntax_Util.un_uinst head2 in - uu____4397.FStar_Syntax_Syntax.n in - (match uu____4396 with + let uu____4307 = FStar_Syntax_Util.head_and_args head1 in + match uu____4307 with + | (head2,uu____4323) -> + let uu____4344 = + let uu____4345 = FStar_Syntax_Util.un_uinst head2 in + uu____4345.FStar_Syntax_Syntax.n in + (match uu____4344 with | FStar_Syntax_Syntax.Tm_fvar fv when FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.quote_lid -> true - | uu____4401 -> false) in - let uu____4402 = tc_term (no_inst env2) head1 in - match uu____4402 with + | uu____4349 -> false) in + let uu____4350 = tc_term (no_inst env2) head1 in + match uu____4350 with | (head2,chead,g_head) -> - let uu____4418 = - let uu____4425 = + let uu____4366 = + let uu____4373 = (Prims.op_Negation env2.FStar_TypeChecker_Env.lax) && (FStar_TypeChecker_Util.short_circuit_head head2) in - if uu____4425 + if uu____4373 then - let uu____4432 = - let uu____4439 = + let uu____4380 = + let uu____4387 = FStar_TypeChecker_Env.expected_typ env0 in check_short_circuit_args env2 head2 chead g_head args - uu____4439 in - match uu____4432 with - | (e1,c,g) -> - let c1 = - let uu____4452 = - ((FStar_TypeChecker_Env.should_verify env2) && - (let uu____4454 = - FStar_Syntax_Util.is_lcomp_partial_return - c in - Prims.op_Negation uu____4454)) - && - (FStar_Syntax_Util.is_pure_or_ghost_lcomp c) in - if uu____4452 - then - FStar_TypeChecker_Util.maybe_assume_result_eq_pure_term - env2 e1 c - else c in - (e1, c1, g) + uu____4387 in + match uu____4380 with | (e1,c,g) -> (e1, c, g) else (let env3 = if isquote then no_inst env2 else env2 in - let uu____4459 = + let uu____4402 = FStar_TypeChecker_Env.expected_typ env0 in check_application_args env3 head2 chead g_head args - uu____4459) in - (match uu____4418 with + uu____4402) in + (match uu____4366 with | (e1,c,g) -> - ((let uu____4472 = + ((let uu____4415 = FStar_TypeChecker_Env.debug env2 FStar_Options.Extreme in - if uu____4472 + if uu____4415 then - let uu____4473 = + let uu____4416 = FStar_TypeChecker_Rel.print_pending_implicits g in FStar_Util.print1 "Introduced {%s} implicits in application\n" - uu____4473 + uu____4416 else ()); - (let uu____4475 = comp_check_expected_typ env0 e1 c in - match uu____4475 with + (let uu____4418 = comp_check_expected_typ env0 e1 c in + match uu____4418 with | (e2,c1,g') -> let gimp = - let uu____4492 = - let uu____4493 = + let uu____4435 = + let uu____4436 = FStar_Syntax_Subst.compress head2 in - uu____4493.FStar_Syntax_Syntax.n in - match uu____4492 with - | FStar_Syntax_Syntax.Tm_uvar (u,uu____4497) -> + uu____4436.FStar_Syntax_Syntax.n in + match uu____4435 with + | FStar_Syntax_Syntax.Tm_uvar (u,uu____4440) -> let imp = ("head of application is a uvar", env0, u, e2, (c1.FStar_Syntax_Syntax.res_typ), (head2.FStar_Syntax_Syntax.pos)) in - let uu___72_4559 = + let uu___71_4502 = FStar_TypeChecker_Rel.trivial_guard in { FStar_TypeChecker_Env.guard_f = - (uu___72_4559.FStar_TypeChecker_Env.guard_f); + (uu___71_4502.FStar_TypeChecker_Env.guard_f); FStar_TypeChecker_Env.deferred = - (uu___72_4559.FStar_TypeChecker_Env.deferred); + (uu___71_4502.FStar_TypeChecker_Env.deferred); FStar_TypeChecker_Env.univ_ineqs = - (uu___72_4559.FStar_TypeChecker_Env.univ_ineqs); + (uu___71_4502.FStar_TypeChecker_Env.univ_ineqs); FStar_TypeChecker_Env.implicits = [imp] } - | uu____4608 -> + | uu____4551 -> FStar_TypeChecker_Rel.trivial_guard in let gres = - let uu____4610 = + let uu____4553 = FStar_TypeChecker_Rel.conj_guard g' gimp in - FStar_TypeChecker_Rel.conj_guard g uu____4610 in - ((let uu____4612 = + FStar_TypeChecker_Rel.conj_guard g uu____4553 in + ((let uu____4555 = FStar_TypeChecker_Env.debug env2 FStar_Options.Extreme in - if uu____4612 + if uu____4555 then - let uu____4613 = + let uu____4556 = FStar_Syntax_Print.term_to_string e2 in - let uu____4614 = + let uu____4557 = FStar_TypeChecker_Rel.guard_to_string env2 gres in FStar_Util.print2 "Guard from application node %s is %s\n" - uu____4613 uu____4614 + uu____4556 uu____4557 else ()); (e2, c1, gres))))))) | FStar_Syntax_Syntax.Tm_match (e1,eqns) -> - let uu____4654 = FStar_TypeChecker_Env.clear_expected_typ env1 in - (match uu____4654 with + let uu____4597 = FStar_TypeChecker_Env.clear_expected_typ env1 in + (match uu____4597 with | (env11,topt) -> let env12 = instantiate_both env11 in - let uu____4674 = tc_term env12 e1 in - (match uu____4674 with + let uu____4617 = tc_term env12 e1 in + (match uu____4617 with | (e11,c1,g1) -> - let uu____4690 = + let uu____4633 = match topt with | FStar_Pervasives_Native.Some t -> (env1, t) | FStar_Pervasives_Native.None -> - let uu____4700 = FStar_Syntax_Util.type_u () in - (match uu____4700 with - | (k,uu____4710) -> + let uu____4643 = FStar_Syntax_Util.type_u () in + (match uu____4643 with + | (k,uu____4653) -> let res_t = FStar_TypeChecker_Util.new_uvar env1 k in - let uu____4712 = + let uu____4655 = FStar_TypeChecker_Env.set_expected_typ env1 res_t in - (uu____4712, res_t)) in - (match uu____4690 with + (uu____4655, res_t)) in + (match uu____4633 with | (env_branches,res_t) -> - ((let uu____4722 = + ((let uu____4665 = FStar_TypeChecker_Env.debug env1 FStar_Options.Extreme in - if uu____4722 + if uu____4665 then - let uu____4723 = + let uu____4666 = FStar_Syntax_Print.term_to_string res_t in FStar_Util.print1 "Tm_match: expected type of branches is %s\n" - uu____4723 + uu____4666 else ()); (let guard_x = FStar_Syntax_Syntax.new_bv @@ -1928,27 +1856,27 @@ and tc_maybe_toplevel_term: let t_eqns = FStar_All.pipe_right eqns (FStar_List.map (tc_eqn guard_x env_branches)) in - let uu____4809 = - let uu____4814 = + let uu____4776 = + let uu____4781 = FStar_List.fold_right - (fun uu____4860 -> - fun uu____4861 -> - match (uu____4860, uu____4861) with - | ((uu____4924,f,c,g),(caccum,gaccum)) - -> - let uu____4984 = + (fun uu____4853 -> + fun uu____4854 -> + match (uu____4853, uu____4854) with + | ((branch1,f,eff_label,cflags,c,g), + (caccum,gaccum)) -> + let uu____5059 = FStar_TypeChecker_Rel.conj_guard g gaccum in - (((f, c) :: caccum), uu____4984)) - t_eqns + (((f, eff_label, cflags, c) :: + caccum), uu____5059)) t_eqns ([], FStar_TypeChecker_Rel.trivial_guard) in - match uu____4814 with + match uu____4781 with | (cases,g) -> - let uu____5023 = + let uu____5150 = FStar_TypeChecker_Util.bind_cases env1 res_t cases in - (uu____5023, g) in - match uu____4809 with + (uu____5150, g) in + match uu____4776 with | (c_branches,g_branches) -> let cres = FStar_TypeChecker_Util.bind @@ -1961,17 +1889,16 @@ and tc_maybe_toplevel_term: let branches = FStar_All.pipe_right t_eqns (FStar_List.map - (fun uu____5119 -> - match uu____5119 with - | ((pat,wopt,br),uu____5147,lc,uu____5149) + (fun uu____5264 -> + match uu____5264 with + | ((pat,wopt,br),uu____5300,eff_label,uu____5302,uu____5303,uu____5304) -> - let uu____5162 = + let uu____5325 = FStar_TypeChecker_Util.maybe_lift - env1 br - lc.FStar_Syntax_Syntax.eff_name + env1 br eff_label cres.FStar_Syntax_Syntax.eff_name - lc.FStar_Syntax_Syntax.res_typ in - (pat, wopt, uu____5162))) in + res_t in + (pat, wopt, uu____5325))) in let e2 = FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_match @@ -1993,19 +1920,19 @@ and tc_maybe_toplevel_term: (cres.FStar_Syntax_Syntax.eff_name)))) FStar_Pervasives_Native.None e3.FStar_Syntax_Syntax.pos in - let uu____5217 = + let uu____5380 = FStar_TypeChecker_Util.is_pure_or_ghost_effect env1 c1.FStar_Syntax_Syntax.eff_name in - if uu____5217 + if uu____5380 then mk_match e11 else (let e_match = - let uu____5224 = + let uu____5387 = FStar_Syntax_Syntax.bv_to_name guard_x in - mk_match uu____5224 in + mk_match uu____5387 in let lb = - let uu____5228 = + let uu____5391 = FStar_TypeChecker_Env.norm_eff_name env1 c1.FStar_Syntax_Syntax.eff_name in @@ -2016,309 +1943,325 @@ and tc_maybe_toplevel_term: FStar_Syntax_Syntax.lbtyp = (c1.FStar_Syntax_Syntax.res_typ); FStar_Syntax_Syntax.lbeff = - uu____5228; + uu____5391; FStar_Syntax_Syntax.lbdef = e11 } in let e2 = - let uu____5232 = - let uu____5235 = - let uu____5236 = - let uu____5249 = - let uu____5250 = - let uu____5251 = + let uu____5395 = + let uu____5398 = + let uu____5399 = + let uu____5412 = + let uu____5413 = + let uu____5414 = FStar_Syntax_Syntax.mk_binder guard_x in - [uu____5251] in + [uu____5414] in FStar_Syntax_Subst.close - uu____5250 e_match in - ((false, [lb]), uu____5249) in + uu____5413 e_match in + ((false, [lb]), uu____5412) in FStar_Syntax_Syntax.Tm_let - uu____5236 in - FStar_Syntax_Syntax.mk uu____5235 in - uu____5232 + uu____5399 in + FStar_Syntax_Syntax.mk uu____5398 in + uu____5395 FStar_Pervasives_Native.None top.FStar_Syntax_Syntax.pos in FStar_TypeChecker_Util.maybe_monadic env1 e2 cres.FStar_Syntax_Syntax.eff_name cres.FStar_Syntax_Syntax.res_typ) in - ((let uu____5264 = + ((let uu____5427 = FStar_TypeChecker_Env.debug env1 FStar_Options.Extreme in - if uu____5264 + if uu____5427 then - let uu____5265 = + let uu____5428 = FStar_Range.string_of_range top.FStar_Syntax_Syntax.pos in - let uu____5266 = - let uu____5267 = - cres.FStar_Syntax_Syntax.comp () in - FStar_All.pipe_left - FStar_Syntax_Print.comp_to_string - uu____5267 in + let uu____5429 = + FStar_Syntax_Print.lcomp_to_string cres in FStar_Util.print2 "(%s) comp type = %s\n" - uu____5265 uu____5266 + uu____5428 uu____5429 else ()); - (let uu____5269 = + (let uu____5431 = FStar_TypeChecker_Rel.conj_guard g1 g_branches in - (e2, cres, uu____5269)))))))) + (e2, cres, uu____5431)))))))) | FStar_Syntax_Syntax.Tm_let ((false - ,{ FStar_Syntax_Syntax.lbname = FStar_Util.Inr uu____5272; - FStar_Syntax_Syntax.lbunivs = uu____5273; - FStar_Syntax_Syntax.lbtyp = uu____5274; - FStar_Syntax_Syntax.lbeff = uu____5275; - FStar_Syntax_Syntax.lbdef = uu____5276;_}::[]),uu____5277) + ,{ FStar_Syntax_Syntax.lbname = FStar_Util.Inr uu____5434; + FStar_Syntax_Syntax.lbunivs = uu____5435; + FStar_Syntax_Syntax.lbtyp = uu____5436; + FStar_Syntax_Syntax.lbeff = uu____5437; + FStar_Syntax_Syntax.lbdef = uu____5438;_}::[]),uu____5439) -> - ((let uu____5297 = + ((let uu____5459 = FStar_TypeChecker_Env.debug env1 FStar_Options.Low in - if uu____5297 + if uu____5459 then - let uu____5298 = FStar_Syntax_Print.term_to_string top in - FStar_Util.print1 "%s\n" uu____5298 + let uu____5460 = FStar_Syntax_Print.term_to_string top in + FStar_Util.print1 "%s\n" uu____5460 else ()); - (let uu____5300 = FStar_Options.use_two_phase_tc () in - if uu____5300 + (let uu____5462 = FStar_Options.use_two_phase_tc () in + if uu____5462 then let is_lb_unannotated t = match t.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Tm_let - ((uu____5311,lb::[]),uu____5313) -> - let uu____5326 = - let uu____5327 = + ((uu____5473,lb::[]),uu____5475) -> + let uu____5488 = + let uu____5489 = FStar_Syntax_Subst.compress lb.FStar_Syntax_Syntax.lbtyp in - uu____5327.FStar_Syntax_Syntax.n in - uu____5326 = FStar_Syntax_Syntax.Tm_unknown - | uu____5330 -> failwith "Impossible" in + uu____5489.FStar_Syntax_Syntax.n in + uu____5488 = FStar_Syntax_Syntax.Tm_unknown + | uu____5492 -> failwith "Impossible" in let drop_lbtyp t = match t.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Tm_let ((t1,lb::[]),t2) -> - let uu___73_5350 = t in - let uu____5351 = - let uu____5352 = - let uu____5365 = - let uu____5372 = - let uu____5375 = - let uu___74_5376 = lb in - let uu____5377 = + let uu___72_5512 = t in + let uu____5513 = + let uu____5514 = + let uu____5527 = + let uu____5534 = + let uu____5537 = + let uu___73_5538 = lb in + let uu____5539 = FStar_Syntax_Syntax.mk FStar_Syntax_Syntax.Tm_unknown FStar_Pervasives_Native.None (lb.FStar_Syntax_Syntax.lbtyp).FStar_Syntax_Syntax.pos in { FStar_Syntax_Syntax.lbname = - (uu___74_5376.FStar_Syntax_Syntax.lbname); + (uu___73_5538.FStar_Syntax_Syntax.lbname); FStar_Syntax_Syntax.lbunivs = - (uu___74_5376.FStar_Syntax_Syntax.lbunivs); - FStar_Syntax_Syntax.lbtyp = uu____5377; + (uu___73_5538.FStar_Syntax_Syntax.lbunivs); + FStar_Syntax_Syntax.lbtyp = uu____5539; FStar_Syntax_Syntax.lbeff = - (uu___74_5376.FStar_Syntax_Syntax.lbeff); + (uu___73_5538.FStar_Syntax_Syntax.lbeff); FStar_Syntax_Syntax.lbdef = - (uu___74_5376.FStar_Syntax_Syntax.lbdef) + (uu___73_5538.FStar_Syntax_Syntax.lbdef) } in - [uu____5375] in - (t1, uu____5372) in - (uu____5365, t2) in - FStar_Syntax_Syntax.Tm_let uu____5352 in + [uu____5537] in + (t1, uu____5534) in + (uu____5527, t2) in + FStar_Syntax_Syntax.Tm_let uu____5514 in { - FStar_Syntax_Syntax.n = uu____5351; + FStar_Syntax_Syntax.n = uu____5513; FStar_Syntax_Syntax.pos = - (uu___73_5350.FStar_Syntax_Syntax.pos); + (uu___72_5512.FStar_Syntax_Syntax.pos); FStar_Syntax_Syntax.vars = - (uu___73_5350.FStar_Syntax_Syntax.vars) + (uu___72_5512.FStar_Syntax_Syntax.vars) } - | uu____5390 -> failwith "Impossible" in - let uu____5391 = + | uu____5552 -> failwith "Impossible" in + let uu____5553 = check_top_level_let - (let uu___75_5400 = env1 in + (let uu___74_5562 = env1 in { FStar_TypeChecker_Env.solver = - (uu___75_5400.FStar_TypeChecker_Env.solver); + (uu___74_5562.FStar_TypeChecker_Env.solver); FStar_TypeChecker_Env.range = - (uu___75_5400.FStar_TypeChecker_Env.range); + (uu___74_5562.FStar_TypeChecker_Env.range); FStar_TypeChecker_Env.curmodule = - (uu___75_5400.FStar_TypeChecker_Env.curmodule); + (uu___74_5562.FStar_TypeChecker_Env.curmodule); FStar_TypeChecker_Env.gamma = - (uu___75_5400.FStar_TypeChecker_Env.gamma); + (uu___74_5562.FStar_TypeChecker_Env.gamma); FStar_TypeChecker_Env.gamma_cache = - (uu___75_5400.FStar_TypeChecker_Env.gamma_cache); + (uu___74_5562.FStar_TypeChecker_Env.gamma_cache); FStar_TypeChecker_Env.modules = - (uu___75_5400.FStar_TypeChecker_Env.modules); + (uu___74_5562.FStar_TypeChecker_Env.modules); FStar_TypeChecker_Env.expected_typ = - (uu___75_5400.FStar_TypeChecker_Env.expected_typ); + (uu___74_5562.FStar_TypeChecker_Env.expected_typ); FStar_TypeChecker_Env.sigtab = - (uu___75_5400.FStar_TypeChecker_Env.sigtab); + (uu___74_5562.FStar_TypeChecker_Env.sigtab); FStar_TypeChecker_Env.is_pattern = - (uu___75_5400.FStar_TypeChecker_Env.is_pattern); + (uu___74_5562.FStar_TypeChecker_Env.is_pattern); FStar_TypeChecker_Env.instantiate_imp = - (uu___75_5400.FStar_TypeChecker_Env.instantiate_imp); + (uu___74_5562.FStar_TypeChecker_Env.instantiate_imp); FStar_TypeChecker_Env.effects = - (uu___75_5400.FStar_TypeChecker_Env.effects); + (uu___74_5562.FStar_TypeChecker_Env.effects); FStar_TypeChecker_Env.generalize = - (uu___75_5400.FStar_TypeChecker_Env.generalize); + (uu___74_5562.FStar_TypeChecker_Env.generalize); FStar_TypeChecker_Env.letrecs = - (uu___75_5400.FStar_TypeChecker_Env.letrecs); + (uu___74_5562.FStar_TypeChecker_Env.letrecs); FStar_TypeChecker_Env.top_level = - (uu___75_5400.FStar_TypeChecker_Env.top_level); + (uu___74_5562.FStar_TypeChecker_Env.top_level); FStar_TypeChecker_Env.check_uvars = - (uu___75_5400.FStar_TypeChecker_Env.check_uvars); + (uu___74_5562.FStar_TypeChecker_Env.check_uvars); FStar_TypeChecker_Env.use_eq = - (uu___75_5400.FStar_TypeChecker_Env.use_eq); + (uu___74_5562.FStar_TypeChecker_Env.use_eq); FStar_TypeChecker_Env.is_iface = - (uu___75_5400.FStar_TypeChecker_Env.is_iface); + (uu___74_5562.FStar_TypeChecker_Env.is_iface); FStar_TypeChecker_Env.admit = - (uu___75_5400.FStar_TypeChecker_Env.admit); + (uu___74_5562.FStar_TypeChecker_Env.admit); FStar_TypeChecker_Env.lax = true; FStar_TypeChecker_Env.lax_universes = - (uu___75_5400.FStar_TypeChecker_Env.lax_universes); + (uu___74_5562.FStar_TypeChecker_Env.lax_universes); FStar_TypeChecker_Env.failhard = - (uu___75_5400.FStar_TypeChecker_Env.failhard); + (uu___74_5562.FStar_TypeChecker_Env.failhard); FStar_TypeChecker_Env.nosynth = - (uu___75_5400.FStar_TypeChecker_Env.nosynth); + (uu___74_5562.FStar_TypeChecker_Env.nosynth); FStar_TypeChecker_Env.tc_term = - (uu___75_5400.FStar_TypeChecker_Env.tc_term); + (uu___74_5562.FStar_TypeChecker_Env.tc_term); FStar_TypeChecker_Env.type_of = - (uu___75_5400.FStar_TypeChecker_Env.type_of); + (uu___74_5562.FStar_TypeChecker_Env.type_of); FStar_TypeChecker_Env.universe_of = - (uu___75_5400.FStar_TypeChecker_Env.universe_of); + (uu___74_5562.FStar_TypeChecker_Env.universe_of); FStar_TypeChecker_Env.use_bv_sorts = - (uu___75_5400.FStar_TypeChecker_Env.use_bv_sorts); + (uu___74_5562.FStar_TypeChecker_Env.use_bv_sorts); FStar_TypeChecker_Env.qname_and_index = - (uu___75_5400.FStar_TypeChecker_Env.qname_and_index); + (uu___74_5562.FStar_TypeChecker_Env.qname_and_index); FStar_TypeChecker_Env.proof_ns = - (uu___75_5400.FStar_TypeChecker_Env.proof_ns); + (uu___74_5562.FStar_TypeChecker_Env.proof_ns); FStar_TypeChecker_Env.synth = - (uu___75_5400.FStar_TypeChecker_Env.synth); + (uu___74_5562.FStar_TypeChecker_Env.synth); FStar_TypeChecker_Env.is_native_tactic = - (uu___75_5400.FStar_TypeChecker_Env.is_native_tactic); + (uu___74_5562.FStar_TypeChecker_Env.is_native_tactic); FStar_TypeChecker_Env.identifier_info = - (uu___75_5400.FStar_TypeChecker_Env.identifier_info); + (uu___74_5562.FStar_TypeChecker_Env.identifier_info); FStar_TypeChecker_Env.tc_hooks = - (uu___75_5400.FStar_TypeChecker_Env.tc_hooks); + (uu___74_5562.FStar_TypeChecker_Env.tc_hooks); FStar_TypeChecker_Env.dsenv = - (uu___75_5400.FStar_TypeChecker_Env.dsenv); + (uu___74_5562.FStar_TypeChecker_Env.dsenv); FStar_TypeChecker_Env.dep_graph = - (uu___75_5400.FStar_TypeChecker_Env.dep_graph) + (uu___74_5562.FStar_TypeChecker_Env.dep_graph) }) top in - match uu____5391 with + match uu____5553 with | (lax_top,l,g) -> let lax_top1 = FStar_TypeChecker_Normalize.remove_uvar_solutions env1 lax_top in - let uu____5411 = FStar_TypeChecker_Env.should_verify env1 in - (if uu____5411 - then - let uu____5418 = - let uu____5419 = is_lb_unannotated top in - if uu____5419 then drop_lbtyp lax_top1 else lax_top1 in - check_top_level_let env1 uu____5418 - else (lax_top1, l, g)) + ((let uu____5574 = + FStar_All.pipe_left (FStar_TypeChecker_Env.debug env1) + (FStar_Options.Other "TwoPhases") in + if uu____5574 + then + let uu____5575 = + FStar_Syntax_Print.term_to_string lax_top1 in + FStar_Util.print1 "Phase 1: checked %s\n" uu____5575 + else ()); + (let uu____5577 = + FStar_TypeChecker_Env.should_verify env1 in + if uu____5577 + then + let uu____5584 = + let uu____5585 = is_lb_unannotated top in + if uu____5585 then drop_lbtyp lax_top1 else lax_top1 in + check_top_level_let env1 uu____5584 + else (lax_top1, l, g))) else check_top_level_let env1 top)) - | FStar_Syntax_Syntax.Tm_let ((false ,uu____5423),uu____5424) -> + | FStar_Syntax_Syntax.Tm_let ((false ,uu____5589),uu____5590) -> check_inner_let env1 top | FStar_Syntax_Syntax.Tm_let ((true - ,{ FStar_Syntax_Syntax.lbname = FStar_Util.Inr uu____5439; - FStar_Syntax_Syntax.lbunivs = uu____5440; - FStar_Syntax_Syntax.lbtyp = uu____5441; - FStar_Syntax_Syntax.lbeff = uu____5442; - FStar_Syntax_Syntax.lbdef = uu____5443;_}::uu____5444),uu____5445) + ,{ FStar_Syntax_Syntax.lbname = FStar_Util.Inr uu____5605; + FStar_Syntax_Syntax.lbunivs = uu____5606; + FStar_Syntax_Syntax.lbtyp = uu____5607; + FStar_Syntax_Syntax.lbeff = uu____5608; + FStar_Syntax_Syntax.lbdef = uu____5609;_}::uu____5610),uu____5611) -> - ((let uu____5467 = + ((let uu____5633 = FStar_TypeChecker_Env.debug env1 FStar_Options.Low in - if uu____5467 + if uu____5633 then - let uu____5468 = FStar_Syntax_Print.term_to_string top in - FStar_Util.print1 "%s\n" uu____5468 + let uu____5634 = FStar_Syntax_Print.term_to_string top in + FStar_Util.print1 "%s\n" uu____5634 else ()); - (let uu____5470 = FStar_Options.use_two_phase_tc () in - if uu____5470 + (let uu____5636 = FStar_Options.use_two_phase_tc () in + if uu____5636 then - let uu____5477 = + let uu____5643 = check_top_level_let_rec - (let uu___76_5486 = env1 in + (let uu___75_5652 = env1 in { FStar_TypeChecker_Env.solver = - (uu___76_5486.FStar_TypeChecker_Env.solver); + (uu___75_5652.FStar_TypeChecker_Env.solver); FStar_TypeChecker_Env.range = - (uu___76_5486.FStar_TypeChecker_Env.range); + (uu___75_5652.FStar_TypeChecker_Env.range); FStar_TypeChecker_Env.curmodule = - (uu___76_5486.FStar_TypeChecker_Env.curmodule); + (uu___75_5652.FStar_TypeChecker_Env.curmodule); FStar_TypeChecker_Env.gamma = - (uu___76_5486.FStar_TypeChecker_Env.gamma); + (uu___75_5652.FStar_TypeChecker_Env.gamma); FStar_TypeChecker_Env.gamma_cache = - (uu___76_5486.FStar_TypeChecker_Env.gamma_cache); + (uu___75_5652.FStar_TypeChecker_Env.gamma_cache); FStar_TypeChecker_Env.modules = - (uu___76_5486.FStar_TypeChecker_Env.modules); + (uu___75_5652.FStar_TypeChecker_Env.modules); FStar_TypeChecker_Env.expected_typ = - (uu___76_5486.FStar_TypeChecker_Env.expected_typ); + (uu___75_5652.FStar_TypeChecker_Env.expected_typ); FStar_TypeChecker_Env.sigtab = - (uu___76_5486.FStar_TypeChecker_Env.sigtab); + (uu___75_5652.FStar_TypeChecker_Env.sigtab); FStar_TypeChecker_Env.is_pattern = - (uu___76_5486.FStar_TypeChecker_Env.is_pattern); + (uu___75_5652.FStar_TypeChecker_Env.is_pattern); FStar_TypeChecker_Env.instantiate_imp = - (uu___76_5486.FStar_TypeChecker_Env.instantiate_imp); + (uu___75_5652.FStar_TypeChecker_Env.instantiate_imp); FStar_TypeChecker_Env.effects = - (uu___76_5486.FStar_TypeChecker_Env.effects); + (uu___75_5652.FStar_TypeChecker_Env.effects); FStar_TypeChecker_Env.generalize = - (uu___76_5486.FStar_TypeChecker_Env.generalize); + (uu___75_5652.FStar_TypeChecker_Env.generalize); FStar_TypeChecker_Env.letrecs = - (uu___76_5486.FStar_TypeChecker_Env.letrecs); + (uu___75_5652.FStar_TypeChecker_Env.letrecs); FStar_TypeChecker_Env.top_level = - (uu___76_5486.FStar_TypeChecker_Env.top_level); + (uu___75_5652.FStar_TypeChecker_Env.top_level); FStar_TypeChecker_Env.check_uvars = - (uu___76_5486.FStar_TypeChecker_Env.check_uvars); + (uu___75_5652.FStar_TypeChecker_Env.check_uvars); FStar_TypeChecker_Env.use_eq = - (uu___76_5486.FStar_TypeChecker_Env.use_eq); + (uu___75_5652.FStar_TypeChecker_Env.use_eq); FStar_TypeChecker_Env.is_iface = - (uu___76_5486.FStar_TypeChecker_Env.is_iface); + (uu___75_5652.FStar_TypeChecker_Env.is_iface); FStar_TypeChecker_Env.admit = - (uu___76_5486.FStar_TypeChecker_Env.admit); + (uu___75_5652.FStar_TypeChecker_Env.admit); FStar_TypeChecker_Env.lax = true; FStar_TypeChecker_Env.lax_universes = - (uu___76_5486.FStar_TypeChecker_Env.lax_universes); + (uu___75_5652.FStar_TypeChecker_Env.lax_universes); FStar_TypeChecker_Env.failhard = - (uu___76_5486.FStar_TypeChecker_Env.failhard); + (uu___75_5652.FStar_TypeChecker_Env.failhard); FStar_TypeChecker_Env.nosynth = - (uu___76_5486.FStar_TypeChecker_Env.nosynth); + (uu___75_5652.FStar_TypeChecker_Env.nosynth); FStar_TypeChecker_Env.tc_term = - (uu___76_5486.FStar_TypeChecker_Env.tc_term); + (uu___75_5652.FStar_TypeChecker_Env.tc_term); FStar_TypeChecker_Env.type_of = - (uu___76_5486.FStar_TypeChecker_Env.type_of); + (uu___75_5652.FStar_TypeChecker_Env.type_of); FStar_TypeChecker_Env.universe_of = - (uu___76_5486.FStar_TypeChecker_Env.universe_of); + (uu___75_5652.FStar_TypeChecker_Env.universe_of); FStar_TypeChecker_Env.use_bv_sorts = - (uu___76_5486.FStar_TypeChecker_Env.use_bv_sorts); + (uu___75_5652.FStar_TypeChecker_Env.use_bv_sorts); FStar_TypeChecker_Env.qname_and_index = - (uu___76_5486.FStar_TypeChecker_Env.qname_and_index); + (uu___75_5652.FStar_TypeChecker_Env.qname_and_index); FStar_TypeChecker_Env.proof_ns = - (uu___76_5486.FStar_TypeChecker_Env.proof_ns); + (uu___75_5652.FStar_TypeChecker_Env.proof_ns); FStar_TypeChecker_Env.synth = - (uu___76_5486.FStar_TypeChecker_Env.synth); + (uu___75_5652.FStar_TypeChecker_Env.synth); FStar_TypeChecker_Env.is_native_tactic = - (uu___76_5486.FStar_TypeChecker_Env.is_native_tactic); + (uu___75_5652.FStar_TypeChecker_Env.is_native_tactic); FStar_TypeChecker_Env.identifier_info = - (uu___76_5486.FStar_TypeChecker_Env.identifier_info); + (uu___75_5652.FStar_TypeChecker_Env.identifier_info); FStar_TypeChecker_Env.tc_hooks = - (uu___76_5486.FStar_TypeChecker_Env.tc_hooks); + (uu___75_5652.FStar_TypeChecker_Env.tc_hooks); FStar_TypeChecker_Env.dsenv = - (uu___76_5486.FStar_TypeChecker_Env.dsenv); + (uu___75_5652.FStar_TypeChecker_Env.dsenv); FStar_TypeChecker_Env.dep_graph = - (uu___76_5486.FStar_TypeChecker_Env.dep_graph) + (uu___75_5652.FStar_TypeChecker_Env.dep_graph) }) top in - match uu____5477 with + match uu____5643 with | (lax_top,l,g) -> let lax_top1 = FStar_TypeChecker_Normalize.remove_uvar_solutions env1 lax_top in - let uu____5497 = FStar_TypeChecker_Env.should_verify env1 in - (if uu____5497 - then check_top_level_let_rec env1 lax_top1 - else (lax_top1, l, g)) + ((let uu____5664 = + FStar_TypeChecker_Env.debug env1 + (FStar_Options.Other "TwoPhases") in + if uu____5664 + then + let uu____5665 = + FStar_Syntax_Print.term_to_string lax_top1 in + FStar_Util.print1 "Phase 1: checked %s\n" uu____5665 + else ()); + (let uu____5667 = + FStar_TypeChecker_Env.should_verify env1 in + if uu____5667 + then check_top_level_let_rec env1 lax_top1 + else (lax_top1, l, g))) else check_top_level_let_rec env1 top)) - | FStar_Syntax_Syntax.Tm_let ((true ,uu____5506),uu____5507) -> + | FStar_Syntax_Syntax.Tm_let ((true ,uu____5676),uu____5677) -> check_inner_let_rec env1 top) and tc_synth: FStar_TypeChecker_Env.env -> @@ -2331,85 +2274,85 @@ and tc_synth: fun env -> fun args -> fun rng -> - let uu____5533 = + let uu____5703 = match args with | (tau,FStar_Pervasives_Native.None )::rest -> (tau, FStar_Pervasives_Native.None, rest) | (a,FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Implicit - uu____5623))::(tau,FStar_Pervasives_Native.None )::rest -> + uu____5793))::(tau,FStar_Pervasives_Native.None )::rest -> (tau, (FStar_Pervasives_Native.Some a), rest) | (a,FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Implicit - uu____5683))::(uu____5684,FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.Implicit uu____5685)):: + uu____5853))::(uu____5854,FStar_Pervasives_Native.Some + (FStar_Syntax_Syntax.Implicit uu____5855)):: (tau,FStar_Pervasives_Native.None )::rest -> (tau, (FStar_Pervasives_Native.Some a), rest) - | uu____5758 -> + | uu____5928 -> FStar_Errors.raise_error (FStar_Errors.Fatal_SynthByTacticError, "synth_by_tactic: bad application") rng in - match uu____5533 with + match uu____5703 with | (tau,atyp,rest) -> let typ = match atyp with | FStar_Pervasives_Native.Some t -> t | FStar_Pervasives_Native.None -> - let uu____5842 = FStar_TypeChecker_Env.expected_typ env in - (match uu____5842 with + let uu____6012 = FStar_TypeChecker_Env.expected_typ env in + (match uu____6012 with | FStar_Pervasives_Native.Some t -> t | FStar_Pervasives_Native.None -> - let uu____5848 = FStar_TypeChecker_Env.get_range env in + let uu____6018 = FStar_TypeChecker_Env.get_range env in FStar_Errors.raise_error (FStar_Errors.Fatal_SynthByTacticError, "synth_by_tactic: need a type annotation when no expected type is present") - uu____5848) in - let uu____5851 = FStar_TypeChecker_Env.clear_expected_typ env in - (match uu____5851 with - | (env',uu____5865) -> - let uu____5870 = tc_term env' typ in - (match uu____5870 with - | (typ1,uu____5884,g1) -> + uu____6018) in + let uu____6021 = FStar_TypeChecker_Env.clear_expected_typ env in + (match uu____6021 with + | (env',uu____6035) -> + let uu____6040 = tc_term env' typ in + (match uu____6040 with + | (typ1,uu____6054,g1) -> (FStar_TypeChecker_Rel.force_trivial_guard env' g1; - (let uu____5887 = tc_tactic env' tau in - match uu____5887 with - | (tau1,uu____5901,g2) -> + (let uu____6057 = tc_tactic env' tau in + match uu____6057 with + | (tau1,uu____6071,g2) -> (FStar_TypeChecker_Rel.force_trivial_guard env' g2; (let t = if env.FStar_TypeChecker_Env.nosynth then - let uu____5909 = - let uu____5910 = + let uu____6079 = + let uu____6080 = FStar_TypeChecker_Util.fvar_const env FStar_Parser_Const.magic_lid in - let uu____5911 = - let uu____5912 = + let uu____6081 = + let uu____6082 = FStar_Syntax_Syntax.as_arg FStar_Syntax_Util.exp_unit in - [uu____5912] in - FStar_Syntax_Syntax.mk_Tm_app uu____5910 - uu____5911 in - uu____5909 FStar_Pervasives_Native.None rng + [uu____6082] in + FStar_Syntax_Syntax.mk_Tm_app uu____6080 + uu____6081 in + uu____6079 FStar_Pervasives_Native.None rng else (let t = env.FStar_TypeChecker_Env.synth env' typ1 tau1 in - (let uu____5918 = + (let uu____6088 = FStar_All.pipe_left (FStar_TypeChecker_Env.debug env) (FStar_Options.Other "Tac") in - if uu____5918 + if uu____6088 then - let uu____5919 = + let uu____6089 = FStar_Syntax_Print.term_to_string t in - FStar_Util.print1 "Got %s\n" uu____5919 + FStar_Util.print1 "Got %s\n" uu____6089 else ()); t) in FStar_TypeChecker_Util.check_uvars tau1.FStar_Syntax_Syntax.pos t; - (let uu____5922 = + (let uu____6092 = FStar_Syntax_Syntax.mk_Tm_app t rest FStar_Pervasives_Native.None rng in - tc_term env uu____5922))))))) + tc_term env uu____6092))))))) and tc_tactic: FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.term -> @@ -2419,75 +2362,75 @@ and tc_tactic: fun env -> fun tau -> let env1 = - let uu___77_5926 = env in + let uu___76_6096 = env in { FStar_TypeChecker_Env.solver = - (uu___77_5926.FStar_TypeChecker_Env.solver); + (uu___76_6096.FStar_TypeChecker_Env.solver); FStar_TypeChecker_Env.range = - (uu___77_5926.FStar_TypeChecker_Env.range); + (uu___76_6096.FStar_TypeChecker_Env.range); FStar_TypeChecker_Env.curmodule = - (uu___77_5926.FStar_TypeChecker_Env.curmodule); + (uu___76_6096.FStar_TypeChecker_Env.curmodule); FStar_TypeChecker_Env.gamma = - (uu___77_5926.FStar_TypeChecker_Env.gamma); + (uu___76_6096.FStar_TypeChecker_Env.gamma); FStar_TypeChecker_Env.gamma_cache = - (uu___77_5926.FStar_TypeChecker_Env.gamma_cache); + (uu___76_6096.FStar_TypeChecker_Env.gamma_cache); FStar_TypeChecker_Env.modules = - (uu___77_5926.FStar_TypeChecker_Env.modules); + (uu___76_6096.FStar_TypeChecker_Env.modules); FStar_TypeChecker_Env.expected_typ = - (uu___77_5926.FStar_TypeChecker_Env.expected_typ); + (uu___76_6096.FStar_TypeChecker_Env.expected_typ); FStar_TypeChecker_Env.sigtab = - (uu___77_5926.FStar_TypeChecker_Env.sigtab); + (uu___76_6096.FStar_TypeChecker_Env.sigtab); FStar_TypeChecker_Env.is_pattern = - (uu___77_5926.FStar_TypeChecker_Env.is_pattern); + (uu___76_6096.FStar_TypeChecker_Env.is_pattern); FStar_TypeChecker_Env.instantiate_imp = - (uu___77_5926.FStar_TypeChecker_Env.instantiate_imp); + (uu___76_6096.FStar_TypeChecker_Env.instantiate_imp); FStar_TypeChecker_Env.effects = - (uu___77_5926.FStar_TypeChecker_Env.effects); + (uu___76_6096.FStar_TypeChecker_Env.effects); FStar_TypeChecker_Env.generalize = - (uu___77_5926.FStar_TypeChecker_Env.generalize); + (uu___76_6096.FStar_TypeChecker_Env.generalize); FStar_TypeChecker_Env.letrecs = - (uu___77_5926.FStar_TypeChecker_Env.letrecs); + (uu___76_6096.FStar_TypeChecker_Env.letrecs); FStar_TypeChecker_Env.top_level = - (uu___77_5926.FStar_TypeChecker_Env.top_level); + (uu___76_6096.FStar_TypeChecker_Env.top_level); FStar_TypeChecker_Env.check_uvars = - (uu___77_5926.FStar_TypeChecker_Env.check_uvars); + (uu___76_6096.FStar_TypeChecker_Env.check_uvars); FStar_TypeChecker_Env.use_eq = - (uu___77_5926.FStar_TypeChecker_Env.use_eq); + (uu___76_6096.FStar_TypeChecker_Env.use_eq); FStar_TypeChecker_Env.is_iface = - (uu___77_5926.FStar_TypeChecker_Env.is_iface); + (uu___76_6096.FStar_TypeChecker_Env.is_iface); FStar_TypeChecker_Env.admit = - (uu___77_5926.FStar_TypeChecker_Env.admit); + (uu___76_6096.FStar_TypeChecker_Env.admit); FStar_TypeChecker_Env.lax = - (uu___77_5926.FStar_TypeChecker_Env.lax); + (uu___76_6096.FStar_TypeChecker_Env.lax); FStar_TypeChecker_Env.lax_universes = - (uu___77_5926.FStar_TypeChecker_Env.lax_universes); + (uu___76_6096.FStar_TypeChecker_Env.lax_universes); FStar_TypeChecker_Env.failhard = true; FStar_TypeChecker_Env.nosynth = - (uu___77_5926.FStar_TypeChecker_Env.nosynth); + (uu___76_6096.FStar_TypeChecker_Env.nosynth); FStar_TypeChecker_Env.tc_term = - (uu___77_5926.FStar_TypeChecker_Env.tc_term); + (uu___76_6096.FStar_TypeChecker_Env.tc_term); FStar_TypeChecker_Env.type_of = - (uu___77_5926.FStar_TypeChecker_Env.type_of); + (uu___76_6096.FStar_TypeChecker_Env.type_of); FStar_TypeChecker_Env.universe_of = - (uu___77_5926.FStar_TypeChecker_Env.universe_of); + (uu___76_6096.FStar_TypeChecker_Env.universe_of); FStar_TypeChecker_Env.use_bv_sorts = - (uu___77_5926.FStar_TypeChecker_Env.use_bv_sorts); + (uu___76_6096.FStar_TypeChecker_Env.use_bv_sorts); FStar_TypeChecker_Env.qname_and_index = - (uu___77_5926.FStar_TypeChecker_Env.qname_and_index); + (uu___76_6096.FStar_TypeChecker_Env.qname_and_index); FStar_TypeChecker_Env.proof_ns = - (uu___77_5926.FStar_TypeChecker_Env.proof_ns); + (uu___76_6096.FStar_TypeChecker_Env.proof_ns); FStar_TypeChecker_Env.synth = - (uu___77_5926.FStar_TypeChecker_Env.synth); + (uu___76_6096.FStar_TypeChecker_Env.synth); FStar_TypeChecker_Env.is_native_tactic = - (uu___77_5926.FStar_TypeChecker_Env.is_native_tactic); + (uu___76_6096.FStar_TypeChecker_Env.is_native_tactic); FStar_TypeChecker_Env.identifier_info = - (uu___77_5926.FStar_TypeChecker_Env.identifier_info); + (uu___76_6096.FStar_TypeChecker_Env.identifier_info); FStar_TypeChecker_Env.tc_hooks = - (uu___77_5926.FStar_TypeChecker_Env.tc_hooks); + (uu___76_6096.FStar_TypeChecker_Env.tc_hooks); FStar_TypeChecker_Env.dsenv = - (uu___77_5926.FStar_TypeChecker_Env.dsenv); + (uu___76_6096.FStar_TypeChecker_Env.dsenv); FStar_TypeChecker_Env.dep_graph = - (uu___77_5926.FStar_TypeChecker_Env.dep_graph) + (uu___76_6096.FStar_TypeChecker_Env.dep_graph) } in tc_check_tot_or_gtot_term env1 tau FStar_Syntax_Syntax.t_tactic_unit and tc_reified_tactic: @@ -2499,75 +2442,75 @@ and tc_reified_tactic: fun env -> fun tau -> let env1 = - let uu___78_5930 = env in + let uu___77_6100 = env in { FStar_TypeChecker_Env.solver = - (uu___78_5930.FStar_TypeChecker_Env.solver); + (uu___77_6100.FStar_TypeChecker_Env.solver); FStar_TypeChecker_Env.range = - (uu___78_5930.FStar_TypeChecker_Env.range); + (uu___77_6100.FStar_TypeChecker_Env.range); FStar_TypeChecker_Env.curmodule = - (uu___78_5930.FStar_TypeChecker_Env.curmodule); + (uu___77_6100.FStar_TypeChecker_Env.curmodule); FStar_TypeChecker_Env.gamma = - (uu___78_5930.FStar_TypeChecker_Env.gamma); + (uu___77_6100.FStar_TypeChecker_Env.gamma); FStar_TypeChecker_Env.gamma_cache = - (uu___78_5930.FStar_TypeChecker_Env.gamma_cache); + (uu___77_6100.FStar_TypeChecker_Env.gamma_cache); FStar_TypeChecker_Env.modules = - (uu___78_5930.FStar_TypeChecker_Env.modules); + (uu___77_6100.FStar_TypeChecker_Env.modules); FStar_TypeChecker_Env.expected_typ = - (uu___78_5930.FStar_TypeChecker_Env.expected_typ); + (uu___77_6100.FStar_TypeChecker_Env.expected_typ); FStar_TypeChecker_Env.sigtab = - (uu___78_5930.FStar_TypeChecker_Env.sigtab); + (uu___77_6100.FStar_TypeChecker_Env.sigtab); FStar_TypeChecker_Env.is_pattern = - (uu___78_5930.FStar_TypeChecker_Env.is_pattern); + (uu___77_6100.FStar_TypeChecker_Env.is_pattern); FStar_TypeChecker_Env.instantiate_imp = - (uu___78_5930.FStar_TypeChecker_Env.instantiate_imp); + (uu___77_6100.FStar_TypeChecker_Env.instantiate_imp); FStar_TypeChecker_Env.effects = - (uu___78_5930.FStar_TypeChecker_Env.effects); + (uu___77_6100.FStar_TypeChecker_Env.effects); FStar_TypeChecker_Env.generalize = - (uu___78_5930.FStar_TypeChecker_Env.generalize); + (uu___77_6100.FStar_TypeChecker_Env.generalize); FStar_TypeChecker_Env.letrecs = - (uu___78_5930.FStar_TypeChecker_Env.letrecs); + (uu___77_6100.FStar_TypeChecker_Env.letrecs); FStar_TypeChecker_Env.top_level = - (uu___78_5930.FStar_TypeChecker_Env.top_level); + (uu___77_6100.FStar_TypeChecker_Env.top_level); FStar_TypeChecker_Env.check_uvars = - (uu___78_5930.FStar_TypeChecker_Env.check_uvars); + (uu___77_6100.FStar_TypeChecker_Env.check_uvars); FStar_TypeChecker_Env.use_eq = - (uu___78_5930.FStar_TypeChecker_Env.use_eq); + (uu___77_6100.FStar_TypeChecker_Env.use_eq); FStar_TypeChecker_Env.is_iface = - (uu___78_5930.FStar_TypeChecker_Env.is_iface); + (uu___77_6100.FStar_TypeChecker_Env.is_iface); FStar_TypeChecker_Env.admit = - (uu___78_5930.FStar_TypeChecker_Env.admit); + (uu___77_6100.FStar_TypeChecker_Env.admit); FStar_TypeChecker_Env.lax = - (uu___78_5930.FStar_TypeChecker_Env.lax); + (uu___77_6100.FStar_TypeChecker_Env.lax); FStar_TypeChecker_Env.lax_universes = - (uu___78_5930.FStar_TypeChecker_Env.lax_universes); + (uu___77_6100.FStar_TypeChecker_Env.lax_universes); FStar_TypeChecker_Env.failhard = true; FStar_TypeChecker_Env.nosynth = - (uu___78_5930.FStar_TypeChecker_Env.nosynth); + (uu___77_6100.FStar_TypeChecker_Env.nosynth); FStar_TypeChecker_Env.tc_term = - (uu___78_5930.FStar_TypeChecker_Env.tc_term); + (uu___77_6100.FStar_TypeChecker_Env.tc_term); FStar_TypeChecker_Env.type_of = - (uu___78_5930.FStar_TypeChecker_Env.type_of); + (uu___77_6100.FStar_TypeChecker_Env.type_of); FStar_TypeChecker_Env.universe_of = - (uu___78_5930.FStar_TypeChecker_Env.universe_of); + (uu___77_6100.FStar_TypeChecker_Env.universe_of); FStar_TypeChecker_Env.use_bv_sorts = - (uu___78_5930.FStar_TypeChecker_Env.use_bv_sorts); + (uu___77_6100.FStar_TypeChecker_Env.use_bv_sorts); FStar_TypeChecker_Env.qname_and_index = - (uu___78_5930.FStar_TypeChecker_Env.qname_and_index); + (uu___77_6100.FStar_TypeChecker_Env.qname_and_index); FStar_TypeChecker_Env.proof_ns = - (uu___78_5930.FStar_TypeChecker_Env.proof_ns); + (uu___77_6100.FStar_TypeChecker_Env.proof_ns); FStar_TypeChecker_Env.synth = - (uu___78_5930.FStar_TypeChecker_Env.synth); + (uu___77_6100.FStar_TypeChecker_Env.synth); FStar_TypeChecker_Env.is_native_tactic = - (uu___78_5930.FStar_TypeChecker_Env.is_native_tactic); + (uu___77_6100.FStar_TypeChecker_Env.is_native_tactic); FStar_TypeChecker_Env.identifier_info = - (uu___78_5930.FStar_TypeChecker_Env.identifier_info); + (uu___77_6100.FStar_TypeChecker_Env.identifier_info); FStar_TypeChecker_Env.tc_hooks = - (uu___78_5930.FStar_TypeChecker_Env.tc_hooks); + (uu___77_6100.FStar_TypeChecker_Env.tc_hooks); FStar_TypeChecker_Env.dsenv = - (uu___78_5930.FStar_TypeChecker_Env.dsenv); + (uu___77_6100.FStar_TypeChecker_Env.dsenv); FStar_TypeChecker_Env.dep_graph = - (uu___78_5930.FStar_TypeChecker_Env.dep_graph) + (uu___77_6100.FStar_TypeChecker_Env.dep_graph) } in tc_check_tot_or_gtot_term env1 tau FStar_Syntax_Syntax.t_tac_unit and tc_tactic_opt: @@ -2581,9 +2524,9 @@ and tc_tactic_opt: match topt with | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None | FStar_Pervasives_Native.Some tactic -> - let uu____5946 = tc_tactic env tactic in - (match uu____5946 with - | (tactic1,uu____5956,uu____5957) -> + let uu____6116 = tc_tactic env tactic in + (match uu____6116 with + | (tactic1,uu____6126,uu____6127) -> FStar_Pervasives_Native.Some tactic1) and tc_value: FStar_TypeChecker_Env.env -> @@ -2594,182 +2537,182 @@ and tc_value: fun env -> fun e -> let check_instantiated_fvar env1 v1 dc e1 t = - let uu____5996 = FStar_TypeChecker_Util.maybe_instantiate env1 e1 t in - match uu____5996 with + let uu____6166 = FStar_TypeChecker_Util.maybe_instantiate env1 e1 t in + match uu____6166 with | (e2,t1,implicits) -> let tc = - let uu____6017 = FStar_TypeChecker_Env.should_verify env1 in - if uu____6017 + let uu____6187 = FStar_TypeChecker_Env.should_verify env1 in + if uu____6187 then FStar_Util.Inl t1 else - (let uu____6023 = - let uu____6024 = FStar_Syntax_Syntax.mk_Total t1 in + (let uu____6193 = + let uu____6194 = FStar_Syntax_Syntax.mk_Total t1 in FStar_All.pipe_left FStar_Syntax_Util.lcomp_of_comp - uu____6024 in - FStar_Util.Inr uu____6023) in - let is_data_ctor uu___61_6034 = - match uu___61_6034 with + uu____6194 in + FStar_Util.Inr uu____6193) in + let is_data_ctor uu___61_6204 = + match uu___61_6204 with | FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Data_ctor ) -> true | FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Record_ctor - uu____6037) -> true - | uu____6044 -> false in - let uu____6047 = + uu____6207) -> true + | uu____6214 -> false in + let uu____6217 = (is_data_ctor dc) && - (let uu____6049 = + (let uu____6219 = FStar_TypeChecker_Env.is_datacon env1 v1.FStar_Syntax_Syntax.v in - Prims.op_Negation uu____6049) in - if uu____6047 + Prims.op_Negation uu____6219) in + if uu____6217 then - let uu____6056 = - let uu____6061 = + let uu____6226 = + let uu____6231 = FStar_Util.format1 "Expected a data constructor; got %s" (v1.FStar_Syntax_Syntax.v).FStar_Ident.str in - (FStar_Errors.Fatal_MissingDataConstructor, uu____6061) in - let uu____6062 = FStar_TypeChecker_Env.get_range env1 in - FStar_Errors.raise_error uu____6056 uu____6062 + (FStar_Errors.Fatal_MissingDataConstructor, uu____6231) in + let uu____6232 = FStar_TypeChecker_Env.get_range env1 in + FStar_Errors.raise_error uu____6226 uu____6232 else value_check_expected_typ env1 e2 tc implicits in let env1 = FStar_TypeChecker_Env.set_range env e.FStar_Syntax_Syntax.pos in let top = FStar_Syntax_Subst.compress e in match top.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Tm_bvar x -> - let uu____6079 = - let uu____6080 = FStar_Syntax_Print.term_to_string top in + let uu____6249 = + let uu____6250 = FStar_Syntax_Print.term_to_string top in FStar_Util.format1 "Impossible: Violation of locally nameless convention: %s" - uu____6080 in - failwith uu____6079 + uu____6250 in + failwith uu____6249 | FStar_Syntax_Syntax.Tm_uvar (u,t1) -> let g = - let uu____6114 = - let uu____6115 = FStar_Syntax_Subst.compress t1 in - uu____6115.FStar_Syntax_Syntax.n in - match uu____6114 with - | FStar_Syntax_Syntax.Tm_arrow uu____6118 -> + let uu____6284 = + let uu____6285 = FStar_Syntax_Subst.compress t1 in + uu____6285.FStar_Syntax_Syntax.n in + match uu____6284 with + | FStar_Syntax_Syntax.Tm_arrow uu____6288 -> FStar_TypeChecker_Rel.trivial_guard - | uu____6131 -> + | uu____6301 -> let imp = ("uvar in term", env1, u, top, t1, (top.FStar_Syntax_Syntax.pos)) in - let uu___79_6169 = FStar_TypeChecker_Rel.trivial_guard in + let uu___78_6339 = FStar_TypeChecker_Rel.trivial_guard in { FStar_TypeChecker_Env.guard_f = - (uu___79_6169.FStar_TypeChecker_Env.guard_f); + (uu___78_6339.FStar_TypeChecker_Env.guard_f); FStar_TypeChecker_Env.deferred = - (uu___79_6169.FStar_TypeChecker_Env.deferred); + (uu___78_6339.FStar_TypeChecker_Env.deferred); FStar_TypeChecker_Env.univ_ineqs = - (uu___79_6169.FStar_TypeChecker_Env.univ_ineqs); + (uu___78_6339.FStar_TypeChecker_Env.univ_ineqs); FStar_TypeChecker_Env.implicits = [imp] } in value_check_expected_typ env1 e (FStar_Util.Inl t1) g | FStar_Syntax_Syntax.Tm_unknown -> let r = FStar_TypeChecker_Env.get_range env1 in - let uu____6221 = - let uu____6234 = FStar_TypeChecker_Env.expected_typ env1 in - match uu____6234 with + let uu____6391 = + let uu____6404 = FStar_TypeChecker_Env.expected_typ env1 in + match uu____6404 with | FStar_Pervasives_Native.None -> - let uu____6249 = FStar_Syntax_Util.type_u () in - (match uu____6249 with + let uu____6419 = FStar_Syntax_Util.type_u () in + (match uu____6419 with | (k,u) -> FStar_TypeChecker_Util.new_implicit_var "type of user-provided implicit term" r env1 k) | FStar_Pervasives_Native.Some t -> (t, [], FStar_TypeChecker_Rel.trivial_guard) in - (match uu____6221 with - | (t,uu____6286,g0) -> - let uu____6300 = + (match uu____6391 with + | (t,uu____6456,g0) -> + let uu____6470 = FStar_TypeChecker_Util.new_implicit_var "user-provided implicit term" r env1 t in - (match uu____6300 with - | (e1,uu____6320,g1) -> - let uu____6334 = - let uu____6335 = FStar_Syntax_Syntax.mk_Total t in - FStar_All.pipe_right uu____6335 + (match uu____6470 with + | (e1,uu____6490,g1) -> + let uu____6504 = + let uu____6505 = FStar_Syntax_Syntax.mk_Total t in + FStar_All.pipe_right uu____6505 FStar_Syntax_Util.lcomp_of_comp in - let uu____6336 = FStar_TypeChecker_Rel.conj_guard g0 g1 in - (e1, uu____6334, uu____6336))) + let uu____6506 = FStar_TypeChecker_Rel.conj_guard g0 g1 in + (e1, uu____6504, uu____6506))) | FStar_Syntax_Syntax.Tm_name x -> - let uu____6338 = + let uu____6508 = if env1.FStar_TypeChecker_Env.use_bv_sorts then - let uu____6351 = FStar_Syntax_Syntax.range_of_bv x in - ((x.FStar_Syntax_Syntax.sort), uu____6351) + let uu____6521 = FStar_Syntax_Syntax.range_of_bv x in + ((x.FStar_Syntax_Syntax.sort), uu____6521) else FStar_TypeChecker_Env.lookup_bv env1 x in - (match uu____6338 with + (match uu____6508 with | (t,rng) -> let x1 = FStar_Syntax_Syntax.set_range_of_bv - (let uu___80_6370 = x in + (let uu___79_6540 = x in { FStar_Syntax_Syntax.ppname = - (uu___80_6370.FStar_Syntax_Syntax.ppname); + (uu___79_6540.FStar_Syntax_Syntax.ppname); FStar_Syntax_Syntax.index = - (uu___80_6370.FStar_Syntax_Syntax.index); + (uu___79_6540.FStar_Syntax_Syntax.index); FStar_Syntax_Syntax.sort = t }) rng in (FStar_TypeChecker_Env.insert_bv_info env1 x1 t; (let e1 = FStar_Syntax_Syntax.bv_to_name x1 in - let uu____6373 = + let uu____6543 = FStar_TypeChecker_Util.maybe_instantiate env1 e1 t in - match uu____6373 with + match uu____6543 with | (e2,t1,implicits) -> let tc = - let uu____6394 = + let uu____6564 = FStar_TypeChecker_Env.should_verify env1 in - if uu____6394 + if uu____6564 then FStar_Util.Inl t1 else - (let uu____6400 = - let uu____6401 = FStar_Syntax_Syntax.mk_Total t1 in + (let uu____6570 = + let uu____6571 = FStar_Syntax_Syntax.mk_Total t1 in FStar_All.pipe_left - FStar_Syntax_Util.lcomp_of_comp uu____6401 in - FStar_Util.Inr uu____6400) in + FStar_Syntax_Util.lcomp_of_comp uu____6571 in + FStar_Util.Inr uu____6570) in value_check_expected_typ env1 e2 tc implicits))) | FStar_Syntax_Syntax.Tm_uinst ({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_fvar fv; - FStar_Syntax_Syntax.pos = uu____6407; - FStar_Syntax_Syntax.vars = uu____6408;_},uu____6409) + FStar_Syntax_Syntax.pos = uu____6577; + FStar_Syntax_Syntax.vars = uu____6578;_},uu____6579) when FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.synth_lid -> - let uu____6414 = FStar_TypeChecker_Env.get_range env1 in + let uu____6584 = FStar_TypeChecker_Env.get_range env1 in FStar_Errors.raise_error (FStar_Errors.Fatal_BadlyInstantiatedSynthByTactic, - "Badly instantiated synth_by_tactic") uu____6414 + "Badly instantiated synth_by_tactic") uu____6584 | FStar_Syntax_Syntax.Tm_fvar fv when FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.synth_lid -> - let uu____6422 = FStar_TypeChecker_Env.get_range env1 in + let uu____6592 = FStar_TypeChecker_Env.get_range env1 in FStar_Errors.raise_error (FStar_Errors.Fatal_BadlyInstantiatedSynthByTactic, - "Badly instantiated synth_by_tactic") uu____6422 + "Badly instantiated synth_by_tactic") uu____6592 | FStar_Syntax_Syntax.Tm_uinst ({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_fvar fv; - FStar_Syntax_Syntax.pos = uu____6430; - FStar_Syntax_Syntax.vars = uu____6431;_},us) + FStar_Syntax_Syntax.pos = uu____6600; + FStar_Syntax_Syntax.vars = uu____6601;_},us) -> let us1 = FStar_List.map (tc_universe env1) us in - let uu____6440 = + let uu____6610 = FStar_TypeChecker_Env.lookup_lid env1 (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in - (match uu____6440 with + (match uu____6610 with | ((us',t),range) -> (if (FStar_List.length us1) <> (FStar_List.length us') then - (let uu____6463 = - let uu____6468 = - let uu____6469 = FStar_Syntax_Print.fv_to_string fv in - let uu____6470 = + (let uu____6633 = + let uu____6638 = + let uu____6639 = FStar_Syntax_Print.fv_to_string fv in + let uu____6640 = FStar_Util.string_of_int (FStar_List.length us1) in - let uu____6471 = + let uu____6641 = FStar_Util.string_of_int (FStar_List.length us') in FStar_Util.format3 "Unexpected number of universe instantiations for \"%s\" (%s vs %s)" - uu____6469 uu____6470 uu____6471 in + uu____6639 uu____6640 uu____6641 in (FStar_Errors.Fatal_UnexpectedNumberOfUniverse, - uu____6468) in - let uu____6472 = FStar_TypeChecker_Env.get_range env1 in - FStar_Errors.raise_error uu____6463 uu____6472) + uu____6638) in + let uu____6642 = FStar_TypeChecker_Env.get_range env1 in + FStar_Errors.raise_error uu____6633 uu____6642) else FStar_List.iter2 (fun u' -> @@ -2777,51 +2720,51 @@ and tc_value: match u' with | FStar_Syntax_Syntax.U_unif u'' -> FStar_Syntax_Unionfind.univ_change u'' u - | uu____6488 -> failwith "Impossible") us' us1; + | uu____6658 -> failwith "Impossible") us' us1; (let fv' = FStar_Syntax_Syntax.set_range_of_fv fv range in FStar_TypeChecker_Env.insert_fv_info env1 fv' t; (let e1 = - let uu____6492 = + let uu____6662 = FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_fvar fv') FStar_Pervasives_Native.None e.FStar_Syntax_Syntax.pos in - FStar_Syntax_Syntax.mk_Tm_uinst uu____6492 us1 in + FStar_Syntax_Syntax.mk_Tm_uinst uu____6662 us1 in check_instantiated_fvar env1 fv'.FStar_Syntax_Syntax.fv_name fv'.FStar_Syntax_Syntax.fv_qual e1 t)))) | FStar_Syntax_Syntax.Tm_fvar fv -> - let uu____6494 = + let uu____6664 = FStar_TypeChecker_Env.lookup_lid env1 (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in - (match uu____6494 with + (match uu____6664 with | ((us,t),range) -> - ((let uu____6517 = + ((let uu____6687 = FStar_All.pipe_left (FStar_TypeChecker_Env.debug env1) (FStar_Options.Other "Range") in - if uu____6517 + if uu____6687 then - let uu____6518 = - let uu____6519 = FStar_Syntax_Syntax.lid_of_fv fv in - FStar_Syntax_Print.lid_to_string uu____6519 in - let uu____6520 = + let uu____6688 = + let uu____6689 = FStar_Syntax_Syntax.lid_of_fv fv in + FStar_Syntax_Print.lid_to_string uu____6689 in + let uu____6690 = FStar_Range.string_of_range e.FStar_Syntax_Syntax.pos in - let uu____6521 = FStar_Range.string_of_range range in - let uu____6522 = FStar_Range.string_of_use_range range in - let uu____6523 = FStar_Syntax_Print.term_to_string t in + let uu____6691 = FStar_Range.string_of_range range in + let uu____6692 = FStar_Range.string_of_use_range range in + let uu____6693 = FStar_Syntax_Print.term_to_string t in FStar_Util.print5 "Lookup up fvar %s at location %s (lid range = defined at %s, used at %s); got universes type %s" - uu____6518 uu____6520 uu____6521 uu____6522 uu____6523 + uu____6688 uu____6690 uu____6691 uu____6692 uu____6693 else ()); (let fv' = FStar_Syntax_Syntax.set_range_of_fv fv range in FStar_TypeChecker_Env.insert_fv_info env1 fv' t; (let e1 = - let uu____6528 = + let uu____6698 = FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_fvar fv') FStar_Pervasives_Native.None e.FStar_Syntax_Syntax.pos in - FStar_Syntax_Syntax.mk_Tm_uinst uu____6528 us in + FStar_Syntax_Syntax.mk_Tm_uinst uu____6698 us in check_instantiated_fvar env1 fv'.FStar_Syntax_Syntax.fv_name fv'.FStar_Syntax_Syntax.fv_qual e1 t)))) @@ -2833,29 +2776,29 @@ and tc_value: value_check_expected_typ env1 e1 (FStar_Util.Inl t) FStar_TypeChecker_Rel.trivial_guard | FStar_Syntax_Syntax.Tm_arrow (bs,c) -> - let uu____6552 = FStar_Syntax_Subst.open_comp bs c in - (match uu____6552 with + let uu____6722 = FStar_Syntax_Subst.open_comp bs c in + (match uu____6722 with | (bs1,c1) -> let env0 = env1 in - let uu____6566 = FStar_TypeChecker_Env.clear_expected_typ env1 in - (match uu____6566 with - | (env2,uu____6580) -> - let uu____6585 = tc_binders env2 bs1 in - (match uu____6585 with + let uu____6736 = FStar_TypeChecker_Env.clear_expected_typ env1 in + (match uu____6736 with + | (env2,uu____6750) -> + let uu____6755 = tc_binders env2 bs1 in + (match uu____6755 with | (bs2,env3,g,us) -> - let uu____6604 = tc_comp env3 c1 in - (match uu____6604 with + let uu____6774 = tc_comp env3 c1 in + (match uu____6774 with | (c2,uc,f) -> let e1 = - let uu___81_6623 = + let uu___80_6793 = FStar_Syntax_Util.arrow bs2 c2 in { FStar_Syntax_Syntax.n = - (uu___81_6623.FStar_Syntax_Syntax.n); + (uu___80_6793.FStar_Syntax_Syntax.n); FStar_Syntax_Syntax.pos = (top.FStar_Syntax_Syntax.pos); FStar_Syntax_Syntax.vars = - (uu___81_6623.FStar_Syntax_Syntax.vars) + (uu___80_6793.FStar_Syntax_Syntax.vars) } in (check_smt_pat env3 e1 bs2 c2; (let u = FStar_Syntax_Syntax.U_max (uc :: us) in @@ -2865,11 +2808,11 @@ and tc_value: FStar_Pervasives_Native.None top.FStar_Syntax_Syntax.pos in let g1 = - let uu____6632 = + let uu____6802 = FStar_TypeChecker_Rel.close_guard_univs us bs2 f in FStar_TypeChecker_Rel.conj_guard g - uu____6632 in + uu____6802 in value_check_expected_typ env0 e1 (FStar_Util.Inl t) g1)))))) | FStar_Syntax_Syntax.Tm_type u -> @@ -2884,58 +2827,58 @@ and tc_value: value_check_expected_typ env1 e1 (FStar_Util.Inl t) FStar_TypeChecker_Rel.trivial_guard | FStar_Syntax_Syntax.Tm_refine (x,phi) -> - let uu____6651 = - let uu____6656 = - let uu____6657 = FStar_Syntax_Syntax.mk_binder x in - [uu____6657] in - FStar_Syntax_Subst.open_term uu____6656 phi in - (match uu____6651 with + let uu____6821 = + let uu____6826 = + let uu____6827 = FStar_Syntax_Syntax.mk_binder x in + [uu____6827] in + FStar_Syntax_Subst.open_term uu____6826 phi in + (match uu____6821 with | (x1,phi1) -> let env0 = env1 in - let uu____6667 = FStar_TypeChecker_Env.clear_expected_typ env1 in - (match uu____6667 with - | (env2,uu____6681) -> - let uu____6686 = - let uu____6699 = FStar_List.hd x1 in - tc_binder env2 uu____6699 in - (match uu____6686 with + let uu____6837 = FStar_TypeChecker_Env.clear_expected_typ env1 in + (match uu____6837 with + | (env2,uu____6851) -> + let uu____6856 = + let uu____6869 = FStar_List.hd x1 in + tc_binder env2 uu____6869 in + (match uu____6856 with | (x2,env3,f1,u) -> - ((let uu____6727 = + ((let uu____6897 = FStar_TypeChecker_Env.debug env3 FStar_Options.High in - if uu____6727 + if uu____6897 then - let uu____6728 = + let uu____6898 = FStar_Range.string_of_range top.FStar_Syntax_Syntax.pos in - let uu____6729 = + let uu____6899 = FStar_Syntax_Print.term_to_string phi1 in - let uu____6730 = + let uu____6900 = FStar_Syntax_Print.bv_to_string (FStar_Pervasives_Native.fst x2) in FStar_Util.print3 "(%s) Checking refinement formula %s; binder is %s\n" - uu____6728 uu____6729 uu____6730 + uu____6898 uu____6899 uu____6900 else ()); - (let uu____6732 = FStar_Syntax_Util.type_u () in - match uu____6732 with - | (t_phi,uu____6744) -> - let uu____6745 = + (let uu____6902 = FStar_Syntax_Util.type_u () in + match uu____6902 with + | (t_phi,uu____6914) -> + let uu____6915 = tc_check_tot_or_gtot_term env3 phi1 t_phi in - (match uu____6745 with - | (phi2,uu____6759,f2) -> + (match uu____6915 with + | (phi2,uu____6929,f2) -> let e1 = - let uu___82_6764 = + let uu___81_6934 = FStar_Syntax_Util.refine (FStar_Pervasives_Native.fst x2) phi2 in { FStar_Syntax_Syntax.n = - (uu___82_6764.FStar_Syntax_Syntax.n); + (uu___81_6934.FStar_Syntax_Syntax.n); FStar_Syntax_Syntax.pos = (top.FStar_Syntax_Syntax.pos); FStar_Syntax_Syntax.vars = - (uu___82_6764.FStar_Syntax_Syntax.vars) + (uu___81_6934.FStar_Syntax_Syntax.vars) } in let t = FStar_Syntax_Syntax.mk @@ -2943,42 +2886,42 @@ and tc_value: FStar_Pervasives_Native.None top.FStar_Syntax_Syntax.pos in let g = - let uu____6771 = + let uu____6941 = FStar_TypeChecker_Rel.close_guard_univs [u] [x2] f2 in FStar_TypeChecker_Rel.conj_guard f1 - uu____6771 in + uu____6941 in value_check_expected_typ env0 e1 (FStar_Util.Inl t) g)))))) - | FStar_Syntax_Syntax.Tm_abs (bs,body,uu____6784) -> + | FStar_Syntax_Syntax.Tm_abs (bs,body,uu____6954) -> let bs1 = FStar_TypeChecker_Util.maybe_add_implicit_binders env1 bs in - ((let uu____6807 = + ((let uu____6977 = FStar_TypeChecker_Env.debug env1 FStar_Options.Low in - if uu____6807 + if uu____6977 then - let uu____6808 = + let uu____6978 = FStar_Syntax_Print.term_to_string - (let uu___83_6811 = top in + (let uu___82_6981 = top in { FStar_Syntax_Syntax.n = (FStar_Syntax_Syntax.Tm_abs (bs1, body, FStar_Pervasives_Native.None)); FStar_Syntax_Syntax.pos = - (uu___83_6811.FStar_Syntax_Syntax.pos); + (uu___82_6981.FStar_Syntax_Syntax.pos); FStar_Syntax_Syntax.vars = - (uu___83_6811.FStar_Syntax_Syntax.vars) + (uu___82_6981.FStar_Syntax_Syntax.vars) }) in - FStar_Util.print1 "Abstraction is: %s\n" uu____6808 + FStar_Util.print1 "Abstraction is: %s\n" uu____6978 else ()); - (let uu____6817 = FStar_Syntax_Subst.open_term bs1 body in - match uu____6817 with | (bs2,body1) -> tc_abs env1 top bs2 body1)) - | uu____6830 -> - let uu____6831 = - let uu____6832 = FStar_Syntax_Print.term_to_string top in - let uu____6833 = FStar_Syntax_Print.tag_of_term top in - FStar_Util.format2 "Unexpected value: %s (%s)" uu____6832 - uu____6833 in - failwith uu____6831 + (let uu____6987 = FStar_Syntax_Subst.open_term bs1 body in + match uu____6987 with | (bs2,body1) -> tc_abs env1 top bs2 body1)) + | uu____7000 -> + let uu____7001 = + let uu____7002 = FStar_Syntax_Print.term_to_string top in + let uu____7003 = FStar_Syntax_Print.tag_of_term top in + FStar_Util.format2 "Unexpected value: %s (%s)" uu____7002 + uu____7003 in + failwith uu____7001 and tc_constant: FStar_TypeChecker_Env.env -> FStar_Range.range -> FStar_Const.sconst -> FStar_Syntax_Syntax.typ @@ -2988,11 +2931,11 @@ and tc_constant: fun c -> match c with | FStar_Const.Const_unit -> FStar_Syntax_Syntax.t_unit - | FStar_Const.Const_bool uu____6843 -> FStar_Syntax_Util.t_bool - | FStar_Const.Const_int (uu____6844,FStar_Pervasives_Native.None ) -> + | FStar_Const.Const_bool uu____7013 -> FStar_Syntax_Util.t_bool + | FStar_Const.Const_int (uu____7014,FStar_Pervasives_Native.None ) -> FStar_Syntax_Syntax.t_int | FStar_Const.Const_int - (uu____6855,FStar_Pervasives_Native.Some msize) -> + (uu____7025,FStar_Pervasives_Native.Some msize) -> FStar_Syntax_Syntax.tconst (match msize with | (FStar_Const.Signed ,FStar_Const.Int8 ) -> @@ -3011,54 +2954,54 @@ and tc_constant: FStar_Parser_Const.uint32_lid | (FStar_Const.Unsigned ,FStar_Const.Int64 ) -> FStar_Parser_Const.uint64_lid) - | FStar_Const.Const_string uu____6871 -> FStar_Syntax_Syntax.t_string - | FStar_Const.Const_float uu____6876 -> FStar_Syntax_Syntax.t_float - | FStar_Const.Const_char uu____6877 -> - let uu____6878 = - let uu____6883 = + | FStar_Const.Const_string uu____7041 -> FStar_Syntax_Syntax.t_string + | FStar_Const.Const_float uu____7046 -> FStar_Syntax_Syntax.t_float + | FStar_Const.Const_char uu____7047 -> + let uu____7048 = + let uu____7053 = FStar_ToSyntax_Env.try_lookup_lid env.FStar_TypeChecker_Env.dsenv FStar_Parser_Const.char_lid in - FStar_All.pipe_right uu____6883 FStar_Util.must in - FStar_All.pipe_right uu____6878 FStar_Pervasives_Native.fst + FStar_All.pipe_right uu____7053 FStar_Util.must in + FStar_All.pipe_right uu____7048 FStar_Pervasives_Native.fst | FStar_Const.Const_effect -> FStar_Syntax_Util.ktype0 - | FStar_Const.Const_range uu____6908 -> FStar_Syntax_Syntax.t_range + | FStar_Const.Const_range uu____7078 -> FStar_Syntax_Syntax.t_range | FStar_Const.Const_range_of -> - let uu____6909 = - let uu____6914 = - let uu____6915 = FStar_Parser_Const.const_to_string c in + let uu____7079 = + let uu____7084 = + let uu____7085 = FStar_Parser_Const.const_to_string c in FStar_Util.format1 "Ill-typed %s: this constant must be fully applied" - uu____6915 in - (FStar_Errors.Fatal_IllTyped, uu____6914) in - FStar_Errors.raise_error uu____6909 r + uu____7085 in + (FStar_Errors.Fatal_IllTyped, uu____7084) in + FStar_Errors.raise_error uu____7079 r | FStar_Const.Const_set_range_of -> - let uu____6916 = - let uu____6921 = - let uu____6922 = FStar_Parser_Const.const_to_string c in + let uu____7086 = + let uu____7091 = + let uu____7092 = FStar_Parser_Const.const_to_string c in FStar_Util.format1 "Ill-typed %s: this constant must be fully applied" - uu____6922 in - (FStar_Errors.Fatal_IllTyped, uu____6921) in - FStar_Errors.raise_error uu____6916 r + uu____7092 in + (FStar_Errors.Fatal_IllTyped, uu____7091) in + FStar_Errors.raise_error uu____7086 r | FStar_Const.Const_reify -> - let uu____6923 = - let uu____6928 = - let uu____6929 = FStar_Parser_Const.const_to_string c in + let uu____7093 = + let uu____7098 = + let uu____7099 = FStar_Parser_Const.const_to_string c in FStar_Util.format1 "Ill-typed %s: this constant must be fully applied" - uu____6929 in - (FStar_Errors.Fatal_IllTyped, uu____6928) in - FStar_Errors.raise_error uu____6923 r - | FStar_Const.Const_reflect uu____6930 -> - let uu____6931 = - let uu____6936 = - let uu____6937 = FStar_Parser_Const.const_to_string c in + uu____7099 in + (FStar_Errors.Fatal_IllTyped, uu____7098) in + FStar_Errors.raise_error uu____7093 r + | FStar_Const.Const_reflect uu____7100 -> + let uu____7101 = + let uu____7106 = + let uu____7107 = FStar_Parser_Const.const_to_string c in FStar_Util.format1 "Ill-typed %s: this constant must be fully applied" - uu____6937 in - (FStar_Errors.Fatal_IllTyped, uu____6936) in - FStar_Errors.raise_error uu____6931 r - | uu____6938 -> + uu____7107 in + (FStar_Errors.Fatal_IllTyped, uu____7106) in + FStar_Errors.raise_error uu____7101 r + | uu____7108 -> FStar_Errors.raise_error (FStar_Errors.Fatal_UnsupportedConstant, "Unsupported constant") r @@ -3072,28 +3015,28 @@ and tc_comp: fun c -> let c0 = c in match c.FStar_Syntax_Syntax.n with - | FStar_Syntax_Syntax.Total (t,uu____6955) -> - let uu____6964 = FStar_Syntax_Util.type_u () in - (match uu____6964 with + | FStar_Syntax_Syntax.Total (t,uu____7125) -> + let uu____7134 = FStar_Syntax_Util.type_u () in + (match uu____7134 with | (k,u) -> - let uu____6977 = tc_check_tot_or_gtot_term env t k in - (match uu____6977 with - | (t1,uu____6991,g) -> - let uu____6993 = + let uu____7147 = tc_check_tot_or_gtot_term env t k in + (match uu____7147 with + | (t1,uu____7161,g) -> + let uu____7163 = FStar_Syntax_Syntax.mk_Total' t1 (FStar_Pervasives_Native.Some u) in - (uu____6993, u, g))) - | FStar_Syntax_Syntax.GTotal (t,uu____6995) -> - let uu____7004 = FStar_Syntax_Util.type_u () in - (match uu____7004 with + (uu____7163, u, g))) + | FStar_Syntax_Syntax.GTotal (t,uu____7165) -> + let uu____7174 = FStar_Syntax_Util.type_u () in + (match uu____7174 with | (k,u) -> - let uu____7017 = tc_check_tot_or_gtot_term env t k in - (match uu____7017 with - | (t1,uu____7031,g) -> - let uu____7033 = + let uu____7187 = tc_check_tot_or_gtot_term env t k in + (match uu____7187 with + | (t1,uu____7201,g) -> + let uu____7203 = FStar_Syntax_Syntax.mk_GTotal' t1 (FStar_Pervasives_Native.Some u) in - (uu____7033, u, g))) + (uu____7203, u, g))) | FStar_Syntax_Syntax.Comp c1 -> let head1 = FStar_Syntax_Syntax.fvar c1.FStar_Syntax_Syntax.effect_name @@ -3106,98 +3049,98 @@ and tc_comp: (FStar_Syntax_Syntax.Tm_uinst (head1, us)) FStar_Pervasives_Native.None c0.FStar_Syntax_Syntax.pos in let tc = - let uu____7041 = - let uu____7042 = - let uu____7043 = + let uu____7211 = + let uu____7212 = + let uu____7213 = FStar_Syntax_Syntax.as_arg c1.FStar_Syntax_Syntax.result_typ in - uu____7043 :: (c1.FStar_Syntax_Syntax.effect_args) in - FStar_Syntax_Syntax.mk_Tm_app head2 uu____7042 in - uu____7041 FStar_Pervasives_Native.None + uu____7213 :: (c1.FStar_Syntax_Syntax.effect_args) in + FStar_Syntax_Syntax.mk_Tm_app head2 uu____7212 in + uu____7211 FStar_Pervasives_Native.None (c1.FStar_Syntax_Syntax.result_typ).FStar_Syntax_Syntax.pos in - let uu____7046 = + let uu____7216 = tc_check_tot_or_gtot_term env tc FStar_Syntax_Syntax.teff in - (match uu____7046 with - | (tc1,uu____7060,f) -> - let uu____7062 = FStar_Syntax_Util.head_and_args tc1 in - (match uu____7062 with + (match uu____7216 with + | (tc1,uu____7230,f) -> + let uu____7232 = FStar_Syntax_Util.head_and_args tc1 in + (match uu____7232 with | (head3,args) -> let comp_univs = - let uu____7106 = - let uu____7107 = FStar_Syntax_Subst.compress head3 in - uu____7107.FStar_Syntax_Syntax.n in - match uu____7106 with - | FStar_Syntax_Syntax.Tm_uinst (uu____7110,us) -> us - | uu____7116 -> [] in - let uu____7117 = FStar_Syntax_Util.head_and_args tc1 in - (match uu____7117 with - | (uu____7138,args1) -> - let uu____7160 = - let uu____7179 = FStar_List.hd args1 in - let uu____7192 = FStar_List.tl args1 in - (uu____7179, uu____7192) in - (match uu____7160 with + let uu____7276 = + let uu____7277 = FStar_Syntax_Subst.compress head3 in + uu____7277.FStar_Syntax_Syntax.n in + match uu____7276 with + | FStar_Syntax_Syntax.Tm_uinst (uu____7280,us) -> us + | uu____7286 -> [] in + let uu____7287 = FStar_Syntax_Util.head_and_args tc1 in + (match uu____7287 with + | (uu____7308,args1) -> + let uu____7330 = + let uu____7349 = FStar_List.hd args1 in + let uu____7362 = FStar_List.tl args1 in + (uu____7349, uu____7362) in + (match uu____7330 with | (res,args2) -> - let uu____7257 = - let uu____7266 = + let uu____7427 = + let uu____7436 = FStar_All.pipe_right c1.FStar_Syntax_Syntax.flags (FStar_List.map - (fun uu___62_7294 -> - match uu___62_7294 with + (fun uu___62_7464 -> + match uu___62_7464 with | FStar_Syntax_Syntax.DECREASES e -> - let uu____7302 = + let uu____7472 = FStar_TypeChecker_Env.clear_expected_typ env in - (match uu____7302 with - | (env1,uu____7314) -> - let uu____7319 = + (match uu____7472 with + | (env1,uu____7484) -> + let uu____7489 = tc_tot_or_gtot_term env1 e in - (match uu____7319 with - | (e1,uu____7331,g) -> + (match uu____7489 with + | (e1,uu____7501,g) -> ((FStar_Syntax_Syntax.DECREASES e1), g))) | f1 -> (f1, FStar_TypeChecker_Rel.trivial_guard))) in - FStar_All.pipe_right uu____7266 + FStar_All.pipe_right uu____7436 FStar_List.unzip in - (match uu____7257 with + (match uu____7427 with | (flags1,guards) -> let u = env.FStar_TypeChecker_Env.universe_of env (FStar_Pervasives_Native.fst res) in let c2 = FStar_Syntax_Syntax.mk_Comp - (let uu___84_7370 = c1 in + (let uu___83_7540 = c1 in { FStar_Syntax_Syntax.comp_univs = comp_univs; FStar_Syntax_Syntax.effect_name = - (uu___84_7370.FStar_Syntax_Syntax.effect_name); + (uu___83_7540.FStar_Syntax_Syntax.effect_name); FStar_Syntax_Syntax.result_typ = (FStar_Pervasives_Native.fst res); FStar_Syntax_Syntax.effect_args = args2; FStar_Syntax_Syntax.flags = - (uu___84_7370.FStar_Syntax_Syntax.flags) + (uu___83_7540.FStar_Syntax_Syntax.flags) }) in let u_c = - let uu____7374 = + let uu____7544 = FStar_TypeChecker_Env.effect_repr env c2 u in - match uu____7374 with + match uu____7544 with | FStar_Pervasives_Native.None -> u | FStar_Pervasives_Native.Some tm -> env.FStar_TypeChecker_Env.universe_of env tm in - let uu____7378 = + let uu____7548 = FStar_List.fold_left FStar_TypeChecker_Rel.conj_guard f guards in - (c2, u_c, uu____7378)))))) + (c2, u_c, uu____7548)))))) and tc_universe: FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.universe -> FStar_Syntax_Syntax.universe @@ -3207,25 +3150,25 @@ and tc_universe: let rec aux u1 = let u2 = FStar_Syntax_Subst.compress_univ u1 in match u2 with - | FStar_Syntax_Syntax.U_bvar uu____7386 -> + | FStar_Syntax_Syntax.U_bvar uu____7556 -> failwith "Impossible: locally nameless" | FStar_Syntax_Syntax.U_unknown -> failwith "Unknown universe" - | FStar_Syntax_Syntax.U_unif uu____7387 -> u2 + | FStar_Syntax_Syntax.U_unif uu____7557 -> u2 | FStar_Syntax_Syntax.U_zero -> u2 | FStar_Syntax_Syntax.U_succ u3 -> - let uu____7397 = aux u3 in FStar_Syntax_Syntax.U_succ uu____7397 + let uu____7567 = aux u3 in FStar_Syntax_Syntax.U_succ uu____7567 | FStar_Syntax_Syntax.U_max us -> - let uu____7401 = FStar_List.map aux us in - FStar_Syntax_Syntax.U_max uu____7401 + let uu____7571 = FStar_List.map aux us in + FStar_Syntax_Syntax.U_max uu____7571 | FStar_Syntax_Syntax.U_name x -> u2 in if env.FStar_TypeChecker_Env.lax_universes then FStar_Syntax_Syntax.U_zero else (match u with | FStar_Syntax_Syntax.U_unknown -> - let uu____7406 = FStar_Syntax_Util.type_u () in - FStar_All.pipe_right uu____7406 FStar_Pervasives_Native.snd - | uu____7415 -> aux u) + let uu____7576 = FStar_Syntax_Util.type_u () in + FStar_All.pipe_right uu____7576 FStar_Pervasives_Native.snd + | uu____7585 -> aux u) and tc_abs: FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.term -> @@ -3239,13 +3182,13 @@ and tc_abs: fun bs -> fun body -> let fail msg t = - let uu____7439 = + let uu____7609 = FStar_TypeChecker_Err.expected_a_term_of_type_t_got_a_function env msg t top in - FStar_Errors.raise_error uu____7439 top.FStar_Syntax_Syntax.pos in + FStar_Errors.raise_error uu____7609 top.FStar_Syntax_Syntax.pos in let check_binders env1 bs1 bs_expected = - let rec aux uu____7533 bs2 bs_expected1 = - match uu____7533 with + let rec aux uu____7703 bs2 bs_expected1 = + match uu____7703 with | (env2,out,g,subst1) -> (match (bs2, bs_expected1) with | ([],[]) -> @@ -3255,121 +3198,121 @@ and tc_abs: ((match (imp, imp') with | (FStar_Pervasives_Native.None ,FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.Implicit uu____7701)) -> - let uu____7706 = - let uu____7711 = - let uu____7712 = + (FStar_Syntax_Syntax.Implicit uu____7871)) -> + let uu____7876 = + let uu____7881 = + let uu____7882 = FStar_Syntax_Print.bv_to_string hd1 in FStar_Util.format1 "Inconsistent implicit argument annotation on argument %s" - uu____7712 in + uu____7882 in (FStar_Errors.Fatal_InconsistentImplicitArgumentAnnotation, - uu____7711) in - let uu____7713 = + uu____7881) in + let uu____7883 = FStar_Syntax_Syntax.range_of_bv hd1 in - FStar_Errors.raise_error uu____7706 uu____7713 + FStar_Errors.raise_error uu____7876 uu____7883 | (FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Implicit - uu____7714),FStar_Pervasives_Native.None ) -> - let uu____7719 = - let uu____7724 = - let uu____7725 = + uu____7884),FStar_Pervasives_Native.None ) -> + let uu____7889 = + let uu____7894 = + let uu____7895 = FStar_Syntax_Print.bv_to_string hd1 in FStar_Util.format1 "Inconsistent implicit argument annotation on argument %s" - uu____7725 in + uu____7895 in (FStar_Errors.Fatal_InconsistentImplicitArgumentAnnotation, - uu____7724) in - let uu____7726 = + uu____7894) in + let uu____7896 = FStar_Syntax_Syntax.range_of_bv hd1 in - FStar_Errors.raise_error uu____7719 uu____7726 - | uu____7727 -> ()); + FStar_Errors.raise_error uu____7889 uu____7896 + | uu____7897 -> ()); (let expected_t = FStar_Syntax_Subst.subst subst1 hd_expected.FStar_Syntax_Syntax.sort in - let uu____7733 = - let uu____7738 = - let uu____7739 = + let uu____7903 = + let uu____7908 = + let uu____7909 = FStar_Syntax_Util.unmeta hd1.FStar_Syntax_Syntax.sort in - uu____7739.FStar_Syntax_Syntax.n in - match uu____7738 with + uu____7909.FStar_Syntax_Syntax.n in + match uu____7908 with | FStar_Syntax_Syntax.Tm_unknown -> (expected_t, g) - | uu____7746 -> - ((let uu____7748 = + | uu____7916 -> + ((let uu____7918 = FStar_TypeChecker_Env.debug env2 FStar_Options.High in - if uu____7748 + if uu____7918 then - let uu____7749 = + let uu____7919 = FStar_Syntax_Print.bv_to_string hd1 in FStar_Util.print1 "Checking binder %s\n" - uu____7749 + uu____7919 else ()); - (let uu____7751 = + (let uu____7921 = tc_tot_or_gtot_term env2 hd1.FStar_Syntax_Syntax.sort in - match uu____7751 with - | (t,uu____7763,g1) -> + match uu____7921 with + | (t,uu____7933,g1) -> let g2 = - let uu____7766 = + let uu____7936 = FStar_TypeChecker_Rel.teq_nosmt env2 t expected_t in - if uu____7766 + if uu____7936 then FStar_TypeChecker_Rel.trivial_guard else - (let uu____7768 = + (let uu____7938 = FStar_TypeChecker_Rel.get_subtyping_prop env2 expected_t t in - match uu____7768 with + match uu____7938 with | FStar_Pervasives_Native.None -> - let uu____7771 = + let uu____7941 = FStar_TypeChecker_Err.basic_type_error env2 FStar_Pervasives_Native.None expected_t t in - let uu____7776 = + let uu____7946 = FStar_TypeChecker_Env.get_range env2 in FStar_Errors.raise_error - uu____7771 uu____7776 + uu____7941 uu____7946 | FStar_Pervasives_Native.Some g2 -> - let uu____7778 = + let uu____7948 = FStar_TypeChecker_Env.get_range env2 in FStar_TypeChecker_Util.label_guard - uu____7778 + uu____7948 "Type annotation on parameter incompatible with the expected type" g2) in let g3 = - let uu____7780 = + let uu____7950 = FStar_TypeChecker_Rel.conj_guard g1 g2 in FStar_TypeChecker_Rel.conj_guard g - uu____7780 in + uu____7950 in (t, g3))) in - match uu____7733 with + match uu____7903 with | (t,g1) -> let hd2 = - let uu___85_7808 = hd1 in + let uu___84_7978 = hd1 in { FStar_Syntax_Syntax.ppname = - (uu___85_7808.FStar_Syntax_Syntax.ppname); + (uu___84_7978.FStar_Syntax_Syntax.ppname); FStar_Syntax_Syntax.index = - (uu___85_7808.FStar_Syntax_Syntax.index); + (uu___84_7978.FStar_Syntax_Syntax.index); FStar_Syntax_Syntax.sort = t } in let b = (hd2, imp) in let b_expected = (hd_expected, imp') in let env3 = push_binding env2 b in let subst2 = - let uu____7821 = + let uu____7991 = FStar_Syntax_Syntax.bv_to_name hd2 in maybe_extend_subst subst1 b_expected - uu____7821 in + uu____7991 in aux (env3, (b :: out), g1, subst2) bs3 bs_expected2)) | (rest,[]) -> @@ -3387,102 +3330,102 @@ and tc_abs: | FStar_Pervasives_Native.None -> ((match env1.FStar_TypeChecker_Env.letrecs with | [] -> () - | uu____7969 -> + | uu____8139 -> failwith "Impossible: Can't have a let rec annotation but no expected type"); - (let uu____7978 = tc_binders env1 bs in - match uu____7978 with - | (bs1,envbody,g,uu____8008) -> + (let uu____8148 = tc_binders env1 bs in + match uu____8148 with + | (bs1,envbody,g,uu____8178) -> (FStar_Pervasives_Native.None, bs1, [], FStar_Pervasives_Native.None, envbody, body1, g))) | FStar_Pervasives_Native.Some t -> let t1 = FStar_Syntax_Subst.compress t in let rec as_function_typ norm1 t2 = - let uu____8052 = - let uu____8053 = FStar_Syntax_Subst.compress t2 in - uu____8053.FStar_Syntax_Syntax.n in - match uu____8052 with - | FStar_Syntax_Syntax.Tm_uvar uu____8076 -> + let uu____8222 = + let uu____8223 = FStar_Syntax_Subst.compress t2 in + uu____8223.FStar_Syntax_Syntax.n in + match uu____8222 with + | FStar_Syntax_Syntax.Tm_uvar uu____8246 -> ((match env1.FStar_TypeChecker_Env.letrecs with | [] -> () - | uu____8100 -> failwith "Impossible"); - (let uu____8109 = tc_binders env1 bs in - match uu____8109 with - | (bs1,envbody,g,uu____8141) -> - let uu____8142 = + | uu____8270 -> failwith "Impossible"); + (let uu____8279 = tc_binders env1 bs in + match uu____8279 with + | (bs1,envbody,g,uu____8311) -> + let uu____8312 = FStar_TypeChecker_Env.clear_expected_typ envbody in - (match uu____8142 with - | (envbody1,uu____8170) -> + (match uu____8312 with + | (envbody1,uu____8340) -> ((FStar_Pervasives_Native.Some t2), bs1, [], FStar_Pervasives_Native.None, envbody1, body1, g)))) | FStar_Syntax_Syntax.Tm_app ({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_uvar - uu____8181; - FStar_Syntax_Syntax.pos = uu____8182; - FStar_Syntax_Syntax.vars = uu____8183;_},uu____8184) + uu____8351; + FStar_Syntax_Syntax.pos = uu____8352; + FStar_Syntax_Syntax.vars = uu____8353;_},uu____8354) -> ((match env1.FStar_TypeChecker_Env.letrecs with | [] -> () - | uu____8228 -> failwith "Impossible"); - (let uu____8237 = tc_binders env1 bs in - match uu____8237 with - | (bs1,envbody,g,uu____8269) -> - let uu____8270 = + | uu____8398 -> failwith "Impossible"); + (let uu____8407 = tc_binders env1 bs in + match uu____8407 with + | (bs1,envbody,g,uu____8439) -> + let uu____8440 = FStar_TypeChecker_Env.clear_expected_typ envbody in - (match uu____8270 with - | (envbody1,uu____8298) -> + (match uu____8440 with + | (envbody1,uu____8468) -> ((FStar_Pervasives_Native.Some t2), bs1, [], FStar_Pervasives_Native.None, envbody1, body1, g)))) - | FStar_Syntax_Syntax.Tm_refine (b,uu____8310) -> - let uu____8315 = + | FStar_Syntax_Syntax.Tm_refine (b,uu____8480) -> + let uu____8485 = as_function_typ norm1 b.FStar_Syntax_Syntax.sort in - (match uu____8315 with - | (uu____8356,bs1,bs',copt,env2,body2,g) -> + (match uu____8485 with + | (uu____8526,bs1,bs',copt,env2,body2,g) -> ((FStar_Pervasives_Native.Some t2), bs1, bs', copt, env2, body2, g)) | FStar_Syntax_Syntax.Tm_arrow (bs_expected,c_expected) -> - let uu____8399 = + let uu____8569 = FStar_Syntax_Subst.open_comp bs_expected c_expected in - (match uu____8399 with + (match uu____8569 with | (bs_expected1,c_expected1) -> let check_actuals_against_formals env2 bs1 bs_expected2 body2 = - let rec handle_more uu____8508 c_expected2 body3 + let rec handle_more uu____8678 c_expected2 body3 = - match uu____8508 with + match uu____8678 with | (env3,bs2,more,guard,subst1) -> (match more with | FStar_Pervasives_Native.None -> - let uu____8628 = + let uu____8798 = FStar_Syntax_Subst.subst_comp subst1 c_expected2 in - (env3, bs2, guard, uu____8628, body3) + (env3, bs2, guard, uu____8798, body3) | FStar_Pervasives_Native.Some (FStar_Util.Inr more_bs_expected) -> let c = - let uu____8659 = + let uu____8829 = FStar_Syntax_Util.arrow more_bs_expected c_expected2 in FStar_Syntax_Syntax.mk_Total - uu____8659 in - let uu____8660 = + uu____8829 in + let uu____8830 = FStar_Syntax_Subst.subst_comp subst1 c in - (env3, bs2, guard, uu____8660, body3) + (env3, bs2, guard, uu____8830, body3) | FStar_Pervasives_Native.Some (FStar_Util.Inl more_bs) -> let c = FStar_Syntax_Subst.subst_comp subst1 c_expected2 in - let uu____8685 = + let uu____8855 = (FStar_Options.ml_ish ()) || (FStar_Syntax_Util.is_named_tot c) in - if uu____8685 + if uu____8855 then let t3 = FStar_TypeChecker_Normalize.unfold_whnf @@ -3493,32 +3436,32 @@ and tc_abs: with | FStar_Syntax_Syntax.Tm_arrow (bs_expected3,c_expected3) -> - let uu____8737 = + let uu____8907 = FStar_Syntax_Subst.open_comp bs_expected3 c_expected3 in - (match uu____8737 with + (match uu____8907 with | (bs_expected4,c_expected4) -> - let uu____8760 = + let uu____8930 = check_binders env3 more_bs bs_expected4 in - (match uu____8760 with + (match uu____8930 with | (env4,bs',more1,guard',subst2) -> - let uu____8810 = - let uu____8841 = + let uu____8980 = + let uu____9011 = FStar_TypeChecker_Rel.conj_guard guard guard' in (env4, (FStar_List.append bs2 bs'), more1, - uu____8841, + uu____9011, subst2) in handle_more - uu____8810 + uu____8980 c_expected4 body3)) - | uu____8858 -> + | uu____9028 -> let body4 = FStar_Syntax_Util.abs more_bs body3 @@ -3530,132 +3473,132 @@ and tc_abs: body3 FStar_Pervasives_Native.None in (env3, bs2, guard, c, body4))) in - let uu____8874 = + let uu____9044 = check_binders env2 bs1 bs_expected2 in - handle_more uu____8874 c_expected1 body2 in + handle_more uu____9044 c_expected1 body2 in let mk_letrec_env envbody bs1 c = let letrecs = guard_letrecs envbody bs1 c in let envbody1 = - let uu___86_8931 = envbody in + let uu___85_9101 = envbody in { FStar_TypeChecker_Env.solver = - (uu___86_8931.FStar_TypeChecker_Env.solver); + (uu___85_9101.FStar_TypeChecker_Env.solver); FStar_TypeChecker_Env.range = - (uu___86_8931.FStar_TypeChecker_Env.range); + (uu___85_9101.FStar_TypeChecker_Env.range); FStar_TypeChecker_Env.curmodule = - (uu___86_8931.FStar_TypeChecker_Env.curmodule); + (uu___85_9101.FStar_TypeChecker_Env.curmodule); FStar_TypeChecker_Env.gamma = - (uu___86_8931.FStar_TypeChecker_Env.gamma); + (uu___85_9101.FStar_TypeChecker_Env.gamma); FStar_TypeChecker_Env.gamma_cache = - (uu___86_8931.FStar_TypeChecker_Env.gamma_cache); + (uu___85_9101.FStar_TypeChecker_Env.gamma_cache); FStar_TypeChecker_Env.modules = - (uu___86_8931.FStar_TypeChecker_Env.modules); + (uu___85_9101.FStar_TypeChecker_Env.modules); FStar_TypeChecker_Env.expected_typ = - (uu___86_8931.FStar_TypeChecker_Env.expected_typ); + (uu___85_9101.FStar_TypeChecker_Env.expected_typ); FStar_TypeChecker_Env.sigtab = - (uu___86_8931.FStar_TypeChecker_Env.sigtab); + (uu___85_9101.FStar_TypeChecker_Env.sigtab); FStar_TypeChecker_Env.is_pattern = - (uu___86_8931.FStar_TypeChecker_Env.is_pattern); + (uu___85_9101.FStar_TypeChecker_Env.is_pattern); FStar_TypeChecker_Env.instantiate_imp = - (uu___86_8931.FStar_TypeChecker_Env.instantiate_imp); + (uu___85_9101.FStar_TypeChecker_Env.instantiate_imp); FStar_TypeChecker_Env.effects = - (uu___86_8931.FStar_TypeChecker_Env.effects); + (uu___85_9101.FStar_TypeChecker_Env.effects); FStar_TypeChecker_Env.generalize = - (uu___86_8931.FStar_TypeChecker_Env.generalize); + (uu___85_9101.FStar_TypeChecker_Env.generalize); FStar_TypeChecker_Env.letrecs = []; FStar_TypeChecker_Env.top_level = - (uu___86_8931.FStar_TypeChecker_Env.top_level); + (uu___85_9101.FStar_TypeChecker_Env.top_level); FStar_TypeChecker_Env.check_uvars = - (uu___86_8931.FStar_TypeChecker_Env.check_uvars); + (uu___85_9101.FStar_TypeChecker_Env.check_uvars); FStar_TypeChecker_Env.use_eq = - (uu___86_8931.FStar_TypeChecker_Env.use_eq); + (uu___85_9101.FStar_TypeChecker_Env.use_eq); FStar_TypeChecker_Env.is_iface = - (uu___86_8931.FStar_TypeChecker_Env.is_iface); + (uu___85_9101.FStar_TypeChecker_Env.is_iface); FStar_TypeChecker_Env.admit = - (uu___86_8931.FStar_TypeChecker_Env.admit); + (uu___85_9101.FStar_TypeChecker_Env.admit); FStar_TypeChecker_Env.lax = - (uu___86_8931.FStar_TypeChecker_Env.lax); + (uu___85_9101.FStar_TypeChecker_Env.lax); FStar_TypeChecker_Env.lax_universes = - (uu___86_8931.FStar_TypeChecker_Env.lax_universes); + (uu___85_9101.FStar_TypeChecker_Env.lax_universes); FStar_TypeChecker_Env.failhard = - (uu___86_8931.FStar_TypeChecker_Env.failhard); + (uu___85_9101.FStar_TypeChecker_Env.failhard); FStar_TypeChecker_Env.nosynth = - (uu___86_8931.FStar_TypeChecker_Env.nosynth); + (uu___85_9101.FStar_TypeChecker_Env.nosynth); FStar_TypeChecker_Env.tc_term = - (uu___86_8931.FStar_TypeChecker_Env.tc_term); + (uu___85_9101.FStar_TypeChecker_Env.tc_term); FStar_TypeChecker_Env.type_of = - (uu___86_8931.FStar_TypeChecker_Env.type_of); + (uu___85_9101.FStar_TypeChecker_Env.type_of); FStar_TypeChecker_Env.universe_of = - (uu___86_8931.FStar_TypeChecker_Env.universe_of); + (uu___85_9101.FStar_TypeChecker_Env.universe_of); FStar_TypeChecker_Env.use_bv_sorts = - (uu___86_8931.FStar_TypeChecker_Env.use_bv_sorts); + (uu___85_9101.FStar_TypeChecker_Env.use_bv_sorts); FStar_TypeChecker_Env.qname_and_index = - (uu___86_8931.FStar_TypeChecker_Env.qname_and_index); + (uu___85_9101.FStar_TypeChecker_Env.qname_and_index); FStar_TypeChecker_Env.proof_ns = - (uu___86_8931.FStar_TypeChecker_Env.proof_ns); + (uu___85_9101.FStar_TypeChecker_Env.proof_ns); FStar_TypeChecker_Env.synth = - (uu___86_8931.FStar_TypeChecker_Env.synth); + (uu___85_9101.FStar_TypeChecker_Env.synth); FStar_TypeChecker_Env.is_native_tactic = - (uu___86_8931.FStar_TypeChecker_Env.is_native_tactic); + (uu___85_9101.FStar_TypeChecker_Env.is_native_tactic); FStar_TypeChecker_Env.identifier_info = - (uu___86_8931.FStar_TypeChecker_Env.identifier_info); + (uu___85_9101.FStar_TypeChecker_Env.identifier_info); FStar_TypeChecker_Env.tc_hooks = - (uu___86_8931.FStar_TypeChecker_Env.tc_hooks); + (uu___85_9101.FStar_TypeChecker_Env.tc_hooks); FStar_TypeChecker_Env.dsenv = - (uu___86_8931.FStar_TypeChecker_Env.dsenv); + (uu___85_9101.FStar_TypeChecker_Env.dsenv); FStar_TypeChecker_Env.dep_graph = - (uu___86_8931.FStar_TypeChecker_Env.dep_graph) + (uu___85_9101.FStar_TypeChecker_Env.dep_graph) } in FStar_All.pipe_right letrecs (FStar_List.fold_left - (fun uu____8979 -> - fun uu____8980 -> - match (uu____8979, uu____8980) with + (fun uu____9149 -> + fun uu____9150 -> + match (uu____9149, uu____9150) with | ((env2,letrec_binders),(l,t3,u_names)) -> - let uu____9042 = - let uu____9049 = - let uu____9050 = + let uu____9212 = + let uu____9219 = + let uu____9220 = FStar_TypeChecker_Env.clear_expected_typ env2 in FStar_All.pipe_right - uu____9050 + uu____9220 FStar_Pervasives_Native.fst in - tc_term uu____9049 t3 in - (match uu____9042 with - | (t4,uu____9072,uu____9073) -> + tc_term uu____9219 t3 in + (match uu____9212 with + | (t4,uu____9242,uu____9243) -> let env3 = FStar_TypeChecker_Env.push_let_binding env2 l (u_names, t4) in let lb = match l with | FStar_Util.Inl x -> - let uu____9083 = + let uu____9253 = FStar_Syntax_Syntax.mk_binder - (let uu___87_9086 = + (let uu___86_9256 = x in { FStar_Syntax_Syntax.ppname = - (uu___87_9086.FStar_Syntax_Syntax.ppname); + (uu___86_9256.FStar_Syntax_Syntax.ppname); FStar_Syntax_Syntax.index = - (uu___87_9086.FStar_Syntax_Syntax.index); + (uu___86_9256.FStar_Syntax_Syntax.index); FStar_Syntax_Syntax.sort = t4 }) in - uu____9083 :: + uu____9253 :: letrec_binders - | uu____9087 -> + | uu____9257 -> letrec_binders in (env3, lb))) (envbody1, [])) in - let uu____9092 = + let uu____9262 = check_actuals_against_formals env1 bs bs_expected1 body1 in - (match uu____9092 with + (match uu____9262 with | (envbody,bs1,g,c,body2) -> - let uu____9146 = mk_letrec_env envbody bs1 c in - (match uu____9146 with + let uu____9316 = mk_letrec_env envbody bs1 c in + (match uu____9316 with | (envbody1,letrecs) -> let envbody2 = FStar_TypeChecker_Env.set_expected_typ @@ -3665,244 +3608,244 @@ and tc_abs: letrecs, (FStar_Pervasives_Native.Some c), envbody2, body2, g)))) - | uu____9192 -> + | uu____9362 -> if Prims.op_Negation norm1 then - let uu____9213 = + let uu____9383 = FStar_TypeChecker_Normalize.unfold_whnf env1 t2 in - as_function_typ true uu____9213 + as_function_typ true uu____9383 else - (let uu____9215 = + (let uu____9385 = expected_function_typ1 env1 FStar_Pervasives_Native.None body1 in - match uu____9215 with - | (uu____9254,bs1,uu____9256,c_opt,envbody,body2,g) + match uu____9385 with + | (uu____9424,bs1,uu____9426,c_opt,envbody,body2,g) -> ((FStar_Pervasives_Native.Some t2), bs1, [], c_opt, envbody, body2, g)) in as_function_typ false t1 in let use_eq = env.FStar_TypeChecker_Env.use_eq in - let uu____9276 = FStar_TypeChecker_Env.clear_expected_typ env in - match uu____9276 with + let uu____9446 = FStar_TypeChecker_Env.clear_expected_typ env in + match uu____9446 with | (env1,topt) -> - ((let uu____9296 = + ((let uu____9466 = FStar_TypeChecker_Env.debug env1 FStar_Options.High in - if uu____9296 + if uu____9466 then - let uu____9297 = + let uu____9467 = match topt with | FStar_Pervasives_Native.None -> "None" | FStar_Pervasives_Native.Some t -> FStar_Syntax_Print.term_to_string t in FStar_Util.print2 "!!!!!!!!!!!!!!!Expected type is %s, top_level=%s\n" - uu____9297 + uu____9467 (if env1.FStar_TypeChecker_Env.top_level then "true" else "false") else ()); - (let uu____9301 = expected_function_typ1 env1 topt body in - match uu____9301 with + (let uu____9471 = expected_function_typ1 env1 topt body in + match uu____9471 with | (tfun_opt,bs1,letrec_binders,c_opt,envbody,body1,g) -> - let uu____9341 = + let uu____9511 = let should_check_expected_effect = - let uu____9349 = - let uu____9356 = - let uu____9357 = + let uu____9519 = + let uu____9526 = + let uu____9527 = FStar_Syntax_Subst.compress body1 in - uu____9357.FStar_Syntax_Syntax.n in - (c_opt, uu____9356) in - match uu____9349 with + uu____9527.FStar_Syntax_Syntax.n in + (c_opt, uu____9526) in + match uu____9519 with | (FStar_Pervasives_Native.None ,FStar_Syntax_Syntax.Tm_ascribed - (uu____9362,(FStar_Util.Inr expected_c,uu____9364),uu____9365)) + (uu____9532,(FStar_Util.Inr expected_c,uu____9534),uu____9535)) -> false - | uu____9414 -> true in - let uu____9421 = + | uu____9584 -> true in + let uu____9591 = tc_term - (let uu___88_9430 = envbody in + (let uu___87_9600 = envbody in { FStar_TypeChecker_Env.solver = - (uu___88_9430.FStar_TypeChecker_Env.solver); + (uu___87_9600.FStar_TypeChecker_Env.solver); FStar_TypeChecker_Env.range = - (uu___88_9430.FStar_TypeChecker_Env.range); + (uu___87_9600.FStar_TypeChecker_Env.range); FStar_TypeChecker_Env.curmodule = - (uu___88_9430.FStar_TypeChecker_Env.curmodule); + (uu___87_9600.FStar_TypeChecker_Env.curmodule); FStar_TypeChecker_Env.gamma = - (uu___88_9430.FStar_TypeChecker_Env.gamma); + (uu___87_9600.FStar_TypeChecker_Env.gamma); FStar_TypeChecker_Env.gamma_cache = - (uu___88_9430.FStar_TypeChecker_Env.gamma_cache); + (uu___87_9600.FStar_TypeChecker_Env.gamma_cache); FStar_TypeChecker_Env.modules = - (uu___88_9430.FStar_TypeChecker_Env.modules); + (uu___87_9600.FStar_TypeChecker_Env.modules); FStar_TypeChecker_Env.expected_typ = - (uu___88_9430.FStar_TypeChecker_Env.expected_typ); + (uu___87_9600.FStar_TypeChecker_Env.expected_typ); FStar_TypeChecker_Env.sigtab = - (uu___88_9430.FStar_TypeChecker_Env.sigtab); + (uu___87_9600.FStar_TypeChecker_Env.sigtab); FStar_TypeChecker_Env.is_pattern = - (uu___88_9430.FStar_TypeChecker_Env.is_pattern); + (uu___87_9600.FStar_TypeChecker_Env.is_pattern); FStar_TypeChecker_Env.instantiate_imp = - (uu___88_9430.FStar_TypeChecker_Env.instantiate_imp); + (uu___87_9600.FStar_TypeChecker_Env.instantiate_imp); FStar_TypeChecker_Env.effects = - (uu___88_9430.FStar_TypeChecker_Env.effects); + (uu___87_9600.FStar_TypeChecker_Env.effects); FStar_TypeChecker_Env.generalize = - (uu___88_9430.FStar_TypeChecker_Env.generalize); + (uu___87_9600.FStar_TypeChecker_Env.generalize); FStar_TypeChecker_Env.letrecs = - (uu___88_9430.FStar_TypeChecker_Env.letrecs); + (uu___87_9600.FStar_TypeChecker_Env.letrecs); FStar_TypeChecker_Env.top_level = false; FStar_TypeChecker_Env.check_uvars = - (uu___88_9430.FStar_TypeChecker_Env.check_uvars); + (uu___87_9600.FStar_TypeChecker_Env.check_uvars); FStar_TypeChecker_Env.use_eq = use_eq; FStar_TypeChecker_Env.is_iface = - (uu___88_9430.FStar_TypeChecker_Env.is_iface); + (uu___87_9600.FStar_TypeChecker_Env.is_iface); FStar_TypeChecker_Env.admit = - (uu___88_9430.FStar_TypeChecker_Env.admit); + (uu___87_9600.FStar_TypeChecker_Env.admit); FStar_TypeChecker_Env.lax = - (uu___88_9430.FStar_TypeChecker_Env.lax); + (uu___87_9600.FStar_TypeChecker_Env.lax); FStar_TypeChecker_Env.lax_universes = - (uu___88_9430.FStar_TypeChecker_Env.lax_universes); + (uu___87_9600.FStar_TypeChecker_Env.lax_universes); FStar_TypeChecker_Env.failhard = - (uu___88_9430.FStar_TypeChecker_Env.failhard); + (uu___87_9600.FStar_TypeChecker_Env.failhard); FStar_TypeChecker_Env.nosynth = - (uu___88_9430.FStar_TypeChecker_Env.nosynth); + (uu___87_9600.FStar_TypeChecker_Env.nosynth); FStar_TypeChecker_Env.tc_term = - (uu___88_9430.FStar_TypeChecker_Env.tc_term); + (uu___87_9600.FStar_TypeChecker_Env.tc_term); FStar_TypeChecker_Env.type_of = - (uu___88_9430.FStar_TypeChecker_Env.type_of); + (uu___87_9600.FStar_TypeChecker_Env.type_of); FStar_TypeChecker_Env.universe_of = - (uu___88_9430.FStar_TypeChecker_Env.universe_of); + (uu___87_9600.FStar_TypeChecker_Env.universe_of); FStar_TypeChecker_Env.use_bv_sorts = - (uu___88_9430.FStar_TypeChecker_Env.use_bv_sorts); + (uu___87_9600.FStar_TypeChecker_Env.use_bv_sorts); FStar_TypeChecker_Env.qname_and_index = - (uu___88_9430.FStar_TypeChecker_Env.qname_and_index); + (uu___87_9600.FStar_TypeChecker_Env.qname_and_index); FStar_TypeChecker_Env.proof_ns = - (uu___88_9430.FStar_TypeChecker_Env.proof_ns); + (uu___87_9600.FStar_TypeChecker_Env.proof_ns); FStar_TypeChecker_Env.synth = - (uu___88_9430.FStar_TypeChecker_Env.synth); + (uu___87_9600.FStar_TypeChecker_Env.synth); FStar_TypeChecker_Env.is_native_tactic = - (uu___88_9430.FStar_TypeChecker_Env.is_native_tactic); + (uu___87_9600.FStar_TypeChecker_Env.is_native_tactic); FStar_TypeChecker_Env.identifier_info = - (uu___88_9430.FStar_TypeChecker_Env.identifier_info); + (uu___87_9600.FStar_TypeChecker_Env.identifier_info); FStar_TypeChecker_Env.tc_hooks = - (uu___88_9430.FStar_TypeChecker_Env.tc_hooks); + (uu___87_9600.FStar_TypeChecker_Env.tc_hooks); FStar_TypeChecker_Env.dsenv = - (uu___88_9430.FStar_TypeChecker_Env.dsenv); + (uu___87_9600.FStar_TypeChecker_Env.dsenv); FStar_TypeChecker_Env.dep_graph = - (uu___88_9430.FStar_TypeChecker_Env.dep_graph) + (uu___87_9600.FStar_TypeChecker_Env.dep_graph) }) body1 in - match uu____9421 with + match uu____9591 with | (body2,cbody,guard_body) -> let guard_body1 = FStar_TypeChecker_Rel.solve_deferred_constraints envbody guard_body in if should_check_expected_effect then - let uu____9447 = - let uu____9454 = - let uu____9459 = - cbody.FStar_Syntax_Syntax.comp () in - (body2, uu____9459) in + let uu____9617 = + let uu____9624 = + let uu____9629 = + FStar_Syntax_Syntax.lcomp_comp cbody in + (body2, uu____9629) in check_expected_effect - (let uu___89_9466 = envbody in + (let uu___88_9632 = envbody in { FStar_TypeChecker_Env.solver = - (uu___89_9466.FStar_TypeChecker_Env.solver); + (uu___88_9632.FStar_TypeChecker_Env.solver); FStar_TypeChecker_Env.range = - (uu___89_9466.FStar_TypeChecker_Env.range); + (uu___88_9632.FStar_TypeChecker_Env.range); FStar_TypeChecker_Env.curmodule = - (uu___89_9466.FStar_TypeChecker_Env.curmodule); + (uu___88_9632.FStar_TypeChecker_Env.curmodule); FStar_TypeChecker_Env.gamma = - (uu___89_9466.FStar_TypeChecker_Env.gamma); + (uu___88_9632.FStar_TypeChecker_Env.gamma); FStar_TypeChecker_Env.gamma_cache = - (uu___89_9466.FStar_TypeChecker_Env.gamma_cache); + (uu___88_9632.FStar_TypeChecker_Env.gamma_cache); FStar_TypeChecker_Env.modules = - (uu___89_9466.FStar_TypeChecker_Env.modules); + (uu___88_9632.FStar_TypeChecker_Env.modules); FStar_TypeChecker_Env.expected_typ = - (uu___89_9466.FStar_TypeChecker_Env.expected_typ); + (uu___88_9632.FStar_TypeChecker_Env.expected_typ); FStar_TypeChecker_Env.sigtab = - (uu___89_9466.FStar_TypeChecker_Env.sigtab); + (uu___88_9632.FStar_TypeChecker_Env.sigtab); FStar_TypeChecker_Env.is_pattern = - (uu___89_9466.FStar_TypeChecker_Env.is_pattern); + (uu___88_9632.FStar_TypeChecker_Env.is_pattern); FStar_TypeChecker_Env.instantiate_imp = - (uu___89_9466.FStar_TypeChecker_Env.instantiate_imp); + (uu___88_9632.FStar_TypeChecker_Env.instantiate_imp); FStar_TypeChecker_Env.effects = - (uu___89_9466.FStar_TypeChecker_Env.effects); + (uu___88_9632.FStar_TypeChecker_Env.effects); FStar_TypeChecker_Env.generalize = - (uu___89_9466.FStar_TypeChecker_Env.generalize); + (uu___88_9632.FStar_TypeChecker_Env.generalize); FStar_TypeChecker_Env.letrecs = - (uu___89_9466.FStar_TypeChecker_Env.letrecs); + (uu___88_9632.FStar_TypeChecker_Env.letrecs); FStar_TypeChecker_Env.top_level = - (uu___89_9466.FStar_TypeChecker_Env.top_level); + (uu___88_9632.FStar_TypeChecker_Env.top_level); FStar_TypeChecker_Env.check_uvars = - (uu___89_9466.FStar_TypeChecker_Env.check_uvars); + (uu___88_9632.FStar_TypeChecker_Env.check_uvars); FStar_TypeChecker_Env.use_eq = use_eq; FStar_TypeChecker_Env.is_iface = - (uu___89_9466.FStar_TypeChecker_Env.is_iface); + (uu___88_9632.FStar_TypeChecker_Env.is_iface); FStar_TypeChecker_Env.admit = - (uu___89_9466.FStar_TypeChecker_Env.admit); + (uu___88_9632.FStar_TypeChecker_Env.admit); FStar_TypeChecker_Env.lax = - (uu___89_9466.FStar_TypeChecker_Env.lax); + (uu___88_9632.FStar_TypeChecker_Env.lax); FStar_TypeChecker_Env.lax_universes = - (uu___89_9466.FStar_TypeChecker_Env.lax_universes); + (uu___88_9632.FStar_TypeChecker_Env.lax_universes); FStar_TypeChecker_Env.failhard = - (uu___89_9466.FStar_TypeChecker_Env.failhard); + (uu___88_9632.FStar_TypeChecker_Env.failhard); FStar_TypeChecker_Env.nosynth = - (uu___89_9466.FStar_TypeChecker_Env.nosynth); + (uu___88_9632.FStar_TypeChecker_Env.nosynth); FStar_TypeChecker_Env.tc_term = - (uu___89_9466.FStar_TypeChecker_Env.tc_term); + (uu___88_9632.FStar_TypeChecker_Env.tc_term); FStar_TypeChecker_Env.type_of = - (uu___89_9466.FStar_TypeChecker_Env.type_of); + (uu___88_9632.FStar_TypeChecker_Env.type_of); FStar_TypeChecker_Env.universe_of = - (uu___89_9466.FStar_TypeChecker_Env.universe_of); + (uu___88_9632.FStar_TypeChecker_Env.universe_of); FStar_TypeChecker_Env.use_bv_sorts = - (uu___89_9466.FStar_TypeChecker_Env.use_bv_sorts); + (uu___88_9632.FStar_TypeChecker_Env.use_bv_sorts); FStar_TypeChecker_Env.qname_and_index = - (uu___89_9466.FStar_TypeChecker_Env.qname_and_index); + (uu___88_9632.FStar_TypeChecker_Env.qname_and_index); FStar_TypeChecker_Env.proof_ns = - (uu___89_9466.FStar_TypeChecker_Env.proof_ns); + (uu___88_9632.FStar_TypeChecker_Env.proof_ns); FStar_TypeChecker_Env.synth = - (uu___89_9466.FStar_TypeChecker_Env.synth); + (uu___88_9632.FStar_TypeChecker_Env.synth); FStar_TypeChecker_Env.is_native_tactic = - (uu___89_9466.FStar_TypeChecker_Env.is_native_tactic); + (uu___88_9632.FStar_TypeChecker_Env.is_native_tactic); FStar_TypeChecker_Env.identifier_info = - (uu___89_9466.FStar_TypeChecker_Env.identifier_info); + (uu___88_9632.FStar_TypeChecker_Env.identifier_info); FStar_TypeChecker_Env.tc_hooks = - (uu___89_9466.FStar_TypeChecker_Env.tc_hooks); + (uu___88_9632.FStar_TypeChecker_Env.tc_hooks); FStar_TypeChecker_Env.dsenv = - (uu___89_9466.FStar_TypeChecker_Env.dsenv); + (uu___88_9632.FStar_TypeChecker_Env.dsenv); FStar_TypeChecker_Env.dep_graph = - (uu___89_9466.FStar_TypeChecker_Env.dep_graph) - }) c_opt uu____9454 in - (match uu____9447 with + (uu___88_9632.FStar_TypeChecker_Env.dep_graph) + }) c_opt uu____9624 in + (match uu____9617 with | (body3,cbody1,guard) -> - let uu____9476 = + let uu____9642 = FStar_TypeChecker_Rel.conj_guard guard_body1 guard in - (body3, cbody1, uu____9476)) + (body3, cbody1, uu____9642)) else - (let uu____9478 = - cbody.FStar_Syntax_Syntax.comp () in - (body2, uu____9478, guard_body1)) in - (match uu____9341 with + (let uu____9644 = + FStar_Syntax_Syntax.lcomp_comp cbody in + (body2, uu____9644, guard_body1)) in + (match uu____9511 with | (body2,cbody,guard) -> let guard1 = - let uu____9493 = + let uu____9655 = env1.FStar_TypeChecker_Env.top_level || - (let uu____9495 = + (let uu____9657 = FStar_TypeChecker_Env.should_verify env1 in - Prims.op_Negation uu____9495) in - if uu____9493 + Prims.op_Negation uu____9657) in + if uu____9655 then - let uu____9496 = + let uu____9658 = FStar_TypeChecker_Rel.conj_guard g guard in FStar_TypeChecker_Rel.discharge_guard envbody - uu____9496 + uu____9658 else (let guard1 = - let uu____9499 = + let uu____9661 = FStar_TypeChecker_Rel.conj_guard g guard in FStar_TypeChecker_Rel.close_guard env1 (FStar_List.append bs1 letrec_binders) - uu____9499 in + uu____9661 in guard1) in let tfun_computed = FStar_Syntax_Util.arrow bs1 cbody in @@ -3911,38 +3854,35 @@ and tc_abs: (FStar_Pervasives_Native.Some (FStar_Syntax_Util.residual_comp_of_comp (FStar_Util.dflt cbody c_opt))) in - let uu____9508 = + let uu____9670 = match tfun_opt with | FStar_Pervasives_Native.Some t -> let t1 = FStar_Syntax_Subst.compress t in (match t1.FStar_Syntax_Syntax.n with - | FStar_Syntax_Syntax.Tm_arrow uu____9529 -> + | FStar_Syntax_Syntax.Tm_arrow uu____9691 -> (e, t1, guard1) - | uu____9542 -> - let uu____9543 = + | uu____9704 -> + let uu____9705 = FStar_TypeChecker_Util.check_and_ascribe env1 e tfun_computed t1 in - (match uu____9543 with + (match uu____9705 with | (e1,guard') -> - let uu____9556 = + let uu____9718 = FStar_TypeChecker_Rel.conj_guard guard1 guard' in - (e1, t1, uu____9556))) + (e1, t1, uu____9718))) | FStar_Pervasives_Native.None -> (e, tfun_computed, guard1) in - (match uu____9508 with + (match uu____9670 with | (e1,tfun,guard2) -> - let c = - if env1.FStar_TypeChecker_Env.top_level - then FStar_Syntax_Syntax.mk_Total tfun - else - FStar_TypeChecker_Util.return_value env1 - tfun e1 in - let uu____9570 = + let c = FStar_Syntax_Syntax.mk_Total tfun in + let uu____9731 = + let uu____9736 = + FStar_Syntax_Util.lcomp_of_comp c in FStar_TypeChecker_Util.strengthen_precondition FStar_Pervasives_Native.None env1 e1 - (FStar_Syntax_Util.lcomp_of_comp c) guard2 in - (match uu____9570 with + uu____9736 guard2 in + (match uu____9731 with | (c1,g1) -> (e1, c1, g1)))))) and check_application_args: FStar_TypeChecker_Env.env -> @@ -3964,157 +3904,234 @@ and check_application_args: let n_args = FStar_List.length args in let r = FStar_TypeChecker_Env.get_range env in let thead = chead.FStar_Syntax_Syntax.res_typ in - (let uu____9619 = + (let uu____9781 = FStar_TypeChecker_Env.debug env FStar_Options.High in - if uu____9619 + if uu____9781 then - let uu____9620 = + let uu____9782 = FStar_Range.string_of_range head1.FStar_Syntax_Syntax.pos in - let uu____9621 = FStar_Syntax_Print.term_to_string thead in - FStar_Util.print2 "(%s) Type of head is %s\n" uu____9620 - uu____9621 + let uu____9783 = FStar_Syntax_Print.term_to_string thead in + FStar_Util.print2 "(%s) Type of head is %s\n" uu____9782 + uu____9783 else ()); - (let monadic_application uu____9678 subst1 arg_comps_rev + (let monadic_application uu____9840 subst1 arg_comps_rev arg_rets_rev guard fvs bs = - match uu____9678 with + match uu____9840 with | (head2,chead1,ghead1,cres) -> let rt = check_no_escape (FStar_Pervasives_Native.Some head2) env fvs cres.FStar_Syntax_Syntax.res_typ in let cres1 = - let uu___90_9737 = cres in + let uu___89_9899 = cres in { FStar_Syntax_Syntax.eff_name = - (uu___90_9737.FStar_Syntax_Syntax.eff_name); + (uu___89_9899.FStar_Syntax_Syntax.eff_name); FStar_Syntax_Syntax.res_typ = rt; FStar_Syntax_Syntax.cflags = - (uu___90_9737.FStar_Syntax_Syntax.cflags); - FStar_Syntax_Syntax.comp = - (uu___90_9737.FStar_Syntax_Syntax.comp) + (uu___89_9899.FStar_Syntax_Syntax.cflags); + FStar_Syntax_Syntax.comp_thunk = + (uu___89_9899.FStar_Syntax_Syntax.comp_thunk) } in - let uu____9738 = + let uu____9900 = match bs with | [] -> - let cres2 = - FStar_TypeChecker_Util.subst_lcomp subst1 cres1 in let g = FStar_TypeChecker_Rel.conj_guard ghead1 guard in - (cres2, g) - | uu____9753 -> + (cres1, g) + | uu____9914 -> let g = - let uu____9761 = + let uu____9922 = FStar_TypeChecker_Rel.conj_guard ghead1 guard in - FStar_All.pipe_right uu____9761 + FStar_All.pipe_right uu____9922 (FStar_TypeChecker_Rel.solve_deferred_constraints env) in - let uu____9762 = - let uu____9763 = - let uu____9766 = - let uu____9767 = - let uu____9768 = - cres1.FStar_Syntax_Syntax.comp () in - FStar_Syntax_Util.arrow bs uu____9768 in - FStar_All.pipe_left - (FStar_Syntax_Subst.subst subst1) - uu____9767 in - FStar_Syntax_Syntax.mk_Total uu____9766 in + let uu____9923 = + let uu____9924 = + let uu____9927 = + let uu____9928 = + FStar_Syntax_Syntax.lcomp_comp cres1 in + FStar_Syntax_Util.arrow bs uu____9928 in + FStar_Syntax_Syntax.mk_Total uu____9927 in FStar_All.pipe_left - FStar_Syntax_Util.lcomp_of_comp uu____9763 in - (uu____9762, g) in - (match uu____9738 with + FStar_Syntax_Util.lcomp_of_comp uu____9924 in + (uu____9923, g) in + (match uu____9900 with | (cres2,guard1) -> - ((let uu____9782 = + ((let uu____9942 = FStar_TypeChecker_Env.debug env FStar_Options.Low in - if uu____9782 + if uu____9942 then - let uu____9783 = + let uu____9943 = FStar_Syntax_Print.lcomp_to_string cres2 in FStar_Util.print1 - "\t Type of result cres is %s\n" uu____9783 + "\t Type of result cres is %s\n" uu____9943 else ()); (let cres3 = - let uu____9786 = - FStar_Syntax_Util.is_pure_or_ghost_lcomp - cres2 in - if uu____9786 + let head_is_pure_and_some_arg_is_effectful = + (FStar_Syntax_Util.is_pure_or_ghost_lcomp + chead1) + && + (FStar_Util.for_some + (fun uu____9959 -> + match uu____9959 with + | (uu____9968,uu____9969,lc) -> + (let uu____9977 = + FStar_Syntax_Util.is_pure_or_ghost_lcomp + lc in + Prims.op_Negation uu____9977) || + (FStar_TypeChecker_Util.should_not_inline_lc + lc)) arg_comps_rev) in + let term = + FStar_Syntax_Syntax.mk_Tm_app head2 + (FStar_List.rev arg_rets_rev) + FStar_Pervasives_Native.None + head2.FStar_Syntax_Syntax.pos in + let uu____9987 = + (FStar_Syntax_Util.is_pure_or_ghost_lcomp + cres2) + && head_is_pure_and_some_arg_is_effectful in + if uu____9987 then - let term = - FStar_Syntax_Syntax.mk_Tm_app head2 - (FStar_List.rev arg_rets_rev) - FStar_Pervasives_Native.None - head2.FStar_Syntax_Syntax.pos in - FStar_TypeChecker_Util.maybe_assume_result_eq_pure_term - env term cres2 - else cres2 in + ((let uu____9989 = + FStar_TypeChecker_Env.debug env + FStar_Options.Extreme in + if uu____9989 + then + let uu____9990 = + FStar_Syntax_Print.term_to_string term in + FStar_Util.print1 + "(a) Monadic app: Return inserted in monadic application: %s\n" + uu____9990 + else ()); + FStar_TypeChecker_Util.maybe_assume_result_eq_pure_term + env term cres2) + else + ((let uu____9994 = + FStar_TypeChecker_Env.debug env + FStar_Options.Extreme in + if uu____9994 + then + let uu____9995 = + FStar_Syntax_Print.term_to_string term in + FStar_Util.print1 + "(a) Monadic app: No return inserted in monadic application: %s\n" + uu____9995 + else ()); + cres2) in let comp = FStar_List.fold_left (fun out_c -> - fun uu____9820 -> - match uu____9820 with + fun uu____10019 -> + match uu____10019 with | ((e,q),x,c) -> - let uu____9853 = - FStar_Syntax_Util.is_pure_or_ghost_lcomp - c in - if uu____9853 - then - FStar_TypeChecker_Util.bind - e.FStar_Syntax_Syntax.pos env - (FStar_Pervasives_Native.Some e) - c (x, out_c) - else - FStar_TypeChecker_Util.bind - e.FStar_Syntax_Syntax.pos env - FStar_Pervasives_Native.None c - (x, out_c)) cres3 arg_comps_rev in + ((let uu____10045 = + FStar_TypeChecker_Env.debug env + FStar_Options.Extreme in + if uu____10045 + then + let uu____10046 = + match x with + | FStar_Pervasives_Native.None + -> "_" + | FStar_Pervasives_Native.Some + x1 -> + FStar_Syntax_Print.bv_to_string + x1 in + let uu____10048 = + FStar_Syntax_Print.term_to_string + e in + FStar_Util.print2 + "(b) Monadic app: Binding argument %s : %s\n" + uu____10046 uu____10048 + else ()); + (let uu____10050 = + FStar_Syntax_Util.is_pure_or_ghost_lcomp + c in + if uu____10050 + then + FStar_TypeChecker_Util.bind + e.FStar_Syntax_Syntax.pos env + (FStar_Pervasives_Native.Some + e) c (x, out_c) + else + FStar_TypeChecker_Util.bind + e.FStar_Syntax_Syntax.pos env + FStar_Pervasives_Native.None c + (x, out_c)))) cres3 + arg_comps_rev in let comp1 = - FStar_TypeChecker_Util.bind - head2.FStar_Syntax_Syntax.pos env - FStar_Pervasives_Native.None chead1 - (FStar_Pervasives_Native.None, comp) in + (let uu____10058 = + FStar_TypeChecker_Env.debug env + FStar_Options.Extreme in + if uu____10058 + then + let uu____10059 = + FStar_Syntax_Print.term_to_string head2 in + FStar_Util.print1 + "(c) Monadic app: Binding head %s " + uu____10059 + else ()); + (let uu____10061 = + FStar_Syntax_Util.is_pure_or_ghost_lcomp + chead1 in + if uu____10061 + then + FStar_TypeChecker_Util.bind + head2.FStar_Syntax_Syntax.pos env + (FStar_Pervasives_Native.Some head2) + chead1 + (FStar_Pervasives_Native.None, comp) + else + FStar_TypeChecker_Util.bind + head2.FStar_Syntax_Syntax.pos env + FStar_Pervasives_Native.None chead1 + (FStar_Pervasives_Native.None, comp)) in + let comp2 = + FStar_TypeChecker_Util.subst_lcomp subst1 comp1 in let shortcuts_evaluation_order = - let uu____9865 = - let uu____9866 = + let uu____10069 = + let uu____10070 = FStar_Syntax_Subst.compress head2 in - uu____9866.FStar_Syntax_Syntax.n in - match uu____9865 with + uu____10070.FStar_Syntax_Syntax.n in + match uu____10069 with | FStar_Syntax_Syntax.Tm_fvar fv -> (FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.op_And) || (FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.op_Or) - | uu____9870 -> false in + | uu____10074 -> false in let app = if shortcuts_evaluation_order then let args1 = FStar_List.fold_left (fun args1 -> - fun uu____9891 -> - match uu____9891 with - | (arg,uu____9905,uu____9906) -> arg - :: args1) [] arg_comps_rev in + fun uu____10095 -> + match uu____10095 with + | (arg,uu____10109,uu____10110) -> + arg :: args1) [] arg_comps_rev in let app = FStar_Syntax_Syntax.mk_Tm_app head2 args1 FStar_Pervasives_Native.None r in let app1 = FStar_TypeChecker_Util.maybe_lift env app cres3.FStar_Syntax_Syntax.eff_name - comp1.FStar_Syntax_Syntax.eff_name - comp1.FStar_Syntax_Syntax.res_typ in + comp2.FStar_Syntax_Syntax.eff_name + comp2.FStar_Syntax_Syntax.res_typ in FStar_TypeChecker_Util.maybe_monadic env app1 - comp1.FStar_Syntax_Syntax.eff_name - comp1.FStar_Syntax_Syntax.res_typ + comp2.FStar_Syntax_Syntax.eff_name + comp2.FStar_Syntax_Syntax.res_typ else - (let uu____9916 = - let map_fun uu____9978 = - match uu____9978 with - | ((e,q),uu____10013,c) -> - let uu____10023 = + (let uu____10120 = + let map_fun uu____10182 = + match uu____10182 with + | ((e,q),uu____10217,c) -> + let uu____10227 = FStar_Syntax_Util.is_pure_or_ghost_lcomp c in - if uu____10023 + if uu____10227 then (FStar_Pervasives_Native.None, (e, q)) @@ -4127,45 +4144,45 @@ and check_application_args: FStar_TypeChecker_Util.maybe_lift env e c.FStar_Syntax_Syntax.eff_name - comp1.FStar_Syntax_Syntax.eff_name + comp2.FStar_Syntax_Syntax.eff_name c.FStar_Syntax_Syntax.res_typ in - let uu____10073 = - let uu____10078 = + let uu____10277 = + let uu____10282 = FStar_Syntax_Syntax.bv_to_name x in - (uu____10078, q) in + (uu____10282, q) in ((FStar_Pervasives_Native.Some (x, (c.FStar_Syntax_Syntax.eff_name), (c.FStar_Syntax_Syntax.res_typ), - e1)), uu____10073)) in - let uu____10107 = - let uu____10132 = - let uu____10155 = - let uu____10170 = - let uu____10179 = + e1)), uu____10277)) in + let uu____10311 = + let uu____10336 = + let uu____10359 = + let uu____10374 = + let uu____10383 = FStar_Syntax_Syntax.as_arg head2 in - (uu____10179, + (uu____10383, FStar_Pervasives_Native.None, chead1) in - uu____10170 :: arg_comps_rev in - FStar_List.map map_fun uu____10155 in + uu____10374 :: arg_comps_rev in + FStar_List.map map_fun uu____10359 in FStar_All.pipe_left FStar_List.split - uu____10132 in - match uu____10107 with + uu____10336 in + match uu____10311 with | (lifted_args,reverse_args) -> - let uu____10352 = - let uu____10353 = + let uu____10556 = + let uu____10557 = FStar_List.hd reverse_args in FStar_Pervasives_Native.fst - uu____10353 in - let uu____10362 = - let uu____10369 = + uu____10557 in + let uu____10566 = + let uu____10573 = FStar_List.tl reverse_args in - FStar_List.rev uu____10369 in - (lifted_args, uu____10352, - uu____10362) in - match uu____9916 with + FStar_List.rev uu____10573 in + (lifted_args, uu____10556, + uu____10566) in + match uu____10120 with | (lifted_args,head3,args1) -> let app = FStar_Syntax_Syntax.mk_Tm_app head3 @@ -4174,15 +4191,15 @@ and check_application_args: FStar_TypeChecker_Util.maybe_lift env app cres3.FStar_Syntax_Syntax.eff_name - comp1.FStar_Syntax_Syntax.eff_name - comp1.FStar_Syntax_Syntax.res_typ in + comp2.FStar_Syntax_Syntax.eff_name + comp2.FStar_Syntax_Syntax.res_typ in let app2 = FStar_TypeChecker_Util.maybe_monadic env app1 - comp1.FStar_Syntax_Syntax.eff_name - comp1.FStar_Syntax_Syntax.res_typ in - let bind_lifted_args e uu___63_10472 = - match uu___63_10472 with + comp2.FStar_Syntax_Syntax.eff_name + comp2.FStar_Syntax_Syntax.res_typ in + let bind_lifted_args e uu___63_10676 = + match uu___63_10676 with | FStar_Pervasives_Native.None -> e | FStar_Pervasives_Native.Some (x,m,t,e1) -> @@ -4190,24 +4207,24 @@ and check_application_args: FStar_Syntax_Util.mk_letbinding (FStar_Util.Inl x) [] t m e1 in let letbinding = - let uu____10527 = - let uu____10530 = - let uu____10531 = - let uu____10544 = - let uu____10545 = - let uu____10546 = + let uu____10731 = + let uu____10734 = + let uu____10735 = + let uu____10748 = + let uu____10749 = + let uu____10750 = FStar_Syntax_Syntax.mk_binder x in - [uu____10546] in + [uu____10750] in FStar_Syntax_Subst.close - uu____10545 e in + uu____10749 e in ((false, [lb]), - uu____10544) in + uu____10748) in FStar_Syntax_Syntax.Tm_let - uu____10531 in + uu____10735 in FStar_Syntax_Syntax.mk - uu____10530 in - uu____10527 + uu____10734 in + uu____10731 FStar_Pervasives_Native.None e.FStar_Syntax_Syntax.pos in FStar_Syntax_Syntax.mk @@ -4215,24 +4232,39 @@ and check_application_args: (letbinding, (FStar_Syntax_Syntax.Meta_monadic (m, - (comp1.FStar_Syntax_Syntax.res_typ))))) + (comp2.FStar_Syntax_Syntax.res_typ))))) FStar_Pervasives_Native.None e.FStar_Syntax_Syntax.pos in FStar_List.fold_left bind_lifted_args app2 lifted_args) in - let uu____10576 = + let uu____10780 = FStar_TypeChecker_Util.strengthen_precondition - FStar_Pervasives_Native.None env app comp1 + FStar_Pervasives_Native.None env app comp2 guard1 in - match uu____10576 with - | (comp2,g) -> (app, comp2, g)))) in - let rec tc_args head_info uu____10665 bs args1 = - match uu____10665 with + match uu____10780 with + | (comp3,g) -> + ((let uu____10796 = + FStar_TypeChecker_Env.debug env + FStar_Options.Extreme in + if uu____10796 + then + let uu____10797 = + FStar_Syntax_Print.term_to_string app in + let uu____10798 = + FStar_Syntax_Print.lcomp_to_string + comp3 in + FStar_Util.print2 + "(d) Monadic app: type of app\n\t(%s)\n\t: %s\n" + uu____10797 uu____10798 + else ()); + (app, comp3, g))))) in + let rec tc_args head_info uu____10874 bs args1 = + match uu____10874 with | (subst1,outargs,arg_rets,g,fvs) -> (match (bs, args1) with | ((x,FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.Implicit uu____10808))::rest, - (uu____10810,FStar_Pervasives_Native.None )::uu____10811) + (FStar_Syntax_Syntax.Implicit uu____11017))::rest, + (uu____11019,FStar_Pervasives_Native.None )::uu____11020) -> let t = FStar_Syntax_Subst.subst subst1 @@ -4240,89 +4272,89 @@ and check_application_args: let t1 = check_no_escape (FStar_Pervasives_Native.Some head1) env fvs t in - let uu____10862 = + let uu____11071 = FStar_TypeChecker_Util.new_implicit_var "Instantiating implicit argument in application" head1.FStar_Syntax_Syntax.pos env t1 in - (match uu____10862 with - | (varg,uu____10882,implicits) -> + (match uu____11071 with + | (varg,uu____11091,implicits) -> let subst2 = (FStar_Syntax_Syntax.NT (x, varg)) :: subst1 in let arg = - let uu____10904 = + let uu____11113 = FStar_Syntax_Syntax.as_implicit true in - (varg, uu____10904) in - let uu____10905 = - let uu____10940 = - let uu____10955 = - let uu____10968 = - let uu____10969 = + (varg, uu____11113) in + let uu____11114 = + let uu____11149 = + let uu____11164 = + let uu____11177 = + let uu____11178 = FStar_Syntax_Syntax.mk_Total t1 in - FStar_All.pipe_right uu____10969 + FStar_All.pipe_right uu____11178 FStar_Syntax_Util.lcomp_of_comp in (arg, FStar_Pervasives_Native.None, - uu____10968) in - uu____10955 :: outargs in - let uu____10988 = + uu____11177) in + uu____11164 :: outargs in + let uu____11197 = FStar_TypeChecker_Rel.conj_guard implicits g in - (subst2, uu____10940, (arg :: arg_rets), - uu____10988, fvs) in - tc_args head_info uu____10905 rest args1) + (subst2, uu____11149, (arg :: arg_rets), + uu____11197, fvs) in + tc_args head_info uu____11114 rest args1) | ((x,aqual)::rest,(e,aq)::rest') -> ((match (aqual, aq) with | (FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Implicit - uu____11080),FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.Implicit uu____11081)) -> + uu____11289),FStar_Pervasives_Native.Some + (FStar_Syntax_Syntax.Implicit uu____11290)) -> () | (FStar_Pervasives_Native.None ,FStar_Pervasives_Native.None ) -> () | (FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Equality ),FStar_Pervasives_Native.None ) -> () - | uu____11094 -> - let uu____11103 = - let uu____11108 = - let uu____11109 = + | uu____11303 -> + let uu____11312 = + let uu____11317 = + let uu____11318 = FStar_Syntax_Print.aqual_to_string aqual in - let uu____11110 = + let uu____11319 = FStar_Syntax_Print.aqual_to_string aq in - let uu____11111 = + let uu____11320 = FStar_Syntax_Print.bv_to_string x in - let uu____11112 = + let uu____11321 = FStar_Syntax_Print.term_to_string e in FStar_Util.format4 "Inconsistent implicit qualifier; %s vs %s\nfor bvar %s and term %s" - uu____11109 uu____11110 uu____11111 - uu____11112 in + uu____11318 uu____11319 uu____11320 + uu____11321 in (FStar_Errors.Fatal_InconsistentImplicitQualifier, - uu____11108) in - FStar_Errors.raise_error uu____11103 + uu____11317) in + FStar_Errors.raise_error uu____11312 e.FStar_Syntax_Syntax.pos); (let targ = FStar_Syntax_Subst.subst subst1 x.FStar_Syntax_Syntax.sort in let x1 = - let uu___91_11115 = x in + let uu___90_11324 = x in { FStar_Syntax_Syntax.ppname = - (uu___91_11115.FStar_Syntax_Syntax.ppname); + (uu___90_11324.FStar_Syntax_Syntax.ppname); FStar_Syntax_Syntax.index = - (uu___91_11115.FStar_Syntax_Syntax.index); + (uu___90_11324.FStar_Syntax_Syntax.index); FStar_Syntax_Syntax.sort = targ } in - (let uu____11117 = + (let uu____11326 = FStar_TypeChecker_Env.debug env FStar_Options.Extreme in - if uu____11117 + if uu____11326 then - let uu____11118 = + let uu____11327 = FStar_Syntax_Print.term_to_string targ in FStar_Util.print1 "\tType of arg (after subst) = %s\n" - uu____11118 + uu____11327 else ()); (let targ1 = check_no_escape @@ -4332,116 +4364,116 @@ and check_application_args: FStar_TypeChecker_Env.set_expected_typ env targ1 in let env2 = - let uu___92_11123 = env1 in + let uu___91_11332 = env1 in { FStar_TypeChecker_Env.solver = - (uu___92_11123.FStar_TypeChecker_Env.solver); + (uu___91_11332.FStar_TypeChecker_Env.solver); FStar_TypeChecker_Env.range = - (uu___92_11123.FStar_TypeChecker_Env.range); + (uu___91_11332.FStar_TypeChecker_Env.range); FStar_TypeChecker_Env.curmodule = - (uu___92_11123.FStar_TypeChecker_Env.curmodule); + (uu___91_11332.FStar_TypeChecker_Env.curmodule); FStar_TypeChecker_Env.gamma = - (uu___92_11123.FStar_TypeChecker_Env.gamma); + (uu___91_11332.FStar_TypeChecker_Env.gamma); FStar_TypeChecker_Env.gamma_cache = - (uu___92_11123.FStar_TypeChecker_Env.gamma_cache); + (uu___91_11332.FStar_TypeChecker_Env.gamma_cache); FStar_TypeChecker_Env.modules = - (uu___92_11123.FStar_TypeChecker_Env.modules); + (uu___91_11332.FStar_TypeChecker_Env.modules); FStar_TypeChecker_Env.expected_typ = - (uu___92_11123.FStar_TypeChecker_Env.expected_typ); + (uu___91_11332.FStar_TypeChecker_Env.expected_typ); FStar_TypeChecker_Env.sigtab = - (uu___92_11123.FStar_TypeChecker_Env.sigtab); + (uu___91_11332.FStar_TypeChecker_Env.sigtab); FStar_TypeChecker_Env.is_pattern = - (uu___92_11123.FStar_TypeChecker_Env.is_pattern); + (uu___91_11332.FStar_TypeChecker_Env.is_pattern); FStar_TypeChecker_Env.instantiate_imp = - (uu___92_11123.FStar_TypeChecker_Env.instantiate_imp); + (uu___91_11332.FStar_TypeChecker_Env.instantiate_imp); FStar_TypeChecker_Env.effects = - (uu___92_11123.FStar_TypeChecker_Env.effects); + (uu___91_11332.FStar_TypeChecker_Env.effects); FStar_TypeChecker_Env.generalize = - (uu___92_11123.FStar_TypeChecker_Env.generalize); + (uu___91_11332.FStar_TypeChecker_Env.generalize); FStar_TypeChecker_Env.letrecs = - (uu___92_11123.FStar_TypeChecker_Env.letrecs); + (uu___91_11332.FStar_TypeChecker_Env.letrecs); FStar_TypeChecker_Env.top_level = - (uu___92_11123.FStar_TypeChecker_Env.top_level); + (uu___91_11332.FStar_TypeChecker_Env.top_level); FStar_TypeChecker_Env.check_uvars = - (uu___92_11123.FStar_TypeChecker_Env.check_uvars); + (uu___91_11332.FStar_TypeChecker_Env.check_uvars); FStar_TypeChecker_Env.use_eq = (is_eq aqual); FStar_TypeChecker_Env.is_iface = - (uu___92_11123.FStar_TypeChecker_Env.is_iface); + (uu___91_11332.FStar_TypeChecker_Env.is_iface); FStar_TypeChecker_Env.admit = - (uu___92_11123.FStar_TypeChecker_Env.admit); + (uu___91_11332.FStar_TypeChecker_Env.admit); FStar_TypeChecker_Env.lax = - (uu___92_11123.FStar_TypeChecker_Env.lax); + (uu___91_11332.FStar_TypeChecker_Env.lax); FStar_TypeChecker_Env.lax_universes = - (uu___92_11123.FStar_TypeChecker_Env.lax_universes); + (uu___91_11332.FStar_TypeChecker_Env.lax_universes); FStar_TypeChecker_Env.failhard = - (uu___92_11123.FStar_TypeChecker_Env.failhard); + (uu___91_11332.FStar_TypeChecker_Env.failhard); FStar_TypeChecker_Env.nosynth = - (uu___92_11123.FStar_TypeChecker_Env.nosynth); + (uu___91_11332.FStar_TypeChecker_Env.nosynth); FStar_TypeChecker_Env.tc_term = - (uu___92_11123.FStar_TypeChecker_Env.tc_term); + (uu___91_11332.FStar_TypeChecker_Env.tc_term); FStar_TypeChecker_Env.type_of = - (uu___92_11123.FStar_TypeChecker_Env.type_of); + (uu___91_11332.FStar_TypeChecker_Env.type_of); FStar_TypeChecker_Env.universe_of = - (uu___92_11123.FStar_TypeChecker_Env.universe_of); + (uu___91_11332.FStar_TypeChecker_Env.universe_of); FStar_TypeChecker_Env.use_bv_sorts = - (uu___92_11123.FStar_TypeChecker_Env.use_bv_sorts); + (uu___91_11332.FStar_TypeChecker_Env.use_bv_sorts); FStar_TypeChecker_Env.qname_and_index = - (uu___92_11123.FStar_TypeChecker_Env.qname_and_index); + (uu___91_11332.FStar_TypeChecker_Env.qname_and_index); FStar_TypeChecker_Env.proof_ns = - (uu___92_11123.FStar_TypeChecker_Env.proof_ns); + (uu___91_11332.FStar_TypeChecker_Env.proof_ns); FStar_TypeChecker_Env.synth = - (uu___92_11123.FStar_TypeChecker_Env.synth); + (uu___91_11332.FStar_TypeChecker_Env.synth); FStar_TypeChecker_Env.is_native_tactic = - (uu___92_11123.FStar_TypeChecker_Env.is_native_tactic); + (uu___91_11332.FStar_TypeChecker_Env.is_native_tactic); FStar_TypeChecker_Env.identifier_info = - (uu___92_11123.FStar_TypeChecker_Env.identifier_info); + (uu___91_11332.FStar_TypeChecker_Env.identifier_info); FStar_TypeChecker_Env.tc_hooks = - (uu___92_11123.FStar_TypeChecker_Env.tc_hooks); + (uu___91_11332.FStar_TypeChecker_Env.tc_hooks); FStar_TypeChecker_Env.dsenv = - (uu___92_11123.FStar_TypeChecker_Env.dsenv); + (uu___91_11332.FStar_TypeChecker_Env.dsenv); FStar_TypeChecker_Env.dep_graph = - (uu___92_11123.FStar_TypeChecker_Env.dep_graph) + (uu___91_11332.FStar_TypeChecker_Env.dep_graph) } in - (let uu____11125 = + (let uu____11334 = FStar_TypeChecker_Env.debug env2 FStar_Options.High in - if uu____11125 + if uu____11334 then - let uu____11126 = + let uu____11335 = FStar_Syntax_Print.tag_of_term e in - let uu____11127 = + let uu____11336 = FStar_Syntax_Print.term_to_string e in - let uu____11128 = + let uu____11337 = FStar_Syntax_Print.term_to_string targ1 in FStar_Util.print3 "Checking arg (%s) %s at type %s\n" - uu____11126 uu____11127 uu____11128 + uu____11335 uu____11336 uu____11337 else ()); - (let uu____11130 = tc_term env2 e in - match uu____11130 with + (let uu____11339 = tc_term env2 e in + match uu____11339 with | (e1,c,g_e) -> let g1 = FStar_TypeChecker_Rel.conj_guard g g_e in let arg = (e1, aq) in let xterm = - let uu____11165 = - let uu____11168 = - let uu____11175 = + let uu____11374 = + let uu____11377 = + let uu____11384 = FStar_Syntax_Syntax.bv_to_name x1 in FStar_Syntax_Syntax.as_arg - uu____11175 in - FStar_Pervasives_Native.fst uu____11168 in - (uu____11165, aq) in - let uu____11182 = + uu____11384 in + FStar_Pervasives_Native.fst uu____11377 in + (uu____11374, aq) in + let uu____11391 = (FStar_Syntax_Util.is_tot_or_gtot_lcomp c) || (FStar_TypeChecker_Util.is_pure_or_ghost_effect env2 c.FStar_Syntax_Syntax.eff_name) in - if uu____11182 + if uu____11391 then let subst2 = - let uu____11190 = FStar_List.hd bs in - maybe_extend_subst subst1 uu____11190 + let uu____11399 = FStar_List.hd bs in + maybe_extend_subst subst1 uu____11399 e1 in tc_args head_info (subst2, @@ -4457,36 +4489,38 @@ and check_application_args: c) :: outargs), (xterm :: arg_rets), g1, (x1 :: fvs)) rest rest')))) - | (uu____11316,[]) -> + | (uu____11525,[]) -> monadic_application head_info subst1 outargs arg_rets g fvs bs - | ([],arg::uu____11348) -> - let uu____11391 = + | ([],arg::uu____11557) -> + let uu____11600 = monadic_application head_info subst1 outargs arg_rets g fvs [] in - (match uu____11391 with + (match uu____11600 with | (head2,chead1,ghead1) -> let rec aux norm1 tres = let tres1 = - let uu____11425 = + let uu____11634 = FStar_Syntax_Subst.compress tres in - FStar_All.pipe_right uu____11425 + FStar_All.pipe_right uu____11634 FStar_Syntax_Util.unrefine in match tres1.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Tm_arrow (bs1,cres') -> - let uu____11450 = + let uu____11659 = FStar_Syntax_Subst.open_comp bs1 cres' in - (match uu____11450 with + (match uu____11659 with | (bs2,cres'1) -> let head_info1 = + let uu____11681 = + FStar_Syntax_Util.lcomp_of_comp + cres'1 in (head2, chead1, ghead1, - (FStar_Syntax_Util.lcomp_of_comp - cres'1)) in - ((let uu____11473 = + uu____11681) in + ((let uu____11683 = FStar_TypeChecker_Env.debug env FStar_Options.Low in - if uu____11473 + if uu____11683 then FStar_Errors.log_issue tres1.FStar_Syntax_Syntax.pos @@ -4497,249 +4531,250 @@ and check_application_args: ([], [], [], FStar_TypeChecker_Rel.trivial_guard, []) bs2 args1)) - | uu____11515 when Prims.op_Negation norm1 + | uu____11725 when Prims.op_Negation norm1 -> let rec norm_tres tres2 = let tres3 = FStar_TypeChecker_Normalize.unfold_whnf env tres2 in - let uu____11521 = - let uu____11522 = + let uu____11731 = + let uu____11732 = FStar_Syntax_Subst.compress tres3 in - uu____11522.FStar_Syntax_Syntax.n in - match uu____11521 with + uu____11732.FStar_Syntax_Syntax.n in + match uu____11731 with | FStar_Syntax_Syntax.Tm_refine ({ FStar_Syntax_Syntax.ppname = - uu____11525; + uu____11735; FStar_Syntax_Syntax.index = - uu____11526; + uu____11736; FStar_Syntax_Syntax.sort = - tres4;_},uu____11528) + tres4;_},uu____11738) -> norm_tres tres4 - | uu____11535 -> tres3 in - let uu____11536 = norm_tres tres1 in - aux true uu____11536 - | uu____11537 -> - let uu____11538 = - let uu____11543 = - let uu____11544 = + | uu____11745 -> tres3 in + let uu____11746 = norm_tres tres1 in + aux true uu____11746 + | uu____11747 -> + let uu____11748 = + let uu____11753 = + let uu____11754 = FStar_TypeChecker_Normalize.term_to_string env thead in - let uu____11545 = + let uu____11755 = FStar_Util.string_of_int n_args in FStar_Util.format2 "Too many arguments to function of type %s; got %s arguments" - uu____11544 uu____11545 in + uu____11754 uu____11755 in (FStar_Errors.Fatal_ToManyArgumentToFunction, - uu____11543) in - let uu____11552 = + uu____11753) in + let uu____11762 = FStar_Syntax_Syntax.argpos arg in - FStar_Errors.raise_error uu____11538 - uu____11552 in + FStar_Errors.raise_error uu____11748 + uu____11762 in aux false chead1.FStar_Syntax_Syntax.res_typ)) in let rec check_function_app tf = - let uu____11571 = - let uu____11572 = + let uu____11781 = + let uu____11782 = FStar_TypeChecker_Normalize.unfold_whnf env tf in - uu____11572.FStar_Syntax_Syntax.n in - match uu____11571 with - | FStar_Syntax_Syntax.Tm_uvar uu____11583 -> + uu____11782.FStar_Syntax_Syntax.n in + match uu____11781 with + | FStar_Syntax_Syntax.Tm_uvar uu____11793 -> let rec tc_args1 env1 args1 = match args1 with | [] -> ([], [], FStar_TypeChecker_Rel.trivial_guard) | (e,imp)::tl1 -> - let uu____11684 = tc_term env1 e in - (match uu____11684 with + let uu____11894 = tc_term env1 e in + (match uu____11894 with | (e1,c,g_e) -> - let uu____11706 = tc_args1 env1 tl1 in - (match uu____11706 with + let uu____11916 = tc_args1 env1 tl1 in + (match uu____11916 with | (args2,comps,g_rest) -> - let uu____11746 = + let uu____11956 = FStar_TypeChecker_Rel.conj_guard g_e g_rest in (((e1, imp) :: args2), (((e1.FStar_Syntax_Syntax.pos), c) :: - comps), uu____11746))) in - let uu____11767 = tc_args1 env args in - (match uu____11767 with + comps), uu____11956))) in + let uu____11977 = tc_args1 env args in + (match uu____11977 with | (args1,comps,g_args) -> let bs = - let uu____11804 = + let uu____12014 = FStar_All.pipe_right comps (FStar_List.map - (fun uu____11842 -> - match uu____11842 with - | (uu____11855,c) -> + (fun uu____12052 -> + match uu____12052 with + | (uu____12065,c) -> ((c.FStar_Syntax_Syntax.res_typ), FStar_Pervasives_Native.None))) in - FStar_Syntax_Util.null_binders_of_tks uu____11804 in + FStar_Syntax_Util.null_binders_of_tks uu____12014 in let ml_or_tot t r1 = - let uu____11872 = FStar_Options.ml_ish () in - if uu____11872 + let uu____12082 = FStar_Options.ml_ish () in + if uu____12082 then FStar_Syntax_Util.ml_comp t r1 else FStar_Syntax_Syntax.mk_Total t in let cres = - let uu____11875 = - let uu____11878 = - let uu____11879 = FStar_Syntax_Util.type_u () in - FStar_All.pipe_right uu____11879 + let uu____12085 = + let uu____12088 = + let uu____12089 = FStar_Syntax_Util.type_u () in + FStar_All.pipe_right uu____12089 FStar_Pervasives_Native.fst in - FStar_TypeChecker_Util.new_uvar env uu____11878 in - ml_or_tot uu____11875 r in + FStar_TypeChecker_Util.new_uvar env uu____12088 in + ml_or_tot uu____12085 r in let bs_cres = FStar_Syntax_Util.arrow bs cres in - ((let uu____11892 = + ((let uu____12102 = FStar_All.pipe_left (FStar_TypeChecker_Env.debug env) FStar_Options.Extreme in - if uu____11892 + if uu____12102 then - let uu____11893 = + let uu____12103 = FStar_Syntax_Print.term_to_string head1 in - let uu____11894 = + let uu____12104 = FStar_Syntax_Print.term_to_string tf in - let uu____11895 = + let uu____12105 = FStar_Syntax_Print.term_to_string bs_cres in FStar_Util.print3 "Forcing the type of %s from %s to %s\n" - uu____11893 uu____11894 uu____11895 + uu____12103 uu____12104 uu____12105 else ()); - (let uu____11898 = + (let uu____12108 = FStar_TypeChecker_Rel.teq env tf bs_cres in FStar_All.pipe_left (FStar_TypeChecker_Rel.force_trivial_guard env) - uu____11898); + uu____12108); (let comp = - let uu____11900 = + let uu____12110 = FStar_All.pipe_left FStar_Syntax_Util.lcomp_of_comp cres in FStar_List.fold_right - (fun uu____11911 -> + (fun uu____12121 -> fun out -> - match uu____11911 with + match uu____12121 with | (r1,c) -> FStar_TypeChecker_Util.bind r1 env FStar_Pervasives_Native.None c (FStar_Pervasives_Native.None, out)) (((head1.FStar_Syntax_Syntax.pos), chead) :: - comps) uu____11900 in - let uu____11925 = + comps) uu____12110 in + let uu____12135 = FStar_Syntax_Syntax.mk_Tm_app head1 args1 FStar_Pervasives_Native.None r in - let uu____11928 = + let uu____12138 = FStar_TypeChecker_Rel.conj_guard ghead g_args in - (uu____11925, comp, uu____11928)))) + (uu____12135, comp, uu____12138)))) | FStar_Syntax_Syntax.Tm_app ({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_uvar - uu____11931; - FStar_Syntax_Syntax.pos = uu____11932; - FStar_Syntax_Syntax.vars = uu____11933;_},uu____11934) + uu____12141; + FStar_Syntax_Syntax.pos = uu____12142; + FStar_Syntax_Syntax.vars = uu____12143;_},uu____12144) -> let rec tc_args1 env1 args1 = match args1 with | [] -> ([], [], FStar_TypeChecker_Rel.trivial_guard) | (e,imp)::tl1 -> - let uu____12055 = tc_term env1 e in - (match uu____12055 with + let uu____12265 = tc_term env1 e in + (match uu____12265 with | (e1,c,g_e) -> - let uu____12077 = tc_args1 env1 tl1 in - (match uu____12077 with + let uu____12287 = tc_args1 env1 tl1 in + (match uu____12287 with | (args2,comps,g_rest) -> - let uu____12117 = + let uu____12327 = FStar_TypeChecker_Rel.conj_guard g_e g_rest in (((e1, imp) :: args2), (((e1.FStar_Syntax_Syntax.pos), c) :: - comps), uu____12117))) in - let uu____12138 = tc_args1 env args in - (match uu____12138 with + comps), uu____12327))) in + let uu____12348 = tc_args1 env args in + (match uu____12348 with | (args1,comps,g_args) -> let bs = - let uu____12175 = + let uu____12385 = FStar_All.pipe_right comps (FStar_List.map - (fun uu____12213 -> - match uu____12213 with - | (uu____12226,c) -> + (fun uu____12423 -> + match uu____12423 with + | (uu____12436,c) -> ((c.FStar_Syntax_Syntax.res_typ), FStar_Pervasives_Native.None))) in - FStar_Syntax_Util.null_binders_of_tks uu____12175 in + FStar_Syntax_Util.null_binders_of_tks uu____12385 in let ml_or_tot t r1 = - let uu____12243 = FStar_Options.ml_ish () in - if uu____12243 + let uu____12453 = FStar_Options.ml_ish () in + if uu____12453 then FStar_Syntax_Util.ml_comp t r1 else FStar_Syntax_Syntax.mk_Total t in let cres = - let uu____12246 = - let uu____12249 = - let uu____12250 = FStar_Syntax_Util.type_u () in - FStar_All.pipe_right uu____12250 + let uu____12456 = + let uu____12459 = + let uu____12460 = FStar_Syntax_Util.type_u () in + FStar_All.pipe_right uu____12460 FStar_Pervasives_Native.fst in - FStar_TypeChecker_Util.new_uvar env uu____12249 in - ml_or_tot uu____12246 r in + FStar_TypeChecker_Util.new_uvar env uu____12459 in + ml_or_tot uu____12456 r in let bs_cres = FStar_Syntax_Util.arrow bs cres in - ((let uu____12263 = + ((let uu____12473 = FStar_All.pipe_left (FStar_TypeChecker_Env.debug env) FStar_Options.Extreme in - if uu____12263 + if uu____12473 then - let uu____12264 = + let uu____12474 = FStar_Syntax_Print.term_to_string head1 in - let uu____12265 = + let uu____12475 = FStar_Syntax_Print.term_to_string tf in - let uu____12266 = + let uu____12476 = FStar_Syntax_Print.term_to_string bs_cres in FStar_Util.print3 "Forcing the type of %s from %s to %s\n" - uu____12264 uu____12265 uu____12266 + uu____12474 uu____12475 uu____12476 else ()); - (let uu____12269 = + (let uu____12479 = FStar_TypeChecker_Rel.teq env tf bs_cres in FStar_All.pipe_left (FStar_TypeChecker_Rel.force_trivial_guard env) - uu____12269); + uu____12479); (let comp = - let uu____12271 = + let uu____12481 = FStar_All.pipe_left FStar_Syntax_Util.lcomp_of_comp cres in FStar_List.fold_right - (fun uu____12282 -> + (fun uu____12492 -> fun out -> - match uu____12282 with + match uu____12492 with | (r1,c) -> FStar_TypeChecker_Util.bind r1 env FStar_Pervasives_Native.None c (FStar_Pervasives_Native.None, out)) (((head1.FStar_Syntax_Syntax.pos), chead) :: - comps) uu____12271 in - let uu____12296 = + comps) uu____12481 in + let uu____12506 = FStar_Syntax_Syntax.mk_Tm_app head1 args1 FStar_Pervasives_Native.None r in - let uu____12299 = + let uu____12509 = FStar_TypeChecker_Rel.conj_guard ghead g_args in - (uu____12296, comp, uu____12299)))) + (uu____12506, comp, uu____12509)))) | FStar_Syntax_Syntax.Tm_arrow (bs,c) -> - let uu____12320 = FStar_Syntax_Subst.open_comp bs c in - (match uu____12320 with + let uu____12530 = FStar_Syntax_Subst.open_comp bs c in + (match uu____12530 with | (bs1,c1) -> let head_info = - (head1, chead, ghead, - (FStar_Syntax_Util.lcomp_of_comp c1)) in + let uu____12554 = + FStar_Syntax_Util.lcomp_of_comp c1 in + (head1, chead, ghead, uu____12554) in tc_args head_info ([], [], [], FStar_TypeChecker_Rel.trivial_guard, []) bs1 args) - | FStar_Syntax_Syntax.Tm_refine (bv,uu____12385) -> + | FStar_Syntax_Syntax.Tm_refine (bv,uu____12596) -> check_function_app bv.FStar_Syntax_Syntax.sort | FStar_Syntax_Syntax.Tm_ascribed - (t,uu____12391,uu____12392) -> check_function_app t - | uu____12433 -> - let uu____12434 = + (t,uu____12602,uu____12603) -> check_function_app t + | uu____12644 -> + let uu____12645 = FStar_TypeChecker_Err.expected_function_typ env tf in - FStar_Errors.raise_error uu____12434 + FStar_Errors.raise_error uu____12645 head1.FStar_Syntax_Syntax.pos in check_function_app thead) and check_short_circuit_args: @@ -4768,12 +4803,12 @@ and check_short_circuit_args: ((FStar_List.length bs) = (FStar_List.length args)) -> let res_t = FStar_Syntax_Util.comp_result c in - let uu____12508 = + let uu____12719 = FStar_List.fold_left2 - (fun uu____12551 -> - fun uu____12552 -> - fun uu____12553 -> - match (uu____12551, uu____12552, uu____12553) + (fun uu____12762 -> + fun uu____12763 -> + fun uu____12764 -> + match (uu____12762, uu____12763, uu____12764) with | ((seen,guard,ghost),(e,aq),(b,aq')) -> (if aq <> aq' @@ -4783,44 +4818,44 @@ and check_short_circuit_args: "Inconsistent implicit qualifiers") e.FStar_Syntax_Syntax.pos else (); - (let uu____12621 = + (let uu____12832 = tc_check_tot_or_gtot_term env e b.FStar_Syntax_Syntax.sort in - match uu____12621 with + match uu____12832 with | (e1,c1,g) -> let short = FStar_TypeChecker_Util.short_circuit head1 seen in let g1 = - let uu____12639 = + let uu____12850 = FStar_TypeChecker_Rel.guard_of_guard_formula short in FStar_TypeChecker_Rel.imp_guard - uu____12639 g in + uu____12850 g in let ghost1 = ghost || - ((let uu____12643 = + ((let uu____12854 = FStar_Syntax_Util.is_total_lcomp c1 in - Prims.op_Negation uu____12643) + Prims.op_Negation uu____12854) && - (let uu____12645 = + (let uu____12856 = FStar_TypeChecker_Util.is_pure_effect env c1.FStar_Syntax_Syntax.eff_name in - Prims.op_Negation uu____12645)) in - let uu____12646 = - let uu____12655 = - let uu____12664 = + Prims.op_Negation uu____12856)) in + let uu____12857 = + let uu____12866 = + let uu____12875 = FStar_Syntax_Syntax.as_arg e1 in - [uu____12664] in - FStar_List.append seen uu____12655 in - let uu____12671 = + [uu____12875] in + FStar_List.append seen uu____12866 in + let uu____12882 = FStar_TypeChecker_Rel.conj_guard guard g1 in - (uu____12646, uu____12671, ghost1)))) + (uu____12857, uu____12882, ghost1)))) ([], g_head, false) args bs in - (match uu____12508 with + (match uu____12719 with | (args1,guard,ghost) -> let e = FStar_Syntax_Syntax.mk_Tm_app head1 args1 @@ -4828,16 +4863,16 @@ and check_short_circuit_args: let c1 = if ghost then - let uu____12707 = + let uu____12918 = FStar_Syntax_Syntax.mk_GTotal res_t in - FStar_All.pipe_right uu____12707 + FStar_All.pipe_right uu____12918 FStar_Syntax_Util.lcomp_of_comp else FStar_Syntax_Util.lcomp_of_comp c in - let uu____12709 = + let uu____12920 = FStar_TypeChecker_Util.strengthen_precondition FStar_Pervasives_Native.None env e c1 guard in - (match uu____12709 with | (c2,g) -> (e, c2, g))) - | uu____12726 -> + (match uu____12920 with | (c2,g) -> (e, c2, g))) + | uu____12937 -> check_application_args env head1 chead g_head args expected_topt and tc_eqn: @@ -4850,185 +4885,187 @@ and tc_eqn: FStar_Pervasives_Native.tuple3 -> ((FStar_Syntax_Syntax.pat,FStar_Syntax_Syntax.term FStar_Pervasives_Native.option,FStar_Syntax_Syntax.term) - FStar_Pervasives_Native.tuple3,FStar_Syntax_Syntax.term,FStar_Syntax_Syntax.lcomp, - FStar_TypeChecker_Env.guard_t) FStar_Pervasives_Native.tuple4 + FStar_Pervasives_Native.tuple3,FStar_Syntax_Syntax.term,FStar_Ident.lident, + FStar_Syntax_Syntax.cflags Prims.list,Prims.bool -> + FStar_Syntax_Syntax.lcomp, + FStar_TypeChecker_Env.guard_t) FStar_Pervasives_Native.tuple6 = fun scrutinee -> fun env -> fun branch1 -> - let uu____12760 = FStar_Syntax_Subst.open_branch branch1 in - match uu____12760 with + let uu____12979 = FStar_Syntax_Subst.open_branch branch1 in + match uu____12979 with | (pattern,when_clause,branch_exp) -> - let uu____12796 = branch1 in - (match uu____12796 with - | (cpat,uu____12828,cbr) -> + let uu____13023 = branch1 in + (match uu____13023 with + | (cpat,uu____13063,cbr) -> let tc_pat allow_implicits pat_t p0 = let tc_annot env1 t = - let uu____12895 = FStar_Syntax_Util.type_u () in - match uu____12895 with + let uu____13130 = FStar_Syntax_Util.type_u () in + match uu____13130 with | (tu,u) -> - let uu____12906 = + let uu____13141 = tc_check_tot_or_gtot_term env1 t tu in - (match uu____12906 with - | (t1,uu____12918,g) -> (t1, g)) in - let uu____12920 = + (match uu____13141 with + | (t1,uu____13153,g) -> (t1, g)) in + let uu____13155 = FStar_TypeChecker_Util.pat_as_exp allow_implicits env p0 tc_annot in - match uu____12920 with + match uu____13155 with | (pat_bvs1,exp,guard_pat_annots,p) -> - ((let uu____12954 = + ((let uu____13189 = FStar_TypeChecker_Env.debug env FStar_Options.High in - if uu____12954 + if uu____13189 then - let uu____12955 = + let uu____13190 = FStar_Syntax_Print.pat_to_string p0 in - let uu____12956 = + let uu____13191 = FStar_Syntax_Print.pat_to_string p in FStar_Util.print2 "Pattern %s elaborated to %s\n" - uu____12955 uu____12956 + uu____13190 uu____13191 else ()); (let pat_env = FStar_List.fold_left FStar_TypeChecker_Env.push_bv env pat_bvs1 in - let uu____12959 = + let uu____13194 = FStar_TypeChecker_Env.clear_expected_typ pat_env in - match uu____12959 with - | (env1,uu____12981) -> + match uu____13194 with + | (env1,uu____13216) -> let env11 = - let uu___93_12987 = env1 in + let uu___92_13222 = env1 in { FStar_TypeChecker_Env.solver = - (uu___93_12987.FStar_TypeChecker_Env.solver); + (uu___92_13222.FStar_TypeChecker_Env.solver); FStar_TypeChecker_Env.range = - (uu___93_12987.FStar_TypeChecker_Env.range); + (uu___92_13222.FStar_TypeChecker_Env.range); FStar_TypeChecker_Env.curmodule = - (uu___93_12987.FStar_TypeChecker_Env.curmodule); + (uu___92_13222.FStar_TypeChecker_Env.curmodule); FStar_TypeChecker_Env.gamma = - (uu___93_12987.FStar_TypeChecker_Env.gamma); + (uu___92_13222.FStar_TypeChecker_Env.gamma); FStar_TypeChecker_Env.gamma_cache = - (uu___93_12987.FStar_TypeChecker_Env.gamma_cache); + (uu___92_13222.FStar_TypeChecker_Env.gamma_cache); FStar_TypeChecker_Env.modules = - (uu___93_12987.FStar_TypeChecker_Env.modules); + (uu___92_13222.FStar_TypeChecker_Env.modules); FStar_TypeChecker_Env.expected_typ = - (uu___93_12987.FStar_TypeChecker_Env.expected_typ); + (uu___92_13222.FStar_TypeChecker_Env.expected_typ); FStar_TypeChecker_Env.sigtab = - (uu___93_12987.FStar_TypeChecker_Env.sigtab); + (uu___92_13222.FStar_TypeChecker_Env.sigtab); FStar_TypeChecker_Env.is_pattern = true; FStar_TypeChecker_Env.instantiate_imp = - (uu___93_12987.FStar_TypeChecker_Env.instantiate_imp); + (uu___92_13222.FStar_TypeChecker_Env.instantiate_imp); FStar_TypeChecker_Env.effects = - (uu___93_12987.FStar_TypeChecker_Env.effects); + (uu___92_13222.FStar_TypeChecker_Env.effects); FStar_TypeChecker_Env.generalize = - (uu___93_12987.FStar_TypeChecker_Env.generalize); + (uu___92_13222.FStar_TypeChecker_Env.generalize); FStar_TypeChecker_Env.letrecs = - (uu___93_12987.FStar_TypeChecker_Env.letrecs); + (uu___92_13222.FStar_TypeChecker_Env.letrecs); FStar_TypeChecker_Env.top_level = - (uu___93_12987.FStar_TypeChecker_Env.top_level); + (uu___92_13222.FStar_TypeChecker_Env.top_level); FStar_TypeChecker_Env.check_uvars = - (uu___93_12987.FStar_TypeChecker_Env.check_uvars); + (uu___92_13222.FStar_TypeChecker_Env.check_uvars); FStar_TypeChecker_Env.use_eq = - (uu___93_12987.FStar_TypeChecker_Env.use_eq); + (uu___92_13222.FStar_TypeChecker_Env.use_eq); FStar_TypeChecker_Env.is_iface = - (uu___93_12987.FStar_TypeChecker_Env.is_iface); + (uu___92_13222.FStar_TypeChecker_Env.is_iface); FStar_TypeChecker_Env.admit = - (uu___93_12987.FStar_TypeChecker_Env.admit); + (uu___92_13222.FStar_TypeChecker_Env.admit); FStar_TypeChecker_Env.lax = - (uu___93_12987.FStar_TypeChecker_Env.lax); + (uu___92_13222.FStar_TypeChecker_Env.lax); FStar_TypeChecker_Env.lax_universes = - (uu___93_12987.FStar_TypeChecker_Env.lax_universes); + (uu___92_13222.FStar_TypeChecker_Env.lax_universes); FStar_TypeChecker_Env.failhard = - (uu___93_12987.FStar_TypeChecker_Env.failhard); + (uu___92_13222.FStar_TypeChecker_Env.failhard); FStar_TypeChecker_Env.nosynth = - (uu___93_12987.FStar_TypeChecker_Env.nosynth); + (uu___92_13222.FStar_TypeChecker_Env.nosynth); FStar_TypeChecker_Env.tc_term = - (uu___93_12987.FStar_TypeChecker_Env.tc_term); + (uu___92_13222.FStar_TypeChecker_Env.tc_term); FStar_TypeChecker_Env.type_of = - (uu___93_12987.FStar_TypeChecker_Env.type_of); + (uu___92_13222.FStar_TypeChecker_Env.type_of); FStar_TypeChecker_Env.universe_of = - (uu___93_12987.FStar_TypeChecker_Env.universe_of); + (uu___92_13222.FStar_TypeChecker_Env.universe_of); FStar_TypeChecker_Env.use_bv_sorts = - (uu___93_12987.FStar_TypeChecker_Env.use_bv_sorts); + (uu___92_13222.FStar_TypeChecker_Env.use_bv_sorts); FStar_TypeChecker_Env.qname_and_index = - (uu___93_12987.FStar_TypeChecker_Env.qname_and_index); + (uu___92_13222.FStar_TypeChecker_Env.qname_and_index); FStar_TypeChecker_Env.proof_ns = - (uu___93_12987.FStar_TypeChecker_Env.proof_ns); + (uu___92_13222.FStar_TypeChecker_Env.proof_ns); FStar_TypeChecker_Env.synth = - (uu___93_12987.FStar_TypeChecker_Env.synth); + (uu___92_13222.FStar_TypeChecker_Env.synth); FStar_TypeChecker_Env.is_native_tactic = - (uu___93_12987.FStar_TypeChecker_Env.is_native_tactic); + (uu___92_13222.FStar_TypeChecker_Env.is_native_tactic); FStar_TypeChecker_Env.identifier_info = - (uu___93_12987.FStar_TypeChecker_Env.identifier_info); + (uu___92_13222.FStar_TypeChecker_Env.identifier_info); FStar_TypeChecker_Env.tc_hooks = - (uu___93_12987.FStar_TypeChecker_Env.tc_hooks); + (uu___92_13222.FStar_TypeChecker_Env.tc_hooks); FStar_TypeChecker_Env.dsenv = - (uu___93_12987.FStar_TypeChecker_Env.dsenv); + (uu___92_13222.FStar_TypeChecker_Env.dsenv); FStar_TypeChecker_Env.dep_graph = - (uu___93_12987.FStar_TypeChecker_Env.dep_graph) + (uu___92_13222.FStar_TypeChecker_Env.dep_graph) } in let expected_pat_t = FStar_TypeChecker_Rel.unrefine env pat_t in - ((let uu____12990 = + ((let uu____13225 = FStar_TypeChecker_Env.debug env FStar_Options.High in - if uu____12990 + if uu____13225 then - let uu____12991 = + let uu____13226 = FStar_Syntax_Print.term_to_string exp in - let uu____12992 = + let uu____13227 = FStar_Syntax_Print.term_to_string pat_t in FStar_Util.print2 "Checking pattern expression %s against expected type %s\n" - uu____12991 uu____12992 + uu____13226 uu____13227 else ()); (let env12 = FStar_TypeChecker_Env.set_expected_typ env11 expected_pat_t in - let uu____12995 = + let uu____13230 = tc_tot_or_gtot_term env12 exp in - match uu____12995 with + match uu____13230 with | (exp1,lc,g) -> let g1 = - let uu___94_13020 = g in + let uu___93_13255 = g in { FStar_TypeChecker_Env.guard_f = FStar_TypeChecker_Common.Trivial; FStar_TypeChecker_Env.deferred = - (uu___94_13020.FStar_TypeChecker_Env.deferred); + (uu___93_13255.FStar_TypeChecker_Env.deferred); FStar_TypeChecker_Env.univ_ineqs = - (uu___94_13020.FStar_TypeChecker_Env.univ_ineqs); + (uu___93_13255.FStar_TypeChecker_Env.univ_ineqs); FStar_TypeChecker_Env.implicits = - (uu___94_13020.FStar_TypeChecker_Env.implicits) + (uu___93_13255.FStar_TypeChecker_Env.implicits) } in - let uu____13021 = - let uu____13022 = + let uu____13256 = + let uu____13257 = FStar_TypeChecker_Rel.teq_nosmt env12 lc.FStar_Syntax_Syntax.res_typ expected_pat_t in - if uu____13022 + if uu____13257 then let env13 = FStar_TypeChecker_Env.set_range env12 exp1.FStar_Syntax_Syntax.pos in - let uu____13024 = + let uu____13259 = FStar_TypeChecker_Rel.discharge_guard_no_smt env13 g1 in - FStar_All.pipe_right uu____13024 + FStar_All.pipe_right uu____13259 FStar_TypeChecker_Rel.resolve_implicits else - (let uu____13026 = - let uu____13031 = - let uu____13032 = + (let uu____13261 = + let uu____13266 = + let uu____13267 = FStar_Syntax_Print.term_to_string lc.FStar_Syntax_Syntax.res_typ in - let uu____13033 = + let uu____13268 = FStar_Syntax_Print.term_to_string expected_pat_t in FStar_Util.format2 "Inferred type of pattern (%s) is incompatible with the type of the scrutinee (%s)" - uu____13032 uu____13033 in + uu____13267 uu____13268 in (FStar_Errors.Fatal_MismatchedPatternType, - uu____13031) in - FStar_Errors.raise_error uu____13026 + uu____13266) in + FStar_Errors.raise_error uu____13261 exp1.FStar_Syntax_Syntax.pos) in let norm_exp = FStar_TypeChecker_Normalize.normalize @@ -5038,60 +5075,60 @@ and tc_eqn: FStar_Syntax_Free.uvars norm_exp in let uvs2 = FStar_Syntax_Free.uvars expected_pat_t in - ((let uu____13050 = - let uu____13051 = + ((let uu____13285 = + let uu____13286 = FStar_Util.set_is_subset_of uvs1 uvs2 in FStar_All.pipe_left Prims.op_Negation - uu____13051 in - if uu____13050 + uu____13286 in + if uu____13285 then let unresolved = - let uu____13063 = + let uu____13298 = FStar_Util.set_difference uvs1 uvs2 in - FStar_All.pipe_right uu____13063 + FStar_All.pipe_right uu____13298 FStar_Util.set_elements in - let uu____13090 = - let uu____13095 = - let uu____13096 = + let uu____13325 = + let uu____13330 = + let uu____13331 = FStar_TypeChecker_Normalize.term_to_string env norm_exp in - let uu____13097 = + let uu____13332 = FStar_TypeChecker_Normalize.term_to_string env expected_pat_t in - let uu____13098 = - let uu____13099 = + let uu____13333 = + let uu____13334 = FStar_All.pipe_right unresolved (FStar_List.map - (fun uu____13117 -> - match uu____13117 with - | (u,uu____13123) -> + (fun uu____13352 -> + match uu____13352 with + | (u,uu____13358) -> FStar_Syntax_Print.uvar_to_string u)) in - FStar_All.pipe_right uu____13099 + FStar_All.pipe_right uu____13334 (FStar_String.concat ", ") in FStar_Util.format3 "Implicit pattern variables in %s could not be resolved against expected type %s;Variables {%s} were unresolved; please bind them explicitly" - uu____13096 uu____13097 - uu____13098 in + uu____13331 uu____13332 + uu____13333 in (FStar_Errors.Fatal_UnresolvedPatternVar, - uu____13095) in - FStar_Errors.raise_error uu____13090 + uu____13330) in + FStar_Errors.raise_error uu____13325 p.FStar_Syntax_Syntax.p else ()); - (let uu____13128 = + (let uu____13363 = FStar_TypeChecker_Env.debug env FStar_Options.High in - if uu____13128 + if uu____13363 then - let uu____13129 = + let uu____13364 = FStar_TypeChecker_Normalize.term_to_string env exp1 in FStar_Util.print1 "Done checking pattern expression %s\n" - uu____13129 + uu____13364 else ()); (let p1 = FStar_TypeChecker_Util.decorate_pattern @@ -5100,45 +5137,45 @@ and tc_eqn: guard_pat_annots, norm_exp))))))) in let pat_t = scrutinee.FStar_Syntax_Syntax.sort in let scrutinee_tm = FStar_Syntax_Syntax.bv_to_name scrutinee in - let uu____13138 = - let uu____13145 = + let uu____13373 = + let uu____13380 = FStar_TypeChecker_Env.push_bv env scrutinee in - FStar_All.pipe_right uu____13145 + FStar_All.pipe_right uu____13380 FStar_TypeChecker_Env.clear_expected_typ in - (match uu____13138 with - | (scrutinee_env,uu____13169) -> - let uu____13174 = tc_pat true pat_t pattern in - (match uu____13174 with + (match uu____13373 with + | (scrutinee_env,uu____13412) -> + let uu____13417 = tc_pat true pat_t pattern in + (match uu____13417 with | (pattern1,pat_bvs1,pat_env,pat_exp,guard_pat_annots,norm_pat_exp) -> - let uu____13215 = + let uu____13466 = match when_clause with | FStar_Pervasives_Native.None -> (FStar_Pervasives_Native.None, FStar_TypeChecker_Rel.trivial_guard) | FStar_Pervasives_Native.Some e -> - let uu____13237 = + let uu____13488 = FStar_TypeChecker_Env.should_verify env in - if uu____13237 + if uu____13488 then FStar_Errors.raise_error (FStar_Errors.Fatal_WhenClauseNotSupported, "When clauses are not yet supported in --verify mode; they will be some day") e.FStar_Syntax_Syntax.pos else - (let uu____13251 = - let uu____13258 = + (let uu____13502 = + let uu____13509 = FStar_TypeChecker_Env.set_expected_typ pat_env FStar_Syntax_Util.t_bool in - tc_term uu____13258 e in - match uu____13251 with + tc_term uu____13509 e in + match uu____13502 with | (e1,c,g) -> ((FStar_Pervasives_Native.Some e1), g)) in - (match uu____13215 with + (match uu____13466 with | (when_clause1,g_when) -> - let uu____13292 = tc_term pat_env branch_exp in - (match uu____13292 with + let uu____13551 = tc_term pat_env branch_exp in + (match uu____13551 with | (branch_exp1,c,g_branch) -> let g_branch1 = FStar_TypeChecker_Rel.conj_guard @@ -5148,7 +5185,7 @@ and tc_eqn: | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None | FStar_Pervasives_Native.Some w -> - let uu____13325 = + let uu____13592 = FStar_Syntax_Util.mk_eq2 FStar_Syntax_Syntax.U_zero FStar_Syntax_Util.t_bool w @@ -5156,15 +5193,15 @@ and tc_eqn: FStar_All.pipe_left (fun _0_41 -> FStar_Pervasives_Native.Some - _0_41) uu____13325 in - let uu____13328 = + _0_41) uu____13592 in + let uu____13595 = let eqs = - let uu____13338 = - let uu____13339 = + let uu____13613 = + let uu____13614 = FStar_TypeChecker_Env.should_verify env in - Prims.op_Negation uu____13339 in - if uu____13338 + Prims.op_Negation uu____13614 in + if uu____13613 then FStar_Pervasives_Native.None else (let e = @@ -5173,38 +5210,38 @@ and tc_eqn: match e.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Tm_uvar - uu____13346 -> + uu____13621 -> FStar_Pervasives_Native.None | FStar_Syntax_Syntax.Tm_constant - uu____13363 -> + uu____13638 -> FStar_Pervasives_Native.None | FStar_Syntax_Syntax.Tm_fvar - uu____13364 -> + uu____13639 -> FStar_Pervasives_Native.None - | uu____13365 -> - let uu____13366 = - let uu____13367 = + | uu____13640 -> + let uu____13641 = + let uu____13642 = env.FStar_TypeChecker_Env.universe_of env pat_t in FStar_Syntax_Util.mk_eq2 - uu____13367 pat_t + uu____13642 pat_t scrutinee_tm e in FStar_Pervasives_Native.Some - uu____13366) in - let uu____13368 = + uu____13641) in + let uu____13643 = FStar_TypeChecker_Util.strengthen_precondition FStar_Pervasives_Native.None env branch_exp1 c g_branch1 in - match uu____13368 with + match uu____13643 with | (c1,g_branch2) -> - let uu____13383 = + let uu____13666 = match (eqs, when_condition) with - | uu____13396 when - let uu____13405 = + | uu____13679 when + let uu____13688 = FStar_TypeChecker_Env.should_verify env in Prims.op_Negation - uu____13405 + uu____13688 -> (c1, g_when) | (FStar_Pervasives_Native.None ,FStar_Pervasives_Native.None @@ -5218,13 +5255,13 @@ and tc_eqn: let g = FStar_TypeChecker_Rel.guard_of_guard_formula gf in - let uu____13417 = + let uu____13700 = FStar_TypeChecker_Util.weaken_precondition env c1 gf in - let uu____13418 = + let uu____13701 = FStar_TypeChecker_Rel.imp_guard g g_when in - (uu____13417, uu____13418) + (uu____13700, uu____13701) | (FStar_Pervasives_Native.Some f,FStar_Pervasives_Native.Some w) -> @@ -5232,21 +5269,21 @@ and tc_eqn: FStar_TypeChecker_Common.NonTrivial f in let g_fw = - let uu____13427 = + let uu____13710 = FStar_Syntax_Util.mk_conj f w in FStar_TypeChecker_Common.NonTrivial - uu____13427 in - let uu____13428 = + uu____13710 in + let uu____13711 = FStar_TypeChecker_Util.weaken_precondition env c1 g_fw in - let uu____13429 = - let uu____13430 = + let uu____13712 = + let uu____13713 = FStar_TypeChecker_Rel.guard_of_guard_formula g_f in FStar_TypeChecker_Rel.imp_guard - uu____13430 g_when in - (uu____13428, uu____13429) + uu____13713 g_when in + (uu____13711, uu____13712) | (FStar_Pervasives_Native.None ,FStar_Pervasives_Native.Some w) -> @@ -5256,112 +5293,127 @@ and tc_eqn: let g = FStar_TypeChecker_Rel.guard_of_guard_formula g_w in - let uu____13438 = + let uu____13721 = FStar_TypeChecker_Util.weaken_precondition env c1 g_w in - (uu____13438, g_when) in - (match uu____13383 with + (uu____13721, g_when) in + (match uu____13666 with | (c_weak,g_when_weak) -> let binders = FStar_List.map FStar_Syntax_Syntax.mk_binder pat_bvs1 in - let uu____13450 = + let maybe_return_c_weak + should_return = + let c_weak1 = + let uu____13746 = + should_return && + (FStar_Syntax_Util.is_pure_or_ghost_lcomp + c_weak) in + if uu____13746 + then + FStar_TypeChecker_Util.maybe_assume_result_eq_pure_term + env branch_exp1 + c_weak + else c_weak in FStar_TypeChecker_Util.close_lcomp - env pat_bvs1 c_weak in - let uu____13451 = + env pat_bvs1 c_weak1 in + let uu____13748 = FStar_TypeChecker_Rel.close_guard env binders g_when_weak in - (uu____13450, uu____13451, - g_branch2)) in - (match uu____13328 with - | (c1,g_when1,g_branch2) -> + ((c_weak.FStar_Syntax_Syntax.eff_name), + (c_weak.FStar_Syntax_Syntax.cflags), + maybe_return_c_weak, + uu____13748, g_branch2)) in + (match uu____13595 with + | (effect_label,cflags,maybe_return_c,g_when1,g_branch2) + -> let branch_guard = - let uu____13472 = - let uu____13473 = + let uu____13791 = + let uu____13792 = FStar_TypeChecker_Env.should_verify env in - Prims.op_Negation uu____13473 in - if uu____13472 + Prims.op_Negation uu____13792 in + if uu____13791 then FStar_Syntax_Util.t_true else (let rec build_branch_guard scrutinee_tm1 pat_exp1 = let discriminate scrutinee_tm2 f = - let uu____13503 = - let uu____13504 = - let uu____13505 = - let uu____13508 = - let uu____13515 = + let uu____13822 = + let uu____13823 = + let uu____13824 = + let uu____13827 = + let uu____13834 = FStar_TypeChecker_Env.typ_of_datacon env f.FStar_Syntax_Syntax.v in FStar_TypeChecker_Env.datacons_of_typ - env uu____13515 in + env uu____13834 in FStar_Pervasives_Native.snd - uu____13508 in + uu____13827 in FStar_List.length - uu____13505 in - uu____13504 > + uu____13824 in + uu____13823 > (Prims.parse_int "1") in - if uu____13503 + if uu____13822 then let discriminator = FStar_Syntax_Util.mk_discriminator f.FStar_Syntax_Syntax.v in - let uu____13521 = + let uu____13840 = FStar_TypeChecker_Env.try_lookup_lid env discriminator in - match uu____13521 with + match uu____13840 with | FStar_Pervasives_Native.None -> [] - | uu____13542 -> + | uu____13861 -> let disc = FStar_Syntax_Syntax.fvar discriminator FStar_Syntax_Syntax.Delta_equational FStar_Pervasives_Native.None in let disc1 = - let uu____13557 = - let uu____13558 + let uu____13876 = + let uu____13877 = - let uu____13559 + let uu____13878 = FStar_Syntax_Syntax.as_arg scrutinee_tm2 in - [uu____13559] in + [uu____13878] in FStar_Syntax_Syntax.mk_Tm_app disc - uu____13558 in - uu____13557 + uu____13877 in + uu____13876 FStar_Pervasives_Native.None scrutinee_tm2.FStar_Syntax_Syntax.pos in - let uu____13562 = + let uu____13881 = FStar_Syntax_Util.mk_eq2 FStar_Syntax_Syntax.U_zero FStar_Syntax_Util.t_bool disc1 FStar_Syntax_Util.exp_true_bool in - [uu____13562] + [uu____13881] else [] in - let fail uu____13567 = - let uu____13568 = - let uu____13569 = + let fail uu____13886 = + let uu____13887 = + let uu____13888 = FStar_Range.string_of_range pat_exp1.FStar_Syntax_Syntax.pos in - let uu____13570 = + let uu____13889 = FStar_Syntax_Print.term_to_string pat_exp1 in - let uu____13571 = + let uu____13890 = FStar_Syntax_Print.tag_of_term pat_exp1 in FStar_Util.format3 "tc_eqn: Impossible (%s) %s (%s)" - uu____13569 - uu____13570 - uu____13571 in - failwith uu____13568 in + uu____13888 + uu____13889 + uu____13890 in + failwith uu____13887 in let rec head_constructor t = match t.FStar_Syntax_Syntax.n with @@ -5369,118 +5421,118 @@ and tc_eqn: fv -> fv.FStar_Syntax_Syntax.fv_name | FStar_Syntax_Syntax.Tm_uinst - (t1,uu____13582) -> + (t1,uu____13901) -> head_constructor t1 - | uu____13587 -> fail () in + | uu____13906 -> fail () in let pat_exp2 = - let uu____13589 = + let uu____13908 = FStar_Syntax_Subst.compress pat_exp1 in FStar_All.pipe_right - uu____13589 + uu____13908 FStar_Syntax_Util.unmeta in match pat_exp2.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Tm_uvar - uu____13592 -> [] + uu____13911 -> [] | FStar_Syntax_Syntax.Tm_app ({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_uvar - uu____13609; + uu____13928; FStar_Syntax_Syntax.pos - = uu____13610; + = uu____13929; FStar_Syntax_Syntax.vars - = uu____13611;_},uu____13612) + = uu____13930;_},uu____13931) -> [] | FStar_Syntax_Syntax.Tm_name - uu____13649 -> [] + uu____13968 -> [] | FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_unit ) -> [] | FStar_Syntax_Syntax.Tm_constant - c2 -> - let uu____13651 = - let uu____13652 = + c1 -> + let uu____13970 = + let uu____13971 = tc_constant env pat_exp2.FStar_Syntax_Syntax.pos - c2 in + c1 in FStar_Syntax_Util.mk_eq2 FStar_Syntax_Syntax.U_zero - uu____13652 + uu____13971 scrutinee_tm1 pat_exp2 in - [uu____13651] + [uu____13970] | FStar_Syntax_Syntax.Tm_uinst - uu____13653 -> + uu____13972 -> let f = head_constructor pat_exp2 in - let uu____13661 = - let uu____13662 = + let uu____13980 = + let uu____13981 = FStar_TypeChecker_Env.is_datacon env f.FStar_Syntax_Syntax.v in Prims.op_Negation - uu____13662 in - if uu____13661 + uu____13981 in + if uu____13980 then [] else - (let uu____13666 = + (let uu____13985 = head_constructor pat_exp2 in discriminate scrutinee_tm1 - uu____13666) + uu____13985) | FStar_Syntax_Syntax.Tm_fvar - uu____13669 -> + uu____13988 -> let f = head_constructor pat_exp2 in - let uu____13671 = - let uu____13672 = + let uu____13990 = + let uu____13991 = FStar_TypeChecker_Env.is_datacon env f.FStar_Syntax_Syntax.v in Prims.op_Negation - uu____13672 in - if uu____13671 + uu____13991 in + if uu____13990 then [] else - (let uu____13676 = + (let uu____13995 = head_constructor pat_exp2 in discriminate scrutinee_tm1 - uu____13676) + uu____13995) | FStar_Syntax_Syntax.Tm_app (head1,args) -> let f = head_constructor head1 in - let uu____13702 = - let uu____13703 = + let uu____14021 = + let uu____14022 = FStar_TypeChecker_Env.is_datacon env f.FStar_Syntax_Syntax.v in Prims.op_Negation - uu____13703 in - if uu____13702 + uu____14022 in + if uu____14021 then [] else (let sub_term_guards = - let uu____13710 = + let uu____14029 = FStar_All.pipe_right args (FStar_List.mapi (fun i -> fun - uu____13742 + uu____14061 -> - match uu____13742 + match uu____14061 with | - (ei,uu____13752) + (ei,uu____14071) -> let projector = @@ -5488,24 +5540,24 @@ and tc_eqn: env f.FStar_Syntax_Syntax.v i in - let uu____13758 + let uu____14077 = FStar_TypeChecker_Env.try_lookup_lid env projector in - (match uu____13758 + (match uu____14077 with | FStar_Pervasives_Native.None -> [] | - uu____13779 + uu____14098 -> let sub_term = - let uu____13793 + let uu____14112 = - let uu____13794 + let uu____14113 = FStar_Syntax_Syntax.fvar (FStar_Ident.set_lid_range @@ -5513,64 +5565,64 @@ and tc_eqn: f.FStar_Syntax_Syntax.p) FStar_Syntax_Syntax.Delta_equational FStar_Pervasives_Native.None in - let uu____13795 + let uu____14114 = - let uu____13796 + let uu____14115 = FStar_Syntax_Syntax.as_arg scrutinee_tm1 in - [uu____13796] in + [uu____14115] in FStar_Syntax_Syntax.mk_Tm_app - uu____13794 - uu____13795 in - uu____13793 + uu____14113 + uu____14114 in + uu____14112 FStar_Pervasives_Native.None f.FStar_Syntax_Syntax.p in build_branch_guard sub_term ei))) in FStar_All.pipe_right - uu____13710 + uu____14029 FStar_List.flatten in - let uu____13805 = + let uu____14124 = discriminate scrutinee_tm1 f in FStar_List.append - uu____13805 + uu____14124 sub_term_guards) - | uu____13808 -> [] in + | uu____14127 -> [] in let build_and_check_branch_guard scrutinee_tm1 pat = - let uu____13820 = - let uu____13821 = + let uu____14139 = + let uu____14140 = FStar_TypeChecker_Env.should_verify env in Prims.op_Negation - uu____13821 in - if uu____13820 + uu____14140 in + if uu____14139 then FStar_TypeChecker_Util.fvar_const env FStar_Parser_Const.true_lid else (let t = - let uu____13824 = + let uu____14143 = build_branch_guard scrutinee_tm1 pat in FStar_All.pipe_left FStar_Syntax_Util.mk_conj_l - uu____13824 in - let uu____13829 = + uu____14143 in + let uu____14148 = FStar_Syntax_Util.type_u () in - match uu____13829 with - | (k,uu____13835) -> - let uu____13836 = + match uu____14148 with + | (k,uu____14154) -> + let uu____14155 = tc_check_tot_or_gtot_term scrutinee_env t k in - (match uu____13836 + (match uu____14155 with - | (t1,uu____13844,uu____13845) + | (t1,uu____14163,uu____14164) -> t1)) in let branch_guard = build_and_check_branch_guard @@ -5587,25 +5639,26 @@ and tc_eqn: let guard = FStar_TypeChecker_Rel.conj_guard g_when1 g_branch2 in - ((let uu____13851 = + ((let uu____14170 = FStar_TypeChecker_Env.debug env FStar_Options.High in - if uu____13851 + if uu____14170 then - let uu____13852 = + let uu____14171 = FStar_TypeChecker_Rel.guard_to_string env guard in FStar_All.pipe_left (FStar_Util.print1 "Carrying guard from match: %s\n") - uu____13852 + uu____14171 else ()); - (let uu____13854 = + (let uu____14173 = FStar_Syntax_Subst.close_branch (pattern1, when_clause1, branch_exp1) in - (uu____13854, branch_guard, c1, - guard))))))))) + (uu____14173, branch_guard, + effect_label, cflags, + maybe_return_c, guard))))))))) and check_top_level_let: FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.term -> @@ -5617,38 +5670,39 @@ and check_top_level_let: let env1 = instantiate_both env in match e.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Tm_let ((false ,lb::[]),e2) -> - let uu____13880 = check_let_bound_def true env1 lb in - (match uu____13880 with + let uu____14203 = check_let_bound_def true env1 lb in + (match uu____14203 with | (e1,univ_vars1,c1,g1,annotated) -> - let uu____13902 = + let uu____14225 = if annotated && (Prims.op_Negation env1.FStar_TypeChecker_Env.generalize) then - let uu____13919 = + let uu____14242 = FStar_TypeChecker_Normalize.reduce_uvar_solutions env1 e1 in - (g1, uu____13919, univ_vars1, c1) + (g1, uu____14242, univ_vars1, c1) else (let g11 = - let uu____13922 = + let uu____14245 = FStar_TypeChecker_Rel.solve_deferred_constraints env1 g1 in - FStar_All.pipe_right uu____13922 + FStar_All.pipe_right uu____14245 FStar_TypeChecker_Rel.resolve_implicits in - let uu____13926 = - let uu____13939 = - let uu____13954 = - let uu____13963 = - let uu____13976 = c1.FStar_Syntax_Syntax.comp () in + let uu____14249 = + let uu____14262 = + let uu____14277 = + let uu____14286 = + let uu____14297 = + FStar_Syntax_Syntax.lcomp_comp c1 in ((lb.FStar_Syntax_Syntax.lbname), e1, - uu____13976) in - [uu____13963] in + uu____14297) in + [uu____14286] in FStar_TypeChecker_Util.generalize env1 false - uu____13954 in - FStar_List.hd uu____13939 in - match uu____13926 with - | (uu____14029,univs1,e11,c11,gvs) -> + uu____14277 in + FStar_List.hd uu____14262 in + match uu____14249 with + | (uu____14342,univs1,e11,c11,gvs) -> let g12 = FStar_All.pipe_left (FStar_TypeChecker_Rel.map_guard g11) @@ -5661,27 +5715,27 @@ and check_top_level_let: FStar_TypeChecker_Normalize.Zeta] env1) in let g13 = FStar_TypeChecker_Rel.abstract_guard_n gvs g12 in - (g13, e11, univs1, - (FStar_Syntax_Util.lcomp_of_comp c11))) in - (match uu____13902 with + let uu____14355 = FStar_Syntax_Util.lcomp_of_comp c11 in + (g13, e11, univs1, uu____14355)) in + (match uu____14225 with | (g11,e11,univ_vars2,c11) -> - let uu____14052 = - let uu____14059 = + let uu____14366 = + let uu____14373 = FStar_TypeChecker_Env.should_verify env1 in - if uu____14059 + if uu____14373 then - let uu____14066 = + let uu____14380 = FStar_TypeChecker_Util.check_top_level env1 g11 c11 in - match uu____14066 with + match uu____14380 with | (ok,c12) -> (if ok then (e2, c12) else - ((let uu____14089 = + ((let uu____14403 = FStar_TypeChecker_Env.get_range env1 in - FStar_Errors.log_issue uu____14089 + FStar_Errors.log_issue uu____14403 FStar_TypeChecker_Err.top_level_effect); - (let uu____14090 = + (let uu____14404 = FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_meta (e2, @@ -5689,19 +5743,20 @@ and check_top_level_let: FStar_Syntax_Syntax.Masked_effect))) FStar_Pervasives_Native.None e2.FStar_Syntax_Syntax.pos in - (uu____14090, c12)))) + (uu____14404, c12)))) else (FStar_TypeChecker_Rel.force_trivial_guard env1 g11; (let c = - let uu____14100 = c11.FStar_Syntax_Syntax.comp () in - FStar_All.pipe_right uu____14100 + let uu____14414 = + FStar_Syntax_Syntax.lcomp_comp c11 in + FStar_All.pipe_right uu____14414 (FStar_TypeChecker_Normalize.normalize_comp [FStar_TypeChecker_Normalize.Beta; FStar_TypeChecker_Normalize.NoFullNorm] env1) in let e21 = - let uu____14108 = + let uu____14418 = FStar_Syntax_Util.is_pure_comp c in - if uu____14108 + if uu____14418 then e2 else FStar_Syntax_Syntax.mk @@ -5712,7 +5767,7 @@ and check_top_level_let: FStar_Pervasives_Native.None e2.FStar_Syntax_Syntax.pos in (e21, c))) in - (match uu____14052 with + (match uu____14366 with | (e21,c12) -> let cres = FStar_TypeChecker_Env.null_wp_for_eff env1 @@ -5725,16 +5780,17 @@ and check_top_level_let: lb.FStar_Syntax_Syntax.lbname univ_vars2 (FStar_Syntax_Util.comp_result c12) (FStar_Syntax_Util.comp_effect_name c12) e11 in - let uu____14132 = + let uu____14442 = FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_let ((false, [lb1]), e21)) FStar_Pervasives_Native.None e.FStar_Syntax_Syntax.pos in - (uu____14132, - (FStar_Syntax_Util.lcomp_of_comp cres), + let uu____14455 = + FStar_Syntax_Util.lcomp_of_comp cres in + (uu____14442, uu____14455, FStar_TypeChecker_Rel.trivial_guard)))) - | uu____14147 -> failwith "Impossible" + | uu____14458 -> failwith "Impossible" and check_inner_let: FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.term -> @@ -5747,112 +5803,111 @@ and check_inner_let: match e.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Tm_let ((false ,lb::[]),e2) -> let env2 = - let uu___95_14178 = env1 in + let uu___94_14489 = env1 in { FStar_TypeChecker_Env.solver = - (uu___95_14178.FStar_TypeChecker_Env.solver); + (uu___94_14489.FStar_TypeChecker_Env.solver); FStar_TypeChecker_Env.range = - (uu___95_14178.FStar_TypeChecker_Env.range); + (uu___94_14489.FStar_TypeChecker_Env.range); FStar_TypeChecker_Env.curmodule = - (uu___95_14178.FStar_TypeChecker_Env.curmodule); + (uu___94_14489.FStar_TypeChecker_Env.curmodule); FStar_TypeChecker_Env.gamma = - (uu___95_14178.FStar_TypeChecker_Env.gamma); + (uu___94_14489.FStar_TypeChecker_Env.gamma); FStar_TypeChecker_Env.gamma_cache = - (uu___95_14178.FStar_TypeChecker_Env.gamma_cache); + (uu___94_14489.FStar_TypeChecker_Env.gamma_cache); FStar_TypeChecker_Env.modules = - (uu___95_14178.FStar_TypeChecker_Env.modules); + (uu___94_14489.FStar_TypeChecker_Env.modules); FStar_TypeChecker_Env.expected_typ = - (uu___95_14178.FStar_TypeChecker_Env.expected_typ); + (uu___94_14489.FStar_TypeChecker_Env.expected_typ); FStar_TypeChecker_Env.sigtab = - (uu___95_14178.FStar_TypeChecker_Env.sigtab); + (uu___94_14489.FStar_TypeChecker_Env.sigtab); FStar_TypeChecker_Env.is_pattern = - (uu___95_14178.FStar_TypeChecker_Env.is_pattern); + (uu___94_14489.FStar_TypeChecker_Env.is_pattern); FStar_TypeChecker_Env.instantiate_imp = - (uu___95_14178.FStar_TypeChecker_Env.instantiate_imp); + (uu___94_14489.FStar_TypeChecker_Env.instantiate_imp); FStar_TypeChecker_Env.effects = - (uu___95_14178.FStar_TypeChecker_Env.effects); + (uu___94_14489.FStar_TypeChecker_Env.effects); FStar_TypeChecker_Env.generalize = - (uu___95_14178.FStar_TypeChecker_Env.generalize); + (uu___94_14489.FStar_TypeChecker_Env.generalize); FStar_TypeChecker_Env.letrecs = - (uu___95_14178.FStar_TypeChecker_Env.letrecs); + (uu___94_14489.FStar_TypeChecker_Env.letrecs); FStar_TypeChecker_Env.top_level = false; FStar_TypeChecker_Env.check_uvars = - (uu___95_14178.FStar_TypeChecker_Env.check_uvars); + (uu___94_14489.FStar_TypeChecker_Env.check_uvars); FStar_TypeChecker_Env.use_eq = - (uu___95_14178.FStar_TypeChecker_Env.use_eq); + (uu___94_14489.FStar_TypeChecker_Env.use_eq); FStar_TypeChecker_Env.is_iface = - (uu___95_14178.FStar_TypeChecker_Env.is_iface); + (uu___94_14489.FStar_TypeChecker_Env.is_iface); FStar_TypeChecker_Env.admit = - (uu___95_14178.FStar_TypeChecker_Env.admit); + (uu___94_14489.FStar_TypeChecker_Env.admit); FStar_TypeChecker_Env.lax = - (uu___95_14178.FStar_TypeChecker_Env.lax); + (uu___94_14489.FStar_TypeChecker_Env.lax); FStar_TypeChecker_Env.lax_universes = - (uu___95_14178.FStar_TypeChecker_Env.lax_universes); + (uu___94_14489.FStar_TypeChecker_Env.lax_universes); FStar_TypeChecker_Env.failhard = - (uu___95_14178.FStar_TypeChecker_Env.failhard); + (uu___94_14489.FStar_TypeChecker_Env.failhard); FStar_TypeChecker_Env.nosynth = - (uu___95_14178.FStar_TypeChecker_Env.nosynth); + (uu___94_14489.FStar_TypeChecker_Env.nosynth); FStar_TypeChecker_Env.tc_term = - (uu___95_14178.FStar_TypeChecker_Env.tc_term); + (uu___94_14489.FStar_TypeChecker_Env.tc_term); FStar_TypeChecker_Env.type_of = - (uu___95_14178.FStar_TypeChecker_Env.type_of); + (uu___94_14489.FStar_TypeChecker_Env.type_of); FStar_TypeChecker_Env.universe_of = - (uu___95_14178.FStar_TypeChecker_Env.universe_of); + (uu___94_14489.FStar_TypeChecker_Env.universe_of); FStar_TypeChecker_Env.use_bv_sorts = - (uu___95_14178.FStar_TypeChecker_Env.use_bv_sorts); + (uu___94_14489.FStar_TypeChecker_Env.use_bv_sorts); FStar_TypeChecker_Env.qname_and_index = - (uu___95_14178.FStar_TypeChecker_Env.qname_and_index); + (uu___94_14489.FStar_TypeChecker_Env.qname_and_index); FStar_TypeChecker_Env.proof_ns = - (uu___95_14178.FStar_TypeChecker_Env.proof_ns); + (uu___94_14489.FStar_TypeChecker_Env.proof_ns); FStar_TypeChecker_Env.synth = - (uu___95_14178.FStar_TypeChecker_Env.synth); + (uu___94_14489.FStar_TypeChecker_Env.synth); FStar_TypeChecker_Env.is_native_tactic = - (uu___95_14178.FStar_TypeChecker_Env.is_native_tactic); + (uu___94_14489.FStar_TypeChecker_Env.is_native_tactic); FStar_TypeChecker_Env.identifier_info = - (uu___95_14178.FStar_TypeChecker_Env.identifier_info); + (uu___94_14489.FStar_TypeChecker_Env.identifier_info); FStar_TypeChecker_Env.tc_hooks = - (uu___95_14178.FStar_TypeChecker_Env.tc_hooks); + (uu___94_14489.FStar_TypeChecker_Env.tc_hooks); FStar_TypeChecker_Env.dsenv = - (uu___95_14178.FStar_TypeChecker_Env.dsenv); + (uu___94_14489.FStar_TypeChecker_Env.dsenv); FStar_TypeChecker_Env.dep_graph = - (uu___95_14178.FStar_TypeChecker_Env.dep_graph) + (uu___94_14489.FStar_TypeChecker_Env.dep_graph) } in - let uu____14179 = - let uu____14190 = - let uu____14191 = FStar_TypeChecker_Env.clear_expected_typ env2 in - FStar_All.pipe_right uu____14191 FStar_Pervasives_Native.fst in - check_let_bound_def false uu____14190 lb in - (match uu____14179 with - | (e1,uu____14213,c1,g1,annotated) -> + let uu____14490 = + let uu____14501 = + let uu____14502 = FStar_TypeChecker_Env.clear_expected_typ env2 in + FStar_All.pipe_right uu____14502 FStar_Pervasives_Native.fst in + check_let_bound_def false uu____14501 lb in + (match uu____14490 with + | (e1,uu____14524,c1,g1,annotated) -> let x = - let uu___96_14218 = + let uu___95_14529 = FStar_Util.left lb.FStar_Syntax_Syntax.lbname in { FStar_Syntax_Syntax.ppname = - (uu___96_14218.FStar_Syntax_Syntax.ppname); + (uu___95_14529.FStar_Syntax_Syntax.ppname); FStar_Syntax_Syntax.index = - (uu___96_14218.FStar_Syntax_Syntax.index); + (uu___95_14529.FStar_Syntax_Syntax.index); FStar_Syntax_Syntax.sort = (c1.FStar_Syntax_Syntax.res_typ) } in - let uu____14219 = - let uu____14224 = - let uu____14225 = FStar_Syntax_Syntax.mk_binder x in - [uu____14225] in - FStar_Syntax_Subst.open_term uu____14224 e2 in - (match uu____14219 with + let uu____14530 = + let uu____14535 = + let uu____14536 = FStar_Syntax_Syntax.mk_binder x in + [uu____14536] in + FStar_Syntax_Subst.open_term uu____14535 e2 in + (match uu____14530 with | (xb,e21) -> let xbinder = FStar_List.hd xb in let x1 = FStar_Pervasives_Native.fst xbinder in - let uu____14244 = - let uu____14251 = FStar_TypeChecker_Env.push_bv env2 x1 in - tc_term uu____14251 e21 in - (match uu____14244 with + let env_x = FStar_TypeChecker_Env.push_bv env2 x1 in + let uu____14556 = tc_term env_x e21 in + (match uu____14556 with | (e22,c2,g2) -> let cres = - FStar_TypeChecker_Util.bind + FStar_TypeChecker_Util.maybe_return_e2_and_bind e1.FStar_Syntax_Syntax.pos env2 - (FStar_Pervasives_Native.Some e1) c1 + (FStar_Pervasives_Native.Some e1) c1 e22 ((FStar_Pervasives_Native.Some x1), c2) in let e11 = FStar_TypeChecker_Util.maybe_lift env2 e1 @@ -5870,100 +5925,100 @@ and check_inner_let: c1.FStar_Syntax_Syntax.res_typ cres.FStar_Syntax_Syntax.eff_name e11 in let e3 = - let uu____14270 = - let uu____14273 = - let uu____14274 = - let uu____14287 = + let uu____14581 = + let uu____14584 = + let uu____14585 = + let uu____14598 = FStar_Syntax_Subst.close xb e23 in - ((false, [lb1]), uu____14287) in - FStar_Syntax_Syntax.Tm_let uu____14274 in - FStar_Syntax_Syntax.mk uu____14273 in - uu____14270 FStar_Pervasives_Native.None + ((false, [lb1]), uu____14598) in + FStar_Syntax_Syntax.Tm_let uu____14585 in + FStar_Syntax_Syntax.mk uu____14584 in + uu____14581 FStar_Pervasives_Native.None e.FStar_Syntax_Syntax.pos in let e4 = FStar_TypeChecker_Util.maybe_monadic env2 e3 cres.FStar_Syntax_Syntax.eff_name cres.FStar_Syntax_Syntax.res_typ in let x_eq_e1 = - let uu____14301 = - let uu____14302 = + let uu____14612 = + let uu____14613 = env2.FStar_TypeChecker_Env.universe_of env2 c1.FStar_Syntax_Syntax.res_typ in - let uu____14303 = + let uu____14614 = FStar_Syntax_Syntax.bv_to_name x1 in - FStar_Syntax_Util.mk_eq2 uu____14302 - c1.FStar_Syntax_Syntax.res_typ uu____14303 e11 in + FStar_Syntax_Util.mk_eq2 uu____14613 + c1.FStar_Syntax_Syntax.res_typ uu____14614 e11 in FStar_All.pipe_left (fun _0_42 -> FStar_TypeChecker_Common.NonTrivial _0_42) - uu____14301 in + uu____14612 in let g21 = - let uu____14305 = - let uu____14306 = + let uu____14616 = + let uu____14617 = FStar_TypeChecker_Rel.guard_of_guard_formula x_eq_e1 in - FStar_TypeChecker_Rel.imp_guard uu____14306 g2 in + FStar_TypeChecker_Rel.imp_guard uu____14617 g2 in FStar_TypeChecker_Rel.close_guard env2 xb - uu____14305 in + uu____14616 in let guard = FStar_TypeChecker_Rel.conj_guard g1 g21 in - let uu____14308 = - let uu____14309 = + let uu____14619 = + let uu____14620 = FStar_TypeChecker_Env.expected_typ env2 in - FStar_Option.isSome uu____14309 in - if uu____14308 + FStar_Option.isSome uu____14620 in + if uu____14619 then let tt = - let uu____14319 = + let uu____14630 = FStar_TypeChecker_Env.expected_typ env2 in - FStar_All.pipe_right uu____14319 + FStar_All.pipe_right uu____14630 FStar_Option.get in - ((let uu____14325 = + ((let uu____14636 = FStar_All.pipe_left (FStar_TypeChecker_Env.debug env2) (FStar_Options.Other "Exports") in - if uu____14325 + if uu____14636 then - let uu____14326 = + let uu____14637 = FStar_Syntax_Print.term_to_string tt in - let uu____14327 = + let uu____14638 = FStar_Syntax_Print.term_to_string cres.FStar_Syntax_Syntax.res_typ in FStar_Util.print2 "Got expected type from env %s\ncres.res_typ=%s\n" - uu____14326 uu____14327 + uu____14637 uu____14638 else ()); (e4, cres, guard)) else (let t = check_no_escape FStar_Pervasives_Native.None env2 [x1] cres.FStar_Syntax_Syntax.res_typ in - (let uu____14332 = + (let uu____14643 = FStar_All.pipe_left (FStar_TypeChecker_Env.debug env2) (FStar_Options.Other "Exports") in - if uu____14332 + if uu____14643 then - let uu____14333 = + let uu____14644 = FStar_Syntax_Print.term_to_string cres.FStar_Syntax_Syntax.res_typ in - let uu____14334 = + let uu____14645 = FStar_Syntax_Print.term_to_string t in FStar_Util.print2 "Checked %s has no escaping types; normalized to %s\n" - uu____14333 uu____14334 + uu____14644 uu____14645 else ()); (e4, - ((let uu___97_14337 = cres in + ((let uu___96_14648 = cres in { FStar_Syntax_Syntax.eff_name = - (uu___97_14337.FStar_Syntax_Syntax.eff_name); + (uu___96_14648.FStar_Syntax_Syntax.eff_name); FStar_Syntax_Syntax.res_typ = t; FStar_Syntax_Syntax.cflags = - (uu___97_14337.FStar_Syntax_Syntax.cflags); - FStar_Syntax_Syntax.comp = - (uu___97_14337.FStar_Syntax_Syntax.comp) + (uu___96_14648.FStar_Syntax_Syntax.cflags); + FStar_Syntax_Syntax.comp_thunk = + (uu___96_14648.FStar_Syntax_Syntax.comp_thunk) })), guard))))) - | uu____14338 -> failwith "Impossible" + | uu____14649 -> failwith "Impossible" and check_top_level_let_rec: FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.term -> @@ -5975,33 +6030,33 @@ and check_top_level_let_rec: let env1 = instantiate_both env in match top.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Tm_let ((true ,lbs),e2) -> - let uu____14370 = FStar_Syntax_Subst.open_let_rec lbs e2 in - (match uu____14370 with + let uu____14681 = FStar_Syntax_Subst.open_let_rec lbs e2 in + (match uu____14681 with | (lbs1,e21) -> - let uu____14389 = + let uu____14700 = FStar_TypeChecker_Env.clear_expected_typ env1 in - (match uu____14389 with + (match uu____14700 with | (env0,topt) -> - let uu____14408 = build_let_rec_env true env0 lbs1 in - (match uu____14408 with + let uu____14719 = build_let_rec_env true env0 lbs1 in + (match uu____14719 with | (lbs2,rec_env) -> - let uu____14427 = check_let_recs rec_env lbs2 in - (match uu____14427 with + let uu____14738 = check_let_recs rec_env lbs2 in + (match uu____14738 with | (lbs3,g_lbs) -> let g_lbs1 = - let uu____14447 = + let uu____14758 = FStar_TypeChecker_Rel.solve_deferred_constraints env1 g_lbs in - FStar_All.pipe_right uu____14447 + FStar_All.pipe_right uu____14758 FStar_TypeChecker_Rel.resolve_implicits in let all_lb_names = - let uu____14453 = + let uu____14764 = FStar_All.pipe_right lbs3 (FStar_List.map (fun lb -> FStar_Util.right lb.FStar_Syntax_Syntax.lbname)) in - FStar_All.pipe_right uu____14453 + FStar_All.pipe_right uu____14764 (fun _0_43 -> FStar_Pervasives_Native.Some _0_43) in let lbs4 = @@ -6030,22 +6085,22 @@ and check_top_level_let_rec: lbdef)) else (let ecs = - let uu____14502 = + let uu____14813 = FStar_All.pipe_right lbs3 (FStar_List.map (fun lb -> - let uu____14542 = + let uu____14853 = FStar_Syntax_Syntax.mk_Total lb.FStar_Syntax_Syntax.lbtyp in ((lb.FStar_Syntax_Syntax.lbname), (lb.FStar_Syntax_Syntax.lbdef), - uu____14542))) in + uu____14853))) in FStar_TypeChecker_Util.generalize env1 - true uu____14502 in + true uu____14813 in FStar_All.pipe_right ecs (FStar_List.map - (fun uu____14591 -> - match uu____14591 with + (fun uu____14902 -> + match uu____14902 with | (x,uvs,e,c,gvs) -> FStar_Syntax_Util.close_univs_and_mk_letbinding all_lb_names x uvs @@ -6054,30 +6109,30 @@ and check_top_level_let_rec: (FStar_Syntax_Util.comp_effect_name c) e))) in let cres = - let uu____14638 = + let uu____14949 = FStar_Syntax_Syntax.mk_Total FStar_Syntax_Syntax.t_unit in FStar_All.pipe_left - FStar_Syntax_Util.lcomp_of_comp uu____14638 in - let uu____14643 = + FStar_Syntax_Util.lcomp_of_comp uu____14949 in + let uu____14954 = FStar_Syntax_Subst.close_let_rec lbs4 e21 in - (match uu____14643 with + (match uu____14954 with | (lbs5,e22) -> - ((let uu____14663 = + ((let uu____14974 = FStar_TypeChecker_Rel.discharge_guard env1 g_lbs1 in - FStar_All.pipe_right uu____14663 + FStar_All.pipe_right uu____14974 (FStar_TypeChecker_Rel.force_trivial_guard env1)); - (let uu____14664 = + (let uu____14975 = FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_let ((true, lbs5), e22)) FStar_Pervasives_Native.None top.FStar_Syntax_Syntax.pos in - (uu____14664, cres, + (uu____14975, cres, FStar_TypeChecker_Rel.trivial_guard)))))))) - | uu____14677 -> failwith "Impossible" + | uu____14988 -> failwith "Impossible" and check_inner_let_rec: FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.term -> @@ -6089,49 +6144,49 @@ and check_inner_let_rec: let env1 = instantiate_both env in match top.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Tm_let ((true ,lbs),e2) -> - let uu____14709 = FStar_Syntax_Subst.open_let_rec lbs e2 in - (match uu____14709 with + let uu____15020 = FStar_Syntax_Subst.open_let_rec lbs e2 in + (match uu____15020 with | (lbs1,e21) -> - let uu____14728 = + let uu____15039 = FStar_TypeChecker_Env.clear_expected_typ env1 in - (match uu____14728 with + (match uu____15039 with | (env0,topt) -> - let uu____14747 = build_let_rec_env false env0 lbs1 in - (match uu____14747 with + let uu____15058 = build_let_rec_env false env0 lbs1 in + (match uu____15058 with | (lbs2,rec_env) -> - let uu____14766 = check_let_recs rec_env lbs2 in - (match uu____14766 with + let uu____15077 = check_let_recs rec_env lbs2 in + (match uu____15077 with | (lbs3,g_lbs) -> - let uu____14785 = + let uu____15096 = FStar_All.pipe_right lbs3 (FStar_Util.fold_map (fun env2 -> fun lb -> let x = - let uu___98_14808 = + let uu___97_15119 = FStar_Util.left lb.FStar_Syntax_Syntax.lbname in { FStar_Syntax_Syntax.ppname = - (uu___98_14808.FStar_Syntax_Syntax.ppname); + (uu___97_15119.FStar_Syntax_Syntax.ppname); FStar_Syntax_Syntax.index = - (uu___98_14808.FStar_Syntax_Syntax.index); + (uu___97_15119.FStar_Syntax_Syntax.index); FStar_Syntax_Syntax.sort = (lb.FStar_Syntax_Syntax.lbtyp) } in let lb1 = - let uu___99_14810 = lb in + let uu___98_15121 = lb in { FStar_Syntax_Syntax.lbname = (FStar_Util.Inl x); FStar_Syntax_Syntax.lbunivs = - (uu___99_14810.FStar_Syntax_Syntax.lbunivs); + (uu___98_15121.FStar_Syntax_Syntax.lbunivs); FStar_Syntax_Syntax.lbtyp = - (uu___99_14810.FStar_Syntax_Syntax.lbtyp); + (uu___98_15121.FStar_Syntax_Syntax.lbtyp); FStar_Syntax_Syntax.lbeff = - (uu___99_14810.FStar_Syntax_Syntax.lbeff); + (uu___98_15121.FStar_Syntax_Syntax.lbeff); FStar_Syntax_Syntax.lbdef = - (uu___99_14810.FStar_Syntax_Syntax.lbdef) + (uu___98_15121.FStar_Syntax_Syntax.lbdef) } in let env3 = FStar_TypeChecker_Env.push_let_binding @@ -6140,7 +6195,7 @@ and check_inner_let_rec: ([], (lb1.FStar_Syntax_Syntax.lbtyp)) in (env3, lb1)) env1) in - (match uu____14785 with + (match uu____15096 with | (env2,lbs4) -> let bvs = FStar_All.pipe_right lbs4 @@ -6148,41 +6203,48 @@ and check_inner_let_rec: (fun lb -> FStar_Util.left lb.FStar_Syntax_Syntax.lbname)) in - let uu____14837 = tc_term env2 e21 in - (match uu____14837 with + let uu____15148 = tc_term env2 e21 in + (match uu____15148 with | (e22,cres,g2) -> + let cres1 = + FStar_TypeChecker_Util.maybe_assume_result_eq_pure_term + env2 e22 cres in + let cres2 = + FStar_Syntax_Util.lcomp_set_flags + cres1 + [FStar_Syntax_Syntax.SHOULD_NOT_INLINE] in let guard = - let uu____14854 = - let uu____14855 = + let uu____15167 = + let uu____15168 = FStar_List.map FStar_Syntax_Syntax.mk_binder bvs in FStar_TypeChecker_Rel.close_guard - env2 uu____14855 g2 in + env2 uu____15168 g2 in FStar_TypeChecker_Rel.conj_guard - g_lbs uu____14854 in - let cres1 = + g_lbs uu____15167 in + let cres3 = FStar_TypeChecker_Util.close_lcomp - env2 bvs cres in + env2 bvs cres2 in let tres = norm env2 - cres1.FStar_Syntax_Syntax.res_typ in - let cres2 = - let uu___100_14859 = cres1 in + cres3.FStar_Syntax_Syntax.res_typ in + let cres4 = + let uu___99_15172 = cres3 in { FStar_Syntax_Syntax.eff_name = - (uu___100_14859.FStar_Syntax_Syntax.eff_name); + (uu___99_15172.FStar_Syntax_Syntax.eff_name); FStar_Syntax_Syntax.res_typ = tres; FStar_Syntax_Syntax.cflags = - (uu___100_14859.FStar_Syntax_Syntax.cflags); - FStar_Syntax_Syntax.comp = - (uu___100_14859.FStar_Syntax_Syntax.comp) + (uu___99_15172.FStar_Syntax_Syntax.cflags); + FStar_Syntax_Syntax.comp_thunk = + (uu___99_15172.FStar_Syntax_Syntax.comp_thunk) } in - let uu____14860 = + let uu____15173 = FStar_Syntax_Subst.close_let_rec lbs4 e22 in - (match uu____14860 with + (match uu____15173 with | (lbs5,e23) -> let e = FStar_Syntax_Syntax.mk @@ -6192,32 +6254,32 @@ and check_inner_let_rec: top.FStar_Syntax_Syntax.pos in (match topt with | FStar_Pervasives_Native.Some - uu____14896 -> - (e, cres2, guard) + uu____15209 -> + (e, cres4, guard) | FStar_Pervasives_Native.None -> let tres1 = check_no_escape FStar_Pervasives_Native.None env2 bvs tres in - let cres3 = - let uu___101_14901 = - cres2 in + let cres5 = + let uu___100_15214 = + cres4 in { FStar_Syntax_Syntax.eff_name = - (uu___101_14901.FStar_Syntax_Syntax.eff_name); + (uu___100_15214.FStar_Syntax_Syntax.eff_name); FStar_Syntax_Syntax.res_typ = tres1; FStar_Syntax_Syntax.cflags = - (uu___101_14901.FStar_Syntax_Syntax.cflags); - FStar_Syntax_Syntax.comp + (uu___100_15214.FStar_Syntax_Syntax.cflags); + FStar_Syntax_Syntax.comp_thunk = - (uu___101_14901.FStar_Syntax_Syntax.comp) + (uu___100_15214.FStar_Syntax_Syntax.comp_thunk) } in - (e, cres3, guard))))))))) - | uu____14904 -> failwith "Impossible" + (e, cres5, guard))))))))) + | uu____15217 -> failwith "Impossible" and build_let_rec_env: Prims.bool -> FStar_TypeChecker_Env.env -> @@ -6230,42 +6292,42 @@ and build_let_rec_env: fun lbs -> let env0 = env in let termination_check_enabled lbname lbdef lbtyp = - let uu____14933 = FStar_Options.ml_ish () in - if uu____14933 + let uu____15246 = FStar_Options.ml_ish () in + if uu____15246 then false else (let t = FStar_TypeChecker_Normalize.unfold_whnf env lbtyp in - let uu____14936 = FStar_Syntax_Util.arrow_formals_comp t in - match uu____14936 with + let uu____15249 = FStar_Syntax_Util.arrow_formals_comp t in + match uu____15249 with | (formals,c) -> - let uu____14961 = FStar_Syntax_Util.abs_formals lbdef in - (match uu____14961 with - | (actuals,uu____14971,uu____14972) -> + let uu____15274 = FStar_Syntax_Util.abs_formals lbdef in + (match uu____15274 with + | (actuals,uu____15284,uu____15285) -> if ((FStar_List.length formals) < (Prims.parse_int "1")) || ((FStar_List.length actuals) < (Prims.parse_int "1")) then - let uu____14985 = - let uu____14990 = - let uu____14991 = + let uu____15298 = + let uu____15303 = + let uu____15304 = FStar_Syntax_Print.term_to_string lbdef in - let uu____14992 = + let uu____15305 = FStar_Syntax_Print.term_to_string lbtyp in FStar_Util.format2 "Only function literals with arrow types can be defined recursively; got %s : %s" - uu____14991 uu____14992 in + uu____15304 uu____15305 in (FStar_Errors.Fatal_RecursiveFunctionLiteral, - uu____14990) in - FStar_Errors.raise_error uu____14985 + uu____15303) in + FStar_Errors.raise_error uu____15298 lbtyp.FStar_Syntax_Syntax.pos else (let actuals1 = - let uu____14995 = + let uu____15308 = FStar_TypeChecker_Env.set_expected_typ env lbtyp in FStar_TypeChecker_Util.maybe_add_implicit_binders - uu____14995 actuals in + uu____15308 actuals in if (FStar_List.length formals) <> (FStar_List.length actuals1) @@ -6275,27 +6337,27 @@ and build_let_rec_env: if n1 = (Prims.parse_int "1") then "1 argument was found" else - (let uu____15016 = + (let uu____15329 = FStar_Util.string_of_int n1 in FStar_Util.format1 "%s arguments were found" - uu____15016) in + uu____15329) in let formals_msg = let n1 = FStar_List.length formals in if n1 = (Prims.parse_int "1") then "1 argument" else - (let uu____15034 = + (let uu____15347 = FStar_Util.string_of_int n1 in FStar_Util.format1 "%s arguments" - uu____15034) in + uu____15347) in let msg = - let uu____15042 = + let uu____15355 = FStar_Syntax_Print.term_to_string lbtyp in - let uu____15043 = + let uu____15356 = FStar_Syntax_Print.lbname_to_string lbname in FStar_Util.format4 "From its type %s, the definition of `let rec %s` expects a function with %s, but %s" - uu____15042 uu____15043 formals_msg + uu____15355 uu____15356 formals_msg actuals_msg in FStar_Errors.raise_error (FStar_Errors.Fatal_LetRecArgumentMismatch, @@ -6307,16 +6369,16 @@ and build_let_rec_env: FStar_All.pipe_right quals (FStar_List.contains FStar_Syntax_Syntax.TotalEffect))))) in - let uu____15050 = + let uu____15363 = FStar_List.fold_left - (fun uu____15076 -> + (fun uu____15389 -> fun lb -> - match uu____15076 with + match uu____15389 with | (lbs1,env1) -> - let uu____15096 = + let uu____15409 = FStar_TypeChecker_Util.extract_let_rec_annotation env1 lb in - (match uu____15096 with + (match uu____15409 with | (univ_vars1,t,check_t) -> let env2 = FStar_TypeChecker_Env.push_univ_vars env1 @@ -6328,192 +6390,192 @@ and build_let_rec_env: if Prims.op_Negation check_t then t else - (let uu____15116 = - let uu____15123 = - let uu____15124 = + (let uu____15429 = + let uu____15436 = + let uu____15437 = FStar_Syntax_Util.type_u () in FStar_All.pipe_left - FStar_Pervasives_Native.fst uu____15124 in + FStar_Pervasives_Native.fst uu____15437 in tc_check_tot_or_gtot_term - (let uu___102_15135 = env0 in + (let uu___101_15448 = env0 in { FStar_TypeChecker_Env.solver = - (uu___102_15135.FStar_TypeChecker_Env.solver); + (uu___101_15448.FStar_TypeChecker_Env.solver); FStar_TypeChecker_Env.range = - (uu___102_15135.FStar_TypeChecker_Env.range); + (uu___101_15448.FStar_TypeChecker_Env.range); FStar_TypeChecker_Env.curmodule = - (uu___102_15135.FStar_TypeChecker_Env.curmodule); + (uu___101_15448.FStar_TypeChecker_Env.curmodule); FStar_TypeChecker_Env.gamma = - (uu___102_15135.FStar_TypeChecker_Env.gamma); + (uu___101_15448.FStar_TypeChecker_Env.gamma); FStar_TypeChecker_Env.gamma_cache = - (uu___102_15135.FStar_TypeChecker_Env.gamma_cache); + (uu___101_15448.FStar_TypeChecker_Env.gamma_cache); FStar_TypeChecker_Env.modules = - (uu___102_15135.FStar_TypeChecker_Env.modules); + (uu___101_15448.FStar_TypeChecker_Env.modules); FStar_TypeChecker_Env.expected_typ = - (uu___102_15135.FStar_TypeChecker_Env.expected_typ); + (uu___101_15448.FStar_TypeChecker_Env.expected_typ); FStar_TypeChecker_Env.sigtab = - (uu___102_15135.FStar_TypeChecker_Env.sigtab); + (uu___101_15448.FStar_TypeChecker_Env.sigtab); FStar_TypeChecker_Env.is_pattern = - (uu___102_15135.FStar_TypeChecker_Env.is_pattern); + (uu___101_15448.FStar_TypeChecker_Env.is_pattern); FStar_TypeChecker_Env.instantiate_imp = - (uu___102_15135.FStar_TypeChecker_Env.instantiate_imp); + (uu___101_15448.FStar_TypeChecker_Env.instantiate_imp); FStar_TypeChecker_Env.effects = - (uu___102_15135.FStar_TypeChecker_Env.effects); + (uu___101_15448.FStar_TypeChecker_Env.effects); FStar_TypeChecker_Env.generalize = - (uu___102_15135.FStar_TypeChecker_Env.generalize); + (uu___101_15448.FStar_TypeChecker_Env.generalize); FStar_TypeChecker_Env.letrecs = - (uu___102_15135.FStar_TypeChecker_Env.letrecs); + (uu___101_15448.FStar_TypeChecker_Env.letrecs); FStar_TypeChecker_Env.top_level = - (uu___102_15135.FStar_TypeChecker_Env.top_level); + (uu___101_15448.FStar_TypeChecker_Env.top_level); FStar_TypeChecker_Env.check_uvars = true; FStar_TypeChecker_Env.use_eq = - (uu___102_15135.FStar_TypeChecker_Env.use_eq); + (uu___101_15448.FStar_TypeChecker_Env.use_eq); FStar_TypeChecker_Env.is_iface = - (uu___102_15135.FStar_TypeChecker_Env.is_iface); + (uu___101_15448.FStar_TypeChecker_Env.is_iface); FStar_TypeChecker_Env.admit = - (uu___102_15135.FStar_TypeChecker_Env.admit); + (uu___101_15448.FStar_TypeChecker_Env.admit); FStar_TypeChecker_Env.lax = - (uu___102_15135.FStar_TypeChecker_Env.lax); + (uu___101_15448.FStar_TypeChecker_Env.lax); FStar_TypeChecker_Env.lax_universes = - (uu___102_15135.FStar_TypeChecker_Env.lax_universes); + (uu___101_15448.FStar_TypeChecker_Env.lax_universes); FStar_TypeChecker_Env.failhard = - (uu___102_15135.FStar_TypeChecker_Env.failhard); + (uu___101_15448.FStar_TypeChecker_Env.failhard); FStar_TypeChecker_Env.nosynth = - (uu___102_15135.FStar_TypeChecker_Env.nosynth); + (uu___101_15448.FStar_TypeChecker_Env.nosynth); FStar_TypeChecker_Env.tc_term = - (uu___102_15135.FStar_TypeChecker_Env.tc_term); + (uu___101_15448.FStar_TypeChecker_Env.tc_term); FStar_TypeChecker_Env.type_of = - (uu___102_15135.FStar_TypeChecker_Env.type_of); + (uu___101_15448.FStar_TypeChecker_Env.type_of); FStar_TypeChecker_Env.universe_of = - (uu___102_15135.FStar_TypeChecker_Env.universe_of); + (uu___101_15448.FStar_TypeChecker_Env.universe_of); FStar_TypeChecker_Env.use_bv_sorts = - (uu___102_15135.FStar_TypeChecker_Env.use_bv_sorts); + (uu___101_15448.FStar_TypeChecker_Env.use_bv_sorts); FStar_TypeChecker_Env.qname_and_index = - (uu___102_15135.FStar_TypeChecker_Env.qname_and_index); + (uu___101_15448.FStar_TypeChecker_Env.qname_and_index); FStar_TypeChecker_Env.proof_ns = - (uu___102_15135.FStar_TypeChecker_Env.proof_ns); + (uu___101_15448.FStar_TypeChecker_Env.proof_ns); FStar_TypeChecker_Env.synth = - (uu___102_15135.FStar_TypeChecker_Env.synth); + (uu___101_15448.FStar_TypeChecker_Env.synth); FStar_TypeChecker_Env.is_native_tactic = - (uu___102_15135.FStar_TypeChecker_Env.is_native_tactic); + (uu___101_15448.FStar_TypeChecker_Env.is_native_tactic); FStar_TypeChecker_Env.identifier_info = - (uu___102_15135.FStar_TypeChecker_Env.identifier_info); + (uu___101_15448.FStar_TypeChecker_Env.identifier_info); FStar_TypeChecker_Env.tc_hooks = - (uu___102_15135.FStar_TypeChecker_Env.tc_hooks); + (uu___101_15448.FStar_TypeChecker_Env.tc_hooks); FStar_TypeChecker_Env.dsenv = - (uu___102_15135.FStar_TypeChecker_Env.dsenv); + (uu___101_15448.FStar_TypeChecker_Env.dsenv); FStar_TypeChecker_Env.dep_graph = - (uu___102_15135.FStar_TypeChecker_Env.dep_graph) - }) t uu____15123 in - match uu____15116 with - | (t1,uu____15137,g) -> + (uu___101_15448.FStar_TypeChecker_Env.dep_graph) + }) t uu____15436 in + match uu____15429 with + | (t1,uu____15450,g) -> let g1 = FStar_TypeChecker_Rel.resolve_implicits g in - ((let uu____15141 = + ((let uu____15454 = FStar_TypeChecker_Rel.discharge_guard env2 g1 in FStar_All.pipe_left - FStar_Pervasives.ignore uu____15141); + FStar_Pervasives.ignore uu____15454); norm env0 t1)) in let env3 = - let uu____15143 = + let uu____15456 = termination_check_enabled lb.FStar_Syntax_Syntax.lbname e t1 in - if uu____15143 + if uu____15456 then - let uu___103_15144 = env2 in + let uu___102_15457 = env2 in { FStar_TypeChecker_Env.solver = - (uu___103_15144.FStar_TypeChecker_Env.solver); + (uu___102_15457.FStar_TypeChecker_Env.solver); FStar_TypeChecker_Env.range = - (uu___103_15144.FStar_TypeChecker_Env.range); + (uu___102_15457.FStar_TypeChecker_Env.range); FStar_TypeChecker_Env.curmodule = - (uu___103_15144.FStar_TypeChecker_Env.curmodule); + (uu___102_15457.FStar_TypeChecker_Env.curmodule); FStar_TypeChecker_Env.gamma = - (uu___103_15144.FStar_TypeChecker_Env.gamma); + (uu___102_15457.FStar_TypeChecker_Env.gamma); FStar_TypeChecker_Env.gamma_cache = - (uu___103_15144.FStar_TypeChecker_Env.gamma_cache); + (uu___102_15457.FStar_TypeChecker_Env.gamma_cache); FStar_TypeChecker_Env.modules = - (uu___103_15144.FStar_TypeChecker_Env.modules); + (uu___102_15457.FStar_TypeChecker_Env.modules); FStar_TypeChecker_Env.expected_typ = - (uu___103_15144.FStar_TypeChecker_Env.expected_typ); + (uu___102_15457.FStar_TypeChecker_Env.expected_typ); FStar_TypeChecker_Env.sigtab = - (uu___103_15144.FStar_TypeChecker_Env.sigtab); + (uu___102_15457.FStar_TypeChecker_Env.sigtab); FStar_TypeChecker_Env.is_pattern = - (uu___103_15144.FStar_TypeChecker_Env.is_pattern); + (uu___102_15457.FStar_TypeChecker_Env.is_pattern); FStar_TypeChecker_Env.instantiate_imp = - (uu___103_15144.FStar_TypeChecker_Env.instantiate_imp); + (uu___102_15457.FStar_TypeChecker_Env.instantiate_imp); FStar_TypeChecker_Env.effects = - (uu___103_15144.FStar_TypeChecker_Env.effects); + (uu___102_15457.FStar_TypeChecker_Env.effects); FStar_TypeChecker_Env.generalize = - (uu___103_15144.FStar_TypeChecker_Env.generalize); + (uu___102_15457.FStar_TypeChecker_Env.generalize); FStar_TypeChecker_Env.letrecs = (((lb.FStar_Syntax_Syntax.lbname), t1, univ_vars1) :: (env2.FStar_TypeChecker_Env.letrecs)); FStar_TypeChecker_Env.top_level = - (uu___103_15144.FStar_TypeChecker_Env.top_level); + (uu___102_15457.FStar_TypeChecker_Env.top_level); FStar_TypeChecker_Env.check_uvars = - (uu___103_15144.FStar_TypeChecker_Env.check_uvars); + (uu___102_15457.FStar_TypeChecker_Env.check_uvars); FStar_TypeChecker_Env.use_eq = - (uu___103_15144.FStar_TypeChecker_Env.use_eq); + (uu___102_15457.FStar_TypeChecker_Env.use_eq); FStar_TypeChecker_Env.is_iface = - (uu___103_15144.FStar_TypeChecker_Env.is_iface); + (uu___102_15457.FStar_TypeChecker_Env.is_iface); FStar_TypeChecker_Env.admit = - (uu___103_15144.FStar_TypeChecker_Env.admit); + (uu___102_15457.FStar_TypeChecker_Env.admit); FStar_TypeChecker_Env.lax = - (uu___103_15144.FStar_TypeChecker_Env.lax); + (uu___102_15457.FStar_TypeChecker_Env.lax); FStar_TypeChecker_Env.lax_universes = - (uu___103_15144.FStar_TypeChecker_Env.lax_universes); + (uu___102_15457.FStar_TypeChecker_Env.lax_universes); FStar_TypeChecker_Env.failhard = - (uu___103_15144.FStar_TypeChecker_Env.failhard); + (uu___102_15457.FStar_TypeChecker_Env.failhard); FStar_TypeChecker_Env.nosynth = - (uu___103_15144.FStar_TypeChecker_Env.nosynth); + (uu___102_15457.FStar_TypeChecker_Env.nosynth); FStar_TypeChecker_Env.tc_term = - (uu___103_15144.FStar_TypeChecker_Env.tc_term); + (uu___102_15457.FStar_TypeChecker_Env.tc_term); FStar_TypeChecker_Env.type_of = - (uu___103_15144.FStar_TypeChecker_Env.type_of); + (uu___102_15457.FStar_TypeChecker_Env.type_of); FStar_TypeChecker_Env.universe_of = - (uu___103_15144.FStar_TypeChecker_Env.universe_of); + (uu___102_15457.FStar_TypeChecker_Env.universe_of); FStar_TypeChecker_Env.use_bv_sorts = - (uu___103_15144.FStar_TypeChecker_Env.use_bv_sorts); + (uu___102_15457.FStar_TypeChecker_Env.use_bv_sorts); FStar_TypeChecker_Env.qname_and_index = - (uu___103_15144.FStar_TypeChecker_Env.qname_and_index); + (uu___102_15457.FStar_TypeChecker_Env.qname_and_index); FStar_TypeChecker_Env.proof_ns = - (uu___103_15144.FStar_TypeChecker_Env.proof_ns); + (uu___102_15457.FStar_TypeChecker_Env.proof_ns); FStar_TypeChecker_Env.synth = - (uu___103_15144.FStar_TypeChecker_Env.synth); + (uu___102_15457.FStar_TypeChecker_Env.synth); FStar_TypeChecker_Env.is_native_tactic = - (uu___103_15144.FStar_TypeChecker_Env.is_native_tactic); + (uu___102_15457.FStar_TypeChecker_Env.is_native_tactic); FStar_TypeChecker_Env.identifier_info = - (uu___103_15144.FStar_TypeChecker_Env.identifier_info); + (uu___102_15457.FStar_TypeChecker_Env.identifier_info); FStar_TypeChecker_Env.tc_hooks = - (uu___103_15144.FStar_TypeChecker_Env.tc_hooks); + (uu___102_15457.FStar_TypeChecker_Env.tc_hooks); FStar_TypeChecker_Env.dsenv = - (uu___103_15144.FStar_TypeChecker_Env.dsenv); + (uu___102_15457.FStar_TypeChecker_Env.dsenv); FStar_TypeChecker_Env.dep_graph = - (uu___103_15144.FStar_TypeChecker_Env.dep_graph) + (uu___102_15457.FStar_TypeChecker_Env.dep_graph) } else FStar_TypeChecker_Env.push_let_binding env2 lb.FStar_Syntax_Syntax.lbname (univ_vars1, t1) in let lb1 = - let uu___104_15161 = lb in + let uu___103_15474 = lb in { FStar_Syntax_Syntax.lbname = - (uu___104_15161.FStar_Syntax_Syntax.lbname); + (uu___103_15474.FStar_Syntax_Syntax.lbname); FStar_Syntax_Syntax.lbunivs = univ_vars1; FStar_Syntax_Syntax.lbtyp = t1; FStar_Syntax_Syntax.lbeff = - (uu___104_15161.FStar_Syntax_Syntax.lbeff); + (uu___103_15474.FStar_Syntax_Syntax.lbeff); FStar_Syntax_Syntax.lbdef = e } in ((lb1 :: lbs1), env3))) ([], env) lbs in - match uu____15050 with | (lbs1,env1) -> ((FStar_List.rev lbs1), env1) + match uu____15363 with | (lbs1,env1) -> ((FStar_List.rev lbs1), env1) and check_let_recs: FStar_TypeChecker_Env.env_t -> FStar_Syntax_Syntax.letbinding Prims.list -> @@ -6522,54 +6584,54 @@ and check_let_recs: = fun env -> fun lbs -> - let uu____15184 = - let uu____15193 = + let uu____15497 = + let uu____15506 = FStar_All.pipe_right lbs (FStar_List.map (fun lb -> - let uu____15219 = + let uu____15532 = FStar_Syntax_Util.abs_formals lb.FStar_Syntax_Syntax.lbdef in - match uu____15219 with + match uu____15532 with | (bs,t,lcomp) -> (match bs with | [] -> - let uu____15247 = + let uu____15560 = FStar_Syntax_Syntax.range_of_lbname lb.FStar_Syntax_Syntax.lbname in FStar_Errors.raise_error (FStar_Errors.Fatal_RecursiveFunctionLiteral, "Only function literals may be defined recursively") - uu____15247 - | uu____15252 -> + uu____15560 + | uu____15565 -> let lb1 = - let uu___105_15255 = lb in - let uu____15256 = + let uu___104_15568 = lb in + let uu____15569 = FStar_Syntax_Util.abs bs t lcomp in { FStar_Syntax_Syntax.lbname = - (uu___105_15255.FStar_Syntax_Syntax.lbname); + (uu___104_15568.FStar_Syntax_Syntax.lbname); FStar_Syntax_Syntax.lbunivs = - (uu___105_15255.FStar_Syntax_Syntax.lbunivs); + (uu___104_15568.FStar_Syntax_Syntax.lbunivs); FStar_Syntax_Syntax.lbtyp = - (uu___105_15255.FStar_Syntax_Syntax.lbtyp); + (uu___104_15568.FStar_Syntax_Syntax.lbtyp); FStar_Syntax_Syntax.lbeff = - (uu___105_15255.FStar_Syntax_Syntax.lbeff); - FStar_Syntax_Syntax.lbdef = uu____15256 + (uu___104_15568.FStar_Syntax_Syntax.lbeff); + FStar_Syntax_Syntax.lbdef = uu____15569 } in - let uu____15259 = - let uu____15266 = + let uu____15572 = + let uu____15579 = FStar_TypeChecker_Env.set_expected_typ env lb1.FStar_Syntax_Syntax.lbtyp in - tc_tot_or_gtot_term uu____15266 + tc_tot_or_gtot_term uu____15579 lb1.FStar_Syntax_Syntax.lbdef in - (match uu____15259 with + (match uu____15572 with | (e,c,g) -> - ((let uu____15275 = - let uu____15276 = + ((let uu____15588 = + let uu____15589 = FStar_Syntax_Util.is_total_lcomp c in - Prims.op_Negation uu____15276 in - if uu____15275 + Prims.op_Negation uu____15589 in + if uu____15588 then FStar_Errors.raise_error (FStar_Errors.Fatal_UnexpectedGTotForLetRec, @@ -6583,8 +6645,8 @@ and check_let_recs: lb1.FStar_Syntax_Syntax.lbtyp FStar_Parser_Const.effect_Tot_lid e in (lb2, g))))))) in - FStar_All.pipe_right uu____15193 FStar_List.unzip in - match uu____15184 with + FStar_All.pipe_right uu____15506 FStar_List.unzip in + match uu____15497 with | (lbs1,gs) -> let g_lbs = FStar_List.fold_right FStar_TypeChecker_Rel.conj_guard gs @@ -6601,12 +6663,12 @@ and check_let_bound_def: fun top_level -> fun env -> fun lb -> - let uu____15325 = FStar_TypeChecker_Env.clear_expected_typ env in - match uu____15325 with - | (env1,uu____15343) -> + let uu____15638 = FStar_TypeChecker_Env.clear_expected_typ env in + match uu____15638 with + | (env1,uu____15656) -> let e1 = lb.FStar_Syntax_Syntax.lbdef in - let uu____15351 = check_lbtyp top_level env lb in - (match uu____15351 with + let uu____15664 = check_lbtyp top_level env lb in + (match uu____15664 with | (topt,wf_annot,univ_vars1,univ_opening,env11) -> (if (Prims.op_Negation top_level) && (univ_vars1 <> []) then @@ -6616,111 +6678,110 @@ and check_let_bound_def: e1.FStar_Syntax_Syntax.pos else (); (let e11 = FStar_Syntax_Subst.subst univ_opening e1 in - let uu____15395 = + let uu____15708 = tc_maybe_toplevel_term - (let uu___106_15404 = env11 in + (let uu___105_15717 = env11 in { FStar_TypeChecker_Env.solver = - (uu___106_15404.FStar_TypeChecker_Env.solver); + (uu___105_15717.FStar_TypeChecker_Env.solver); FStar_TypeChecker_Env.range = - (uu___106_15404.FStar_TypeChecker_Env.range); + (uu___105_15717.FStar_TypeChecker_Env.range); FStar_TypeChecker_Env.curmodule = - (uu___106_15404.FStar_TypeChecker_Env.curmodule); + (uu___105_15717.FStar_TypeChecker_Env.curmodule); FStar_TypeChecker_Env.gamma = - (uu___106_15404.FStar_TypeChecker_Env.gamma); + (uu___105_15717.FStar_TypeChecker_Env.gamma); FStar_TypeChecker_Env.gamma_cache = - (uu___106_15404.FStar_TypeChecker_Env.gamma_cache); + (uu___105_15717.FStar_TypeChecker_Env.gamma_cache); FStar_TypeChecker_Env.modules = - (uu___106_15404.FStar_TypeChecker_Env.modules); + (uu___105_15717.FStar_TypeChecker_Env.modules); FStar_TypeChecker_Env.expected_typ = - (uu___106_15404.FStar_TypeChecker_Env.expected_typ); + (uu___105_15717.FStar_TypeChecker_Env.expected_typ); FStar_TypeChecker_Env.sigtab = - (uu___106_15404.FStar_TypeChecker_Env.sigtab); + (uu___105_15717.FStar_TypeChecker_Env.sigtab); FStar_TypeChecker_Env.is_pattern = - (uu___106_15404.FStar_TypeChecker_Env.is_pattern); + (uu___105_15717.FStar_TypeChecker_Env.is_pattern); FStar_TypeChecker_Env.instantiate_imp = - (uu___106_15404.FStar_TypeChecker_Env.instantiate_imp); + (uu___105_15717.FStar_TypeChecker_Env.instantiate_imp); FStar_TypeChecker_Env.effects = - (uu___106_15404.FStar_TypeChecker_Env.effects); + (uu___105_15717.FStar_TypeChecker_Env.effects); FStar_TypeChecker_Env.generalize = - (uu___106_15404.FStar_TypeChecker_Env.generalize); + (uu___105_15717.FStar_TypeChecker_Env.generalize); FStar_TypeChecker_Env.letrecs = - (uu___106_15404.FStar_TypeChecker_Env.letrecs); + (uu___105_15717.FStar_TypeChecker_Env.letrecs); FStar_TypeChecker_Env.top_level = top_level; FStar_TypeChecker_Env.check_uvars = - (uu___106_15404.FStar_TypeChecker_Env.check_uvars); + (uu___105_15717.FStar_TypeChecker_Env.check_uvars); FStar_TypeChecker_Env.use_eq = - (uu___106_15404.FStar_TypeChecker_Env.use_eq); + (uu___105_15717.FStar_TypeChecker_Env.use_eq); FStar_TypeChecker_Env.is_iface = - (uu___106_15404.FStar_TypeChecker_Env.is_iface); + (uu___105_15717.FStar_TypeChecker_Env.is_iface); FStar_TypeChecker_Env.admit = - (uu___106_15404.FStar_TypeChecker_Env.admit); + (uu___105_15717.FStar_TypeChecker_Env.admit); FStar_TypeChecker_Env.lax = - (uu___106_15404.FStar_TypeChecker_Env.lax); + (uu___105_15717.FStar_TypeChecker_Env.lax); FStar_TypeChecker_Env.lax_universes = - (uu___106_15404.FStar_TypeChecker_Env.lax_universes); + (uu___105_15717.FStar_TypeChecker_Env.lax_universes); FStar_TypeChecker_Env.failhard = - (uu___106_15404.FStar_TypeChecker_Env.failhard); + (uu___105_15717.FStar_TypeChecker_Env.failhard); FStar_TypeChecker_Env.nosynth = - (uu___106_15404.FStar_TypeChecker_Env.nosynth); + (uu___105_15717.FStar_TypeChecker_Env.nosynth); FStar_TypeChecker_Env.tc_term = - (uu___106_15404.FStar_TypeChecker_Env.tc_term); + (uu___105_15717.FStar_TypeChecker_Env.tc_term); FStar_TypeChecker_Env.type_of = - (uu___106_15404.FStar_TypeChecker_Env.type_of); + (uu___105_15717.FStar_TypeChecker_Env.type_of); FStar_TypeChecker_Env.universe_of = - (uu___106_15404.FStar_TypeChecker_Env.universe_of); + (uu___105_15717.FStar_TypeChecker_Env.universe_of); FStar_TypeChecker_Env.use_bv_sorts = - (uu___106_15404.FStar_TypeChecker_Env.use_bv_sorts); + (uu___105_15717.FStar_TypeChecker_Env.use_bv_sorts); FStar_TypeChecker_Env.qname_and_index = - (uu___106_15404.FStar_TypeChecker_Env.qname_and_index); + (uu___105_15717.FStar_TypeChecker_Env.qname_and_index); FStar_TypeChecker_Env.proof_ns = - (uu___106_15404.FStar_TypeChecker_Env.proof_ns); + (uu___105_15717.FStar_TypeChecker_Env.proof_ns); FStar_TypeChecker_Env.synth = - (uu___106_15404.FStar_TypeChecker_Env.synth); + (uu___105_15717.FStar_TypeChecker_Env.synth); FStar_TypeChecker_Env.is_native_tactic = - (uu___106_15404.FStar_TypeChecker_Env.is_native_tactic); + (uu___105_15717.FStar_TypeChecker_Env.is_native_tactic); FStar_TypeChecker_Env.identifier_info = - (uu___106_15404.FStar_TypeChecker_Env.identifier_info); + (uu___105_15717.FStar_TypeChecker_Env.identifier_info); FStar_TypeChecker_Env.tc_hooks = - (uu___106_15404.FStar_TypeChecker_Env.tc_hooks); + (uu___105_15717.FStar_TypeChecker_Env.tc_hooks); FStar_TypeChecker_Env.dsenv = - (uu___106_15404.FStar_TypeChecker_Env.dsenv); + (uu___105_15717.FStar_TypeChecker_Env.dsenv); FStar_TypeChecker_Env.dep_graph = - (uu___106_15404.FStar_TypeChecker_Env.dep_graph) + (uu___105_15717.FStar_TypeChecker_Env.dep_graph) }) e11 in - match uu____15395 with + match uu____15708 with | (e12,c1,g1) -> - let uu____15418 = - let uu____15423 = + let uu____15731 = + let uu____15736 = FStar_TypeChecker_Env.set_range env11 e12.FStar_Syntax_Syntax.pos in FStar_TypeChecker_Util.strengthen_precondition (FStar_Pervasives_Native.Some - (fun uu____15427 -> + (fun uu____15740 -> FStar_Util.return_all FStar_TypeChecker_Err.ill_kinded_type)) - uu____15423 e12 c1 wf_annot in - (match uu____15418 with + uu____15736 e12 c1 wf_annot in + (match uu____15731 with | (c11,guard_f) -> let g11 = FStar_TypeChecker_Rel.conj_guard g1 guard_f in - ((let uu____15442 = + ((let uu____15755 = FStar_TypeChecker_Env.debug env FStar_Options.Extreme in - if uu____15442 + if uu____15755 then - let uu____15443 = + let uu____15756 = FStar_Syntax_Print.lbname_to_string lb.FStar_Syntax_Syntax.lbname in - let uu____15444 = - FStar_Syntax_Print.term_to_string - c11.FStar_Syntax_Syntax.res_typ in - let uu____15445 = + let uu____15757 = + FStar_Syntax_Print.lcomp_to_string c11 in + let uu____15758 = FStar_TypeChecker_Rel.guard_to_string env g11 in FStar_Util.print3 - "checked top-level def %s, result type is %s, guard is %s\n" - uu____15443 uu____15444 uu____15445 + "checked let-bound def %s : %s guard is %s\n" + uu____15756 uu____15757 uu____15758 else ()); (e12, univ_vars1, c11, g11, (FStar_Option.isSome topt))))))) @@ -6739,19 +6800,19 @@ and check_lbtyp: let t = FStar_Syntax_Subst.compress lb.FStar_Syntax_Syntax.lbtyp in match t.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Tm_unknown -> - let uu____15479 = + let uu____15792 = FStar_Syntax_Subst.univ_var_opening lb.FStar_Syntax_Syntax.lbunivs in - (match uu____15479 with + (match uu____15792 with | (univ_opening,univ_vars1) -> (FStar_Pervasives_Native.None, FStar_TypeChecker_Rel.trivial_guard, univ_vars1, univ_opening, env)) - | uu____15518 -> - let uu____15519 = + | uu____15831 -> + let uu____15832 = FStar_Syntax_Subst.univ_var_opening lb.FStar_Syntax_Syntax.lbunivs in - (match uu____15519 with + (match uu____15832 with | (univ_opening,univ_vars1) -> let t1 = FStar_Syntax_Subst.subst univ_opening t in let env1 = @@ -6760,40 +6821,40 @@ and check_lbtyp: top_level && (Prims.op_Negation env.FStar_TypeChecker_Env.generalize) then - let uu____15568 = + let uu____15881 = FStar_TypeChecker_Env.set_expected_typ env1 t1 in ((FStar_Pervasives_Native.Some t1), FStar_TypeChecker_Rel.trivial_guard, univ_vars1, - univ_opening, uu____15568) + univ_opening, uu____15881) else - (let uu____15576 = FStar_Syntax_Util.type_u () in - match uu____15576 with - | (k,uu____15596) -> - let uu____15597 = tc_check_tot_or_gtot_term env1 t1 k in - (match uu____15597 with - | (t2,uu____15619,g) -> - ((let uu____15622 = + (let uu____15889 = FStar_Syntax_Util.type_u () in + match uu____15889 with + | (k,uu____15909) -> + let uu____15910 = tc_check_tot_or_gtot_term env1 t1 k in + (match uu____15910 with + | (t2,uu____15932,g) -> + ((let uu____15935 = FStar_TypeChecker_Env.debug env FStar_Options.Medium in - if uu____15622 + if uu____15935 then - let uu____15623 = - let uu____15624 = + let uu____15936 = + let uu____15937 = FStar_Syntax_Syntax.range_of_lbname lb.FStar_Syntax_Syntax.lbname in - FStar_Range.string_of_range uu____15624 in - let uu____15625 = + FStar_Range.string_of_range uu____15937 in + let uu____15938 = FStar_Syntax_Print.term_to_string t2 in FStar_Util.print2 "(%s) Checked type annotation %s\n" - uu____15623 uu____15625 + uu____15936 uu____15938 else ()); (let t3 = norm env1 t2 in - let uu____15628 = + let uu____15941 = FStar_TypeChecker_Env.set_expected_typ env1 t3 in ((FStar_Pervasives_Native.Some t3), g, - univ_vars1, univ_opening, uu____15628)))))) + univ_vars1, univ_opening, uu____15941)))))) and tc_binder: FStar_TypeChecker_Env.env -> (FStar_Syntax_Syntax.bv,FStar_Syntax_Syntax.aqual) @@ -6803,52 +6864,52 @@ and tc_binder: FStar_Syntax_Syntax.universe) FStar_Pervasives_Native.tuple4 = fun env -> - fun uu____15636 -> - match uu____15636 with + fun uu____15949 -> + match uu____15949 with | (x,imp) -> - let uu____15655 = FStar_Syntax_Util.type_u () in - (match uu____15655 with + let uu____15968 = FStar_Syntax_Util.type_u () in + (match uu____15968 with | (tu,u) -> - ((let uu____15675 = + ((let uu____15988 = FStar_TypeChecker_Env.debug env FStar_Options.Extreme in - if uu____15675 + if uu____15988 then - let uu____15676 = FStar_Syntax_Print.bv_to_string x in - let uu____15677 = + let uu____15989 = FStar_Syntax_Print.bv_to_string x in + let uu____15990 = FStar_Syntax_Print.term_to_string x.FStar_Syntax_Syntax.sort in - let uu____15678 = FStar_Syntax_Print.term_to_string tu in + let uu____15991 = FStar_Syntax_Print.term_to_string tu in FStar_Util.print3 "Checking binders %s:%s at type %s\n" - uu____15676 uu____15677 uu____15678 + uu____15989 uu____15990 uu____15991 else ()); - (let uu____15680 = + (let uu____15993 = tc_check_tot_or_gtot_term env x.FStar_Syntax_Syntax.sort tu in - match uu____15680 with - | (t,uu____15700,g) -> + match uu____15993 with + | (t,uu____16013,g) -> let x1 = - ((let uu___107_15708 = x in + ((let uu___106_16021 = x in { FStar_Syntax_Syntax.ppname = - (uu___107_15708.FStar_Syntax_Syntax.ppname); + (uu___106_16021.FStar_Syntax_Syntax.ppname); FStar_Syntax_Syntax.index = - (uu___107_15708.FStar_Syntax_Syntax.index); + (uu___106_16021.FStar_Syntax_Syntax.index); FStar_Syntax_Syntax.sort = t }), imp) in - ((let uu____15710 = + ((let uu____16023 = FStar_TypeChecker_Env.debug env FStar_Options.High in - if uu____15710 + if uu____16023 then - let uu____15711 = + let uu____16024 = FStar_Syntax_Print.bv_to_string (FStar_Pervasives_Native.fst x1) in - let uu____15712 = + let uu____16025 = FStar_Syntax_Print.term_to_string t in FStar_Util.print2 "Pushing binder %s at type %s\n" - uu____15711 uu____15712 + uu____16024 uu____16025 else ()); - (let uu____15714 = push_binding env x1 in - (x1, uu____15714, g, u)))))) + (let uu____16027 = push_binding env x1 in + (x1, uu____16027, g, u)))))) and tc_binders: FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.binders -> @@ -6861,17 +6922,17 @@ and tc_binders: match bs1 with | [] -> ([], env1, FStar_TypeChecker_Rel.trivial_guard, []) | b::bs2 -> - let uu____15804 = tc_binder env1 b in - (match uu____15804 with + let uu____16117 = tc_binder env1 b in + (match uu____16117 with | (b1,env',g,u) -> - let uu____15845 = aux env' bs2 in - (match uu____15845 with + let uu____16158 = aux env' bs2 in + (match uu____16158 with | (bs3,env'1,g',us) -> - let uu____15898 = - let uu____15899 = + let uu____16211 = + let uu____16212 = FStar_TypeChecker_Rel.close_guard_univs [u] [b1] g' in - FStar_TypeChecker_Rel.conj_guard g uu____15899 in - ((b1 :: bs3), env'1, uu____15898, (u :: us)))) in + FStar_TypeChecker_Rel.conj_guard g uu____16212 in + ((b1 :: bs3), env'1, uu____16211, (u :: us)))) in aux env bs and tc_pats: FStar_TypeChecker_Env.env -> @@ -6885,27 +6946,27 @@ and tc_pats: fun pats -> let tc_args env1 args = FStar_List.fold_right - (fun uu____15984 -> - fun uu____15985 -> - match (uu____15984, uu____15985) with + (fun uu____16297 -> + fun uu____16298 -> + match (uu____16297, uu____16298) with | ((t,imp),(args1,g)) -> - let uu____16054 = tc_term env1 t in - (match uu____16054 with - | (t1,uu____16072,g') -> - let uu____16074 = + let uu____16367 = tc_term env1 t in + (match uu____16367 with + | (t1,uu____16385,g') -> + let uu____16387 = FStar_TypeChecker_Rel.conj_guard g g' in - (((t1, imp) :: args1), uu____16074))) args + (((t1, imp) :: args1), uu____16387))) args ([], FStar_TypeChecker_Rel.trivial_guard) in FStar_List.fold_right (fun p -> - fun uu____16116 -> - match uu____16116 with + fun uu____16429 -> + match uu____16429 with | (pats1,g) -> - let uu____16141 = tc_args env p in - (match uu____16141 with + let uu____16454 = tc_args env p in + (match uu____16454 with | (args,g') -> - let uu____16154 = FStar_TypeChecker_Rel.conj_guard g g' in - ((args :: pats1), uu____16154))) pats + let uu____16467 = FStar_TypeChecker_Rel.conj_guard g g' in + ((args :: pats1), uu____16467))) pats ([], FStar_TypeChecker_Rel.trivial_guard) and tc_tot_or_gtot_term: FStar_TypeChecker_Env.env -> @@ -6915,54 +6976,55 @@ and tc_tot_or_gtot_term: = fun env -> fun e -> - let uu____16167 = tc_maybe_toplevel_term env e in - match uu____16167 with + let uu____16480 = tc_maybe_toplevel_term env e in + match uu____16480 with | (e1,c,g) -> - let uu____16183 = FStar_Syntax_Util.is_tot_or_gtot_lcomp c in - if uu____16183 + let uu____16496 = FStar_Syntax_Util.is_tot_or_gtot_lcomp c in + if uu____16496 then (e1, c, g) else (let g1 = FStar_TypeChecker_Rel.solve_deferred_constraints env g in - let c1 = c.FStar_Syntax_Syntax.comp () in + let c1 = FStar_Syntax_Syntax.lcomp_comp c in let c2 = norm_c env c1 in - let uu____16196 = - let uu____16201 = + let uu____16507 = + let uu____16512 = FStar_TypeChecker_Util.is_pure_effect env (FStar_Syntax_Util.comp_effect_name c2) in - if uu____16201 + if uu____16512 then - let uu____16206 = + let uu____16517 = FStar_Syntax_Syntax.mk_Total (FStar_Syntax_Util.comp_result c2) in - (uu____16206, false) + (uu____16517, false) else - (let uu____16208 = + (let uu____16519 = FStar_Syntax_Syntax.mk_GTotal (FStar_Syntax_Util.comp_result c2) in - (uu____16208, true)) in - match uu____16196 with + (uu____16519, true)) in + match uu____16507 with | (target_comp,allow_ghost) -> - let uu____16217 = + let uu____16528 = FStar_TypeChecker_Rel.sub_comp env c2 target_comp in - (match uu____16217 with + (match uu____16528 with | FStar_Pervasives_Native.Some g' -> - let uu____16227 = + let uu____16538 = + FStar_Syntax_Util.lcomp_of_comp target_comp in + let uu____16539 = FStar_TypeChecker_Rel.conj_guard g1 g' in - (e1, (FStar_Syntax_Util.lcomp_of_comp target_comp), - uu____16227) - | uu____16228 -> + (e1, uu____16538, uu____16539) + | uu____16540 -> if allow_ghost then - let uu____16237 = + let uu____16549 = FStar_TypeChecker_Err.expected_ghost_expression e1 c2 in - FStar_Errors.raise_error uu____16237 + FStar_Errors.raise_error uu____16549 e1.FStar_Syntax_Syntax.pos else - (let uu____16249 = + (let uu____16561 = FStar_TypeChecker_Err.expected_pure_expression e1 c2 in - FStar_Errors.raise_error uu____16249 + FStar_Errors.raise_error uu____16561 e1.FStar_Syntax_Syntax.pos))) and tc_check_tot_or_gtot_term: FStar_TypeChecker_Env.env -> @@ -6984,8 +7046,8 @@ and tc_trivial_guard: = fun env -> fun t -> - let uu____16272 = tc_tot_or_gtot_term env t in - match uu____16272 with + let uu____16584 = tc_tot_or_gtot_term env t in + match uu____16584 with | (t1,c,g) -> (FStar_TypeChecker_Rel.force_trivial_guard env g; (t1, c)) let type_of_tot_term: @@ -6996,121 +7058,121 @@ let type_of_tot_term: = fun env -> fun e -> - (let uu____16300 = + (let uu____16612 = FStar_All.pipe_left (FStar_TypeChecker_Env.debug env) (FStar_Options.Other "RelCheck") in - if uu____16300 + if uu____16612 then - let uu____16301 = FStar_Syntax_Print.term_to_string e in - FStar_Util.print1 "Checking term %s\n" uu____16301 + let uu____16613 = FStar_Syntax_Print.term_to_string e in + FStar_Util.print1 "Checking term %s\n" uu____16613 else ()); (let env1 = - let uu___108_16304 = env in + let uu___107_16616 = env in { FStar_TypeChecker_Env.solver = - (uu___108_16304.FStar_TypeChecker_Env.solver); + (uu___107_16616.FStar_TypeChecker_Env.solver); FStar_TypeChecker_Env.range = - (uu___108_16304.FStar_TypeChecker_Env.range); + (uu___107_16616.FStar_TypeChecker_Env.range); FStar_TypeChecker_Env.curmodule = - (uu___108_16304.FStar_TypeChecker_Env.curmodule); + (uu___107_16616.FStar_TypeChecker_Env.curmodule); FStar_TypeChecker_Env.gamma = - (uu___108_16304.FStar_TypeChecker_Env.gamma); + (uu___107_16616.FStar_TypeChecker_Env.gamma); FStar_TypeChecker_Env.gamma_cache = - (uu___108_16304.FStar_TypeChecker_Env.gamma_cache); + (uu___107_16616.FStar_TypeChecker_Env.gamma_cache); FStar_TypeChecker_Env.modules = - (uu___108_16304.FStar_TypeChecker_Env.modules); + (uu___107_16616.FStar_TypeChecker_Env.modules); FStar_TypeChecker_Env.expected_typ = - (uu___108_16304.FStar_TypeChecker_Env.expected_typ); + (uu___107_16616.FStar_TypeChecker_Env.expected_typ); FStar_TypeChecker_Env.sigtab = - (uu___108_16304.FStar_TypeChecker_Env.sigtab); + (uu___107_16616.FStar_TypeChecker_Env.sigtab); FStar_TypeChecker_Env.is_pattern = - (uu___108_16304.FStar_TypeChecker_Env.is_pattern); + (uu___107_16616.FStar_TypeChecker_Env.is_pattern); FStar_TypeChecker_Env.instantiate_imp = - (uu___108_16304.FStar_TypeChecker_Env.instantiate_imp); + (uu___107_16616.FStar_TypeChecker_Env.instantiate_imp); FStar_TypeChecker_Env.effects = - (uu___108_16304.FStar_TypeChecker_Env.effects); + (uu___107_16616.FStar_TypeChecker_Env.effects); FStar_TypeChecker_Env.generalize = - (uu___108_16304.FStar_TypeChecker_Env.generalize); + (uu___107_16616.FStar_TypeChecker_Env.generalize); FStar_TypeChecker_Env.letrecs = []; FStar_TypeChecker_Env.top_level = false; FStar_TypeChecker_Env.check_uvars = - (uu___108_16304.FStar_TypeChecker_Env.check_uvars); + (uu___107_16616.FStar_TypeChecker_Env.check_uvars); FStar_TypeChecker_Env.use_eq = - (uu___108_16304.FStar_TypeChecker_Env.use_eq); + (uu___107_16616.FStar_TypeChecker_Env.use_eq); FStar_TypeChecker_Env.is_iface = - (uu___108_16304.FStar_TypeChecker_Env.is_iface); + (uu___107_16616.FStar_TypeChecker_Env.is_iface); FStar_TypeChecker_Env.admit = - (uu___108_16304.FStar_TypeChecker_Env.admit); + (uu___107_16616.FStar_TypeChecker_Env.admit); FStar_TypeChecker_Env.lax = - (uu___108_16304.FStar_TypeChecker_Env.lax); + (uu___107_16616.FStar_TypeChecker_Env.lax); FStar_TypeChecker_Env.lax_universes = - (uu___108_16304.FStar_TypeChecker_Env.lax_universes); + (uu___107_16616.FStar_TypeChecker_Env.lax_universes); FStar_TypeChecker_Env.failhard = - (uu___108_16304.FStar_TypeChecker_Env.failhard); + (uu___107_16616.FStar_TypeChecker_Env.failhard); FStar_TypeChecker_Env.nosynth = - (uu___108_16304.FStar_TypeChecker_Env.nosynth); + (uu___107_16616.FStar_TypeChecker_Env.nosynth); FStar_TypeChecker_Env.tc_term = - (uu___108_16304.FStar_TypeChecker_Env.tc_term); + (uu___107_16616.FStar_TypeChecker_Env.tc_term); FStar_TypeChecker_Env.type_of = - (uu___108_16304.FStar_TypeChecker_Env.type_of); + (uu___107_16616.FStar_TypeChecker_Env.type_of); FStar_TypeChecker_Env.universe_of = - (uu___108_16304.FStar_TypeChecker_Env.universe_of); + (uu___107_16616.FStar_TypeChecker_Env.universe_of); FStar_TypeChecker_Env.use_bv_sorts = - (uu___108_16304.FStar_TypeChecker_Env.use_bv_sorts); + (uu___107_16616.FStar_TypeChecker_Env.use_bv_sorts); FStar_TypeChecker_Env.qname_and_index = - (uu___108_16304.FStar_TypeChecker_Env.qname_and_index); + (uu___107_16616.FStar_TypeChecker_Env.qname_and_index); FStar_TypeChecker_Env.proof_ns = - (uu___108_16304.FStar_TypeChecker_Env.proof_ns); + (uu___107_16616.FStar_TypeChecker_Env.proof_ns); FStar_TypeChecker_Env.synth = - (uu___108_16304.FStar_TypeChecker_Env.synth); + (uu___107_16616.FStar_TypeChecker_Env.synth); FStar_TypeChecker_Env.is_native_tactic = - (uu___108_16304.FStar_TypeChecker_Env.is_native_tactic); + (uu___107_16616.FStar_TypeChecker_Env.is_native_tactic); FStar_TypeChecker_Env.identifier_info = - (uu___108_16304.FStar_TypeChecker_Env.identifier_info); + (uu___107_16616.FStar_TypeChecker_Env.identifier_info); FStar_TypeChecker_Env.tc_hooks = - (uu___108_16304.FStar_TypeChecker_Env.tc_hooks); + (uu___107_16616.FStar_TypeChecker_Env.tc_hooks); FStar_TypeChecker_Env.dsenv = - (uu___108_16304.FStar_TypeChecker_Env.dsenv); + (uu___107_16616.FStar_TypeChecker_Env.dsenv); FStar_TypeChecker_Env.dep_graph = - (uu___108_16304.FStar_TypeChecker_Env.dep_graph) + (uu___107_16616.FStar_TypeChecker_Env.dep_graph) } in - let uu____16311 = + let uu____16623 = try tc_tot_or_gtot_term env1 e with - | FStar_Errors.Error (e1,msg,uu____16346) -> - let uu____16347 = FStar_TypeChecker_Env.get_range env1 in - FStar_Errors.raise_error (e1, msg) uu____16347 in - match uu____16311 with + | FStar_Errors.Error (e1,msg,uu____16658) -> + let uu____16659 = FStar_TypeChecker_Env.get_range env1 in + FStar_Errors.raise_error (e1, msg) uu____16659 in + match uu____16623 with | (t,c,g) -> - let uu____16363 = FStar_Syntax_Util.is_total_lcomp c in - if uu____16363 + let uu____16675 = FStar_Syntax_Util.is_total_lcomp c in + if uu____16675 then (t, (c.FStar_Syntax_Syntax.res_typ), g) else - (let uu____16373 = - let uu____16378 = - let uu____16379 = FStar_Syntax_Print.term_to_string e in + (let uu____16685 = + let uu____16690 = + let uu____16691 = FStar_Syntax_Print.term_to_string e in FStar_Util.format1 "Implicit argument: Expected a total term; got a ghost term: %s" - uu____16379 in - (FStar_Errors.Fatal_UnexpectedImplictArgument, uu____16378) in - let uu____16380 = FStar_TypeChecker_Env.get_range env1 in - FStar_Errors.raise_error uu____16373 uu____16380)) + uu____16691 in + (FStar_Errors.Fatal_UnexpectedImplictArgument, uu____16690) in + let uu____16692 = FStar_TypeChecker_Env.get_range env1 in + FStar_Errors.raise_error uu____16685 uu____16692)) let level_of_type_fail: - 'Auu____16391 . + 'Auu____16703 . FStar_TypeChecker_Env.env -> - FStar_Syntax_Syntax.term -> Prims.string -> 'Auu____16391 + FStar_Syntax_Syntax.term -> Prims.string -> 'Auu____16703 = fun env -> fun e -> fun t -> - let uu____16404 = - let uu____16409 = - let uu____16410 = FStar_Syntax_Print.term_to_string e in + let uu____16716 = + let uu____16721 = + let uu____16722 = FStar_Syntax_Print.term_to_string e in FStar_Util.format2 "Expected a term of type 'Type'; got %s : %s" - uu____16410 t in - (FStar_Errors.Fatal_UnexpectedTermType, uu____16409) in - let uu____16411 = FStar_TypeChecker_Env.get_range env in - FStar_Errors.raise_error uu____16404 uu____16411 + uu____16722 t in + (FStar_Errors.Fatal_UnexpectedTermType, uu____16721) in + let uu____16723 = FStar_TypeChecker_Env.get_range env in + FStar_Errors.raise_error uu____16716 uu____16723 let level_of_type: FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.term -> @@ -7120,12 +7182,12 @@ let level_of_type: fun e -> fun t -> let rec aux retry t1 = - let uu____16428 = - let uu____16429 = FStar_Syntax_Util.unrefine t1 in - uu____16429.FStar_Syntax_Syntax.n in - match uu____16428 with + let uu____16740 = + let uu____16741 = FStar_Syntax_Util.unrefine t1 in + uu____16741.FStar_Syntax_Syntax.n in + match uu____16740 with | FStar_Syntax_Syntax.Tm_type u -> u - | uu____16433 -> + | uu____16745 -> if retry then let t2 = @@ -7134,87 +7196,87 @@ let level_of_type: FStar_Syntax_Syntax.Delta_constant] env t1 in aux false t2 else - (let uu____16436 = FStar_Syntax_Util.type_u () in - match uu____16436 with + (let uu____16748 = FStar_Syntax_Util.type_u () in + match uu____16748 with | (t_u,u) -> let env1 = - let uu___111_16444 = env in + let uu___110_16756 = env in { FStar_TypeChecker_Env.solver = - (uu___111_16444.FStar_TypeChecker_Env.solver); + (uu___110_16756.FStar_TypeChecker_Env.solver); FStar_TypeChecker_Env.range = - (uu___111_16444.FStar_TypeChecker_Env.range); + (uu___110_16756.FStar_TypeChecker_Env.range); FStar_TypeChecker_Env.curmodule = - (uu___111_16444.FStar_TypeChecker_Env.curmodule); + (uu___110_16756.FStar_TypeChecker_Env.curmodule); FStar_TypeChecker_Env.gamma = - (uu___111_16444.FStar_TypeChecker_Env.gamma); + (uu___110_16756.FStar_TypeChecker_Env.gamma); FStar_TypeChecker_Env.gamma_cache = - (uu___111_16444.FStar_TypeChecker_Env.gamma_cache); + (uu___110_16756.FStar_TypeChecker_Env.gamma_cache); FStar_TypeChecker_Env.modules = - (uu___111_16444.FStar_TypeChecker_Env.modules); + (uu___110_16756.FStar_TypeChecker_Env.modules); FStar_TypeChecker_Env.expected_typ = - (uu___111_16444.FStar_TypeChecker_Env.expected_typ); + (uu___110_16756.FStar_TypeChecker_Env.expected_typ); FStar_TypeChecker_Env.sigtab = - (uu___111_16444.FStar_TypeChecker_Env.sigtab); + (uu___110_16756.FStar_TypeChecker_Env.sigtab); FStar_TypeChecker_Env.is_pattern = - (uu___111_16444.FStar_TypeChecker_Env.is_pattern); + (uu___110_16756.FStar_TypeChecker_Env.is_pattern); FStar_TypeChecker_Env.instantiate_imp = - (uu___111_16444.FStar_TypeChecker_Env.instantiate_imp); + (uu___110_16756.FStar_TypeChecker_Env.instantiate_imp); FStar_TypeChecker_Env.effects = - (uu___111_16444.FStar_TypeChecker_Env.effects); + (uu___110_16756.FStar_TypeChecker_Env.effects); FStar_TypeChecker_Env.generalize = - (uu___111_16444.FStar_TypeChecker_Env.generalize); + (uu___110_16756.FStar_TypeChecker_Env.generalize); FStar_TypeChecker_Env.letrecs = - (uu___111_16444.FStar_TypeChecker_Env.letrecs); + (uu___110_16756.FStar_TypeChecker_Env.letrecs); FStar_TypeChecker_Env.top_level = - (uu___111_16444.FStar_TypeChecker_Env.top_level); + (uu___110_16756.FStar_TypeChecker_Env.top_level); FStar_TypeChecker_Env.check_uvars = - (uu___111_16444.FStar_TypeChecker_Env.check_uvars); + (uu___110_16756.FStar_TypeChecker_Env.check_uvars); FStar_TypeChecker_Env.use_eq = - (uu___111_16444.FStar_TypeChecker_Env.use_eq); + (uu___110_16756.FStar_TypeChecker_Env.use_eq); FStar_TypeChecker_Env.is_iface = - (uu___111_16444.FStar_TypeChecker_Env.is_iface); + (uu___110_16756.FStar_TypeChecker_Env.is_iface); FStar_TypeChecker_Env.admit = - (uu___111_16444.FStar_TypeChecker_Env.admit); + (uu___110_16756.FStar_TypeChecker_Env.admit); FStar_TypeChecker_Env.lax = true; FStar_TypeChecker_Env.lax_universes = - (uu___111_16444.FStar_TypeChecker_Env.lax_universes); + (uu___110_16756.FStar_TypeChecker_Env.lax_universes); FStar_TypeChecker_Env.failhard = - (uu___111_16444.FStar_TypeChecker_Env.failhard); + (uu___110_16756.FStar_TypeChecker_Env.failhard); FStar_TypeChecker_Env.nosynth = - (uu___111_16444.FStar_TypeChecker_Env.nosynth); + (uu___110_16756.FStar_TypeChecker_Env.nosynth); FStar_TypeChecker_Env.tc_term = - (uu___111_16444.FStar_TypeChecker_Env.tc_term); + (uu___110_16756.FStar_TypeChecker_Env.tc_term); FStar_TypeChecker_Env.type_of = - (uu___111_16444.FStar_TypeChecker_Env.type_of); + (uu___110_16756.FStar_TypeChecker_Env.type_of); FStar_TypeChecker_Env.universe_of = - (uu___111_16444.FStar_TypeChecker_Env.universe_of); + (uu___110_16756.FStar_TypeChecker_Env.universe_of); FStar_TypeChecker_Env.use_bv_sorts = - (uu___111_16444.FStar_TypeChecker_Env.use_bv_sorts); + (uu___110_16756.FStar_TypeChecker_Env.use_bv_sorts); FStar_TypeChecker_Env.qname_and_index = - (uu___111_16444.FStar_TypeChecker_Env.qname_and_index); + (uu___110_16756.FStar_TypeChecker_Env.qname_and_index); FStar_TypeChecker_Env.proof_ns = - (uu___111_16444.FStar_TypeChecker_Env.proof_ns); + (uu___110_16756.FStar_TypeChecker_Env.proof_ns); FStar_TypeChecker_Env.synth = - (uu___111_16444.FStar_TypeChecker_Env.synth); + (uu___110_16756.FStar_TypeChecker_Env.synth); FStar_TypeChecker_Env.is_native_tactic = - (uu___111_16444.FStar_TypeChecker_Env.is_native_tactic); + (uu___110_16756.FStar_TypeChecker_Env.is_native_tactic); FStar_TypeChecker_Env.identifier_info = - (uu___111_16444.FStar_TypeChecker_Env.identifier_info); + (uu___110_16756.FStar_TypeChecker_Env.identifier_info); FStar_TypeChecker_Env.tc_hooks = - (uu___111_16444.FStar_TypeChecker_Env.tc_hooks); + (uu___110_16756.FStar_TypeChecker_Env.tc_hooks); FStar_TypeChecker_Env.dsenv = - (uu___111_16444.FStar_TypeChecker_Env.dsenv); + (uu___110_16756.FStar_TypeChecker_Env.dsenv); FStar_TypeChecker_Env.dep_graph = - (uu___111_16444.FStar_TypeChecker_Env.dep_graph) + (uu___110_16756.FStar_TypeChecker_Env.dep_graph) } in let g = FStar_TypeChecker_Rel.teq env1 t1 t_u in ((match g.FStar_TypeChecker_Env.guard_f with | FStar_TypeChecker_Common.NonTrivial f -> - let uu____16448 = + let uu____16760 = FStar_Syntax_Print.term_to_string t1 in - level_of_type_fail env1 e uu____16448 - | uu____16449 -> + level_of_type_fail env1 e uu____16760 + | uu____16761 -> FStar_TypeChecker_Rel.force_trivial_guard env1 g); u)) in aux true t @@ -7225,30 +7287,30 @@ let rec universe_of_aux: = fun env -> fun e -> - let uu____16458 = - let uu____16459 = FStar_Syntax_Subst.compress e in - uu____16459.FStar_Syntax_Syntax.n in - match uu____16458 with - | FStar_Syntax_Syntax.Tm_bvar uu____16464 -> failwith "Impossible" + let uu____16770 = + let uu____16771 = FStar_Syntax_Subst.compress e in + uu____16771.FStar_Syntax_Syntax.n in + match uu____16770 with + | FStar_Syntax_Syntax.Tm_bvar uu____16776 -> failwith "Impossible" | FStar_Syntax_Syntax.Tm_unknown -> failwith "Impossible" - | FStar_Syntax_Syntax.Tm_delayed uu____16469 -> failwith "Impossible" - | FStar_Syntax_Syntax.Tm_let uu____16496 -> + | FStar_Syntax_Syntax.Tm_delayed uu____16781 -> failwith "Impossible" + | FStar_Syntax_Syntax.Tm_let uu____16808 -> let e1 = FStar_TypeChecker_Normalize.normalize [] env e in universe_of_aux env e1 - | FStar_Syntax_Syntax.Tm_abs (bs,t,uu____16512) -> + | FStar_Syntax_Syntax.Tm_abs (bs,t,uu____16824) -> level_of_type_fail env e "arrow type" - | FStar_Syntax_Syntax.Tm_uvar (uu____16535,t) -> t - | FStar_Syntax_Syntax.Tm_meta (t,uu____16562) -> universe_of_aux env t + | FStar_Syntax_Syntax.Tm_uvar (uu____16847,t) -> t + | FStar_Syntax_Syntax.Tm_meta (t,uu____16874) -> universe_of_aux env t | FStar_Syntax_Syntax.Tm_name n1 -> n1.FStar_Syntax_Syntax.sort | FStar_Syntax_Syntax.Tm_fvar fv -> - let uu____16569 = + let uu____16881 = FStar_TypeChecker_Env.lookup_lid env (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in - (match uu____16569 with | ((uu____16580,t),uu____16582) -> t) + (match uu____16881 with | ((uu____16892,t),uu____16894) -> t) | FStar_Syntax_Syntax.Tm_ascribed - (uu____16587,(FStar_Util.Inl t,uu____16589),uu____16590) -> t + (uu____16899,(FStar_Util.Inl t,uu____16901),uu____16902) -> t | FStar_Syntax_Syntax.Tm_ascribed - (uu____16637,(FStar_Util.Inr c,uu____16639),uu____16640) -> + (uu____16949,(FStar_Util.Inr c,uu____16951),uu____16952) -> FStar_Syntax_Util.comp_result c | FStar_Syntax_Syntax.Tm_type u -> FStar_Syntax_Syntax.mk @@ -7258,21 +7320,21 @@ let rec universe_of_aux: tc_constant env e.FStar_Syntax_Syntax.pos sc | FStar_Syntax_Syntax.Tm_uinst ({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_fvar fv; - FStar_Syntax_Syntax.pos = uu____16690; - FStar_Syntax_Syntax.vars = uu____16691;_},us) + FStar_Syntax_Syntax.pos = uu____17002; + FStar_Syntax_Syntax.vars = uu____17003;_},us) -> - let uu____16697 = + let uu____17009 = FStar_TypeChecker_Env.lookup_lid env (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in - (match uu____16697 with - | ((us',t),uu____16710) -> + (match uu____17009 with + | ((us',t),uu____17022) -> (if (FStar_List.length us) <> (FStar_List.length us') then - (let uu____16716 = FStar_TypeChecker_Env.get_range env in + (let uu____17028 = FStar_TypeChecker_Env.get_range env in FStar_Errors.raise_error (FStar_Errors.Fatal_UnexpectedNumberOfUniverse, "Unexpected number of universe instantiations") - uu____16716) + uu____17028) else FStar_List.iter2 (fun u' -> @@ -7280,37 +7342,37 @@ let rec universe_of_aux: match u' with | FStar_Syntax_Syntax.U_unif u'' -> FStar_Syntax_Unionfind.univ_change u'' u - | uu____16732 -> failwith "Impossible") us' us; + | uu____17044 -> failwith "Impossible") us' us; t)) - | FStar_Syntax_Syntax.Tm_uinst uu____16733 -> + | FStar_Syntax_Syntax.Tm_uinst uu____17045 -> failwith "Impossible: Tm_uinst's head must be an fvar" - | FStar_Syntax_Syntax.Tm_refine (x,uu____16743) -> + | FStar_Syntax_Syntax.Tm_refine (x,uu____17055) -> universe_of_aux env x.FStar_Syntax_Syntax.sort | FStar_Syntax_Syntax.Tm_arrow (bs,c) -> - let uu____16766 = FStar_Syntax_Subst.open_comp bs c in - (match uu____16766 with + let uu____17078 = FStar_Syntax_Subst.open_comp bs c in + (match uu____17078 with | (bs1,c1) -> let us = FStar_List.map - (fun uu____16786 -> - match uu____16786 with - | (b,uu____16792) -> - let uu____16793 = + (fun uu____17098 -> + match uu____17098 with + | (b,uu____17104) -> + let uu____17105 = universe_of_aux env b.FStar_Syntax_Syntax.sort in level_of_type env b.FStar_Syntax_Syntax.sort - uu____16793) bs1 in + uu____17105) bs1 in let u_res = let res = FStar_Syntax_Util.comp_result c1 in - let uu____16798 = universe_of_aux env res in - level_of_type env res uu____16798 in + let uu____17110 = universe_of_aux env res in + level_of_type env res uu____17110 in let u_c = - let uu____16800 = + let uu____17112 = FStar_TypeChecker_Env.effect_repr env c1 u_res in - match uu____16800 with + match uu____17112 with | FStar_Pervasives_Native.None -> u_res | FStar_Pervasives_Native.Some trepr -> - let uu____16804 = universe_of_aux env trepr in - level_of_type env trepr uu____16804 in + let uu____17116 = universe_of_aux env trepr in + level_of_type env trepr uu____17116 in let u = FStar_TypeChecker_Normalize.normalize_universe env (FStar_Syntax_Syntax.U_max (u_c :: us)) in @@ -7321,170 +7383,170 @@ let rec universe_of_aux: let hd3 = FStar_Syntax_Subst.compress hd2 in match hd3.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Tm_unknown -> failwith "Impossible" - | FStar_Syntax_Syntax.Tm_bvar uu____16897 -> + | FStar_Syntax_Syntax.Tm_bvar uu____17209 -> failwith "Impossible" - | FStar_Syntax_Syntax.Tm_delayed uu____16912 -> + | FStar_Syntax_Syntax.Tm_delayed uu____17224 -> failwith "Impossible" - | FStar_Syntax_Syntax.Tm_fvar uu____16951 -> - let uu____16952 = universe_of_aux env hd3 in - (uu____16952, args1) - | FStar_Syntax_Syntax.Tm_name uu____16965 -> - let uu____16966 = universe_of_aux env hd3 in - (uu____16966, args1) - | FStar_Syntax_Syntax.Tm_uvar uu____16979 -> - let uu____16996 = universe_of_aux env hd3 in - (uu____16996, args1) - | FStar_Syntax_Syntax.Tm_uinst uu____17009 -> - let uu____17016 = universe_of_aux env hd3 in - (uu____17016, args1) - | FStar_Syntax_Syntax.Tm_ascribed uu____17029 -> - let uu____17056 = universe_of_aux env hd3 in - (uu____17056, args1) - | FStar_Syntax_Syntax.Tm_refine uu____17069 -> - let uu____17076 = universe_of_aux env hd3 in - (uu____17076, args1) - | FStar_Syntax_Syntax.Tm_constant uu____17089 -> - let uu____17090 = universe_of_aux env hd3 in - (uu____17090, args1) - | FStar_Syntax_Syntax.Tm_arrow uu____17103 -> - let uu____17116 = universe_of_aux env hd3 in - (uu____17116, args1) - | FStar_Syntax_Syntax.Tm_meta uu____17129 -> - let uu____17136 = universe_of_aux env hd3 in - (uu____17136, args1) - | FStar_Syntax_Syntax.Tm_type uu____17149 -> - let uu____17150 = universe_of_aux env hd3 in - (uu____17150, args1) - | FStar_Syntax_Syntax.Tm_match (uu____17163,hd4::uu____17165) -> - let uu____17230 = FStar_Syntax_Subst.open_branch hd4 in - (match uu____17230 with - | (uu____17245,uu____17246,hd5) -> - let uu____17264 = FStar_Syntax_Util.head_and_args hd5 in - (match uu____17264 with + | FStar_Syntax_Syntax.Tm_fvar uu____17263 -> + let uu____17264 = universe_of_aux env hd3 in + (uu____17264, args1) + | FStar_Syntax_Syntax.Tm_name uu____17277 -> + let uu____17278 = universe_of_aux env hd3 in + (uu____17278, args1) + | FStar_Syntax_Syntax.Tm_uvar uu____17291 -> + let uu____17308 = universe_of_aux env hd3 in + (uu____17308, args1) + | FStar_Syntax_Syntax.Tm_uinst uu____17321 -> + let uu____17328 = universe_of_aux env hd3 in + (uu____17328, args1) + | FStar_Syntax_Syntax.Tm_ascribed uu____17341 -> + let uu____17368 = universe_of_aux env hd3 in + (uu____17368, args1) + | FStar_Syntax_Syntax.Tm_refine uu____17381 -> + let uu____17388 = universe_of_aux env hd3 in + (uu____17388, args1) + | FStar_Syntax_Syntax.Tm_constant uu____17401 -> + let uu____17402 = universe_of_aux env hd3 in + (uu____17402, args1) + | FStar_Syntax_Syntax.Tm_arrow uu____17415 -> + let uu____17428 = universe_of_aux env hd3 in + (uu____17428, args1) + | FStar_Syntax_Syntax.Tm_meta uu____17441 -> + let uu____17448 = universe_of_aux env hd3 in + (uu____17448, args1) + | FStar_Syntax_Syntax.Tm_type uu____17461 -> + let uu____17462 = universe_of_aux env hd3 in + (uu____17462, args1) + | FStar_Syntax_Syntax.Tm_match (uu____17475,hd4::uu____17477) -> + let uu____17542 = FStar_Syntax_Subst.open_branch hd4 in + (match uu____17542 with + | (uu____17557,uu____17558,hd5) -> + let uu____17576 = FStar_Syntax_Util.head_and_args hd5 in + (match uu____17576 with | (hd6,args2) -> type_of_head retry hd6 args2)) - | uu____17315 when retry -> + | uu____17627 when retry -> let e1 = FStar_TypeChecker_Normalize.normalize [FStar_TypeChecker_Normalize.Beta; FStar_TypeChecker_Normalize.NoDeltaSteps] env e in - let uu____17317 = FStar_Syntax_Util.head_and_args e1 in - (match uu____17317 with + let uu____17629 = FStar_Syntax_Util.head_and_args e1 in + (match uu____17629 with | (hd4,args2) -> type_of_head false hd4 args2) - | uu____17368 -> - let uu____17369 = + | uu____17680 -> + let uu____17681 = FStar_TypeChecker_Env.clear_expected_typ env in - (match uu____17369 with - | (env1,uu____17391) -> + (match uu____17681 with + | (env1,uu____17703) -> let env2 = - let uu___112_17397 = env1 in + let uu___111_17709 = env1 in { FStar_TypeChecker_Env.solver = - (uu___112_17397.FStar_TypeChecker_Env.solver); + (uu___111_17709.FStar_TypeChecker_Env.solver); FStar_TypeChecker_Env.range = - (uu___112_17397.FStar_TypeChecker_Env.range); + (uu___111_17709.FStar_TypeChecker_Env.range); FStar_TypeChecker_Env.curmodule = - (uu___112_17397.FStar_TypeChecker_Env.curmodule); + (uu___111_17709.FStar_TypeChecker_Env.curmodule); FStar_TypeChecker_Env.gamma = - (uu___112_17397.FStar_TypeChecker_Env.gamma); + (uu___111_17709.FStar_TypeChecker_Env.gamma); FStar_TypeChecker_Env.gamma_cache = - (uu___112_17397.FStar_TypeChecker_Env.gamma_cache); + (uu___111_17709.FStar_TypeChecker_Env.gamma_cache); FStar_TypeChecker_Env.modules = - (uu___112_17397.FStar_TypeChecker_Env.modules); + (uu___111_17709.FStar_TypeChecker_Env.modules); FStar_TypeChecker_Env.expected_typ = - (uu___112_17397.FStar_TypeChecker_Env.expected_typ); + (uu___111_17709.FStar_TypeChecker_Env.expected_typ); FStar_TypeChecker_Env.sigtab = - (uu___112_17397.FStar_TypeChecker_Env.sigtab); + (uu___111_17709.FStar_TypeChecker_Env.sigtab); FStar_TypeChecker_Env.is_pattern = - (uu___112_17397.FStar_TypeChecker_Env.is_pattern); + (uu___111_17709.FStar_TypeChecker_Env.is_pattern); FStar_TypeChecker_Env.instantiate_imp = - (uu___112_17397.FStar_TypeChecker_Env.instantiate_imp); + (uu___111_17709.FStar_TypeChecker_Env.instantiate_imp); FStar_TypeChecker_Env.effects = - (uu___112_17397.FStar_TypeChecker_Env.effects); + (uu___111_17709.FStar_TypeChecker_Env.effects); FStar_TypeChecker_Env.generalize = - (uu___112_17397.FStar_TypeChecker_Env.generalize); + (uu___111_17709.FStar_TypeChecker_Env.generalize); FStar_TypeChecker_Env.letrecs = - (uu___112_17397.FStar_TypeChecker_Env.letrecs); + (uu___111_17709.FStar_TypeChecker_Env.letrecs); FStar_TypeChecker_Env.top_level = false; FStar_TypeChecker_Env.check_uvars = - (uu___112_17397.FStar_TypeChecker_Env.check_uvars); + (uu___111_17709.FStar_TypeChecker_Env.check_uvars); FStar_TypeChecker_Env.use_eq = - (uu___112_17397.FStar_TypeChecker_Env.use_eq); + (uu___111_17709.FStar_TypeChecker_Env.use_eq); FStar_TypeChecker_Env.is_iface = - (uu___112_17397.FStar_TypeChecker_Env.is_iface); + (uu___111_17709.FStar_TypeChecker_Env.is_iface); FStar_TypeChecker_Env.admit = - (uu___112_17397.FStar_TypeChecker_Env.admit); + (uu___111_17709.FStar_TypeChecker_Env.admit); FStar_TypeChecker_Env.lax = true; FStar_TypeChecker_Env.lax_universes = - (uu___112_17397.FStar_TypeChecker_Env.lax_universes); + (uu___111_17709.FStar_TypeChecker_Env.lax_universes); FStar_TypeChecker_Env.failhard = - (uu___112_17397.FStar_TypeChecker_Env.failhard); + (uu___111_17709.FStar_TypeChecker_Env.failhard); FStar_TypeChecker_Env.nosynth = - (uu___112_17397.FStar_TypeChecker_Env.nosynth); + (uu___111_17709.FStar_TypeChecker_Env.nosynth); FStar_TypeChecker_Env.tc_term = - (uu___112_17397.FStar_TypeChecker_Env.tc_term); + (uu___111_17709.FStar_TypeChecker_Env.tc_term); FStar_TypeChecker_Env.type_of = - (uu___112_17397.FStar_TypeChecker_Env.type_of); + (uu___111_17709.FStar_TypeChecker_Env.type_of); FStar_TypeChecker_Env.universe_of = - (uu___112_17397.FStar_TypeChecker_Env.universe_of); + (uu___111_17709.FStar_TypeChecker_Env.universe_of); FStar_TypeChecker_Env.use_bv_sorts = true; FStar_TypeChecker_Env.qname_and_index = - (uu___112_17397.FStar_TypeChecker_Env.qname_and_index); + (uu___111_17709.FStar_TypeChecker_Env.qname_and_index); FStar_TypeChecker_Env.proof_ns = - (uu___112_17397.FStar_TypeChecker_Env.proof_ns); + (uu___111_17709.FStar_TypeChecker_Env.proof_ns); FStar_TypeChecker_Env.synth = - (uu___112_17397.FStar_TypeChecker_Env.synth); + (uu___111_17709.FStar_TypeChecker_Env.synth); FStar_TypeChecker_Env.is_native_tactic = - (uu___112_17397.FStar_TypeChecker_Env.is_native_tactic); + (uu___111_17709.FStar_TypeChecker_Env.is_native_tactic); FStar_TypeChecker_Env.identifier_info = - (uu___112_17397.FStar_TypeChecker_Env.identifier_info); + (uu___111_17709.FStar_TypeChecker_Env.identifier_info); FStar_TypeChecker_Env.tc_hooks = - (uu___112_17397.FStar_TypeChecker_Env.tc_hooks); + (uu___111_17709.FStar_TypeChecker_Env.tc_hooks); FStar_TypeChecker_Env.dsenv = - (uu___112_17397.FStar_TypeChecker_Env.dsenv); + (uu___111_17709.FStar_TypeChecker_Env.dsenv); FStar_TypeChecker_Env.dep_graph = - (uu___112_17397.FStar_TypeChecker_Env.dep_graph) + (uu___111_17709.FStar_TypeChecker_Env.dep_graph) } in - ((let uu____17399 = + ((let uu____17711 = FStar_All.pipe_left (FStar_TypeChecker_Env.debug env2) (FStar_Options.Other "UniverseOf") in - if uu____17399 + if uu____17711 then - let uu____17400 = - let uu____17401 = + let uu____17712 = + let uu____17713 = FStar_TypeChecker_Env.get_range env2 in - FStar_Range.string_of_range uu____17401 in - let uu____17402 = + FStar_Range.string_of_range uu____17713 in + let uu____17714 = FStar_Syntax_Print.term_to_string hd3 in FStar_Util.print2 "%s: About to type-check %s\n" - uu____17400 uu____17402 + uu____17712 uu____17714 else ()); - (let uu____17404 = tc_term env2 hd3 in - match uu____17404 with - | (uu____17425,{ + (let uu____17716 = tc_term env2 hd3 in + match uu____17716 with + | (uu____17737,{ FStar_Syntax_Syntax.eff_name = - uu____17426; + uu____17738; FStar_Syntax_Syntax.res_typ = t; FStar_Syntax_Syntax.cflags = - uu____17428; - FStar_Syntax_Syntax.comp = - uu____17429;_},g) + uu____17740; + FStar_Syntax_Syntax.comp_thunk = + uu____17741;_},g) -> - ((let uu____17440 = + ((let uu____17760 = FStar_TypeChecker_Rel.solve_deferred_constraints env2 g in - FStar_All.pipe_right uu____17440 + FStar_All.pipe_right uu____17760 FStar_Pervasives.ignore); (t, args1))))) in - let uu____17451 = type_of_head true hd1 args in - (match uu____17451 with + let uu____17771 = type_of_head true hd1 args in + (match uu____17771 with | (t,args1) -> let t1 = FStar_TypeChecker_Normalize.normalize [FStar_TypeChecker_Normalize.UnfoldUntil FStar_Syntax_Syntax.Delta_constant] env t in - let uu____17491 = FStar_Syntax_Util.arrow_formals_comp t1 in - (match uu____17491 with + let uu____17811 = FStar_Syntax_Util.arrow_formals_comp t1 in + (match uu____17811 with | (bs,res) -> let res1 = FStar_Syntax_Util.comp_result res in if (FStar_List.length bs) = (FStar_List.length args1) @@ -7492,14 +7554,14 @@ let rec universe_of_aux: let subst1 = FStar_Syntax_Util.subst_of_list bs args1 in FStar_Syntax_Subst.subst subst1 res1 else - (let uu____17535 = + (let uu____17855 = FStar_Syntax_Print.term_to_string res1 in - level_of_type_fail env e uu____17535))) - | FStar_Syntax_Syntax.Tm_match (uu____17538,hd1::uu____17540) -> - let uu____17605 = FStar_Syntax_Subst.open_branch hd1 in - (match uu____17605 with - | (uu____17608,uu____17609,hd2) -> universe_of_aux env hd2) - | FStar_Syntax_Syntax.Tm_match (uu____17627,[]) -> + level_of_type_fail env e uu____17855))) + | FStar_Syntax_Syntax.Tm_match (uu____17858,hd1::uu____17860) -> + let uu____17925 = FStar_Syntax_Subst.open_branch hd1 in + (match uu____17925 with + | (uu____17928,uu____17929,hd2) -> universe_of_aux env hd2) + | FStar_Syntax_Syntax.Tm_match (uu____17947,[]) -> level_of_type_fail env e "empty match cases" let universe_of: FStar_TypeChecker_Env.env -> @@ -7507,8 +7569,8 @@ let universe_of: = fun env -> fun e -> - let uu____17670 = universe_of_aux env e in - level_of_type env e uu____17670 + let uu____17990 = universe_of_aux env e in + level_of_type env e uu____17990 let tc_tparams: FStar_TypeChecker_Env.env_t -> FStar_Syntax_Syntax.binders -> @@ -7517,7 +7579,7 @@ let tc_tparams: = fun env -> fun tps -> - let uu____17689 = tc_binders env tps in - match uu____17689 with + let uu____18009 = tc_binders env tps in + match uu____18009 with | (tps1,env1,g,us) -> (FStar_TypeChecker_Rel.force_trivial_guard env1 g; (tps1, env1, us)) \ No newline at end of file diff --git a/src/ocaml-output/FStar_TypeChecker_Util.ml b/src/ocaml-output/FStar_TypeChecker_Util.ml index cf4cff47e0d..cae5e8ba5a1 100644 --- a/src/ocaml-output/FStar_TypeChecker_Util.ml +++ b/src/ocaml-output/FStar_TypeChecker_Util.ml @@ -56,8 +56,8 @@ let new_uvar: let uu____84 = new_uvar_aux env k in FStar_Pervasives_Native.fst uu____84 let as_uvar: FStar_Syntax_Syntax.typ -> FStar_Syntax_Syntax.uvar = - fun uu___75_93 -> - match uu___75_93 with + fun uu___78_93 -> + match uu___78_93 with | { FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_uvar (uv,uu____95); FStar_Syntax_Syntax.pos = uu____96; FStar_Syntax_Syntax.vars = uu____97;_} -> uv @@ -91,7 +91,7 @@ let new_implicit_var: (match uu____237 with | (t,u) -> let g = - let uu___96_257 = FStar_TypeChecker_Rel.trivial_guard in + let uu___102_257 = FStar_TypeChecker_Rel.trivial_guard in let uu____258 = let uu____273 = let uu____286 = as_uvar u in @@ -99,11 +99,11 @@ let new_implicit_var: [uu____273] in { FStar_TypeChecker_Env.guard_f = - (uu___96_257.FStar_TypeChecker_Env.guard_f); + (uu___102_257.FStar_TypeChecker_Env.guard_f); FStar_TypeChecker_Env.deferred = - (uu___96_257.FStar_TypeChecker_Env.deferred); + (uu___102_257.FStar_TypeChecker_Env.deferred); FStar_TypeChecker_Env.univ_ineqs = - (uu___96_257.FStar_TypeChecker_Env.univ_ineqs); + (uu___102_257.FStar_TypeChecker_Env.univ_ineqs); FStar_TypeChecker_Env.implicits = uu____258 } in let uu____311 = @@ -182,12 +182,12 @@ let extract_let_rec_annotation: e.FStar_Syntax_Syntax.pos scope k in FStar_All.pipe_right uu____487 FStar_Pervasives_Native.fst in - ((let uu___97_497 = a in + ((let uu___103_497 = a in { FStar_Syntax_Syntax.ppname = - (uu___97_497.FStar_Syntax_Syntax.ppname); + (uu___103_497.FStar_Syntax_Syntax.ppname); FStar_Syntax_Syntax.index = - (uu___97_497.FStar_Syntax_Syntax.index); + (uu___103_497.FStar_Syntax_Syntax.index); FStar_Syntax_Syntax.sort = t2 }), false)) | uu____498 -> (a, true) in @@ -326,12 +326,12 @@ let pat_as_exp: | t -> tc_annot env1 t in match uu____1092 with | (t_x,guard) -> - ((let uu___98_1126 = x in + ((let uu___104_1126 = x in { FStar_Syntax_Syntax.ppname = - (uu___98_1126.FStar_Syntax_Syntax.ppname); + (uu___104_1126.FStar_Syntax_Syntax.ppname); FStar_Syntax_Syntax.index = - (uu___98_1126.FStar_Syntax_Syntax.index); + (uu___104_1126.FStar_Syntax_Syntax.index); FStar_Syntax_Syntax.sort = t_x }), guard) in let rec pat_as_arg_with_env allow_wc_dependence env1 p1 = @@ -356,12 +356,12 @@ let pat_as_exp: | (k,uu____1234) -> let t = new_uvar env1 k in let x1 = - let uu___99_1237 = x in + let uu___105_1237 = x in { FStar_Syntax_Syntax.ppname = - (uu___99_1237.FStar_Syntax_Syntax.ppname); + (uu___105_1237.FStar_Syntax_Syntax.ppname); FStar_Syntax_Syntax.index = - (uu___99_1237.FStar_Syntax_Syntax.index); + (uu___105_1237.FStar_Syntax_Syntax.index); FStar_Syntax_Syntax.sort = t } in let uu____1238 = @@ -372,12 +372,12 @@ let pat_as_exp: (match uu____1238 with | (e,u) -> let p2 = - let uu___100_1269 = p1 in + let uu___106_1269 = p1 in { FStar_Syntax_Syntax.v = (FStar_Syntax_Syntax.Pat_dot_term (x1, e)); FStar_Syntax_Syntax.p = - (uu___100_1269.FStar_Syntax_Syntax.p) + (uu___106_1269.FStar_Syntax_Syntax.p) } in ([], [], [], env1, e, FStar_TypeChecker_Rel.trivial_guard, p2))) @@ -464,13 +464,13 @@ let pat_as_exp: FStar_All.pipe_right (FStar_List.rev w) FStar_List.flatten in (uu____1947, uu____1958, uu____1969, env2, e, guard, - (let uu___101_1991 = p1 in + (let uu___107_1991 = p1 in { FStar_Syntax_Syntax.v = (FStar_Syntax_Syntax.Pat_cons (fv, (FStar_List.rev pats1))); FStar_Syntax_Syntax.p = - (uu___101_1991.FStar_Syntax_Syntax.p) + (uu___107_1991.FStar_Syntax_Syntax.p) }))) in let rec elaborate_pat env1 p1 = let maybe_dot inaccessible a r = @@ -577,7 +577,7 @@ let pat_as_exp: (p2, uu____2556) in let uu____2559 = aux formals' pats' in uu____2549 :: uu____2559) in - let uu___102_2574 = p1 in + let uu___108_2574 = p1 in let uu____2577 = let uu____2578 = let uu____2591 = aux f pats1 in @@ -586,7 +586,7 @@ let pat_as_exp: { FStar_Syntax_Syntax.v = uu____2577; FStar_Syntax_Syntax.p = - (uu___102_2574.FStar_Syntax_Syntax.p) + (uu___108_2574.FStar_Syntax_Syntax.p) })) | uu____2608 -> p1 in let one_pat allow_wc_dependence env1 p1 = @@ -652,12 +652,12 @@ let decorate_pattern: [FStar_TypeChecker_Normalize.Beta] env y.FStar_Syntax_Syntax.sort in let x1 = - let uu___103_2860 = x in + let uu___109_2860 = x in { FStar_Syntax_Syntax.ppname = - (uu___103_2860.FStar_Syntax_Syntax.ppname); + (uu___109_2860.FStar_Syntax_Syntax.ppname); FStar_Syntax_Syntax.index = - (uu___103_2860.FStar_Syntax_Syntax.index); + (uu___109_2860.FStar_Syntax_Syntax.index); FStar_Syntax_Syntax.sort = s } in pkg (FStar_Syntax_Syntax.Pat_var x1))) @@ -679,12 +679,12 @@ let decorate_pattern: [FStar_TypeChecker_Normalize.Beta] env y.FStar_Syntax_Syntax.sort in let x1 = - let uu___104_2871 = x in + let uu___110_2871 = x in { FStar_Syntax_Syntax.ppname = - (uu___104_2871.FStar_Syntax_Syntax.ppname); + (uu___110_2871.FStar_Syntax_Syntax.ppname); FStar_Syntax_Syntax.index = - (uu___104_2871.FStar_Syntax_Syntax.index); + (uu___110_2871.FStar_Syntax_Syntax.index); FStar_Syntax_Syntax.sort = s } in pkg (FStar_Syntax_Syntax.Pat_wild x1))) @@ -880,6 +880,18 @@ let rec decorated_pattern_as_term: mk1 uu____3890 in (vars1, uu____3889)) | FStar_Syntax_Syntax.Pat_dot_term (x,e) -> ([], e) +let comp_univ_opt: + FStar_Syntax_Syntax.comp' FStar_Syntax_Syntax.syntax -> + FStar_Syntax_Syntax.universe FStar_Pervasives_Native.option + = + fun c -> + match c.FStar_Syntax_Syntax.n with + | FStar_Syntax_Syntax.Total (uu____3936,uopt) -> uopt + | FStar_Syntax_Syntax.GTotal (uu____3946,uopt) -> uopt + | FStar_Syntax_Syntax.Comp c1 -> + (match c1.FStar_Syntax_Syntax.comp_univs with + | [] -> FStar_Pervasives_Native.None + | hd1::uu____3960 -> FStar_Pervasives_Native.Some hd1) let destruct_comp: FStar_Syntax_Syntax.comp_typ -> (FStar_Syntax_Syntax.universe,FStar_Syntax_Syntax.typ,FStar_Syntax_Syntax.typ) @@ -888,23 +900,23 @@ let destruct_comp: fun c -> let wp = match c.FStar_Syntax_Syntax.effect_args with - | (wp,uu____3946)::[] -> wp - | uu____3963 -> - let uu____3972 = - let uu____3973 = - let uu____3974 = + | (wp,uu____3984)::[] -> wp + | uu____4001 -> + let uu____4010 = + let uu____4011 = + let uu____4012 = FStar_List.map - (fun uu____3984 -> - match uu____3984 with - | (x,uu____3990) -> FStar_Syntax_Print.term_to_string x) + (fun uu____4022 -> + match uu____4022 with + | (x,uu____4028) -> FStar_Syntax_Print.term_to_string x) c.FStar_Syntax_Syntax.effect_args in - FStar_All.pipe_right uu____3974 (FStar_String.concat ", ") in + FStar_All.pipe_right uu____4012 (FStar_String.concat ", ") in FStar_Util.format2 "Impossible: Got a computation %s with effect args [%s]" - (c.FStar_Syntax_Syntax.effect_name).FStar_Ident.str uu____3973 in - failwith uu____3972 in - let uu____3995 = FStar_List.hd c.FStar_Syntax_Syntax.comp_univs in - (uu____3995, (c.FStar_Syntax_Syntax.result_typ), wp) + (c.FStar_Syntax_Syntax.effect_name).FStar_Ident.str uu____4011 in + failwith uu____4010 in + let uu____4033 = FStar_List.hd c.FStar_Syntax_Syntax.comp_univs in + (uu____4033, (c.FStar_Syntax_Syntax.result_typ), wp) let lift_comp: FStar_Syntax_Syntax.comp_typ -> FStar_Ident.lident -> @@ -913,22 +925,22 @@ let lift_comp: fun c -> fun m -> fun lift -> - let uu____4009 = destruct_comp c in - match uu____4009 with - | (u,uu____4017,wp) -> - let uu____4019 = - let uu____4028 = - let uu____4029 = + let uu____4047 = destruct_comp c in + match uu____4047 with + | (u,uu____4055,wp) -> + let uu____4057 = + let uu____4066 = + let uu____4067 = lift.FStar_TypeChecker_Env.mlift_wp u c.FStar_Syntax_Syntax.result_typ wp in - FStar_Syntax_Syntax.as_arg uu____4029 in - [uu____4028] in + FStar_Syntax_Syntax.as_arg uu____4067 in + [uu____4066] in { FStar_Syntax_Syntax.comp_univs = [u]; FStar_Syntax_Syntax.effect_name = m; FStar_Syntax_Syntax.result_typ = (c.FStar_Syntax_Syntax.result_typ); - FStar_Syntax_Syntax.effect_args = uu____4019; + FStar_Syntax_Syntax.effect_args = uu____4057; FStar_Syntax_Syntax.flags = [] } let join_effects: @@ -938,11 +950,11 @@ let join_effects: fun env -> fun l1 -> fun l2 -> - let uu____4039 = - let uu____4046 = FStar_TypeChecker_Env.norm_eff_name env l1 in - let uu____4047 = FStar_TypeChecker_Env.norm_eff_name env l2 in - FStar_TypeChecker_Env.join env uu____4046 uu____4047 in - match uu____4039 with | (m,uu____4049,uu____4050) -> m + let uu____4077 = + let uu____4084 = FStar_TypeChecker_Env.norm_eff_name env l1 in + let uu____4085 = FStar_TypeChecker_Env.norm_eff_name env l2 in + FStar_TypeChecker_Env.join env uu____4084 uu____4085 in + match uu____4077 with | (m,uu____4087,uu____4088) -> m let join_lcomp: FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.lcomp -> @@ -951,10 +963,10 @@ let join_lcomp: fun env -> fun c1 -> fun c2 -> - let uu____4060 = + let uu____4098 = (FStar_Syntax_Util.is_total_lcomp c1) && (FStar_Syntax_Util.is_total_lcomp c2) in - if uu____4060 + if uu____4098 then FStar_Parser_Const.effect_Tot_lid else join_effects env c1.FStar_Syntax_Syntax.eff_name @@ -976,22 +988,22 @@ let lift_and_destruct: fun c2 -> let c11 = FStar_TypeChecker_Env.unfold_effect_abbrev env c1 in let c21 = FStar_TypeChecker_Env.unfold_effect_abbrev env c2 in - let uu____4097 = + let uu____4135 = FStar_TypeChecker_Env.join env c11.FStar_Syntax_Syntax.effect_name c21.FStar_Syntax_Syntax.effect_name in - match uu____4097 with + match uu____4135 with | (m,lift1,lift2) -> let m1 = lift_comp c11 m lift1 in let m2 = lift_comp c21 m lift2 in let md = FStar_TypeChecker_Env.get_effect_decl env m in - let uu____4134 = + let uu____4172 = FStar_TypeChecker_Env.wp_signature env md.FStar_Syntax_Syntax.mname in - (match uu____4134 with + (match uu____4172 with | (a,kwp) -> - let uu____4165 = destruct_comp m1 in - let uu____4172 = destruct_comp m2 in - ((md, a, kwp), uu____4165, uu____4172)) + let uu____4203 = destruct_comp m1 in + let uu____4210 = destruct_comp m2 in + ((md, a, kwp), uu____4203, uu____4210)) let is_pure_effect: FStar_TypeChecker_Env.env -> FStar_Ident.lident -> Prims.bool = fun env -> @@ -1017,18 +1029,18 @@ let mk_comp_l: fun result -> fun wp -> fun flags1 -> - let uu____4234 = - let uu____4235 = - let uu____4244 = FStar_Syntax_Syntax.as_arg wp in - [uu____4244] in + let uu____4272 = + let uu____4273 = + let uu____4282 = FStar_Syntax_Syntax.as_arg wp in + [uu____4282] in { FStar_Syntax_Syntax.comp_univs = [u_result]; FStar_Syntax_Syntax.effect_name = mname; FStar_Syntax_Syntax.result_typ = result; - FStar_Syntax_Syntax.effect_args = uu____4235; + FStar_Syntax_Syntax.effect_args = uu____4273; FStar_Syntax_Syntax.flags = flags1 } in - FStar_Syntax_Syntax.mk_Comp uu____4234 + FStar_Syntax_Syntax.mk_Comp uu____4272 let mk_comp: FStar_Syntax_Syntax.eff_decl -> FStar_Syntax_Syntax.universe -> @@ -1057,28 +1069,21 @@ let subst_lcomp: = fun subst1 -> fun lc -> - let uu___105_4283 = lc in - let uu____4284 = + let uu____4321 = FStar_Syntax_Subst.subst subst1 lc.FStar_Syntax_Syntax.res_typ in - { - FStar_Syntax_Syntax.eff_name = - (uu___105_4283.FStar_Syntax_Syntax.eff_name); - FStar_Syntax_Syntax.res_typ = uu____4284; - FStar_Syntax_Syntax.cflags = - (uu___105_4283.FStar_Syntax_Syntax.cflags); - FStar_Syntax_Syntax.comp = - (fun uu____4289 -> - let uu____4290 = lc.FStar_Syntax_Syntax.comp () in - FStar_Syntax_Subst.subst_comp subst1 uu____4290) - } + FStar_Syntax_Syntax.mk_lcomp lc.FStar_Syntax_Syntax.eff_name uu____4321 + lc.FStar_Syntax_Syntax.cflags + (fun uu____4324 -> + let uu____4325 = FStar_Syntax_Syntax.lcomp_comp lc in + FStar_Syntax_Subst.subst_comp subst1 uu____4325) let is_function: FStar_Syntax_Syntax.term -> Prims.bool = fun t -> - let uu____4294 = - let uu____4295 = FStar_Syntax_Subst.compress t in - uu____4295.FStar_Syntax_Syntax.n in - match uu____4294 with - | FStar_Syntax_Syntax.Tm_arrow uu____4298 -> true - | uu____4311 -> false + let uu____4329 = + let uu____4330 = FStar_Syntax_Subst.compress t in + uu____4330.FStar_Syntax_Syntax.n in + match uu____4329 with + | FStar_Syntax_Syntax.Tm_arrow uu____4333 -> true + | uu____4346 -> false let label: Prims.string -> FStar_Range.range -> FStar_Syntax_Syntax.typ -> FStar_Syntax_Syntax.typ @@ -1102,12 +1107,12 @@ let label_opt: match reason with | FStar_Pervasives_Native.None -> f | FStar_Pervasives_Native.Some reason1 -> - let uu____4349 = - let uu____4350 = FStar_TypeChecker_Env.should_verify env in - FStar_All.pipe_left Prims.op_Negation uu____4350 in - if uu____4349 + let uu____4384 = + let uu____4385 = FStar_TypeChecker_Env.should_verify env in + FStar_All.pipe_left Prims.op_Negation uu____4385 in + if uu____4384 then f - else (let uu____4352 = reason1 () in label uu____4352 r f) + else (let uu____4387 = reason1 () in label uu____4387 r f) let label_guard: FStar_Range.range -> Prims.string -> @@ -1119,18 +1124,18 @@ let label_guard: match g.FStar_TypeChecker_Env.guard_f with | FStar_TypeChecker_Common.Trivial -> g | FStar_TypeChecker_Common.NonTrivial f -> - let uu___106_4363 = g in - let uu____4364 = - let uu____4365 = label reason r f in - FStar_TypeChecker_Common.NonTrivial uu____4365 in + let uu___111_4398 = g in + let uu____4399 = + let uu____4400 = label reason r f in + FStar_TypeChecker_Common.NonTrivial uu____4400 in { - FStar_TypeChecker_Env.guard_f = uu____4364; + FStar_TypeChecker_Env.guard_f = uu____4399; FStar_TypeChecker_Env.deferred = - (uu___106_4363.FStar_TypeChecker_Env.deferred); + (uu___111_4398.FStar_TypeChecker_Env.deferred); FStar_TypeChecker_Env.univ_ineqs = - (uu___106_4363.FStar_TypeChecker_Env.univ_ineqs); + (uu___111_4398.FStar_TypeChecker_Env.univ_ineqs); FStar_TypeChecker_Env.implicits = - (uu___106_4363.FStar_TypeChecker_Env.implicits) + (uu___111_4398.FStar_TypeChecker_Env.implicits) } let close_comp: FStar_TypeChecker_Env.env -> @@ -1140,13 +1145,13 @@ let close_comp: fun env -> fun bvs -> fun c -> - let uu____4379 = FStar_Syntax_Util.is_ml_comp c in - if uu____4379 + let uu____4414 = FStar_Syntax_Util.is_ml_comp c in + if uu____4414 then c else - (let uu____4381 = + (let uu____4416 = env.FStar_TypeChecker_Env.lax && (FStar_Options.ml_ish ()) in - if uu____4381 + if uu____4416 then c else (let close_wp u_res md res_t bvs1 wp0 = @@ -1154,15 +1159,15 @@ let close_comp: (fun x -> fun wp -> let bs = - let uu____4420 = FStar_Syntax_Syntax.mk_binder x in - [uu____4420] in + let uu____4455 = FStar_Syntax_Syntax.mk_binder x in + [uu____4455] in let us = - let uu____4424 = - let uu____4427 = + let uu____4459 = + let uu____4462 = env.FStar_TypeChecker_Env.universe_of env x.FStar_Syntax_Syntax.sort in - [uu____4427] in - u_res :: uu____4424 in + [uu____4462] in + u_res :: uu____4459 in let wp1 = FStar_Syntax_Util.abs bs wp (FStar_Pervasives_Native.Some @@ -1170,28 +1175,28 @@ let close_comp: FStar_Parser_Const.effect_Tot_lid FStar_Pervasives_Native.None [FStar_Syntax_Syntax.TOTAL])) in - let uu____4431 = - let uu____4432 = + let uu____4466 = + let uu____4467 = FStar_TypeChecker_Env.inst_effect_fun_with us env md md.FStar_Syntax_Syntax.close_wp in - let uu____4433 = - let uu____4434 = FStar_Syntax_Syntax.as_arg res_t in - let uu____4435 = - let uu____4438 = + let uu____4468 = + let uu____4469 = FStar_Syntax_Syntax.as_arg res_t in + let uu____4470 = + let uu____4473 = FStar_Syntax_Syntax.as_arg x.FStar_Syntax_Syntax.sort in - let uu____4439 = - let uu____4442 = + let uu____4474 = + let uu____4477 = FStar_Syntax_Syntax.as_arg wp1 in - [uu____4442] in - uu____4438 :: uu____4439 in - uu____4434 :: uu____4435 in - FStar_Syntax_Syntax.mk_Tm_app uu____4432 uu____4433 in - uu____4431 FStar_Pervasives_Native.None + [uu____4477] in + uu____4473 :: uu____4474 in + uu____4469 :: uu____4470 in + FStar_Syntax_Syntax.mk_Tm_app uu____4467 uu____4468 in + uu____4466 FStar_Pervasives_Native.None wp0.FStar_Syntax_Syntax.pos) bvs1 wp0 in let c1 = FStar_TypeChecker_Env.unfold_effect_abbrev env c in - let uu____4446 = destruct_comp c1 in - match uu____4446 with + let uu____4481 = destruct_comp c1 in + match uu____4481 with | (u_res_t,res_t,wp) -> let md = FStar_TypeChecker_Env.get_effect_decl env @@ -1207,95 +1212,400 @@ let close_lcomp: fun env -> fun bvs -> fun lc -> - let close1 uu____4474 = - let uu____4475 = lc.FStar_Syntax_Syntax.comp () in - close_comp env bvs uu____4475 in - let uu___107_4476 = lc in - { - FStar_Syntax_Syntax.eff_name = - (uu___107_4476.FStar_Syntax_Syntax.eff_name); - FStar_Syntax_Syntax.res_typ = - (uu___107_4476.FStar_Syntax_Syntax.res_typ); - FStar_Syntax_Syntax.cflags = - (uu___107_4476.FStar_Syntax_Syntax.cflags); - FStar_Syntax_Syntax.comp = close1 - } + FStar_Syntax_Syntax.mk_lcomp lc.FStar_Syntax_Syntax.eff_name + lc.FStar_Syntax_Syntax.res_typ lc.FStar_Syntax_Syntax.cflags + (fun uu____4508 -> + let uu____4509 = FStar_Syntax_Syntax.lcomp_comp lc in + close_comp env bvs uu____4509) +let should_not_inline_lc: FStar_Syntax_Syntax.lcomp -> Prims.bool = + fun lc -> + FStar_All.pipe_right lc.FStar_Syntax_Syntax.cflags + (FStar_Util.for_some + (fun uu___79_4516 -> + match uu___79_4516 with + | FStar_Syntax_Syntax.SHOULD_NOT_INLINE -> true + | uu____4517 -> false)) +let should_return: + FStar_TypeChecker_Env.env -> + FStar_Syntax_Syntax.term FStar_Pervasives_Native.option -> + FStar_Syntax_Syntax.lcomp -> Prims.bool + = + fun env -> + fun eopt -> + fun lc -> + match eopt with + | FStar_Pervasives_Native.None -> false + | FStar_Pervasives_Native.Some e -> + (((FStar_Syntax_Util.is_pure_or_ghost_lcomp lc) && + (let uu____4533 = + FStar_Syntax_Util.is_unit lc.FStar_Syntax_Syntax.res_typ in + Prims.op_Negation uu____4533)) + && + (let uu____4540 = FStar_Syntax_Util.head_and_args' e in + match uu____4540 with + | (head1,uu____4554) -> + let uu____4571 = + let uu____4572 = FStar_Syntax_Util.un_uinst head1 in + uu____4572.FStar_Syntax_Syntax.n in + (match uu____4571 with + | FStar_Syntax_Syntax.Tm_fvar fv -> + let uu____4576 = + let uu____4577 = FStar_Syntax_Syntax.lid_of_fv fv in + FStar_TypeChecker_Env.is_irreducible env + uu____4577 in + Prims.op_Negation uu____4576 + | uu____4578 -> true))) + && + (let uu____4580 = should_not_inline_lc lc in + Prims.op_Negation uu____4580) let return_value: FStar_TypeChecker_Env.env -> - FStar_Syntax_Syntax.typ -> + FStar_Syntax_Syntax.universe FStar_Pervasives_Native.option -> + FStar_Syntax_Syntax.typ -> + FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.comp + = + fun env -> + fun u_t_opt -> + fun t -> + fun v1 -> + let c = + let uu____4598 = + let uu____4599 = + FStar_TypeChecker_Env.lid_exists env + FStar_Parser_Const.effect_GTot_lid in + FStar_All.pipe_left Prims.op_Negation uu____4599 in + if uu____4598 + then FStar_Syntax_Syntax.mk_Total t + else + (let uu____4601 = FStar_Syntax_Util.is_unit t in + if uu____4601 + then + FStar_Syntax_Syntax.mk_Total' t + (FStar_Pervasives_Native.Some FStar_Syntax_Syntax.U_zero) + else + (let m = + FStar_TypeChecker_Env.get_effect_decl env + FStar_Parser_Const.effect_PURE_lid in + let u_t = + match u_t_opt with + | FStar_Pervasives_Native.None -> + env.FStar_TypeChecker_Env.universe_of env t + | FStar_Pervasives_Native.Some u_t -> u_t in + let wp = + let uu____4607 = + env.FStar_TypeChecker_Env.lax && + (FStar_Options.ml_ish ()) in + if uu____4607 + then FStar_Syntax_Syntax.tun + else + (let uu____4609 = + FStar_TypeChecker_Env.wp_signature env + FStar_Parser_Const.effect_PURE_lid in + match uu____4609 with + | (a,kwp) -> + let k = + FStar_Syntax_Subst.subst + [FStar_Syntax_Syntax.NT (a, t)] kwp in + let uu____4617 = + let uu____4618 = + let uu____4619 = + FStar_TypeChecker_Env.inst_effect_fun_with + [u_t] env m m.FStar_Syntax_Syntax.ret_wp in + let uu____4620 = + let uu____4621 = + FStar_Syntax_Syntax.as_arg t in + let uu____4622 = + let uu____4625 = + FStar_Syntax_Syntax.as_arg v1 in + [uu____4625] in + uu____4621 :: uu____4622 in + FStar_Syntax_Syntax.mk_Tm_app uu____4619 + uu____4620 in + uu____4618 FStar_Pervasives_Native.None + v1.FStar_Syntax_Syntax.pos in + FStar_TypeChecker_Normalize.normalize + [FStar_TypeChecker_Normalize.Beta; + FStar_TypeChecker_Normalize.NoFullNorm] env + uu____4617) in + mk_comp m u_t t wp [FStar_Syntax_Syntax.RETURN])) in + (let uu____4629 = + FStar_All.pipe_left (FStar_TypeChecker_Env.debug env) + (FStar_Options.Other "Return") in + if uu____4629 + then + let uu____4630 = + FStar_Range.string_of_range v1.FStar_Syntax_Syntax.pos in + let uu____4631 = FStar_Syntax_Print.term_to_string v1 in + let uu____4632 = + FStar_TypeChecker_Normalize.comp_to_string env c in + FStar_Util.print3 "(%s) returning %s at comp type %s\n" + uu____4630 uu____4631 uu____4632 + else ()); + c +let weaken_flags: + FStar_Syntax_Syntax.cflags Prims.list -> + FStar_Syntax_Syntax.cflags Prims.list + = + fun flags1 -> + let uu____4643 = + FStar_All.pipe_right flags1 + (FStar_Util.for_some + (fun uu___80_4647 -> + match uu___80_4647 with + | FStar_Syntax_Syntax.SHOULD_NOT_INLINE -> true + | uu____4648 -> false)) in + if uu____4643 + then [FStar_Syntax_Syntax.SHOULD_NOT_INLINE] + else + FStar_All.pipe_right flags1 + (FStar_List.collect + (fun uu___81_4657 -> + match uu___81_4657 with + | FStar_Syntax_Syntax.TOTAL -> + [FStar_Syntax_Syntax.TRIVIAL_POSTCONDITION] + | FStar_Syntax_Syntax.RETURN -> + [FStar_Syntax_Syntax.PARTIAL_RETURN; + FStar_Syntax_Syntax.TRIVIAL_POSTCONDITION] + | f -> [f])) +let weaken_comp: + FStar_TypeChecker_Env.env -> + FStar_Syntax_Syntax.comp -> FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.comp = fun env -> - fun t -> - fun v1 -> - let c = - let uu____4487 = - let uu____4488 = - FStar_TypeChecker_Env.lid_exists env - FStar_Parser_Const.effect_GTot_lid in - FStar_All.pipe_left Prims.op_Negation uu____4488 in - if uu____4487 - then FStar_Syntax_Syntax.mk_Total t + fun c -> + fun formula -> + let uu____4670 = FStar_Syntax_Util.is_ml_comp c in + if uu____4670 + then c + else + (let c1 = FStar_TypeChecker_Env.unfold_effect_abbrev env c in + let uu____4673 = destruct_comp c1 in + match uu____4673 with + | (u_res_t,res_t,wp) -> + let md = + FStar_TypeChecker_Env.get_effect_decl env + c1.FStar_Syntax_Syntax.effect_name in + let wp1 = + let uu____4687 = + let uu____4688 = + FStar_TypeChecker_Env.inst_effect_fun_with [u_res_t] env + md md.FStar_Syntax_Syntax.assume_p in + let uu____4689 = + let uu____4690 = FStar_Syntax_Syntax.as_arg res_t in + let uu____4691 = + let uu____4694 = FStar_Syntax_Syntax.as_arg formula in + let uu____4695 = + let uu____4698 = FStar_Syntax_Syntax.as_arg wp in + [uu____4698] in + uu____4694 :: uu____4695 in + uu____4690 :: uu____4691 in + FStar_Syntax_Syntax.mk_Tm_app uu____4688 uu____4689 in + uu____4687 FStar_Pervasives_Native.None + wp.FStar_Syntax_Syntax.pos in + let uu____4701 = weaken_flags c1.FStar_Syntax_Syntax.flags in + mk_comp md u_res_t res_t wp1 uu____4701) +let weaken_precondition: + FStar_TypeChecker_Env.env -> + FStar_Syntax_Syntax.lcomp -> + FStar_TypeChecker_Common.guard_formula -> FStar_Syntax_Syntax.lcomp + = + fun env -> + fun lc -> + fun f -> + let weaken uu____4716 = + let c = FStar_Syntax_Syntax.lcomp_comp lc in + let uu____4718 = + env.FStar_TypeChecker_Env.lax && (FStar_Options.ml_ish ()) in + if uu____4718 + then c else - (let uu____4490 = FStar_Syntax_Util.is_unit t in - if uu____4490 + (match f with + | FStar_TypeChecker_Common.Trivial -> c + | FStar_TypeChecker_Common.NonTrivial f1 -> weaken_comp env c f1) in + let uu____4721 = weaken_flags lc.FStar_Syntax_Syntax.cflags in + FStar_Syntax_Syntax.mk_lcomp lc.FStar_Syntax_Syntax.eff_name + lc.FStar_Syntax_Syntax.res_typ uu____4721 weaken +let strengthen_comp: + FStar_TypeChecker_Env.env -> + (Prims.unit -> Prims.string) FStar_Pervasives_Native.option -> + FStar_Syntax_Syntax.comp -> + FStar_Syntax_Syntax.formula -> + FStar_Syntax_Syntax.cflags Prims.list -> FStar_Syntax_Syntax.comp + = + fun env -> + fun reason -> + fun c -> + fun f -> + fun flags1 -> + if env.FStar_TypeChecker_Env.lax + then c + else + (let c1 = FStar_TypeChecker_Env.unfold_effect_abbrev env c in + let uu____4754 = destruct_comp c1 in + match uu____4754 with + | (u_res_t,res_t,wp) -> + let md = + FStar_TypeChecker_Env.get_effect_decl env + c1.FStar_Syntax_Syntax.effect_name in + let wp1 = + let uu____4768 = + let uu____4769 = + FStar_TypeChecker_Env.inst_effect_fun_with [u_res_t] + env md md.FStar_Syntax_Syntax.assert_p in + let uu____4770 = + let uu____4771 = FStar_Syntax_Syntax.as_arg res_t in + let uu____4772 = + let uu____4775 = + let uu____4776 = + let uu____4777 = + FStar_TypeChecker_Env.get_range env in + label_opt env reason uu____4777 f in + FStar_All.pipe_left FStar_Syntax_Syntax.as_arg + uu____4776 in + let uu____4778 = + let uu____4781 = FStar_Syntax_Syntax.as_arg wp in + [uu____4781] in + uu____4775 :: uu____4778 in + uu____4771 :: uu____4772 in + FStar_Syntax_Syntax.mk_Tm_app uu____4769 uu____4770 in + uu____4768 FStar_Pervasives_Native.None + wp.FStar_Syntax_Syntax.pos in + mk_comp md u_res_t res_t wp1 flags1) +let strengthen_precondition: + (Prims.unit -> Prims.string) FStar_Pervasives_Native.option -> + FStar_TypeChecker_Env.env -> + FStar_Syntax_Syntax.term -> + FStar_Syntax_Syntax.lcomp -> + FStar_TypeChecker_Env.guard_t -> + (FStar_Syntax_Syntax.lcomp,FStar_TypeChecker_Env.guard_t) + FStar_Pervasives_Native.tuple2 + = + fun reason -> + fun env -> + fun e_for_debug_only -> + fun lc -> + fun g0 -> + let uu____4816 = FStar_TypeChecker_Rel.is_trivial g0 in + if uu____4816 + then (lc, g0) + else + (let flags1 = + let uu____4825 = + let uu____4832 = FStar_Syntax_Util.is_tot_or_gtot_lcomp lc in + if uu____4832 + then (true, [FStar_Syntax_Syntax.TRIVIAL_POSTCONDITION]) + else (false, []) in + match uu____4825 with + | (maybe_trivial_post,flags1) -> + let uu____4852 = + FStar_All.pipe_right lc.FStar_Syntax_Syntax.cflags + (FStar_List.collect + (fun uu___82_4860 -> + match uu___82_4860 with + | FStar_Syntax_Syntax.RETURN -> + [FStar_Syntax_Syntax.PARTIAL_RETURN] + | FStar_Syntax_Syntax.PARTIAL_RETURN -> + [FStar_Syntax_Syntax.PARTIAL_RETURN] + | FStar_Syntax_Syntax.SOMETRIVIAL when + Prims.op_Negation maybe_trivial_post -> + [FStar_Syntax_Syntax.TRIVIAL_POSTCONDITION] + | FStar_Syntax_Syntax.TRIVIAL_POSTCONDITION + when Prims.op_Negation maybe_trivial_post + -> + [FStar_Syntax_Syntax.TRIVIAL_POSTCONDITION] + | FStar_Syntax_Syntax.SHOULD_NOT_INLINE -> + [FStar_Syntax_Syntax.SHOULD_NOT_INLINE] + | uu____4863 -> [])) in + FStar_List.append flags1 uu____4852 in + let strengthen uu____4867 = + let c = FStar_Syntax_Syntax.lcomp_comp lc in + if env.FStar_TypeChecker_Env.lax + then c + else + (let g01 = FStar_TypeChecker_Rel.simplify_guard env g0 in + let uu____4871 = FStar_TypeChecker_Rel.guard_form g01 in + match uu____4871 with + | FStar_TypeChecker_Common.Trivial -> c + | FStar_TypeChecker_Common.NonTrivial f -> + ((let uu____4874 = + FStar_All.pipe_left + (FStar_TypeChecker_Env.debug env) + FStar_Options.Extreme in + if uu____4874 + then + let uu____4875 = + FStar_TypeChecker_Normalize.term_to_string env + e_for_debug_only in + let uu____4876 = + FStar_TypeChecker_Normalize.term_to_string env + f in + FStar_Util.print2 + "-------------Strengthening pre-condition of term %s with guard %s\n" + uu____4875 uu____4876 + else ()); + strengthen_comp env reason c f flags1)) in + let uu____4878 = + let uu____4879 = + FStar_TypeChecker_Env.norm_eff_name env + lc.FStar_Syntax_Syntax.eff_name in + FStar_Syntax_Syntax.mk_lcomp uu____4879 + lc.FStar_Syntax_Syntax.res_typ flags1 strengthen in + (uu____4878, + (let uu___112_4881 = g0 in + { + FStar_TypeChecker_Env.guard_f = + FStar_TypeChecker_Common.Trivial; + FStar_TypeChecker_Env.deferred = + (uu___112_4881.FStar_TypeChecker_Env.deferred); + FStar_TypeChecker_Env.univ_ineqs = + (uu___112_4881.FStar_TypeChecker_Env.univ_ineqs); + FStar_TypeChecker_Env.implicits = + (uu___112_4881.FStar_TypeChecker_Env.implicits) + }))) +let lcomp_has_trivial_postcondition: FStar_Syntax_Syntax.lcomp -> Prims.bool + = + fun lc -> + (FStar_Syntax_Util.is_tot_or_gtot_lcomp lc) || + (FStar_Util.for_some + (fun uu___83_4886 -> + match uu___83_4886 with + | FStar_Syntax_Syntax.SOMETRIVIAL -> true + | FStar_Syntax_Syntax.TRIVIAL_POSTCONDITION -> true + | uu____4887 -> false) lc.FStar_Syntax_Syntax.cflags) +let maybe_add_with_type: + FStar_TypeChecker_Env.env -> + FStar_Syntax_Syntax.universe FStar_Pervasives_Native.option -> + FStar_Syntax_Syntax.lcomp -> + FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term + = + fun env -> + fun uopt -> + fun lc -> + fun e -> + let uu____4904 = + (FStar_Syntax_Util.is_lcomp_partial_return lc) || + env.FStar_TypeChecker_Env.lax in + if uu____4904 + then e + else + (let uu____4906 = + (lcomp_has_trivial_postcondition lc) && + (let uu____4908 = + FStar_TypeChecker_Env.try_lookup_lid env + FStar_Parser_Const.with_type_lid in + FStar_Option.isSome uu____4908) in + if uu____4906 then - FStar_Syntax_Syntax.mk_Total' t - (FStar_Pervasives_Native.Some FStar_Syntax_Syntax.U_zero) - else - (let m = - FStar_TypeChecker_Env.get_effect_decl env - FStar_Parser_Const.effect_PURE_lid in - let u_t = env.FStar_TypeChecker_Env.universe_of env t in - let wp = - let uu____4495 = - env.FStar_TypeChecker_Env.lax && - (FStar_Options.ml_ish ()) in - if uu____4495 - then FStar_Syntax_Syntax.tun - else - (let uu____4497 = - FStar_TypeChecker_Env.wp_signature env - FStar_Parser_Const.effect_PURE_lid in - match uu____4497 with - | (a,kwp) -> - let k = - FStar_Syntax_Subst.subst - [FStar_Syntax_Syntax.NT (a, t)] kwp in - let uu____4505 = - let uu____4506 = - let uu____4507 = - FStar_TypeChecker_Env.inst_effect_fun_with - [u_t] env m m.FStar_Syntax_Syntax.ret_wp in - let uu____4508 = - let uu____4509 = FStar_Syntax_Syntax.as_arg t in - let uu____4510 = - let uu____4513 = - FStar_Syntax_Syntax.as_arg v1 in - [uu____4513] in - uu____4509 :: uu____4510 in - FStar_Syntax_Syntax.mk_Tm_app uu____4507 - uu____4508 in - uu____4506 FStar_Pervasives_Native.None - v1.FStar_Syntax_Syntax.pos in - FStar_TypeChecker_Normalize.normalize - [FStar_TypeChecker_Normalize.Beta; - FStar_TypeChecker_Normalize.NoFullNorm] env - uu____4505) in - mk_comp m u_t t wp [FStar_Syntax_Syntax.RETURN])) in - (let uu____4517 = - FStar_All.pipe_left (FStar_TypeChecker_Env.debug env) - (FStar_Options.Other "Return") in - if uu____4517 - then - let uu____4518 = - FStar_Range.string_of_range v1.FStar_Syntax_Syntax.pos in - let uu____4519 = FStar_Syntax_Print.term_to_string v1 in - let uu____4520 = FStar_TypeChecker_Normalize.comp_to_string env c in - FStar_Util.print3 "(%s) returning %s at comp type %s\n" uu____4518 - uu____4519 uu____4520 - else ()); - c + let u = + match uopt with + | FStar_Pervasives_Native.Some u -> u + | FStar_Pervasives_Native.None -> + env.FStar_TypeChecker_Env.universe_of env + lc.FStar_Syntax_Syntax.res_typ in + FStar_Syntax_Util.mk_with_type u + lc.FStar_Syntax_Syntax.res_typ e + else e) let bind: FStar_Range.range -> FStar_TypeChecker_Env.env -> @@ -1307,448 +1617,426 @@ let bind: fun env -> fun e1opt -> fun lc1 -> - fun uu____4538 -> - match uu____4538 with + fun uu____4946 -> + match uu____4946 with | (b,lc2) -> + let debug1 f = + let uu____4964 = + (FStar_TypeChecker_Env.debug env FStar_Options.Extreme) + || + (FStar_All.pipe_left (FStar_TypeChecker_Env.debug env) + (FStar_Options.Other "bind")) in + if uu____4964 then f () else () in let lc11 = FStar_TypeChecker_Normalize.ghost_to_pure_lcomp env lc1 in let lc21 = FStar_TypeChecker_Normalize.ghost_to_pure_lcomp env lc2 in let joined_eff = join_lcomp env lc11 lc21 in - ((let uu____4551 = - (FStar_TypeChecker_Env.debug env FStar_Options.Extreme) - || - (FStar_All.pipe_left (FStar_TypeChecker_Env.debug env) - (FStar_Options.Other "bind")) in - if uu____4551 + let bind_flags = + let uu____4972 = + (should_not_inline_lc lc11) || + (should_not_inline_lc lc21) in + if uu____4972 + then [FStar_Syntax_Syntax.SHOULD_NOT_INLINE] + else + (let flags1 = + let uu____4979 = FStar_Syntax_Util.is_total_lcomp lc11 in + if uu____4979 + then + let uu____4982 = + FStar_Syntax_Util.is_total_lcomp lc21 in + (if uu____4982 + then [FStar_Syntax_Syntax.TOTAL] + else + (let uu____4986 = + FStar_Syntax_Util.is_tot_or_gtot_lcomp lc21 in + if uu____4986 + then [FStar_Syntax_Syntax.SOMETRIVIAL] + else [])) + else + (let uu____4991 = + (FStar_Syntax_Util.is_tot_or_gtot_lcomp lc11) && + (FStar_Syntax_Util.is_tot_or_gtot_lcomp lc21) in + if uu____4991 + then [FStar_Syntax_Syntax.SOMETRIVIAL] + else []) in + let uu____4995 = lcomp_has_trivial_postcondition lc21 in + if uu____4995 + then FStar_Syntax_Syntax.TRIVIAL_POSTCONDITION :: flags1 + else flags1) in + let bind_it uu____5002 = + let uu____5003 = + env.FStar_TypeChecker_Env.lax && + (FStar_Options.ml_ish ()) in + if uu____5003 then - let bstr = - match b with - | FStar_Pervasives_Native.None -> "none" - | FStar_Pervasives_Native.Some x -> - FStar_Syntax_Print.bv_to_string x in - let uu____4554 = - match e1opt with - | FStar_Pervasives_Native.None -> "None" - | FStar_Pervasives_Native.Some e -> - FStar_Syntax_Print.term_to_string e in - let uu____4556 = FStar_Syntax_Print.lcomp_to_string lc11 in - let uu____4557 = FStar_Syntax_Print.lcomp_to_string lc21 in - FStar_Util.print4 - "Before lift: Making bind (e1=%s)@c1=%s\nb=%s\t\tc2=%s\n" - uu____4554 uu____4556 bstr uu____4557 - else ()); - (let bind_it uu____4562 = - let uu____4563 = - env.FStar_TypeChecker_Env.lax && - (FStar_Options.ml_ish ()) in - if uu____4563 - then - let u_t = - env.FStar_TypeChecker_Env.universe_of env - lc21.FStar_Syntax_Syntax.res_typ in - lax_mk_tot_or_comp_l joined_eff u_t - lc21.FStar_Syntax_Syntax.res_typ [] - else - (let c1 = lc11.FStar_Syntax_Syntax.comp () in - let c2 = lc21.FStar_Syntax_Syntax.comp () in - (let uu____4573 = - (FStar_TypeChecker_Env.debug env - FStar_Options.Extreme) - || - (FStar_All.pipe_left - (FStar_TypeChecker_Env.debug env) - (FStar_Options.Other "bind")) in - if uu____4573 - then - let uu____4574 = + let u_t = + env.FStar_TypeChecker_Env.universe_of env + lc21.FStar_Syntax_Syntax.res_typ in + lax_mk_tot_or_comp_l joined_eff u_t + lc21.FStar_Syntax_Syntax.res_typ [] + else + (let c1 = FStar_Syntax_Syntax.lcomp_comp lc11 in + let c2 = FStar_Syntax_Syntax.lcomp_comp lc21 in + debug1 + (fun uu____5017 -> + let uu____5018 = + FStar_Syntax_Print.comp_to_string c1 in + let uu____5019 = match b with | FStar_Pervasives_Native.None -> "none" | FStar_Pervasives_Native.Some x -> FStar_Syntax_Print.bv_to_string x in - let uu____4576 = - FStar_Syntax_Print.lcomp_to_string lc11 in - let uu____4577 = - FStar_Syntax_Print.comp_to_string c1 in - let uu____4578 = - FStar_Syntax_Print.lcomp_to_string lc21 in - let uu____4579 = + let uu____5021 = FStar_Syntax_Print.comp_to_string c2 in - FStar_Util.print5 - "b=%s,Evaluated %s to %s\n And %s to %s\n" - uu____4574 uu____4576 uu____4577 uu____4578 - uu____4579 - else ()); - (let aux uu____4594 = - let uu____4595 = FStar_Syntax_Util.is_trivial_wp c1 in - if uu____4595 - then - match b with - | FStar_Pervasives_Native.None -> - FStar_Util.Inl (c2, "trivial no binder") - | FStar_Pervasives_Native.Some uu____4624 -> - let uu____4625 = - FStar_Syntax_Util.is_ml_comp c2 in - (if uu____4625 - then FStar_Util.Inl (c2, "trivial ml") - else - FStar_Util.Inr - "c1 trivial; but c2 is not ML") - else - (let uu____4652 = - (FStar_Syntax_Util.is_ml_comp c1) && - (FStar_Syntax_Util.is_ml_comp c2) in - if uu____4652 - then FStar_Util.Inl (c2, "both ml") - else - FStar_Util.Inr - "c1 not trivial, and both are not ML") in - let subst_c2 reason = - match (e1opt, b) with - | (FStar_Pervasives_Native.Some - e,FStar_Pervasives_Native.Some x) -> - let uu____4708 = - let uu____4713 = - FStar_Syntax_Subst.subst_comp - [FStar_Syntax_Syntax.NT (x, e)] c2 in - (uu____4713, reason) in - FStar_Util.Inl uu____4708 - | uu____4718 -> aux () in - let try_simplify uu____4740 = - let rec maybe_close t x c = - let uu____4751 = - let uu____4752 = - FStar_TypeChecker_Normalize.unfold_whnf env t in - uu____4752.FStar_Syntax_Syntax.n in - match uu____4751 with - | FStar_Syntax_Syntax.Tm_refine (y,uu____4756) -> - maybe_close y.FStar_Syntax_Syntax.sort x c - | FStar_Syntax_Syntax.Tm_fvar fv when - FStar_Syntax_Syntax.fv_eq_lid fv - FStar_Parser_Const.unit_lid - -> close_comp env [x] c - | uu____4762 -> c in - let uu____4763 = - let uu____4764 = - FStar_TypeChecker_Env.try_lookup_effect_lid env - FStar_Parser_Const.effect_GTot_lid in - FStar_Option.isNone uu____4764 in - if uu____4763 - then - let uu____4777 = - (FStar_Syntax_Util.is_tot_or_gtot_comp c1) && - (FStar_Syntax_Util.is_tot_or_gtot_comp c2) in - (if uu____4777 - then - FStar_Util.Inl - (c2, - "Early in prims; we don't have bind yet") - else - (let uu____4797 = - FStar_TypeChecker_Env.get_range env in - FStar_Errors.raise_error - (FStar_Errors.Fatal_NonTrivialPreConditionInPrims, - "Non-trivial pre-conditions very early in prims, even before we have defined the PURE monad") - uu____4797)) - else - (let uu____4809 = - (FStar_Syntax_Util.is_total_comp c1) && - (FStar_Syntax_Util.is_total_comp c2) in - if uu____4809 - then subst_c2 "both total" - else - (let uu____4821 = - (FStar_Syntax_Util.is_tot_or_gtot_comp c1) - && - (FStar_Syntax_Util.is_tot_or_gtot_comp c2) in - if uu____4821 - then - let uu____4832 = - let uu____4837 = - FStar_Syntax_Syntax.mk_GTotal - (FStar_Syntax_Util.comp_result c2) in - (uu____4837, "both gtot") in - FStar_Util.Inl uu____4832 - else - (match (e1opt, b) with - | (FStar_Pervasives_Native.Some - e,FStar_Pervasives_Native.Some x) -> - let uu____4863 = - (FStar_Syntax_Util.is_total_comp c1) - && - (let uu____4865 = - FStar_Syntax_Syntax.is_null_bv - x in - Prims.op_Negation uu____4865) in - if uu____4863 - then - let c21 = - FStar_Syntax_Subst.subst_comp - [FStar_Syntax_Syntax.NT (x, e)] - c2 in - let x1 = - let uu___108_4878 = x in - { - FStar_Syntax_Syntax.ppname = - (uu___108_4878.FStar_Syntax_Syntax.ppname); - FStar_Syntax_Syntax.index = - (uu___108_4878.FStar_Syntax_Syntax.index); - FStar_Syntax_Syntax.sort = - (FStar_Syntax_Util.comp_result - c1) - } in - let uu____4879 = - let uu____4884 = - maybe_close - x1.FStar_Syntax_Syntax.sort x1 - c21 in - (uu____4884, "c1 Tot") in - FStar_Util.Inl uu____4879 - else aux () - | uu____4890 -> aux ()))) in - let uu____4899 = try_simplify () in - match uu____4899 with - | FStar_Util.Inl (c,reason) -> - ((let uu____4923 = - (FStar_TypeChecker_Env.debug env - FStar_Options.Extreme) - || - (FStar_All.pipe_left - (FStar_TypeChecker_Env.debug env) - (FStar_Options.Other "bind")) in - if uu____4923 + FStar_Util.print3 + "(1) bind: \n\tc1=%s\n\tx=%s\n\tc2=%s\n(1. end bind)\n" + uu____5018 uu____5019 uu____5021); + (let aux uu____5033 = + let uu____5034 = FStar_Syntax_Util.is_trivial_wp c1 in + if uu____5034 + then + match b with + | FStar_Pervasives_Native.None -> + FStar_Util.Inl (c2, "trivial no binder") + | FStar_Pervasives_Native.Some uu____5055 -> + let uu____5056 = + FStar_Syntax_Util.is_ml_comp c2 in + (if uu____5056 + then FStar_Util.Inl (c2, "trivial ml") + else + FStar_Util.Inr + "c1 trivial; but c2 is not ML") + else + (let uu____5075 = + (FStar_Syntax_Util.is_ml_comp c1) && + (FStar_Syntax_Util.is_ml_comp c2) in + if uu____5075 + then FStar_Util.Inl (c2, "both ml") + else + FStar_Util.Inr + "c1 not trivial, and both are not ML") in + let subst_c2 e1opt1 reason = + match (e1opt1, b) with + | (FStar_Pervasives_Native.Some + e,FStar_Pervasives_Native.Some x) -> + let uu____5142 = + let uu____5147 = + FStar_Syntax_Subst.subst_comp + [FStar_Syntax_Syntax.NT (x, e)] c2 in + (uu____5147, reason) in + FStar_Util.Inl uu____5142 + | uu____5154 -> aux () in + let try_simplify uu____5176 = + let rec maybe_close t x c = + let uu____5187 = + let uu____5188 = + FStar_TypeChecker_Normalize.unfold_whnf env t in + uu____5188.FStar_Syntax_Syntax.n in + match uu____5187 with + | FStar_Syntax_Syntax.Tm_refine (y,uu____5192) -> + maybe_close y.FStar_Syntax_Syntax.sort x c + | FStar_Syntax_Syntax.Tm_fvar fv when + FStar_Syntax_Syntax.fv_eq_lid fv + FStar_Parser_Const.unit_lid + -> close_comp env [x] c + | uu____5198 -> c in + let uu____5199 = + let uu____5200 = + FStar_TypeChecker_Env.try_lookup_effect_lid env + FStar_Parser_Const.effect_GTot_lid in + FStar_Option.isNone uu____5200 in + if uu____5199 + then + let uu____5211 = + (FStar_Syntax_Util.is_tot_or_gtot_comp c1) && + (FStar_Syntax_Util.is_tot_or_gtot_comp c2) in + (if uu____5211 + then + FStar_Util.Inl + (c2, "Early in prims; we don't have bind yet") + else + (let uu____5225 = + FStar_TypeChecker_Env.get_range env in + FStar_Errors.raise_error + (FStar_Errors.Fatal_NonTrivialPreConditionInPrims, + "Non-trivial pre-conditions very early in prims, even before we have defined the PURE monad") + uu____5225)) + else + (let uu____5235 = + (FStar_Syntax_Util.is_total_comp c1) && + (FStar_Syntax_Util.is_total_comp c2) in + if uu____5235 + then subst_c2 e1opt "both total" + else + (let uu____5245 = + (FStar_Syntax_Util.is_tot_or_gtot_comp c1) && + (FStar_Syntax_Util.is_tot_or_gtot_comp c2) in + if uu____5245 then - let uu____4924 = - FStar_Syntax_Print.comp_to_string c1 in - let uu____4925 = - FStar_Syntax_Print.comp_to_string c2 in - let uu____4926 = + let uu____5254 = + let uu____5259 = + FStar_Syntax_Syntax.mk_GTotal + (FStar_Syntax_Util.comp_result c2) in + (uu____5259, "both gtot") in + FStar_Util.Inl uu____5254 + else + (match (e1opt, b) with + | (FStar_Pervasives_Native.Some + e,FStar_Pervasives_Native.Some x) -> + let uu____5283 = + (FStar_Syntax_Util.is_total_comp c1) + && + (let uu____5285 = + FStar_Syntax_Syntax.is_null_bv x in + Prims.op_Negation uu____5285) in + if uu____5283 + then + let c21 = + FStar_Syntax_Subst.subst_comp + [FStar_Syntax_Syntax.NT (x, e)] c2 in + let x1 = + let uu___113_5296 = x in + { + FStar_Syntax_Syntax.ppname = + (uu___113_5296.FStar_Syntax_Syntax.ppname); + FStar_Syntax_Syntax.index = + (uu___113_5296.FStar_Syntax_Syntax.index); + FStar_Syntax_Syntax.sort = + (FStar_Syntax_Util.comp_result + c1) + } in + let uu____5297 = + let uu____5302 = + maybe_close + x1.FStar_Syntax_Syntax.sort x1 + c21 in + (uu____5302, "c1 Tot") in + FStar_Util.Inl uu____5297 + else aux () + | uu____5308 -> aux ()))) in + let uu____5317 = try_simplify () in + match uu____5317 with + | FStar_Util.Inl (c,reason) -> + (debug1 + (fun uu____5337 -> + let uu____5338 = FStar_Syntax_Print.comp_to_string c in - let uu____4927 = - FStar_Syntax_Print.lid_to_string joined_eff in - FStar_Util.print5 - "Simplified (because %s) bind c1: %s\n\nc2: %s\n\nto c: %s\n\nWith effect lid: %s\n\n" - reason uu____4924 uu____4925 uu____4926 - uu____4927 - else ()); - c) - | FStar_Util.Inr reason -> + FStar_Util.print2 + "(2) bind: Simplified (because %s) to\n\t%s\n" + reason uu____5338); + c) + | FStar_Util.Inr reason -> + (debug1 + (fun uu____5347 -> + FStar_Util.print1 + "(2) bind: Not simplified because %s\n" + reason); + (let mk_bind c11 b1 c21 = + let uu____5362 = lift_and_destruct env c11 c21 in + match uu____5362 with + | ((md,a,kwp),(u_t1,t1,wp1),(u_t2,t2,wp2)) -> + let bs = + match b1 with + | FStar_Pervasives_Native.None -> + let uu____5419 = + FStar_Syntax_Syntax.null_binder t1 in + [uu____5419] + | FStar_Pervasives_Native.Some x -> + let uu____5421 = + FStar_Syntax_Syntax.mk_binder x in + [uu____5421] in + let mk_lam wp = + FStar_Syntax_Util.abs bs wp + (FStar_Pervasives_Native.Some + (FStar_Syntax_Util.mk_residual_comp + FStar_Parser_Const.effect_Tot_lid + FStar_Pervasives_Native.None + [FStar_Syntax_Syntax.TOTAL])) in + let r11 = + FStar_Syntax_Syntax.mk + (FStar_Syntax_Syntax.Tm_constant + (FStar_Const.Const_range r1)) + FStar_Pervasives_Native.None r1 in + let wp_args = + let uu____5434 = + FStar_Syntax_Syntax.as_arg r11 in + let uu____5435 = + let uu____5438 = + FStar_Syntax_Syntax.as_arg t1 in + let uu____5439 = + let uu____5442 = + FStar_Syntax_Syntax.as_arg t2 in + let uu____5443 = + let uu____5446 = + FStar_Syntax_Syntax.as_arg wp1 in + let uu____5447 = + let uu____5450 = + let uu____5451 = mk_lam wp2 in + FStar_Syntax_Syntax.as_arg + uu____5451 in + [uu____5450] in + uu____5446 :: uu____5447 in + uu____5442 :: uu____5443 in + uu____5438 :: uu____5439 in + uu____5434 :: uu____5435 in + let wp = + let uu____5455 = + let uu____5456 = + FStar_TypeChecker_Env.inst_effect_fun_with + [u_t1; u_t2] env md + md.FStar_Syntax_Syntax.bind_wp in + FStar_Syntax_Syntax.mk_Tm_app + uu____5456 wp_args in + uu____5455 FStar_Pervasives_Native.None + t2.FStar_Syntax_Syntax.pos in + mk_comp md u_t2 t2 wp bind_flags in + let mk_seq c11 b1 c21 = + let c12 = + FStar_TypeChecker_Env.unfold_effect_abbrev + env c11 in + let c22 = + FStar_TypeChecker_Env.unfold_effect_abbrev + env c21 in + let uu____5475 = + FStar_TypeChecker_Env.join env + c12.FStar_Syntax_Syntax.effect_name + c22.FStar_Syntax_Syntax.effect_name in + match uu____5475 with + | (m,uu____5483,lift2) -> + let c23 = + let uu____5486 = lift_comp c22 m lift2 in + FStar_Syntax_Syntax.mk_Comp uu____5486 in + let uu____5487 = destruct_comp c12 in + (match uu____5487 with + | (u1,t1,wp1) -> + let md_pure_or_ghost = + FStar_TypeChecker_Env.get_effect_decl + env + c12.FStar_Syntax_Syntax.effect_name in + let vc1 = + let uu____5501 = + let uu____5502 = + FStar_TypeChecker_Env.inst_effect_fun_with + [u1] env md_pure_or_ghost + md_pure_or_ghost.FStar_Syntax_Syntax.trivial in + let uu____5503 = + let uu____5504 = + FStar_Syntax_Syntax.as_arg t1 in + let uu____5505 = + let uu____5508 = + FStar_Syntax_Syntax.as_arg + wp1 in + [uu____5508] in + uu____5504 :: uu____5505 in + FStar_Syntax_Syntax.mk_Tm_app + uu____5502 uu____5503 in + uu____5501 + FStar_Pervasives_Native.None r1 in + strengthen_comp env + FStar_Pervasives_Native.None c23 vc1 + bind_flags) in let c1_typ = FStar_TypeChecker_Env.unfold_effect_abbrev env c1 in - let uu____4937 = destruct_comp c1_typ in - (match uu____4937 with - | (u_res_t1,res_t1,uu____4946) -> - let should_inline_c1 uu____4950 = - ((FStar_Syntax_Util.is_pure_or_ghost_comp - c1) - && - (let uu____4952 = - FStar_Syntax_Util.is_unit res_t1 in - Prims.op_Negation uu____4952)) - && - (match e1opt with - | FStar_Pervasives_Native.Some e1 -> - let uu____4964 = - FStar_Syntax_Util.head_and_args' - e1 in - (match uu____4964 with - | (head1,uu____4978) -> - let uu____4995 = - let uu____4996 = - FStar_Syntax_Util.un_uinst - head1 in - uu____4996.FStar_Syntax_Syntax.n in - (match uu____4995 with - | FStar_Syntax_Syntax.Tm_fvar - fv -> - let uu____5000 = - let uu____5021 = - FStar_Syntax_Syntax.lid_of_fv - fv in - FStar_TypeChecker_Env.lookup_qname - env uu____5021 in - (match uu____5000 with - | FStar_Pervasives_Native.Some - (FStar_Util.Inr - (se,uu____5023),uu____5024) - -> - Prims.op_Negation - (FStar_List.existsb - (fun - uu___76_5072 - -> - match uu___76_5072 - with - | FStar_Syntax_Syntax.Irreducible - -> true - | FStar_Syntax_Syntax.Assumption - -> true - | uu____5073 - -> false) - se.FStar_Syntax_Syntax.sigquals) - | uu____5074 -> true) - | FStar_Syntax_Syntax.Tm_let - ((true ,uu____5095),uu____5096) - -> false - | uu____5111 -> true)) - | uu____5112 -> false) in - let c21 = - let uu____5116 = should_inline_c1 () in - if uu____5116 + let uu____5514 = destruct_comp c1_typ in + match uu____5514 with + | (u_res_t1,res_t1,uu____5523) -> + let uu____5524 = + (FStar_Option.isSome b) && + (should_return env e1opt lc11) in + if uu____5524 + then + let e1 = FStar_Option.get e1opt in + let x = FStar_Option.get b in + let uu____5527 = + FStar_Syntax_Util.is_partial_return c1 in + (if uu____5527 then - match (e1opt, b) with - | (FStar_Pervasives_Native.Some - e,FStar_Pervasives_Native.Some bv) -> - let uu____5127 = - subst_c2 "inline all pure" in - (match uu____5127 with - | FStar_Util.Inl (c21,uu____5137) - -> - let c2_typ = - FStar_TypeChecker_Env.unfold_effect_abbrev - env c21 in - let uu____5143 = - destruct_comp c2_typ in - (match uu____5143 with - | (u_res_t,res_t,wp) -> - let md = - FStar_TypeChecker_Env.get_effect_decl - env - c2_typ.FStar_Syntax_Syntax.effect_name in - let wp1 = - if - Prims.op_Negation - (FStar_List.existsb - (fun uu___77_5160 - -> - match uu___77_5160 - with - | FStar_Syntax_Syntax.RETURN - -> true - | FStar_Syntax_Syntax.PARTIAL_RETURN - -> true - | uu____5161 - -> false) - c1_typ.FStar_Syntax_Syntax.flags) - then - let uu____5162 = - let uu____5163 = - FStar_TypeChecker_Env.inst_effect_fun_with - [u_res_t] env md - md.FStar_Syntax_Syntax.assume_p in - let uu____5164 = - let uu____5165 = - FStar_Syntax_Syntax.as_arg - res_t in - let uu____5166 = - let uu____5169 = - let uu____5170 - = - let uu____5171 - = - FStar_Syntax_Syntax.bv_to_name - bv in - FStar_Syntax_Util.mk_eq2 - u_res_t1 - res_t1 - uu____5171 - e in - FStar_Syntax_Syntax.as_arg - uu____5170 in - let uu____5172 = - let uu____5175 - = - FStar_Syntax_Syntax.as_arg - wp in - [uu____5175] in - uu____5169 :: - uu____5172 in - uu____5165 :: - uu____5166 in - FStar_Syntax_Syntax.mk_Tm_app - uu____5163 - uu____5164 in - uu____5162 - FStar_Pervasives_Native.None - wp.FStar_Syntax_Syntax.pos - else wp in - mk_comp md u_res_t res_t - wp1 - c2_typ.FStar_Syntax_Syntax.flags) - | FStar_Util.Inr uu____5179 -> c2) - | (uu____5184,uu____5185) -> c2 - else c2 in - let uu____5195 = - lift_and_destruct env c1 c21 in - (match uu____5195 with - | ((md,a,kwp),(u_t1,t1,wp1),(u_t2,t2,wp2)) - -> - let bs = - match b with - | FStar_Pervasives_Native.None -> - let uu____5252 = - FStar_Syntax_Syntax.null_binder - t1 in - [uu____5252] - | FStar_Pervasives_Native.Some x -> - let uu____5254 = - FStar_Syntax_Syntax.mk_binder x in - [uu____5254] in - let mk_lam wp = - FStar_Syntax_Util.abs bs wp - (FStar_Pervasives_Native.Some - (FStar_Syntax_Util.mk_residual_comp - FStar_Parser_Const.effect_Tot_lid - FStar_Pervasives_Native.None - [FStar_Syntax_Syntax.TOTAL])) in - let r11 = - FStar_Syntax_Syntax.mk - (FStar_Syntax_Syntax.Tm_constant - (FStar_Const.Const_range r1)) - FStar_Pervasives_Native.None r1 in - let wp_args = - let uu____5267 = - FStar_Syntax_Syntax.as_arg r11 in - let uu____5268 = - let uu____5271 = - FStar_Syntax_Syntax.as_arg t1 in - let uu____5272 = - let uu____5275 = - FStar_Syntax_Syntax.as_arg t2 in - let uu____5276 = - let uu____5279 = - FStar_Syntax_Syntax.as_arg - wp1 in - let uu____5280 = - let uu____5283 = - let uu____5284 = mk_lam wp2 in - FStar_Syntax_Syntax.as_arg - uu____5284 in - [uu____5283] in - uu____5279 :: uu____5280 in - uu____5275 :: uu____5276 in - uu____5271 :: uu____5272 in - uu____5267 :: uu____5268 in - let wp = - let uu____5288 = - let uu____5289 = - FStar_TypeChecker_Env.inst_effect_fun_with - [u_t1; u_t2] env md - md.FStar_Syntax_Syntax.bind_wp in - FStar_Syntax_Syntax.mk_Tm_app - uu____5289 wp_args in - uu____5288 - FStar_Pervasives_Native.None - t2.FStar_Syntax_Syntax.pos in - mk_comp md u_t2 t2 wp [])))) in - { - FStar_Syntax_Syntax.eff_name = joined_eff; - FStar_Syntax_Syntax.res_typ = - (lc21.FStar_Syntax_Syntax.res_typ); - FStar_Syntax_Syntax.cflags = []; - FStar_Syntax_Syntax.comp = bind_it - })) + (debug1 + (fun uu____5535 -> + let uu____5536 = + FStar_TypeChecker_Normalize.term_to_string + env e1 in + let uu____5537 = + FStar_Syntax_Print.bv_to_string + x in + FStar_Util.print2 + "(3) bind (case a): Substituting %s for %s" + uu____5536 uu____5537); + (let c21 = + FStar_Syntax_Subst.subst_comp + [FStar_Syntax_Syntax.NT (x, e1)] + c2 in + mk_bind c1 b c21)) + else + (let uu____5540 = + ((FStar_Options.vcgen_optimize_bind_as_seq + ()) + && + (lcomp_has_trivial_postcondition + lc11)) + && + (let uu____5542 = + FStar_TypeChecker_Env.try_lookup_lid + env + FStar_Parser_Const.with_type_lid in + FStar_Option.isSome uu____5542) in + if uu____5540 + then + let e1' = + let uu____5564 = + FStar_Options.vcgen_decorate_with_type + () in + if uu____5564 + then + FStar_Syntax_Util.mk_with_type + u_res_t1 res_t1 e1 + else e1 in + (debug1 + (fun uu____5575 -> + let uu____5576 = + FStar_TypeChecker_Normalize.term_to_string + env e1' in + let uu____5577 = + FStar_Syntax_Print.bv_to_string + x in + FStar_Util.print2 + "(3) bind (case b): Substituting %s for %s" + uu____5576 uu____5577); + (let c21 = + FStar_Syntax_Subst.subst_comp + [FStar_Syntax_Syntax.NT + (x, e1')] c2 in + mk_seq c1 b c21)) + else + (debug1 + (fun uu____5589 -> + let uu____5590 = + FStar_TypeChecker_Normalize.term_to_string + env e1 in + let uu____5591 = + FStar_Syntax_Print.bv_to_string + x in + FStar_Util.print2 + "(3) bind (case c): Adding equality %s = %s" + uu____5590 uu____5591); + (let c21 = + FStar_Syntax_Subst.subst_comp + [FStar_Syntax_Syntax.NT (x, e1)] + c2 in + let x_eq_e = + let uu____5594 = + FStar_Syntax_Syntax.bv_to_name + x in + FStar_Syntax_Util.mk_eq2 u_res_t1 + res_t1 e1 uu____5594 in + let c22 = + weaken_comp env c21 x_eq_e in + mk_bind c1 b c22)))) + else mk_bind c1 b c2)))) in + FStar_Syntax_Syntax.mk_lcomp joined_eff + lc21.FStar_Syntax_Syntax.res_typ bind_flags bind_it let weaken_guard: FStar_TypeChecker_Common.guard_formula -> FStar_TypeChecker_Common.guard_formula -> @@ -1761,418 +2049,149 @@ let weaken_guard: f1,FStar_TypeChecker_Common.NonTrivial f2) -> let g = FStar_Syntax_Util.mk_imp f1 f2 in FStar_TypeChecker_Common.NonTrivial g - | uu____5301 -> g2 -let weaken_precondition: + | uu____5606 -> g2 +let maybe_assume_result_eq_pure_term: FStar_TypeChecker_Env.env -> - FStar_Syntax_Syntax.lcomp -> - FStar_TypeChecker_Common.guard_formula -> FStar_Syntax_Syntax.lcomp + FStar_Syntax_Syntax.term -> + FStar_Syntax_Syntax.lcomp -> FStar_Syntax_Syntax.lcomp = fun env -> - fun lc -> - fun f -> - let weaken uu____5320 = - let c = lc.FStar_Syntax_Syntax.comp () in - let uu____5324 = - env.FStar_TypeChecker_Env.lax && (FStar_Options.ml_ish ()) in - if uu____5324 - then c + fun e -> + fun lc -> + let should_return1 = + (((Prims.op_Negation env.FStar_TypeChecker_Env.lax) && + (FStar_TypeChecker_Env.lid_exists env + FStar_Parser_Const.effect_GTot_lid)) + && (should_return env (FStar_Pervasives_Native.Some e) lc)) + && + (let uu____5622 = FStar_Syntax_Util.is_lcomp_partial_return lc in + Prims.op_Negation uu____5622) in + let flags1 = + if should_return1 + then + let uu____5628 = FStar_Syntax_Util.is_total_lcomp lc in + (if uu____5628 + then FStar_Syntax_Syntax.RETURN :: + (lc.FStar_Syntax_Syntax.cflags) + else FStar_Syntax_Syntax.PARTIAL_RETURN :: + (lc.FStar_Syntax_Syntax.cflags)) + else lc.FStar_Syntax_Syntax.cflags in + let refine1 uu____5636 = + let c = FStar_Syntax_Syntax.lcomp_comp lc in + let u_t = + match comp_univ_opt c with + | FStar_Pervasives_Native.Some u_t -> u_t + | FStar_Pervasives_Native.None -> + env.FStar_TypeChecker_Env.universe_of env + (FStar_Syntax_Util.comp_result c) in + let uu____5640 = FStar_Syntax_Util.is_tot_or_gtot_comp c in + if uu____5640 + then + let retc = + return_value env (FStar_Pervasives_Native.Some u_t) + (FStar_Syntax_Util.comp_result c) e in + let uu____5642 = + let uu____5643 = FStar_Syntax_Util.is_pure_comp c in + Prims.op_Negation uu____5643 in + (if uu____5642 + then + let retc1 = FStar_Syntax_Util.comp_to_comp_typ retc in + let retc2 = + let uu___114_5646 = retc1 in + { + FStar_Syntax_Syntax.comp_univs = + (uu___114_5646.FStar_Syntax_Syntax.comp_univs); + FStar_Syntax_Syntax.effect_name = + FStar_Parser_Const.effect_GHOST_lid; + FStar_Syntax_Syntax.result_typ = + (uu___114_5646.FStar_Syntax_Syntax.result_typ); + FStar_Syntax_Syntax.effect_args = + (uu___114_5646.FStar_Syntax_Syntax.effect_args); + FStar_Syntax_Syntax.flags = flags1 + } in + FStar_Syntax_Syntax.mk_Comp retc2 + else FStar_Syntax_Util.comp_set_flags retc flags1) else - (match f with - | FStar_TypeChecker_Common.Trivial -> c - | FStar_TypeChecker_Common.NonTrivial f1 -> - let uu____5331 = FStar_Syntax_Util.is_ml_comp c in - if uu____5331 - then c - else - (let c1 = FStar_TypeChecker_Env.unfold_effect_abbrev env c in - let uu____5336 = destruct_comp c1 in - match uu____5336 with - | (u_res_t,res_t,wp) -> - let md = - FStar_TypeChecker_Env.get_effect_decl env - c1.FStar_Syntax_Syntax.effect_name in - let wp1 = - let uu____5352 = - let uu____5353 = - FStar_TypeChecker_Env.inst_effect_fun_with - [u_res_t] env md - md.FStar_Syntax_Syntax.assume_p in - let uu____5354 = - let uu____5355 = - FStar_Syntax_Syntax.as_arg res_t in - let uu____5356 = - let uu____5359 = - FStar_Syntax_Syntax.as_arg f1 in - let uu____5360 = - let uu____5363 = - FStar_Syntax_Syntax.as_arg wp in - [uu____5363] in - uu____5359 :: uu____5360 in - uu____5355 :: uu____5356 in - FStar_Syntax_Syntax.mk_Tm_app uu____5353 - uu____5354 in - uu____5352 FStar_Pervasives_Native.None - wp.FStar_Syntax_Syntax.pos in - mk_comp md u_res_t res_t wp1 - c1.FStar_Syntax_Syntax.flags)) in - let uu___109_5366 = lc in - { - FStar_Syntax_Syntax.eff_name = - (uu___109_5366.FStar_Syntax_Syntax.eff_name); - FStar_Syntax_Syntax.res_typ = - (uu___109_5366.FStar_Syntax_Syntax.res_typ); - FStar_Syntax_Syntax.cflags = - (uu___109_5366.FStar_Syntax_Syntax.cflags); - FStar_Syntax_Syntax.comp = weaken - } -let strengthen_precondition: - (Prims.unit -> Prims.string) FStar_Pervasives_Native.option -> + (let c1 = FStar_TypeChecker_Env.unfold_effect_abbrev env c in + let t = c1.FStar_Syntax_Syntax.result_typ in + let c2 = FStar_Syntax_Syntax.mk_Comp c1 in + let x = + FStar_Syntax_Syntax.new_bv + (FStar_Pervasives_Native.Some (t.FStar_Syntax_Syntax.pos)) t in + let xexp = FStar_Syntax_Syntax.bv_to_name x in + let ret1 = + let uu____5657 = + let uu____5660 = + return_value env (FStar_Pervasives_Native.Some u_t) t xexp in + FStar_Syntax_Util.comp_set_flags uu____5660 + [FStar_Syntax_Syntax.PARTIAL_RETURN] in + FStar_All.pipe_left FStar_Syntax_Util.lcomp_of_comp uu____5657 in + let eq1 = FStar_Syntax_Util.mk_eq2 u_t t xexp e in + let eq_ret = + weaken_precondition env ret1 + (FStar_TypeChecker_Common.NonTrivial eq1) in + let uu____5665 = + let uu____5666 = + let uu____5667 = FStar_Syntax_Util.lcomp_of_comp c2 in + bind e.FStar_Syntax_Syntax.pos env + FStar_Pervasives_Native.None uu____5667 + ((FStar_Pervasives_Native.Some x), eq_ret) in + FStar_Syntax_Syntax.lcomp_comp uu____5666 in + FStar_Syntax_Util.comp_set_flags uu____5665 flags1) in + if Prims.op_Negation should_return1 + then lc + else + FStar_Syntax_Syntax.mk_lcomp lc.FStar_Syntax_Syntax.eff_name + lc.FStar_Syntax_Syntax.res_typ flags1 refine1 +let maybe_return_e2_and_bind: + FStar_Range.range -> FStar_TypeChecker_Env.env -> - FStar_Syntax_Syntax.term -> + FStar_Syntax_Syntax.term FStar_Pervasives_Native.option -> FStar_Syntax_Syntax.lcomp -> - FStar_TypeChecker_Env.guard_t -> - (FStar_Syntax_Syntax.lcomp,FStar_TypeChecker_Env.guard_t) - FStar_Pervasives_Native.tuple2 + FStar_Syntax_Syntax.term -> + lcomp_with_binder -> FStar_Syntax_Syntax.lcomp = - fun reason -> + fun r -> fun env -> - fun e -> - fun lc -> - fun g0 -> - let uu____5399 = FStar_TypeChecker_Rel.is_trivial g0 in - if uu____5399 - then (lc, g0) - else - ((let uu____5406 = - FStar_All.pipe_left (FStar_TypeChecker_Env.debug env) - FStar_Options.Extreme in - if uu____5406 - then - let uu____5407 = - FStar_TypeChecker_Normalize.term_to_string env e in - let uu____5408 = - FStar_TypeChecker_Rel.guard_to_string env g0 in - FStar_Util.print2 - "+++++++++++++Strengthening pre-condition of term %s with guard %s\n" - uu____5407 uu____5408 - else ()); - (let flags1 = - FStar_All.pipe_right lc.FStar_Syntax_Syntax.cflags - (FStar_List.collect - (fun uu___78_5418 -> - match uu___78_5418 with - | FStar_Syntax_Syntax.RETURN -> - [FStar_Syntax_Syntax.PARTIAL_RETURN] - | FStar_Syntax_Syntax.PARTIAL_RETURN -> - [FStar_Syntax_Syntax.PARTIAL_RETURN] - | uu____5421 -> [])) in - let strengthen uu____5427 = - let c = lc.FStar_Syntax_Syntax.comp () in - if env.FStar_TypeChecker_Env.lax - then c - else - (let g01 = FStar_TypeChecker_Rel.simplify_guard env g0 in - let uu____5435 = FStar_TypeChecker_Rel.guard_form g01 in - match uu____5435 with - | FStar_TypeChecker_Common.Trivial -> c - | FStar_TypeChecker_Common.NonTrivial f -> - ((let uu____5440 = - FStar_All.pipe_left - (FStar_TypeChecker_Env.debug env) - FStar_Options.Extreme in - if uu____5440 - then - let uu____5441 = - FStar_TypeChecker_Normalize.term_to_string env - e in - let uu____5442 = - FStar_TypeChecker_Normalize.term_to_string env - f in - FStar_Util.print2 - "-------------Strengthening pre-condition of term %s with guard %s\n" - uu____5441 uu____5442 - else ()); - (let c1 = - FStar_TypeChecker_Env.unfold_effect_abbrev env c in - let uu____5445 = destruct_comp c1 in - match uu____5445 with - | (u_res_t,res_t,wp) -> - let md = - FStar_TypeChecker_Env.get_effect_decl env - c1.FStar_Syntax_Syntax.effect_name in - let wp1 = - let uu____5461 = - let uu____5462 = - FStar_TypeChecker_Env.inst_effect_fun_with - [u_res_t] env md - md.FStar_Syntax_Syntax.assert_p in - let uu____5463 = - let uu____5464 = - FStar_Syntax_Syntax.as_arg res_t in - let uu____5465 = - let uu____5468 = - let uu____5469 = - let uu____5470 = - FStar_TypeChecker_Env.get_range - env in - label_opt env reason uu____5470 f in - FStar_All.pipe_left - FStar_Syntax_Syntax.as_arg - uu____5469 in - let uu____5471 = - let uu____5474 = - FStar_Syntax_Syntax.as_arg wp in - [uu____5474] in - uu____5468 :: uu____5471 in - uu____5464 :: uu____5465 in - FStar_Syntax_Syntax.mk_Tm_app uu____5462 - uu____5463 in - uu____5461 FStar_Pervasives_Native.None - wp.FStar_Syntax_Syntax.pos in - ((let uu____5478 = - FStar_All.pipe_left - (FStar_TypeChecker_Env.debug env) - FStar_Options.Extreme in - if uu____5478 - then - let uu____5479 = - FStar_Syntax_Print.term_to_string wp1 in - FStar_Util.print1 - "-------------Strengthened pre-condition is %s\n" - uu____5479 - else ()); - (let c2 = mk_comp md u_res_t res_t wp1 flags1 in - c2))))) in - let uu____5482 = - let uu___110_5483 = lc in - let uu____5484 = - FStar_TypeChecker_Env.norm_eff_name env - lc.FStar_Syntax_Syntax.eff_name in - let uu____5485 = - let uu____5488 = - (FStar_Syntax_Util.is_pure_lcomp lc) && - (let uu____5490 = - FStar_Syntax_Util.is_function_typ - lc.FStar_Syntax_Syntax.res_typ in - FStar_All.pipe_left Prims.op_Negation uu____5490) in - if uu____5488 then flags1 else [] in - { - FStar_Syntax_Syntax.eff_name = uu____5484; - FStar_Syntax_Syntax.res_typ = - (uu___110_5483.FStar_Syntax_Syntax.res_typ); - FStar_Syntax_Syntax.cflags = uu____5485; - FStar_Syntax_Syntax.comp = strengthen - } in - (uu____5482, - (let uu___111_5495 = g0 in - { - FStar_TypeChecker_Env.guard_f = - FStar_TypeChecker_Common.Trivial; - FStar_TypeChecker_Env.deferred = - (uu___111_5495.FStar_TypeChecker_Env.deferred); - FStar_TypeChecker_Env.univ_ineqs = - (uu___111_5495.FStar_TypeChecker_Env.univ_ineqs); - FStar_TypeChecker_Env.implicits = - (uu___111_5495.FStar_TypeChecker_Env.implicits) - })))) -let add_equality_to_post_condition: - FStar_TypeChecker_Env.env -> - FStar_Syntax_Syntax.comp -> - FStar_Syntax_Syntax.typ -> - FStar_Syntax_Syntax.comp' FStar_Syntax_Syntax.syntax - = - fun env -> - fun comp -> - fun res_t -> - let md_pure = - FStar_TypeChecker_Env.get_effect_decl env - FStar_Parser_Const.effect_PURE_lid in - let x = FStar_Syntax_Syntax.new_bv FStar_Pervasives_Native.None res_t in - let y = FStar_Syntax_Syntax.new_bv FStar_Pervasives_Native.None res_t in - let uu____5510 = - let uu____5515 = FStar_Syntax_Syntax.bv_to_name x in - let uu____5516 = FStar_Syntax_Syntax.bv_to_name y in - (uu____5515, uu____5516) in - match uu____5510 with - | (xexp,yexp) -> - let u_res_t = env.FStar_TypeChecker_Env.universe_of env res_t in - let yret = - let uu____5525 = - let uu____5526 = - FStar_TypeChecker_Env.inst_effect_fun_with [u_res_t] env - md_pure md_pure.FStar_Syntax_Syntax.ret_wp in - let uu____5527 = - let uu____5528 = FStar_Syntax_Syntax.as_arg res_t in - let uu____5529 = - let uu____5532 = FStar_Syntax_Syntax.as_arg yexp in - [uu____5532] in - uu____5528 :: uu____5529 in - FStar_Syntax_Syntax.mk_Tm_app uu____5526 uu____5527 in - uu____5525 FStar_Pervasives_Native.None - res_t.FStar_Syntax_Syntax.pos in - let x_eq_y_yret = - let uu____5538 = - let uu____5539 = - FStar_TypeChecker_Env.inst_effect_fun_with [u_res_t] env - md_pure md_pure.FStar_Syntax_Syntax.assume_p in - let uu____5540 = - let uu____5541 = FStar_Syntax_Syntax.as_arg res_t in - let uu____5542 = - let uu____5545 = - let uu____5546 = - FStar_Syntax_Util.mk_eq2 u_res_t res_t xexp yexp in - FStar_All.pipe_left FStar_Syntax_Syntax.as_arg - uu____5546 in - let uu____5547 = - let uu____5550 = - FStar_All.pipe_left FStar_Syntax_Syntax.as_arg yret in - [uu____5550] in - uu____5545 :: uu____5547 in - uu____5541 :: uu____5542 in - FStar_Syntax_Syntax.mk_Tm_app uu____5539 uu____5540 in - uu____5538 FStar_Pervasives_Native.None - res_t.FStar_Syntax_Syntax.pos in - let forall_y_x_eq_y_yret = - let uu____5556 = - let uu____5557 = - FStar_TypeChecker_Env.inst_effect_fun_with - [u_res_t; u_res_t] env md_pure - md_pure.FStar_Syntax_Syntax.close_wp in - let uu____5558 = - let uu____5559 = FStar_Syntax_Syntax.as_arg res_t in - let uu____5560 = - let uu____5563 = FStar_Syntax_Syntax.as_arg res_t in - let uu____5564 = - let uu____5567 = - let uu____5568 = - let uu____5569 = - let uu____5570 = FStar_Syntax_Syntax.mk_binder y in - [uu____5570] in - FStar_Syntax_Util.abs uu____5569 x_eq_y_yret - (FStar_Pervasives_Native.Some - (FStar_Syntax_Util.mk_residual_comp - FStar_Parser_Const.effect_Tot_lid - FStar_Pervasives_Native.None - [FStar_Syntax_Syntax.TOTAL])) in - FStar_All.pipe_left FStar_Syntax_Syntax.as_arg - uu____5568 in - [uu____5567] in - uu____5563 :: uu____5564 in - uu____5559 :: uu____5560 in - FStar_Syntax_Syntax.mk_Tm_app uu____5557 uu____5558 in - uu____5556 FStar_Pervasives_Native.None - res_t.FStar_Syntax_Syntax.pos in - let lc2 = - mk_comp md_pure u_res_t res_t forall_y_x_eq_y_yret - [FStar_Syntax_Syntax.PARTIAL_RETURN] in - let lc = - let uu____5577 = FStar_TypeChecker_Env.get_range env in - bind uu____5577 env FStar_Pervasives_Native.None - (FStar_Syntax_Util.lcomp_of_comp comp) - ((FStar_Pervasives_Native.Some x), - (FStar_Syntax_Util.lcomp_of_comp lc2)) in - lc.FStar_Syntax_Syntax.comp () -let ite: - FStar_TypeChecker_Env.env -> - FStar_Syntax_Syntax.formula -> - FStar_Syntax_Syntax.lcomp -> - FStar_Syntax_Syntax.lcomp -> FStar_Syntax_Syntax.lcomp - = - fun env -> - fun guard -> - fun lcomp_then -> - fun lcomp_else -> - let joined_eff = join_lcomp env lcomp_then lcomp_else in - let comp uu____5596 = - let uu____5597 = - env.FStar_TypeChecker_Env.lax && (FStar_Options.ml_ish ()) in - if uu____5597 - then - let u_t = - env.FStar_TypeChecker_Env.universe_of env - lcomp_then.FStar_Syntax_Syntax.res_typ in - lax_mk_tot_or_comp_l joined_eff u_t - lcomp_then.FStar_Syntax_Syntax.res_typ [] - else - (let uu____5600 = - let uu____5625 = lcomp_then.FStar_Syntax_Syntax.comp () in - let uu____5626 = lcomp_else.FStar_Syntax_Syntax.comp () in - lift_and_destruct env uu____5625 uu____5626 in - match uu____5600 with - | ((md,uu____5628,uu____5629),(u_res_t,res_t,wp_then), - (uu____5633,uu____5634,wp_else)) -> - let ifthenelse md1 res_t1 g wp_t wp_e = - let uu____5672 = - FStar_Range.union_ranges wp_t.FStar_Syntax_Syntax.pos - wp_e.FStar_Syntax_Syntax.pos in - let uu____5673 = - let uu____5674 = - FStar_TypeChecker_Env.inst_effect_fun_with [u_res_t] - env md1 md1.FStar_Syntax_Syntax.if_then_else in - let uu____5675 = - let uu____5676 = FStar_Syntax_Syntax.as_arg res_t1 in - let uu____5677 = - let uu____5680 = FStar_Syntax_Syntax.as_arg g in - let uu____5681 = - let uu____5684 = FStar_Syntax_Syntax.as_arg wp_t in - let uu____5685 = - let uu____5688 = - FStar_Syntax_Syntax.as_arg wp_e in - [uu____5688] in - uu____5684 :: uu____5685 in - uu____5680 :: uu____5681 in - uu____5676 :: uu____5677 in - FStar_Syntax_Syntax.mk_Tm_app uu____5674 uu____5675 in - uu____5673 FStar_Pervasives_Native.None uu____5672 in - let wp = ifthenelse md res_t guard wp_then wp_else in - let uu____5694 = - let uu____5695 = FStar_Options.split_cases () in - uu____5695 > (Prims.parse_int "0") in - if uu____5694 - then - let comp = mk_comp md u_res_t res_t wp [] in - add_equality_to_post_condition env comp res_t - else - (let wp1 = - let uu____5701 = - let uu____5702 = - FStar_TypeChecker_Env.inst_effect_fun_with - [u_res_t] env md md.FStar_Syntax_Syntax.ite_wp in - let uu____5703 = - let uu____5704 = FStar_Syntax_Syntax.as_arg res_t in - let uu____5705 = - let uu____5708 = FStar_Syntax_Syntax.as_arg wp in - [uu____5708] in - uu____5704 :: uu____5705 in - FStar_Syntax_Syntax.mk_Tm_app uu____5702 uu____5703 in - uu____5701 FStar_Pervasives_Native.None - wp.FStar_Syntax_Syntax.pos in - mk_comp md u_res_t res_t wp1 [])) in - let uu____5711 = - join_effects env lcomp_then.FStar_Syntax_Syntax.eff_name - lcomp_else.FStar_Syntax_Syntax.eff_name in - { - FStar_Syntax_Syntax.eff_name = uu____5711; - FStar_Syntax_Syntax.res_typ = - (lcomp_then.FStar_Syntax_Syntax.res_typ); - FStar_Syntax_Syntax.cflags = []; - FStar_Syntax_Syntax.comp = comp - } + fun e1opt -> + fun lc1 -> + fun e2 -> + fun uu____5690 -> + match uu____5690 with + | (x,lc2) -> + let lc21 = + let eff1 = + FStar_TypeChecker_Env.norm_eff_name env + lc1.FStar_Syntax_Syntax.eff_name in + let eff2 = + FStar_TypeChecker_Env.norm_eff_name env + lc2.FStar_Syntax_Syntax.eff_name in + let uu____5702 = + ((let uu____5705 = is_pure_or_ghost_effect env eff1 in + Prims.op_Negation uu____5705) || + (should_not_inline_lc lc1)) + && (is_pure_or_ghost_effect env eff2) in + if uu____5702 + then maybe_assume_result_eq_pure_term env e2 lc2 + else lc2 in + bind r env e1opt lc1 (x, lc21) let fvar_const: FStar_TypeChecker_Env.env -> FStar_Ident.lident -> FStar_Syntax_Syntax.term = fun env -> fun lid -> - let uu____5718 = - let uu____5719 = FStar_TypeChecker_Env.get_range env in - FStar_Ident.set_lid_range lid uu____5719 in - FStar_Syntax_Syntax.fvar uu____5718 FStar_Syntax_Syntax.Delta_constant + let uu____5715 = + let uu____5716 = FStar_TypeChecker_Env.get_range env in + FStar_Ident.set_lid_range lid uu____5716 in + FStar_Syntax_Syntax.fvar uu____5715 FStar_Syntax_Syntax.Delta_constant FStar_Pervasives_Native.None let bind_cases: FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.typ -> - (FStar_Syntax_Syntax.typ,FStar_Syntax_Syntax.lcomp) - FStar_Pervasives_Native.tuple2 Prims.list -> + (FStar_Syntax_Syntax.typ,FStar_Ident.lident,FStar_Syntax_Syntax.cflags + Prims.list,Prims.bool -> + FStar_Syntax_Syntax.lcomp) + FStar_Pervasives_Native.tuple4 Prims.list -> FStar_Syntax_Syntax.lcomp = fun env -> @@ -2181,256 +2200,158 @@ let bind_cases: let eff = FStar_List.fold_left (fun eff -> - fun uu____5751 -> - match uu____5751 with - | (uu____5756,lc) -> - join_effects env eff lc.FStar_Syntax_Syntax.eff_name) + fun uu____5775 -> + match uu____5775 with + | (uu____5788,eff_label,uu____5790,uu____5791) -> + join_effects env eff eff_label) FStar_Parser_Const.effect_PURE_lid lcases in - let bind_cases uu____5761 = - let u_res_t = env.FStar_TypeChecker_Env.universe_of env res_t in - let uu____5763 = - env.FStar_TypeChecker_Env.lax && (FStar_Options.ml_ish ()) in - if uu____5763 - then lax_mk_tot_or_comp_l eff u_res_t res_t [] - else - (let ifthenelse md res_t1 g wp_t wp_e = - let uu____5783 = - FStar_Range.union_ranges wp_t.FStar_Syntax_Syntax.pos - wp_e.FStar_Syntax_Syntax.pos in - let uu____5784 = - let uu____5785 = - FStar_TypeChecker_Env.inst_effect_fun_with [u_res_t] env - md md.FStar_Syntax_Syntax.if_then_else in - let uu____5786 = - let uu____5787 = FStar_Syntax_Syntax.as_arg res_t1 in - let uu____5788 = - let uu____5791 = FStar_Syntax_Syntax.as_arg g in - let uu____5792 = - let uu____5795 = FStar_Syntax_Syntax.as_arg wp_t in - let uu____5796 = - let uu____5799 = FStar_Syntax_Syntax.as_arg wp_e in - [uu____5799] in - uu____5795 :: uu____5796 in - uu____5791 :: uu____5792 in - uu____5787 :: uu____5788 in - FStar_Syntax_Syntax.mk_Tm_app uu____5785 uu____5786 in - uu____5784 FStar_Pervasives_Native.None uu____5783 in - let default_case = - let post_k = - let uu____5806 = - let uu____5813 = FStar_Syntax_Syntax.null_binder res_t in - [uu____5813] in - let uu____5814 = - FStar_Syntax_Syntax.mk_Total FStar_Syntax_Util.ktype0 in - FStar_Syntax_Util.arrow uu____5806 uu____5814 in - let kwp = - let uu____5820 = - let uu____5827 = FStar_Syntax_Syntax.null_binder post_k in - [uu____5827] in - let uu____5828 = - FStar_Syntax_Syntax.mk_Total FStar_Syntax_Util.ktype0 in - FStar_Syntax_Util.arrow uu____5820 uu____5828 in - let post = - FStar_Syntax_Syntax.new_bv FStar_Pervasives_Native.None - post_k in - let wp = - let uu____5833 = - let uu____5834 = FStar_Syntax_Syntax.mk_binder post in - [uu____5834] in - let uu____5835 = - let uu____5836 = - let uu____5839 = FStar_TypeChecker_Env.get_range env in - label FStar_TypeChecker_Err.exhaustiveness_check - uu____5839 in - let uu____5840 = - fvar_const env FStar_Parser_Const.false_lid in - FStar_All.pipe_left uu____5836 uu____5840 in - FStar_Syntax_Util.abs uu____5833 uu____5835 - (FStar_Pervasives_Native.Some - (FStar_Syntax_Util.mk_residual_comp - FStar_Parser_Const.effect_Tot_lid - FStar_Pervasives_Native.None - [FStar_Syntax_Syntax.TOTAL])) in - let md = - FStar_TypeChecker_Env.get_effect_decl env - FStar_Parser_Const.effect_PURE_lid in - mk_comp md u_res_t res_t wp [] in - let comp = - FStar_List.fold_right - (fun uu____5864 -> - fun celse -> - match uu____5864 with - | (g,cthen) -> - let uu____5872 = - let uu____5897 = - cthen.FStar_Syntax_Syntax.comp () in - lift_and_destruct env uu____5897 celse in - (match uu____5872 with - | ((md,uu____5899,uu____5900),(uu____5901,uu____5902,wp_then), - (uu____5904,uu____5905,wp_else)) -> - let uu____5925 = - ifthenelse md res_t g wp_then wp_else in - mk_comp md u_res_t res_t uu____5925 [])) - lcases default_case in - let uu____5926 = - let uu____5927 = FStar_Options.split_cases () in - uu____5927 > (Prims.parse_int "0") in - if uu____5926 - then add_equality_to_post_condition env comp res_t - else - (let comp1 = FStar_TypeChecker_Env.comp_to_comp_typ env comp in - let md = - FStar_TypeChecker_Env.get_effect_decl env - comp1.FStar_Syntax_Syntax.effect_name in - let uu____5931 = destruct_comp comp1 in - match uu____5931 with - | (uu____5938,uu____5939,wp) -> - let wp1 = - let uu____5944 = - let uu____5945 = - FStar_TypeChecker_Env.inst_effect_fun_with - [u_res_t] env md md.FStar_Syntax_Syntax.ite_wp in - let uu____5946 = - let uu____5947 = FStar_Syntax_Syntax.as_arg res_t in - let uu____5948 = - let uu____5951 = FStar_Syntax_Syntax.as_arg wp in - [uu____5951] in - uu____5947 :: uu____5948 in - FStar_Syntax_Syntax.mk_Tm_app uu____5945 uu____5946 in - uu____5944 FStar_Pervasives_Native.None - wp.FStar_Syntax_Syntax.pos in - mk_comp md u_res_t res_t wp1 [])) in - { - FStar_Syntax_Syntax.eff_name = eff; - FStar_Syntax_Syntax.res_typ = res_t; - FStar_Syntax_Syntax.cflags = []; - FStar_Syntax_Syntax.comp = bind_cases - } -let maybe_assume_result_eq_pure_term: - FStar_TypeChecker_Env.env -> - FStar_Syntax_Syntax.term -> - FStar_Syntax_Syntax.lcomp -> FStar_Syntax_Syntax.lcomp - = - fun env -> - fun e -> - fun lc -> - let flags1 = - let uu____5966 = - ((let uu____5969 = - FStar_Syntax_Util.is_function_typ - lc.FStar_Syntax_Syntax.res_typ in - Prims.op_Negation uu____5969) && - (FStar_Syntax_Util.is_pure_or_ghost_lcomp lc)) - && - (let uu____5971 = FStar_Syntax_Util.is_lcomp_partial_return lc in - Prims.op_Negation uu____5971) in - if uu____5966 - then FStar_Syntax_Syntax.PARTIAL_RETURN :: - (lc.FStar_Syntax_Syntax.cflags) - else lc.FStar_Syntax_Syntax.cflags in - let refine1 uu____5980 = - let c = lc.FStar_Syntax_Syntax.comp () in - let uu____5984 = - ((let uu____5987 = - is_pure_or_ghost_effect env lc.FStar_Syntax_Syntax.eff_name in - Prims.op_Negation uu____5987) || - (FStar_Syntax_Util.is_unit lc.FStar_Syntax_Syntax.res_typ)) - || env.FStar_TypeChecker_Env.lax in - if uu____5984 - then c - else - (let uu____5991 = FStar_Syntax_Util.is_partial_return c in - if uu____5991 - then c - else - (let uu____5995 = FStar_Syntax_Util.is_tot_or_gtot_comp c in - if uu____5995 - then - let uu____5998 = - let uu____5999 = - FStar_TypeChecker_Env.lid_exists env - FStar_Parser_Const.effect_GTot_lid in - Prims.op_Negation uu____5999 in - (if uu____5998 - then - let uu____6002 = - let uu____6003 = - FStar_Range.string_of_range - e.FStar_Syntax_Syntax.pos in - let uu____6004 = FStar_Syntax_Print.term_to_string e in - FStar_Util.format2 "%s: %s\n" uu____6003 uu____6004 in - failwith uu____6002 - else - (let retc = - return_value env (FStar_Syntax_Util.comp_result c) e in - let uu____6009 = - let uu____6010 = FStar_Syntax_Util.is_pure_comp c in - Prims.op_Negation uu____6010 in - if uu____6009 - then - let retc1 = FStar_Syntax_Util.comp_to_comp_typ retc in - let retc2 = - let uu___112_6015 = retc1 in - { - FStar_Syntax_Syntax.comp_univs = - (uu___112_6015.FStar_Syntax_Syntax.comp_univs); - FStar_Syntax_Syntax.effect_name = - FStar_Parser_Const.effect_GHOST_lid; - FStar_Syntax_Syntax.result_typ = - (uu___112_6015.FStar_Syntax_Syntax.result_typ); - FStar_Syntax_Syntax.effect_args = - (uu___112_6015.FStar_Syntax_Syntax.effect_args); - FStar_Syntax_Syntax.flags = flags1 - } in - FStar_Syntax_Syntax.mk_Comp retc2 - else FStar_Syntax_Util.comp_set_flags retc flags1)) - else - (let c1 = FStar_TypeChecker_Env.unfold_effect_abbrev env c in - let t = c1.FStar_Syntax_Syntax.result_typ in - let c2 = FStar_Syntax_Syntax.mk_Comp c1 in - let x = - FStar_Syntax_Syntax.new_bv + let uu____5800 = + let uu____5807 = + FStar_All.pipe_right lcases + (FStar_Util.for_some + (fun uu____5839 -> + match uu____5839 with + | (uu____5852,uu____5853,flags1,uu____5855) -> + FStar_All.pipe_right flags1 + (FStar_Util.for_some + (fun uu___84_5867 -> + match uu___84_5867 with + | FStar_Syntax_Syntax.SHOULD_NOT_INLINE -> + true + | uu____5868 -> false)))) in + if uu____5807 + then (true, [FStar_Syntax_Syntax.SHOULD_NOT_INLINE]) + else (false, []) in + match uu____5800 with + | (should_not_inline_whole_match,bind_cases_flags) -> + let bind_cases uu____5889 = + let u_res_t = env.FStar_TypeChecker_Env.universe_of env res_t in + let uu____5891 = + env.FStar_TypeChecker_Env.lax && (FStar_Options.ml_ish ()) in + if uu____5891 + then lax_mk_tot_or_comp_l eff u_res_t res_t [] + else + (let ifthenelse md res_t1 g wp_t wp_e = + let uu____5911 = + FStar_Range.union_ranges wp_t.FStar_Syntax_Syntax.pos + wp_e.FStar_Syntax_Syntax.pos in + let uu____5912 = + let uu____5913 = + FStar_TypeChecker_Env.inst_effect_fun_with [u_res_t] + env md md.FStar_Syntax_Syntax.if_then_else in + let uu____5914 = + let uu____5915 = FStar_Syntax_Syntax.as_arg res_t1 in + let uu____5916 = + let uu____5919 = FStar_Syntax_Syntax.as_arg g in + let uu____5920 = + let uu____5923 = FStar_Syntax_Syntax.as_arg wp_t in + let uu____5924 = + let uu____5927 = FStar_Syntax_Syntax.as_arg wp_e in + [uu____5927] in + uu____5923 :: uu____5924 in + uu____5919 :: uu____5920 in + uu____5915 :: uu____5916 in + FStar_Syntax_Syntax.mk_Tm_app uu____5913 uu____5914 in + uu____5912 FStar_Pervasives_Native.None uu____5911 in + let default_case = + let post_k = + let uu____5934 = + let uu____5941 = FStar_Syntax_Syntax.null_binder res_t in + [uu____5941] in + let uu____5942 = + FStar_Syntax_Syntax.mk_Total FStar_Syntax_Util.ktype0 in + FStar_Syntax_Util.arrow uu____5934 uu____5942 in + let kwp = + let uu____5948 = + let uu____5955 = + FStar_Syntax_Syntax.null_binder post_k in + [uu____5955] in + let uu____5956 = + FStar_Syntax_Syntax.mk_Total FStar_Syntax_Util.ktype0 in + FStar_Syntax_Util.arrow uu____5948 uu____5956 in + let post = + FStar_Syntax_Syntax.new_bv FStar_Pervasives_Native.None + post_k in + let wp = + let uu____5961 = + let uu____5962 = FStar_Syntax_Syntax.mk_binder post in + [uu____5962] in + let uu____5963 = + let uu____5964 = + let uu____5967 = FStar_TypeChecker_Env.get_range env in + label FStar_TypeChecker_Err.exhaustiveness_check + uu____5967 in + let uu____5968 = + fvar_const env FStar_Parser_Const.false_lid in + FStar_All.pipe_left uu____5964 uu____5968 in + FStar_Syntax_Util.abs uu____5961 uu____5963 (FStar_Pervasives_Native.Some - (t.FStar_Syntax_Syntax.pos)) t in - let xexp = FStar_Syntax_Syntax.bv_to_name x in - let ret1 = - let uu____6026 = - let uu____6029 = return_value env t xexp in - FStar_Syntax_Util.comp_set_flags uu____6029 - [FStar_Syntax_Syntax.PARTIAL_RETURN] in - FStar_All.pipe_left FStar_Syntax_Util.lcomp_of_comp - uu____6026 in - let eq1 = - let uu____6033 = - env.FStar_TypeChecker_Env.universe_of env t in - FStar_Syntax_Util.mk_eq2 uu____6033 t xexp e in - let eq_ret = - weaken_precondition env ret1 - (FStar_TypeChecker_Common.NonTrivial eq1) in - let uu____6035 = - let uu____6036 = - let uu____6041 = - bind e.FStar_Syntax_Syntax.pos env - FStar_Pervasives_Native.None - (FStar_Syntax_Util.lcomp_of_comp c2) - ((FStar_Pervasives_Native.Some x), eq_ret) in - uu____6041.FStar_Syntax_Syntax.comp in - uu____6036 () in - FStar_Syntax_Util.comp_set_flags uu____6035 flags1))) in - let uu____6044 = - FStar_Syntax_Util.is_unit lc.FStar_Syntax_Syntax.res_typ in - if uu____6044 - then lc - else - (let uu___113_6046 = lc in - { - FStar_Syntax_Syntax.eff_name = - (uu___113_6046.FStar_Syntax_Syntax.eff_name); - FStar_Syntax_Syntax.res_typ = - (uu___113_6046.FStar_Syntax_Syntax.res_typ); - FStar_Syntax_Syntax.cflags = flags1; - FStar_Syntax_Syntax.comp = refine1 - }) + (FStar_Syntax_Util.mk_residual_comp + FStar_Parser_Const.effect_Tot_lid + FStar_Pervasives_Native.None + [FStar_Syntax_Syntax.TOTAL])) in + let md = + FStar_TypeChecker_Env.get_effect_decl env + FStar_Parser_Const.effect_PURE_lid in + mk_comp md u_res_t res_t wp [] in + let maybe_return eff_label_then cthen = + let uu____5984 = + should_not_inline_whole_match || + (let uu____5986 = is_pure_or_ghost_effect env eff in + Prims.op_Negation uu____5986) in + if uu____5984 then cthen true else cthen false in + let comp = + FStar_List.fold_right + (fun uu____6018 -> + fun celse -> + match uu____6018 with + | (g,eff_label,uu____6034,cthen) -> + let uu____6044 = + let uu____6069 = + let uu____6070 = + maybe_return eff_label cthen in + FStar_Syntax_Syntax.lcomp_comp uu____6070 in + lift_and_destruct env uu____6069 celse in + (match uu____6044 with + | ((md,uu____6072,uu____6073),(uu____6074,uu____6075,wp_then), + (uu____6077,uu____6078,wp_else)) -> + let uu____6098 = + ifthenelse md res_t g wp_then wp_else in + mk_comp md u_res_t res_t uu____6098 [])) + lcases default_case in + match lcases with + | [] -> comp + | uu____6111::[] -> comp + | uu____6148 -> + let comp1 = + FStar_TypeChecker_Env.comp_to_comp_typ env comp in + let md = + FStar_TypeChecker_Env.get_effect_decl env + comp1.FStar_Syntax_Syntax.effect_name in + let uu____6165 = destruct_comp comp1 in + (match uu____6165 with + | (uu____6172,uu____6173,wp) -> + let wp1 = + let uu____6178 = + let uu____6179 = + FStar_TypeChecker_Env.inst_effect_fun_with + [u_res_t] env md + md.FStar_Syntax_Syntax.ite_wp in + let uu____6180 = + let uu____6181 = + FStar_Syntax_Syntax.as_arg res_t in + let uu____6182 = + let uu____6185 = + FStar_Syntax_Syntax.as_arg wp in + [uu____6185] in + uu____6181 :: uu____6182 in + FStar_Syntax_Syntax.mk_Tm_app uu____6179 + uu____6180 in + uu____6178 FStar_Pervasives_Native.None + wp.FStar_Syntax_Syntax.pos in + mk_comp md u_res_t res_t wp1 bind_cases_flags)) in + FStar_Syntax_Syntax.mk_lcomp eff res_t bind_cases_flags + bind_cases let check_comp: FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.term -> @@ -2443,14 +2364,14 @@ let check_comp: fun e -> fun c -> fun c' -> - let uu____6071 = FStar_TypeChecker_Rel.sub_comp env c c' in - match uu____6071 with + let uu____6212 = FStar_TypeChecker_Rel.sub_comp env c c' in + match uu____6212 with | FStar_Pervasives_Native.None -> - let uu____6080 = + let uu____6221 = FStar_TypeChecker_Err.computed_computation_type_does_not_match_annotation env e c c' in - let uu____6085 = FStar_TypeChecker_Env.get_range env in - FStar_Errors.raise_error uu____6080 uu____6085 + let uu____6226 = FStar_TypeChecker_Env.get_range env in + FStar_Errors.raise_error uu____6221 uu____6226 | FStar_Pervasives_Native.Some g -> (e, c', g) let maybe_coerce_bool_to_type: FStar_TypeChecker_Env.env -> @@ -2466,22 +2387,22 @@ let maybe_coerce_bool_to_type: fun t -> let is_type1 t1 = let t2 = FStar_TypeChecker_Normalize.unfold_whnf env t1 in - let uu____6118 = - let uu____6119 = FStar_Syntax_Subst.compress t2 in - uu____6119.FStar_Syntax_Syntax.n in - match uu____6118 with - | FStar_Syntax_Syntax.Tm_type uu____6122 -> true - | uu____6123 -> false in - let uu____6124 = - let uu____6125 = + let uu____6259 = + let uu____6260 = FStar_Syntax_Subst.compress t2 in + uu____6260.FStar_Syntax_Syntax.n in + match uu____6259 with + | FStar_Syntax_Syntax.Tm_type uu____6263 -> true + | uu____6264 -> false in + let uu____6265 = + let uu____6266 = FStar_Syntax_Util.unrefine lc.FStar_Syntax_Syntax.res_typ in - uu____6125.FStar_Syntax_Syntax.n in - match uu____6124 with + uu____6266.FStar_Syntax_Syntax.n in + match uu____6265 with | FStar_Syntax_Syntax.Tm_fvar fv when (FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.bool_lid) && (is_type1 t) -> - let uu____6133 = + let uu____6274 = FStar_TypeChecker_Env.lookup_lid env FStar_Parser_Const.b2t_lid in let b2t1 = @@ -2491,25 +2412,25 @@ let maybe_coerce_bool_to_type: (FStar_Syntax_Syntax.Delta_defined_at_level (Prims.parse_int "1")) FStar_Pervasives_Native.None in let lc1 = - let uu____6144 = - let uu____6145 = - let uu____6146 = + let uu____6285 = + let uu____6286 = + let uu____6287 = FStar_Syntax_Syntax.mk_Total FStar_Syntax_Util.ktype0 in FStar_All.pipe_left FStar_Syntax_Util.lcomp_of_comp - uu____6146 in - (FStar_Pervasives_Native.None, uu____6145) in + uu____6287 in + (FStar_Pervasives_Native.None, uu____6286) in bind e.FStar_Syntax_Syntax.pos env - (FStar_Pervasives_Native.Some e) lc uu____6144 in + (FStar_Pervasives_Native.Some e) lc uu____6285 in let e1 = - let uu____6156 = - let uu____6157 = - let uu____6158 = FStar_Syntax_Syntax.as_arg e in - [uu____6158] in - FStar_Syntax_Syntax.mk_Tm_app b2t1 uu____6157 in - uu____6156 FStar_Pervasives_Native.None + let uu____6297 = + let uu____6298 = + let uu____6299 = FStar_Syntax_Syntax.as_arg e in + [uu____6299] in + FStar_Syntax_Syntax.mk_Tm_app b2t1 uu____6298 in + uu____6297 FStar_Pervasives_Native.None e.FStar_Syntax_Syntax.pos in (e1, lc1) - | uu____6163 -> (e, lc) + | uu____6304 -> (e, lc) let weaken_result_typ: FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.term -> @@ -2524,84 +2445,84 @@ let weaken_result_typ: fun t -> let use_eq = env.FStar_TypeChecker_Env.use_eq || - (let uu____6192 = + (let uu____6333 = FStar_TypeChecker_Env.effect_decl_opt env lc.FStar_Syntax_Syntax.eff_name in - match uu____6192 with + match uu____6333 with | FStar_Pervasives_Native.Some (ed,qualifiers) -> FStar_All.pipe_right qualifiers (FStar_List.contains FStar_Syntax_Syntax.Reifiable) - | uu____6215 -> false) in + | uu____6356 -> false) in let gopt = if use_eq then - let uu____6237 = + let uu____6378 = FStar_TypeChecker_Rel.try_teq true env lc.FStar_Syntax_Syntax.res_typ t in - (uu____6237, false) + (uu____6378, false) else - (let uu____6243 = + (let uu____6384 = FStar_TypeChecker_Rel.get_subtyping_predicate env lc.FStar_Syntax_Syntax.res_typ t in - (uu____6243, true)) in + (uu____6384, true)) in match gopt with - | (FStar_Pervasives_Native.None ,uu____6254) -> + | (FStar_Pervasives_Native.None ,uu____6395) -> if env.FStar_TypeChecker_Env.failhard then - let uu____6263 = + let uu____6404 = FStar_TypeChecker_Err.basic_type_error env (FStar_Pervasives_Native.Some e) t lc.FStar_Syntax_Syntax.res_typ in - FStar_Errors.raise_error uu____6263 e.FStar_Syntax_Syntax.pos + FStar_Errors.raise_error uu____6404 e.FStar_Syntax_Syntax.pos else (FStar_TypeChecker_Rel.subtype_fail env e lc.FStar_Syntax_Syntax.res_typ t; (e, - ((let uu___114_6277 = lc in + ((let uu___115_6418 = lc in { FStar_Syntax_Syntax.eff_name = - (uu___114_6277.FStar_Syntax_Syntax.eff_name); + (uu___115_6418.FStar_Syntax_Syntax.eff_name); FStar_Syntax_Syntax.res_typ = t; FStar_Syntax_Syntax.cflags = - (uu___114_6277.FStar_Syntax_Syntax.cflags); - FStar_Syntax_Syntax.comp = - (uu___114_6277.FStar_Syntax_Syntax.comp) + (uu___115_6418.FStar_Syntax_Syntax.cflags); + FStar_Syntax_Syntax.comp_thunk = + (uu___115_6418.FStar_Syntax_Syntax.comp_thunk) })), FStar_TypeChecker_Rel.trivial_guard)) | (FStar_Pervasives_Native.Some g,apply_guard1) -> - let uu____6282 = FStar_TypeChecker_Rel.guard_form g in - (match uu____6282 with + let uu____6423 = FStar_TypeChecker_Rel.guard_form g in + (match uu____6423 with | FStar_TypeChecker_Common.Trivial -> let lc1 = - let uu___115_6290 = lc in + let uu___116_6431 = lc in { FStar_Syntax_Syntax.eff_name = - (uu___115_6290.FStar_Syntax_Syntax.eff_name); + (uu___116_6431.FStar_Syntax_Syntax.eff_name); FStar_Syntax_Syntax.res_typ = t; FStar_Syntax_Syntax.cflags = - (uu___115_6290.FStar_Syntax_Syntax.cflags); - FStar_Syntax_Syntax.comp = - (uu___115_6290.FStar_Syntax_Syntax.comp) + (uu___116_6431.FStar_Syntax_Syntax.cflags); + FStar_Syntax_Syntax.comp_thunk = + (uu___116_6431.FStar_Syntax_Syntax.comp_thunk) } in (e, lc1, g) | FStar_TypeChecker_Common.NonTrivial f -> let g1 = - let uu___116_6293 = g in + let uu___117_6434 = g in { FStar_TypeChecker_Env.guard_f = FStar_TypeChecker_Common.Trivial; FStar_TypeChecker_Env.deferred = - (uu___116_6293.FStar_TypeChecker_Env.deferred); + (uu___117_6434.FStar_TypeChecker_Env.deferred); FStar_TypeChecker_Env.univ_ineqs = - (uu___116_6293.FStar_TypeChecker_Env.univ_ineqs); + (uu___117_6434.FStar_TypeChecker_Env.univ_ineqs); FStar_TypeChecker_Env.implicits = - (uu___116_6293.FStar_TypeChecker_Env.implicits) + (uu___117_6434.FStar_TypeChecker_Env.implicits) } in - let strengthen uu____6299 = - let uu____6300 = + let strengthen uu____6438 = + let uu____6439 = env.FStar_TypeChecker_Env.lax && (FStar_Options.ml_ish ()) in - if uu____6300 - then lc.FStar_Syntax_Syntax.comp () + if uu____6439 + then FStar_Syntax_Syntax.lcomp_comp lc else (let f1 = FStar_TypeChecker_Normalize.normalize @@ -2609,220 +2530,160 @@ let weaken_result_typ: FStar_TypeChecker_Normalize.Eager_unfolding; FStar_TypeChecker_Normalize.Simplify; FStar_TypeChecker_Normalize.Primops] env f in - let uu____6305 = - let uu____6306 = FStar_Syntax_Subst.compress f1 in - uu____6306.FStar_Syntax_Syntax.n in - match uu____6305 with + let uu____6442 = + let uu____6443 = FStar_Syntax_Subst.compress f1 in + uu____6443.FStar_Syntax_Syntax.n in + match uu____6442 with | FStar_Syntax_Syntax.Tm_abs - (uu____6311,{ + (uu____6446,{ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_fvar fv; FStar_Syntax_Syntax.pos = - uu____6313; + uu____6448; FStar_Syntax_Syntax.vars = - uu____6314;_},uu____6315) + uu____6449;_},uu____6450) when FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.true_lid -> let lc1 = - let uu___117_6337 = lc in + let uu___118_6472 = lc in { FStar_Syntax_Syntax.eff_name = - (uu___117_6337.FStar_Syntax_Syntax.eff_name); + (uu___118_6472.FStar_Syntax_Syntax.eff_name); FStar_Syntax_Syntax.res_typ = t; FStar_Syntax_Syntax.cflags = - (uu___117_6337.FStar_Syntax_Syntax.cflags); - FStar_Syntax_Syntax.comp = - (uu___117_6337.FStar_Syntax_Syntax.comp) + (uu___118_6472.FStar_Syntax_Syntax.cflags); + FStar_Syntax_Syntax.comp_thunk = + (uu___118_6472.FStar_Syntax_Syntax.comp_thunk) } in - lc1.FStar_Syntax_Syntax.comp () - | uu____6338 -> - let c = lc.FStar_Syntax_Syntax.comp () in - ((let uu____6343 = + FStar_Syntax_Syntax.lcomp_comp lc1 + | uu____6473 -> + let c = FStar_Syntax_Syntax.lcomp_comp lc in + ((let uu____6476 = FStar_All.pipe_left (FStar_TypeChecker_Env.debug env) FStar_Options.Extreme in - if uu____6343 + if uu____6476 then - let uu____6344 = + let uu____6477 = FStar_TypeChecker_Normalize.term_to_string env lc.FStar_Syntax_Syntax.res_typ in - let uu____6345 = + let uu____6478 = FStar_TypeChecker_Normalize.term_to_string env t in - let uu____6346 = + let uu____6479 = FStar_TypeChecker_Normalize.comp_to_string env c in - let uu____6347 = + let uu____6480 = FStar_TypeChecker_Normalize.term_to_string env f1 in FStar_Util.print4 "Weakened from %s to %s\nStrengthening %s with guard %s\n" - uu____6344 uu____6345 uu____6346 uu____6347 + uu____6477 uu____6478 uu____6479 uu____6480 else ()); - (let ct = - FStar_TypeChecker_Env.unfold_effect_abbrev - env c in - let uu____6350 = - FStar_TypeChecker_Env.wp_signature env - FStar_Parser_Const.effect_PURE_lid in - match uu____6350 with - | (a,kwp) -> - let k = - FStar_Syntax_Subst.subst - [FStar_Syntax_Syntax.NT (a, t)] kwp in - let md = - FStar_TypeChecker_Env.get_effect_decl env - ct.FStar_Syntax_Syntax.effect_name in - let x = - FStar_Syntax_Syntax.new_bv - (FStar_Pervasives_Native.Some - (t.FStar_Syntax_Syntax.pos)) t in - let xexp = FStar_Syntax_Syntax.bv_to_name x in - let uu____6363 = destruct_comp ct in - (match uu____6363 with - | (u_t,uu____6373,uu____6374) -> - let wp = - let uu____6378 = - let uu____6379 = - FStar_TypeChecker_Env.inst_effect_fun_with - [u_t] env md - md.FStar_Syntax_Syntax.ret_wp in - let uu____6380 = - let uu____6381 = - FStar_Syntax_Syntax.as_arg t in - let uu____6382 = - let uu____6385 = - FStar_Syntax_Syntax.as_arg - xexp in - [uu____6385] in - uu____6381 :: uu____6382 in - FStar_Syntax_Syntax.mk_Tm_app - uu____6379 uu____6380 in - uu____6378 - FStar_Pervasives_Native.None - xexp.FStar_Syntax_Syntax.pos in - let cret = - let uu____6389 = - mk_comp md u_t t wp - [FStar_Syntax_Syntax.RETURN] in - FStar_All.pipe_left - FStar_Syntax_Util.lcomp_of_comp - uu____6389 in - let guard = - if apply_guard1 - then - let uu____6399 = - let uu____6400 = - let uu____6401 = - FStar_Syntax_Syntax.as_arg - xexp in - [uu____6401] in - FStar_Syntax_Syntax.mk_Tm_app f1 - uu____6400 in - uu____6399 - FStar_Pervasives_Native.None - f1.FStar_Syntax_Syntax.pos - else f1 in - let uu____6405 = - let uu____6410 = - FStar_All.pipe_left - (fun _0_40 -> - FStar_Pervasives_Native.Some - _0_40) - (FStar_TypeChecker_Err.subtyping_failed - env - lc.FStar_Syntax_Syntax.res_typ - t) in - let uu____6423 = - FStar_TypeChecker_Env.set_range - env e.FStar_Syntax_Syntax.pos in - let uu____6424 = - FStar_All.pipe_left - FStar_TypeChecker_Rel.guard_of_guard_formula - (FStar_TypeChecker_Common.NonTrivial - guard) in - strengthen_precondition uu____6410 - uu____6423 e cret uu____6424 in - (match uu____6405 with - | (eq_ret,_trivial_so_ok_to_discard) - -> - let x1 = - let uu___118_6430 = x in - { - FStar_Syntax_Syntax.ppname = - (uu___118_6430.FStar_Syntax_Syntax.ppname); - FStar_Syntax_Syntax.index = - (uu___118_6430.FStar_Syntax_Syntax.index); - FStar_Syntax_Syntax.sort = - (lc.FStar_Syntax_Syntax.res_typ) - } in - let c1 = - let uu____6432 = - let uu____6433 = - FStar_Syntax_Syntax.mk_Comp - ct in - FStar_All.pipe_left - FStar_Syntax_Util.lcomp_of_comp - uu____6433 in - bind e.FStar_Syntax_Syntax.pos - env - (FStar_Pervasives_Native.Some - e) uu____6432 - ((FStar_Pervasives_Native.Some - x1), eq_ret) in - let c2 = - c1.FStar_Syntax_Syntax.comp () in - ((let uu____6444 = - FStar_All.pipe_left - (FStar_TypeChecker_Env.debug - env) - FStar_Options.Extreme in - if uu____6444 - then - let uu____6445 = - FStar_TypeChecker_Normalize.comp_to_string - env c2 in - FStar_Util.print1 - "Strengthened to %s\n" - uu____6445 - else ()); - c2)))))) in + (let u_t_opt = comp_univ_opt c in + let x = + FStar_Syntax_Syntax.new_bv + (FStar_Pervasives_Native.Some + (t.FStar_Syntax_Syntax.pos)) t in + let xexp = FStar_Syntax_Syntax.bv_to_name x in + let cret = return_value env u_t_opt t xexp in + let guard = + if apply_guard1 + then + let uu____6493 = + let uu____6494 = + let uu____6495 = + FStar_Syntax_Syntax.as_arg xexp in + [uu____6495] in + FStar_Syntax_Syntax.mk_Tm_app f1 + uu____6494 in + uu____6493 FStar_Pervasives_Native.None + f1.FStar_Syntax_Syntax.pos + else f1 in + let uu____6499 = + let uu____6504 = + FStar_All.pipe_left + (fun _0_40 -> + FStar_Pervasives_Native.Some _0_40) + (FStar_TypeChecker_Err.subtyping_failed + env lc.FStar_Syntax_Syntax.res_typ t) in + let uu____6517 = + FStar_TypeChecker_Env.set_range env + e.FStar_Syntax_Syntax.pos in + let uu____6518 = + FStar_Syntax_Util.lcomp_of_comp cret in + let uu____6519 = + FStar_All.pipe_left + FStar_TypeChecker_Rel.guard_of_guard_formula + (FStar_TypeChecker_Common.NonTrivial + guard) in + strengthen_precondition uu____6504 uu____6517 + e uu____6518 uu____6519 in + match uu____6499 with + | (eq_ret,_trivial_so_ok_to_discard) -> + let x1 = + let uu___119_6523 = x in + { + FStar_Syntax_Syntax.ppname = + (uu___119_6523.FStar_Syntax_Syntax.ppname); + FStar_Syntax_Syntax.index = + (uu___119_6523.FStar_Syntax_Syntax.index); + FStar_Syntax_Syntax.sort = + (lc.FStar_Syntax_Syntax.res_typ) + } in + let c1 = + let uu____6525 = + FStar_Syntax_Util.lcomp_of_comp c in + bind e.FStar_Syntax_Syntax.pos env + (FStar_Pervasives_Native.Some e) + uu____6525 + ((FStar_Pervasives_Native.Some x1), + eq_ret) in + let c2 = FStar_Syntax_Syntax.lcomp_comp c1 in + ((let uu____6530 = + FStar_All.pipe_left + (FStar_TypeChecker_Env.debug env) + FStar_Options.Extreme in + if uu____6530 + then + let uu____6531 = + FStar_TypeChecker_Normalize.comp_to_string + env c2 in + FStar_Util.print1 + "Strengthened to %s\n" uu____6531 + else ()); + c2)))) in let flags1 = FStar_All.pipe_right lc.FStar_Syntax_Syntax.cflags (FStar_List.collect - (fun uu___79_6455 -> - match uu___79_6455 with + (fun uu___85_6541 -> + match uu___85_6541 with | FStar_Syntax_Syntax.RETURN -> [FStar_Syntax_Syntax.PARTIAL_RETURN] | FStar_Syntax_Syntax.PARTIAL_RETURN -> [FStar_Syntax_Syntax.PARTIAL_RETURN] | FStar_Syntax_Syntax.CPS -> [FStar_Syntax_Syntax.CPS] - | uu____6458 -> [])) in + | uu____6544 -> [])) in let lc1 = - let uu___119_6460 = lc in - let uu____6461 = + let uu____6546 = FStar_TypeChecker_Env.norm_eff_name env lc.FStar_Syntax_Syntax.eff_name in - { - FStar_Syntax_Syntax.eff_name = uu____6461; - FStar_Syntax_Syntax.res_typ = t; - FStar_Syntax_Syntax.cflags = flags1; - FStar_Syntax_Syntax.comp = strengthen - } in + FStar_Syntax_Syntax.mk_lcomp uu____6546 t flags1 + strengthen in let g2 = - let uu___120_6463 = g1 in + let uu___120_6548 = g1 in { FStar_TypeChecker_Env.guard_f = FStar_TypeChecker_Common.Trivial; FStar_TypeChecker_Env.deferred = - (uu___120_6463.FStar_TypeChecker_Env.deferred); + (uu___120_6548.FStar_TypeChecker_Env.deferred); FStar_TypeChecker_Env.univ_ineqs = - (uu___120_6463.FStar_TypeChecker_Env.univ_ineqs); + (uu___120_6548.FStar_TypeChecker_Env.univ_ineqs); FStar_TypeChecker_Env.implicits = - (uu___120_6463.FStar_TypeChecker_Env.implicits) + (uu___120_6548.FStar_TypeChecker_Env.implicits) } in (e, lc1, g2)) let pure_or_ghost_pre_and_post: @@ -2835,30 +2696,30 @@ let pure_or_ghost_pre_and_post: fun comp -> let mk_post_type res_t ens = let x = FStar_Syntax_Syntax.new_bv FStar_Pervasives_Native.None res_t in - let uu____6486 = - let uu____6487 = - let uu____6488 = - let uu____6489 = - let uu____6490 = FStar_Syntax_Syntax.bv_to_name x in - FStar_Syntax_Syntax.as_arg uu____6490 in - [uu____6489] in - FStar_Syntax_Syntax.mk_Tm_app ens uu____6488 in - uu____6487 FStar_Pervasives_Native.None + let uu____6571 = + let uu____6572 = + let uu____6573 = + let uu____6574 = + let uu____6575 = FStar_Syntax_Syntax.bv_to_name x in + FStar_Syntax_Syntax.as_arg uu____6575 in + [uu____6574] in + FStar_Syntax_Syntax.mk_Tm_app ens uu____6573 in + uu____6572 FStar_Pervasives_Native.None res_t.FStar_Syntax_Syntax.pos in - FStar_Syntax_Util.refine x uu____6486 in + FStar_Syntax_Util.refine x uu____6571 in let norm1 t = FStar_TypeChecker_Normalize.normalize [FStar_TypeChecker_Normalize.Beta; FStar_TypeChecker_Normalize.Eager_unfolding; FStar_TypeChecker_Normalize.EraseUniverses] env t in - let uu____6497 = FStar_Syntax_Util.is_tot_or_gtot_comp comp in - if uu____6497 + let uu____6582 = FStar_Syntax_Util.is_tot_or_gtot_comp comp in + if uu____6582 then (FStar_Pervasives_Native.None, (FStar_Syntax_Util.comp_result comp)) else (match comp.FStar_Syntax_Syntax.n with - | FStar_Syntax_Syntax.GTotal uu____6515 -> failwith "Impossible" - | FStar_Syntax_Syntax.Total uu____6530 -> failwith "Impossible" + | FStar_Syntax_Syntax.GTotal uu____6600 -> failwith "Impossible" + | FStar_Syntax_Syntax.Total uu____6615 -> failwith "Impossible" | FStar_Syntax_Syntax.Comp ct -> if (FStar_Ident.lid_equals ct.FStar_Syntax_Syntax.effect_name @@ -2868,107 +2729,107 @@ let pure_or_ghost_pre_and_post: FStar_Parser_Const.effect_Ghost_lid) then (match ct.FStar_Syntax_Syntax.effect_args with - | (req,uu____6559)::(ens,uu____6561)::uu____6562 -> - let uu____6591 = - let uu____6594 = norm1 req in - FStar_Pervasives_Native.Some uu____6594 in - let uu____6595 = - let uu____6596 = + | (req,uu____6644)::(ens,uu____6646)::uu____6647 -> + let uu____6676 = + let uu____6679 = norm1 req in + FStar_Pervasives_Native.Some uu____6679 in + let uu____6680 = + let uu____6681 = mk_post_type ct.FStar_Syntax_Syntax.result_typ ens in - FStar_All.pipe_left norm1 uu____6596 in - (uu____6591, uu____6595) - | uu____6599 -> - let uu____6608 = - let uu____6613 = - let uu____6614 = + FStar_All.pipe_left norm1 uu____6681 in + (uu____6676, uu____6680) + | uu____6684 -> + let uu____6693 = + let uu____6698 = + let uu____6699 = FStar_Syntax_Print.comp_to_string comp in FStar_Util.format1 "Effect constructor is not fully applied; got %s" - uu____6614 in + uu____6699 in (FStar_Errors.Fatal_EffectConstructorNotFullyApplied, - uu____6613) in - FStar_Errors.raise_error uu____6608 + uu____6698) in + FStar_Errors.raise_error uu____6693 comp.FStar_Syntax_Syntax.pos) else (let ct1 = FStar_TypeChecker_Env.unfold_effect_abbrev env comp in match ct1.FStar_Syntax_Syntax.effect_args with - | (wp,uu____6630)::uu____6631 -> - let uu____6650 = - let uu____6655 = + | (wp,uu____6715)::uu____6716 -> + let uu____6735 = + let uu____6740 = FStar_TypeChecker_Env.lookup_lid env FStar_Parser_Const.as_requires in FStar_All.pipe_left FStar_Pervasives_Native.fst - uu____6655 in - (match uu____6650 with - | (us_r,uu____6687) -> - let uu____6688 = - let uu____6693 = + uu____6740 in + (match uu____6735 with + | (us_r,uu____6772) -> + let uu____6773 = + let uu____6778 = FStar_TypeChecker_Env.lookup_lid env FStar_Parser_Const.as_ensures in FStar_All.pipe_left FStar_Pervasives_Native.fst - uu____6693 in - (match uu____6688 with - | (us_e,uu____6725) -> + uu____6778 in + (match uu____6773 with + | (us_e,uu____6810) -> let r = (ct1.FStar_Syntax_Syntax.result_typ).FStar_Syntax_Syntax.pos in let as_req = - let uu____6728 = + let uu____6813 = FStar_Syntax_Syntax.fvar (FStar_Ident.set_lid_range FStar_Parser_Const.as_requires r) FStar_Syntax_Syntax.Delta_equational FStar_Pervasives_Native.None in - FStar_Syntax_Syntax.mk_Tm_uinst uu____6728 + FStar_Syntax_Syntax.mk_Tm_uinst uu____6813 us_r in let as_ens = - let uu____6730 = + let uu____6815 = FStar_Syntax_Syntax.fvar (FStar_Ident.set_lid_range FStar_Parser_Const.as_ensures r) FStar_Syntax_Syntax.Delta_equational FStar_Pervasives_Native.None in - FStar_Syntax_Syntax.mk_Tm_uinst uu____6730 + FStar_Syntax_Syntax.mk_Tm_uinst uu____6815 us_e in let req = - let uu____6734 = - let uu____6735 = - let uu____6736 = - let uu____6747 = + let uu____6819 = + let uu____6820 = + let uu____6821 = + let uu____6832 = FStar_Syntax_Syntax.as_arg wp in - [uu____6747] in + [uu____6832] in ((ct1.FStar_Syntax_Syntax.result_typ), (FStar_Pervasives_Native.Some FStar_Syntax_Syntax.imp_tag)) - :: uu____6736 in + :: uu____6821 in FStar_Syntax_Syntax.mk_Tm_app as_req - uu____6735 in - uu____6734 FStar_Pervasives_Native.None + uu____6820 in + uu____6819 FStar_Pervasives_Native.None (ct1.FStar_Syntax_Syntax.result_typ).FStar_Syntax_Syntax.pos in let ens = - let uu____6765 = - let uu____6766 = - let uu____6767 = - let uu____6778 = + let uu____6850 = + let uu____6851 = + let uu____6852 = + let uu____6863 = FStar_Syntax_Syntax.as_arg wp in - [uu____6778] in + [uu____6863] in ((ct1.FStar_Syntax_Syntax.result_typ), (FStar_Pervasives_Native.Some FStar_Syntax_Syntax.imp_tag)) - :: uu____6767 in + :: uu____6852 in FStar_Syntax_Syntax.mk_Tm_app as_ens - uu____6766 in - uu____6765 FStar_Pervasives_Native.None + uu____6851 in + uu____6850 FStar_Pervasives_Native.None (ct1.FStar_Syntax_Syntax.result_typ).FStar_Syntax_Syntax.pos in - let uu____6793 = - let uu____6796 = norm1 req in - FStar_Pervasives_Native.Some uu____6796 in - let uu____6797 = - let uu____6798 = + let uu____6878 = + let uu____6881 = norm1 req in + FStar_Pervasives_Native.Some uu____6881 in + let uu____6882 = + let uu____6883 = mk_post_type ct1.FStar_Syntax_Syntax.result_typ ens in - norm1 uu____6798 in - (uu____6793, uu____6797))) - | uu____6801 -> failwith "Impossible")) + norm1 uu____6883 in + (uu____6878, uu____6882))) + | uu____6886 -> failwith "Impossible")) let reify_body: FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term @@ -2983,14 +2844,14 @@ let reify_body: FStar_TypeChecker_Normalize.Eager_unfolding; FStar_TypeChecker_Normalize.EraseUniverses; FStar_TypeChecker_Normalize.AllowUnboundUniverses] env tm in - (let uu____6827 = + (let uu____6912 = FStar_All.pipe_left (FStar_TypeChecker_Env.debug env) (FStar_Options.Other "SMTEncodingReify") in - if uu____6827 + if uu____6912 then - let uu____6828 = FStar_Syntax_Print.term_to_string tm in - let uu____6829 = FStar_Syntax_Print.term_to_string tm' in - FStar_Util.print2 "Reified body %s \nto %s\n" uu____6828 uu____6829 + let uu____6913 = FStar_Syntax_Print.term_to_string tm in + let uu____6914 = FStar_Syntax_Print.term_to_string tm' in + FStar_Util.print2 "Reified body %s \nto %s\n" uu____6913 uu____6914 else ()); tm' let reify_body_with_arg: @@ -3011,45 +2872,45 @@ let reify_body_with_arg: FStar_TypeChecker_Normalize.Eager_unfolding; FStar_TypeChecker_Normalize.EraseUniverses; FStar_TypeChecker_Normalize.AllowUnboundUniverses] env tm in - (let uu____6847 = + (let uu____6932 = FStar_All.pipe_left (FStar_TypeChecker_Env.debug env) (FStar_Options.Other "SMTEncodingReify") in - if uu____6847 + if uu____6932 then - let uu____6848 = FStar_Syntax_Print.term_to_string tm in - let uu____6849 = FStar_Syntax_Print.term_to_string tm' in - FStar_Util.print2 "Reified body %s \nto %s\n" uu____6848 - uu____6849 + let uu____6933 = FStar_Syntax_Print.term_to_string tm in + let uu____6934 = FStar_Syntax_Print.term_to_string tm' in + FStar_Util.print2 "Reified body %s \nto %s\n" uu____6933 + uu____6934 else ()); tm' let remove_reify: FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term = fun t -> - let uu____6854 = - let uu____6855 = - let uu____6856 = FStar_Syntax_Subst.compress t in - uu____6856.FStar_Syntax_Syntax.n in - match uu____6855 with - | FStar_Syntax_Syntax.Tm_app uu____6859 -> false - | uu____6874 -> true in - if uu____6854 + let uu____6939 = + let uu____6940 = + let uu____6941 = FStar_Syntax_Subst.compress t in + uu____6941.FStar_Syntax_Syntax.n in + match uu____6940 with + | FStar_Syntax_Syntax.Tm_app uu____6944 -> false + | uu____6959 -> true in + if uu____6939 then t else - (let uu____6876 = FStar_Syntax_Util.head_and_args t in - match uu____6876 with + (let uu____6961 = FStar_Syntax_Util.head_and_args t in + match uu____6961 with | (head1,args) -> - let uu____6913 = - let uu____6914 = - let uu____6915 = FStar_Syntax_Subst.compress head1 in - uu____6915.FStar_Syntax_Syntax.n in - match uu____6914 with + let uu____6998 = + let uu____6999 = + let uu____7000 = FStar_Syntax_Subst.compress head1 in + uu____7000.FStar_Syntax_Syntax.n in + match uu____6999 with | FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_reify ) -> true - | uu____6918 -> false in - if uu____6913 + | uu____7003 -> false in + if uu____6998 then (match args with | x::[] -> FStar_Pervasives_Native.fst x - | uu____6940 -> + | uu____7025 -> failwith "Impossible : Reify applied to multiple arguments after normalization.") else t) @@ -3068,21 +2929,21 @@ let maybe_instantiate: then (e, torig, FStar_TypeChecker_Rel.trivial_guard) else (let number_of_implicits t1 = - let uu____6977 = FStar_Syntax_Util.arrow_formals t1 in - match uu____6977 with - | (formals,uu____6991) -> + let uu____7062 = FStar_Syntax_Util.arrow_formals t1 in + match uu____7062 with + | (formals,uu____7076) -> let n_implicits = - let uu____7009 = + let uu____7094 = FStar_All.pipe_right formals (FStar_Util.prefix_until - (fun uu____7085 -> - match uu____7085 with - | (uu____7092,imp) -> + (fun uu____7170 -> + match uu____7170 with + | (uu____7177,imp) -> (imp = FStar_Pervasives_Native.None) || (imp = (FStar_Pervasives_Native.Some FStar_Syntax_Syntax.Equality)))) in - match uu____7009 with + match uu____7094 with | FStar_Pervasives_Native.None -> FStar_List.length formals | FStar_Pervasives_Native.Some @@ -3090,87 +2951,87 @@ let maybe_instantiate: FStar_List.length implicits in n_implicits in let inst_n_binders t1 = - let uu____7223 = FStar_TypeChecker_Env.expected_typ env in - match uu____7223 with + let uu____7308 = FStar_TypeChecker_Env.expected_typ env in + match uu____7308 with | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None | FStar_Pervasives_Native.Some expected_t -> let n_expected = number_of_implicits expected_t in let n_available = number_of_implicits t1 in if n_available < n_expected then - let uu____7247 = - let uu____7252 = - let uu____7253 = FStar_Util.string_of_int n_expected in - let uu____7260 = FStar_Syntax_Print.term_to_string e in - let uu____7261 = FStar_Util.string_of_int n_available in + let uu____7332 = + let uu____7337 = + let uu____7338 = FStar_Util.string_of_int n_expected in + let uu____7345 = FStar_Syntax_Print.term_to_string e in + let uu____7346 = FStar_Util.string_of_int n_available in FStar_Util.format3 "Expected a term with %s implicit arguments, but %s has only %s" - uu____7253 uu____7260 uu____7261 in + uu____7338 uu____7345 uu____7346 in (FStar_Errors.Fatal_MissingImplicitArguments, - uu____7252) in - let uu____7268 = FStar_TypeChecker_Env.get_range env in - FStar_Errors.raise_error uu____7247 uu____7268 + uu____7337) in + let uu____7353 = FStar_TypeChecker_Env.get_range env in + FStar_Errors.raise_error uu____7332 uu____7353 else FStar_Pervasives_Native.Some (n_available - n_expected) in - let decr_inst uu___80_7289 = - match uu___80_7289 with + let decr_inst uu___86_7374 = + match uu___86_7374 with | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None | FStar_Pervasives_Native.Some i -> FStar_Pervasives_Native.Some (i - (Prims.parse_int "1")) in match torig.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Tm_arrow (bs,c) -> - let uu____7319 = FStar_Syntax_Subst.open_comp bs c in - (match uu____7319 with + let uu____7404 = FStar_Syntax_Subst.open_comp bs c in + (match uu____7404 with | (bs1,c1) -> let rec aux subst1 inst_n bs2 = match (inst_n, bs2) with - | (FStar_Pervasives_Native.Some _0_41,uu____7428) when + | (FStar_Pervasives_Native.Some _0_41,uu____7513) when _0_41 = (Prims.parse_int "0") -> ([], bs2, subst1, FStar_TypeChecker_Rel.trivial_guard) - | (uu____7471,(x,FStar_Pervasives_Native.Some + | (uu____7556,(x,FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Implicit dot))::rest) -> let t1 = FStar_Syntax_Subst.subst subst1 x.FStar_Syntax_Syntax.sort in - let uu____7504 = + let uu____7589 = new_implicit_var "Instantiation of implicit argument" e.FStar_Syntax_Syntax.pos env t1 in - (match uu____7504 with - | (v1,uu____7544,g) -> + (match uu____7589 with + | (v1,uu____7629,g) -> let subst2 = (FStar_Syntax_Syntax.NT (x, v1)) :: subst1 in - let uu____7561 = + let uu____7646 = aux subst2 (decr_inst inst_n) rest in - (match uu____7561 with + (match uu____7646 with | (args,bs3,subst3,g') -> - let uu____7654 = + let uu____7739 = FStar_TypeChecker_Rel.conj_guard g g' in (((v1, (FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Implicit dot))) - :: args), bs3, subst3, uu____7654))) - | (uu____7681,bs3) -> + :: args), bs3, subst3, uu____7739))) + | (uu____7766,bs3) -> ([], bs3, subst1, FStar_TypeChecker_Rel.trivial_guard) in - let uu____7727 = - let uu____7754 = inst_n_binders t in - aux [] uu____7754 bs1 in - (match uu____7727 with + let uu____7812 = + let uu____7839 = inst_n_binders t in + aux [] uu____7839 bs1 in + (match uu____7812 with | (args,bs2,subst1,guard) -> (match (args, bs2) with - | ([],uu____7825) -> (e, torig, guard) - | (uu____7856,[]) when - let uu____7887 = + | ([],uu____7910) -> (e, torig, guard) + | (uu____7941,[]) when + let uu____7972 = FStar_Syntax_Util.is_total_comp c1 in - Prims.op_Negation uu____7887 -> + Prims.op_Negation uu____7972 -> (e, torig, FStar_TypeChecker_Rel.trivial_guard) - | uu____7888 -> + | uu____7973 -> let t1 = match bs2 with | [] -> FStar_Syntax_Util.comp_result c1 - | uu____7920 -> + | uu____8005 -> FStar_Syntax_Util.arrow bs2 c1 in let t2 = FStar_Syntax_Subst.subst subst1 t1 in let e1 = @@ -3178,18 +3039,18 @@ let maybe_instantiate: FStar_Pervasives_Native.None e.FStar_Syntax_Syntax.pos in (e1, t2, guard)))) - | uu____7935 -> (e, t, FStar_TypeChecker_Rel.trivial_guard)) + | uu____8020 -> (e, t, FStar_TypeChecker_Rel.trivial_guard)) let string_of_univs: FStar_Syntax_Syntax.universe_uvar FStar_Util.set -> Prims.string = fun univs1 -> - let uu____7943 = - let uu____7946 = FStar_Util.set_elements univs1 in - FStar_All.pipe_right uu____7946 + let uu____8028 = + let uu____8031 = FStar_Util.set_elements univs1 in + FStar_All.pipe_right uu____8031 (FStar_List.map (fun u -> - let uu____7956 = FStar_Syntax_Unionfind.univ_uvar_id u in - FStar_All.pipe_right uu____7956 FStar_Util.string_of_int)) in - FStar_All.pipe_right uu____7943 (FStar_String.concat ", ") + let uu____8041 = FStar_Syntax_Unionfind.univ_uvar_id u in + FStar_All.pipe_right uu____8041 FStar_Util.string_of_int)) in + FStar_All.pipe_right uu____8028 (FStar_String.concat ", ") let gen_univs: FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.universe_uvar FStar_Util.set -> @@ -3197,51 +3058,51 @@ let gen_univs: = fun env -> fun x -> - let uu____7973 = FStar_Util.set_is_empty x in - if uu____7973 + let uu____8058 = FStar_Util.set_is_empty x in + if uu____8058 then [] else (let s = - let uu____7980 = - let uu____7983 = FStar_TypeChecker_Env.univ_vars env in - FStar_Util.set_difference x uu____7983 in - FStar_All.pipe_right uu____7980 FStar_Util.set_elements in - (let uu____7991 = + let uu____8065 = + let uu____8068 = FStar_TypeChecker_Env.univ_vars env in + FStar_Util.set_difference x uu____8068 in + FStar_All.pipe_right uu____8065 FStar_Util.set_elements in + (let uu____8076 = FStar_All.pipe_left (FStar_TypeChecker_Env.debug env) (FStar_Options.Other "Gen") in - if uu____7991 + if uu____8076 then - let uu____7992 = - let uu____7993 = FStar_TypeChecker_Env.univ_vars env in - string_of_univs uu____7993 in - FStar_Util.print1 "univ_vars in env: %s\n" uu____7992 + let uu____8077 = + let uu____8078 = FStar_TypeChecker_Env.univ_vars env in + string_of_univs uu____8078 in + FStar_Util.print1 "univ_vars in env: %s\n" uu____8077 else ()); (let r = - let uu____8000 = FStar_TypeChecker_Env.get_range env in - FStar_Pervasives_Native.Some uu____8000 in + let uu____8085 = FStar_TypeChecker_Env.get_range env in + FStar_Pervasives_Native.Some uu____8085 in let u_names = FStar_All.pipe_right s (FStar_List.map (fun u -> let u_name = FStar_Syntax_Syntax.new_univ_name r in - (let uu____8015 = + (let uu____8100 = FStar_All.pipe_left (FStar_TypeChecker_Env.debug env) (FStar_Options.Other "Gen") in - if uu____8015 + if uu____8100 then - let uu____8016 = - let uu____8017 = + let uu____8101 = + let uu____8102 = FStar_Syntax_Unionfind.univ_uvar_id u in FStar_All.pipe_left FStar_Util.string_of_int - uu____8017 in - let uu____8018 = + uu____8102 in + let uu____8103 = FStar_Syntax_Print.univ_to_string (FStar_Syntax_Syntax.U_unif u) in - let uu____8019 = + let uu____8104 = FStar_Syntax_Print.univ_to_string (FStar_Syntax_Syntax.U_name u_name) in FStar_Util.print3 "Setting ?%s (%s) to %s\n" - uu____8016 uu____8018 uu____8019 + uu____8101 uu____8103 uu____8104 else ()); FStar_Syntax_Unionfind.univ_change u (FStar_Syntax_Syntax.U_name u_name); @@ -3256,9 +3117,9 @@ let gather_free_univnames: let ctx_univnames = FStar_TypeChecker_Env.univnames env in let tm_univnames = FStar_Syntax_Free.univnames t in let univnames1 = - let uu____8041 = + let uu____8126 = FStar_Util.fifo_set_difference tm_univnames ctx_univnames in - FStar_All.pipe_right uu____8041 FStar_Util.fifo_set_elements in + FStar_All.pipe_right uu____8126 FStar_Util.fifo_set_elements in univnames1 let check_universe_generalization: FStar_Syntax_Syntax.univ_name Prims.list -> @@ -3269,17 +3130,17 @@ let check_universe_generalization: fun generalized_univ_names -> fun t -> match (explicit_univ_names, generalized_univ_names) with - | ([],uu____8073) -> generalized_univ_names - | (uu____8080,[]) -> explicit_univ_names - | uu____8087 -> - let uu____8096 = - let uu____8101 = - let uu____8102 = FStar_Syntax_Print.term_to_string t in + | ([],uu____8158) -> generalized_univ_names + | (uu____8165,[]) -> explicit_univ_names + | uu____8172 -> + let uu____8181 = + let uu____8186 = + let uu____8187 = FStar_Syntax_Print.term_to_string t in Prims.strcat "Generalized universe in a term containing explicit universe annotation : " - uu____8102 in - (FStar_Errors.Fatal_UnexpectedGeneralizedUniverse, uu____8101) in - FStar_Errors.raise_error uu____8096 t.FStar_Syntax_Syntax.pos + uu____8187 in + (FStar_Errors.Fatal_UnexpectedGeneralizedUniverse, uu____8186) in + FStar_Errors.raise_error uu____8181 t.FStar_Syntax_Syntax.pos let generalize_universes: FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.tscheme @@ -3292,22 +3153,22 @@ let generalize_universes: FStar_TypeChecker_Normalize.Beta] env t0 in let univnames1 = gather_free_univnames env t in let univs1 = FStar_Syntax_Free.univs t in - (let uu____8119 = + (let uu____8204 = FStar_All.pipe_left (FStar_TypeChecker_Env.debug env) (FStar_Options.Other "Gen") in - if uu____8119 + if uu____8204 then - let uu____8120 = string_of_univs univs1 in - FStar_Util.print1 "univs to gen : %s\n" uu____8120 + let uu____8205 = string_of_univs univs1 in + FStar_Util.print1 "univs to gen : %s\n" uu____8205 else ()); (let gen1 = gen_univs env univs1 in - (let uu____8126 = + (let uu____8211 = FStar_All.pipe_left (FStar_TypeChecker_Env.debug env) (FStar_Options.Other "Gen") in - if uu____8126 + if uu____8211 then - let uu____8127 = FStar_Syntax_Print.term_to_string t in - FStar_Util.print1 "After generalization: %s\n" uu____8127 + let uu____8212 = FStar_Syntax_Print.term_to_string t in + FStar_Util.print1 "After generalization: %s\n" uu____8212 else ()); (let univs2 = check_universe_generalization univnames1 gen1 t0 in let t1 = FStar_TypeChecker_Normalize.reduce_uvar_solutions env t in @@ -3326,29 +3187,29 @@ let gen: fun env -> fun is_rec -> fun lecs -> - let uu____8197 = - let uu____8198 = + let uu____8282 = + let uu____8283 = FStar_Util.for_all - (fun uu____8211 -> - match uu____8211 with - | (uu____8220,uu____8221,c) -> + (fun uu____8296 -> + match uu____8296 with + | (uu____8305,uu____8306,c) -> FStar_Syntax_Util.is_pure_or_ghost_comp c) lecs in - FStar_All.pipe_left Prims.op_Negation uu____8198 in - if uu____8197 + FStar_All.pipe_left Prims.op_Negation uu____8283 in + if uu____8282 then FStar_Pervasives_Native.None else (let norm1 c = - (let uu____8267 = + (let uu____8352 = FStar_TypeChecker_Env.debug env FStar_Options.Medium in - if uu____8267 + if uu____8352 then - let uu____8268 = FStar_Syntax_Print.comp_to_string c in + let uu____8353 = FStar_Syntax_Print.comp_to_string c in FStar_Util.print1 "Normalizing before generalizing:\n\t %s\n" - uu____8268 + uu____8353 else ()); (let c1 = - let uu____8271 = FStar_TypeChecker_Env.should_verify env in - if uu____8271 + let uu____8356 = FStar_TypeChecker_Env.should_verify env in + if uu____8356 then FStar_TypeChecker_Normalize.normalize_comp [FStar_TypeChecker_Normalize.Beta; @@ -3362,20 +3223,20 @@ let gen: FStar_TypeChecker_Normalize.Exclude FStar_TypeChecker_Normalize.Zeta; FStar_TypeChecker_Normalize.NoFullNorm] env c in - (let uu____8274 = + (let uu____8359 = FStar_TypeChecker_Env.debug env FStar_Options.Medium in - if uu____8274 + if uu____8359 then - let uu____8275 = FStar_Syntax_Print.comp_to_string c1 in - FStar_Util.print1 "Normalized to:\n\t %s\n" uu____8275 + let uu____8360 = FStar_Syntax_Print.comp_to_string c1 in + FStar_Util.print1 "Normalized to:\n\t %s\n" uu____8360 else ()); c1) in let env_uvars = FStar_TypeChecker_Env.uvars_in_env env in let gen_uvars uvs = - let uu____8336 = FStar_Util.set_difference uvs env_uvars in - FStar_All.pipe_right uu____8336 FStar_Util.set_elements in - let univs_and_uvars_of_lec uu____8466 = - match uu____8466 with + let uu____8421 = FStar_Util.set_difference uvs env_uvars in + FStar_All.pipe_right uu____8421 FStar_Util.set_elements in + let univs_and_uvars_of_lec uu____8551 = + match uu____8551 with | (lbname,e,c) -> let t = FStar_All.pipe_right (FStar_Syntax_Util.comp_result c) @@ -3384,249 +3245,249 @@ let gen: let t1 = FStar_Syntax_Util.comp_result c1 in let univs1 = FStar_Syntax_Free.univs t1 in let uvt = FStar_Syntax_Free.uvars t1 in - ((let uu____8532 = + ((let uu____8617 = FStar_All.pipe_left (FStar_TypeChecker_Env.debug env) (FStar_Options.Other "Gen") in - if uu____8532 + if uu____8617 then - let uu____8533 = - let uu____8534 = - let uu____8537 = FStar_Util.set_elements univs1 in - FStar_All.pipe_right uu____8537 + let uu____8618 = + let uu____8619 = + let uu____8622 = FStar_Util.set_elements univs1 in + FStar_All.pipe_right uu____8622 (FStar_List.map (fun u -> FStar_Syntax_Print.univ_to_string (FStar_Syntax_Syntax.U_unif u))) in - FStar_All.pipe_right uu____8534 + FStar_All.pipe_right uu____8619 (FStar_String.concat ", ") in - let uu____8564 = - let uu____8565 = - let uu____8568 = FStar_Util.set_elements uvt in - FStar_All.pipe_right uu____8568 + let uu____8649 = + let uu____8650 = + let uu____8653 = FStar_Util.set_elements uvt in + FStar_All.pipe_right uu____8653 (FStar_List.map - (fun uu____8596 -> - match uu____8596 with + (fun uu____8681 -> + match uu____8681 with | (u,t2) -> - let uu____8603 = + let uu____8688 = FStar_Syntax_Print.uvar_to_string u in - let uu____8604 = + let uu____8689 = FStar_Syntax_Print.term_to_string t2 in FStar_Util.format2 "(%s : %s)" - uu____8603 uu____8604)) in - FStar_All.pipe_right uu____8565 + uu____8688 uu____8689)) in + FStar_All.pipe_right uu____8650 (FStar_String.concat ", ") in FStar_Util.print2 - "^^^^\n\tFree univs = %s\n\tFree uvt=%s\n" uu____8533 - uu____8564 + "^^^^\n\tFree univs = %s\n\tFree uvt=%s\n" uu____8618 + uu____8649 else ()); (let univs2 = - let uu____8611 = FStar_Util.set_elements uvt in + let uu____8696 = FStar_Util.set_elements uvt in FStar_List.fold_left (fun univs2 -> - fun uu____8634 -> - match uu____8634 with - | (uu____8643,t2) -> - let uu____8645 = FStar_Syntax_Free.univs t2 in - FStar_Util.set_union univs2 uu____8645) - univs1 uu____8611 in + fun uu____8719 -> + match uu____8719 with + | (uu____8728,t2) -> + let uu____8730 = FStar_Syntax_Free.univs t2 in + FStar_Util.set_union univs2 uu____8730) + univs1 uu____8696 in let uvs = gen_uvars uvt in - (let uu____8668 = + (let uu____8753 = FStar_All.pipe_left (FStar_TypeChecker_Env.debug env) (FStar_Options.Other "Gen") in - if uu____8668 + if uu____8753 then - let uu____8669 = - let uu____8670 = - let uu____8673 = FStar_Util.set_elements univs2 in - FStar_All.pipe_right uu____8673 + let uu____8754 = + let uu____8755 = + let uu____8758 = FStar_Util.set_elements univs2 in + FStar_All.pipe_right uu____8758 (FStar_List.map (fun u -> FStar_Syntax_Print.univ_to_string (FStar_Syntax_Syntax.U_unif u))) in - FStar_All.pipe_right uu____8670 + FStar_All.pipe_right uu____8755 (FStar_String.concat ", ") in - let uu____8700 = - let uu____8701 = + let uu____8785 = + let uu____8786 = FStar_All.pipe_right uvs (FStar_List.map - (fun uu____8733 -> - match uu____8733 with + (fun uu____8818 -> + match uu____8818 with | (u,t2) -> - let uu____8740 = + let uu____8825 = FStar_Syntax_Print.uvar_to_string u in - let uu____8741 = + let uu____8826 = FStar_TypeChecker_Normalize.term_to_string env t2 in FStar_Util.format2 "(%s : %s)" - uu____8740 uu____8741)) in - FStar_All.pipe_right uu____8701 + uu____8825 uu____8826)) in + FStar_All.pipe_right uu____8786 (FStar_String.concat ", ") in FStar_Util.print2 - "^^^^\n\tFree univs = %s\n\tgen_uvars =%s" uu____8669 - uu____8700 + "^^^^\n\tFree univs = %s\n\tgen_uvars =%s" uu____8754 + uu____8785 else ()); (univs2, uvs, (lbname, e, c1)))) in - let uu____8771 = - let uu____8804 = FStar_List.hd lecs in - univs_and_uvars_of_lec uu____8804 in - match uu____8771 with + let uu____8856 = + let uu____8889 = FStar_List.hd lecs in + univs_and_uvars_of_lec uu____8889 in + match uu____8856 with | (univs1,uvs,lec_hd) -> let force_univs_eq lec2 u1 u2 = - let uu____8922 = + let uu____9007 = (FStar_Util.set_is_subset_of u1 u2) && (FStar_Util.set_is_subset_of u2 u1) in - if uu____8922 + if uu____9007 then () else - (let uu____8924 = lec_hd in - match uu____8924 with - | (lb1,uu____8932,uu____8933) -> - let uu____8934 = lec2 in - (match uu____8934 with - | (lb2,uu____8942,uu____8943) -> + (let uu____9009 = lec_hd in + match uu____9009 with + | (lb1,uu____9017,uu____9018) -> + let uu____9019 = lec2 in + (match uu____9019 with + | (lb2,uu____9027,uu____9028) -> let msg = - let uu____8945 = + let uu____9030 = FStar_Syntax_Print.lbname_to_string lb1 in - let uu____8946 = + let uu____9031 = FStar_Syntax_Print.lbname_to_string lb2 in FStar_Util.format2 "Generalizing the types of these mutually recursive definitions requires an incompatible set of universes for %s and %s" - uu____8945 uu____8946 in - let uu____8947 = + uu____9030 uu____9031 in + let uu____9032 = FStar_TypeChecker_Env.get_range env in FStar_Errors.raise_error (FStar_Errors.Fatal_IncompatibleSetOfUniverse, - msg) uu____8947)) in + msg) uu____9032)) in let force_uvars_eq lec2 u1 u2 = let uvars_subseteq u11 u21 = FStar_All.pipe_right u11 (FStar_Util.for_all - (fun uu____9058 -> - match uu____9058 with - | (u,uu____9066) -> + (fun uu____9143 -> + match uu____9143 with + | (u,uu____9151) -> FStar_All.pipe_right u21 (FStar_Util.for_some - (fun uu____9088 -> - match uu____9088 with - | (u',uu____9096) -> + (fun uu____9173 -> + match uu____9173 with + | (u',uu____9181) -> FStar_Syntax_Unionfind.equiv u u')))) in - let uu____9101 = + let uu____9186 = (uvars_subseteq u1 u2) && (uvars_subseteq u2 u1) in - if uu____9101 + if uu____9186 then () else - (let uu____9103 = lec_hd in - match uu____9103 with - | (lb1,uu____9111,uu____9112) -> - let uu____9113 = lec2 in - (match uu____9113 with - | (lb2,uu____9121,uu____9122) -> + (let uu____9188 = lec_hd in + match uu____9188 with + | (lb1,uu____9196,uu____9197) -> + let uu____9198 = lec2 in + (match uu____9198 with + | (lb2,uu____9206,uu____9207) -> let msg = - let uu____9124 = + let uu____9209 = FStar_Syntax_Print.lbname_to_string lb1 in - let uu____9125 = + let uu____9210 = FStar_Syntax_Print.lbname_to_string lb2 in FStar_Util.format2 "Generalizing the types of these mutually recursive definitions requires an incompatible number of types for %s and %s" - uu____9124 uu____9125 in - let uu____9126 = + uu____9209 uu____9210 in + let uu____9211 = FStar_TypeChecker_Env.get_range env in FStar_Errors.raise_error (FStar_Errors.Fatal_IncompatibleNumberOfTypes, - msg) uu____9126)) in + msg) uu____9211)) in let lecs1 = - let uu____9136 = FStar_List.tl lecs in + let uu____9221 = FStar_List.tl lecs in FStar_List.fold_right (fun this_lec -> fun lecs1 -> - let uu____9195 = univs_and_uvars_of_lec this_lec in - match uu____9195 with + let uu____9280 = univs_and_uvars_of_lec this_lec in + match uu____9280 with | (this_univs,this_uvs,this_lec1) -> (force_univs_eq this_lec1 univs1 this_univs; force_uvars_eq this_lec1 uvs this_uvs; this_lec1 :: - lecs1)) uu____9136 [] in + lecs1)) uu____9221 [] in let lecs2 = lec_hd :: lecs1 in let gen_types uvs1 = let fail k = - let uu____9348 = lec_hd in - match uu____9348 with + let uu____9433 = lec_hd in + match uu____9433 with | (lbname,e,c) -> - let uu____9358 = - let uu____9363 = - let uu____9364 = + let uu____9443 = + let uu____9448 = + let uu____9449 = FStar_Syntax_Print.term_to_string k in - let uu____9365 = + let uu____9450 = FStar_Syntax_Print.lbname_to_string lbname in - let uu____9366 = + let uu____9451 = FStar_Syntax_Print.term_to_string (FStar_Syntax_Util.comp_result c) in FStar_Util.format3 "Failed to resolve implicit argument of type '%s' in the type of %s (%s)" - uu____9364 uu____9365 uu____9366 in + uu____9449 uu____9450 uu____9451 in (FStar_Errors.Fatal_FailToResolveImplicitArgument, - uu____9363) in - let uu____9367 = FStar_TypeChecker_Env.get_range env in - FStar_Errors.raise_error uu____9358 uu____9367 in + uu____9448) in + let uu____9452 = FStar_TypeChecker_Env.get_range env in + FStar_Errors.raise_error uu____9443 uu____9452 in FStar_All.pipe_right uvs1 (FStar_List.map - (fun uu____9397 -> - match uu____9397 with + (fun uu____9482 -> + match uu____9482 with | (u,k) -> - let uu____9410 = FStar_Syntax_Unionfind.find u in - (match uu____9410 with - | FStar_Pervasives_Native.Some uu____9419 -> + let uu____9495 = FStar_Syntax_Unionfind.find u in + (match uu____9495 with + | FStar_Pervasives_Native.Some uu____9504 -> failwith "Unexpected instantiation of mutually recursive uvar" - | uu____9426 -> + | uu____9511 -> let k1 = FStar_TypeChecker_Normalize.normalize [FStar_TypeChecker_Normalize.Beta; FStar_TypeChecker_Normalize.Exclude FStar_TypeChecker_Normalize.Zeta] env k in - let uu____9430 = + let uu____9515 = FStar_Syntax_Util.arrow_formals k1 in - (match uu____9430 with + (match uu____9515 with | (bs,kres) -> - ((let uu____9468 = - let uu____9469 = - let uu____9472 = + ((let uu____9553 = + let uu____9554 = + let uu____9557 = FStar_TypeChecker_Normalize.unfold_whnf env kres in FStar_Syntax_Util.unrefine - uu____9472 in - uu____9469.FStar_Syntax_Syntax.n in - match uu____9468 with + uu____9557 in + uu____9554.FStar_Syntax_Syntax.n in + match uu____9553 with | FStar_Syntax_Syntax.Tm_type - uu____9473 -> + uu____9558 -> let free = FStar_Syntax_Free.names kres in - let uu____9477 = - let uu____9478 = + let uu____9562 = + let uu____9563 = FStar_Util.set_is_empty free in - Prims.op_Negation uu____9478 in - if uu____9477 + Prims.op_Negation uu____9563 in + if uu____9562 then fail kres else () - | uu____9480 -> fail kres); + | uu____9565 -> fail kres); (let a = - let uu____9482 = - let uu____9485 = + let uu____9567 = + let uu____9570 = FStar_TypeChecker_Env.get_range env in FStar_All.pipe_left (fun _0_42 -> FStar_Pervasives_Native.Some - _0_42) uu____9485 in + _0_42) uu____9570 in FStar_Syntax_Syntax.new_bv - uu____9482 kres in + uu____9567 kres in let t = - let uu____9489 = + let uu____9574 = FStar_Syntax_Syntax.bv_to_name a in FStar_Syntax_Util.abs bs - uu____9489 + uu____9574 (FStar_Pervasives_Native.Some (FStar_Syntax_Util.residual_tot kres)) in @@ -3639,15 +3500,15 @@ let gen: let ecs = FStar_All.pipe_right lecs2 (FStar_List.map - (fun uu____9608 -> - match uu____9608 with + (fun uu____9693 -> + match uu____9693 with | (lbname,e,c) -> - let uu____9654 = + let uu____9739 = match (gen_tvars, gen_univs1) with | ([],[]) -> (e, c, []) - | uu____9723 -> - let uu____9738 = (e, c) in - (match uu____9738 with + | uu____9808 -> + let uu____9823 = (e, c) in + (match uu____9823 with | (e0,c0) -> let c1 = FStar_TypeChecker_Normalize.normalize_comp @@ -3666,23 +3527,23 @@ let gen: then let tvar_args = FStar_List.map - (fun uu____9775 -> - match uu____9775 with - | (x,uu____9783) -> - let uu____9788 = + (fun uu____9860 -> + match uu____9860 with + | (x,uu____9868) -> + let uu____9873 = FStar_Syntax_Syntax.bv_to_name x in FStar_Syntax_Syntax.iarg - uu____9788) + uu____9873) gen_tvars in let instantiate_lbname_with_app tm fv = - let uu____9798 = - let uu____9799 = + let uu____9883 = + let uu____9884 = FStar_Util.right lbname in FStar_Syntax_Syntax.fv_eq fv - uu____9799 in - if uu____9798 + uu____9884 in + if uu____9883 then FStar_Syntax_Syntax.mk_Tm_app tm tvar_args @@ -3693,24 +3554,24 @@ let gen: instantiate_lbname_with_app e1 else e1 in let t = - let uu____9807 = - let uu____9808 = + let uu____9892 = + let uu____9893 = FStar_Syntax_Subst.compress (FStar_Syntax_Util.comp_result c1) in - uu____9808.FStar_Syntax_Syntax.n in - match uu____9807 with + uu____9893.FStar_Syntax_Syntax.n in + match uu____9892 with | FStar_Syntax_Syntax.Tm_arrow (bs,cod) -> - let uu____9831 = + let uu____9916 = FStar_Syntax_Subst.open_comp bs cod in - (match uu____9831 with + (match uu____9916 with | (bs1,cod1) -> FStar_Syntax_Util.arrow (FStar_List.append gen_tvars bs1) cod1) - | uu____9846 -> + | uu____9931 -> FStar_Syntax_Util.arrow gen_tvars c1 in let e' = @@ -3718,10 +3579,10 @@ let gen: (FStar_Pervasives_Native.Some (FStar_Syntax_Util.residual_comp_of_comp c1)) in - let uu____9848 = + let uu____9933 = FStar_Syntax_Syntax.mk_Total t in - (e', uu____9848, gen_tvars)) in - (match uu____9654 with + (e', uu____9933, gen_tvars)) in + (match uu____9739 with | (e1,c1,gvs) -> (lbname, gen_univs1, e1, c1, gvs)))) in FStar_Pervasives_Native.Some ecs) @@ -3737,71 +3598,71 @@ let generalize: fun env -> fun is_rec -> fun lecs -> - (let uu____9994 = Obj.magic () in ()); - (let uu____9996 = FStar_TypeChecker_Env.debug env FStar_Options.Low in - if uu____9996 + (let uu____10079 = Obj.magic () in ()); + (let uu____10081 = FStar_TypeChecker_Env.debug env FStar_Options.Low in + if uu____10081 then - let uu____9997 = - let uu____9998 = + let uu____10082 = + let uu____10083 = FStar_List.map - (fun uu____10011 -> - match uu____10011 with - | (lb,uu____10019,uu____10020) -> + (fun uu____10096 -> + match uu____10096 with + | (lb,uu____10104,uu____10105) -> FStar_Syntax_Print.lbname_to_string lb) lecs in - FStar_All.pipe_right uu____9998 (FStar_String.concat ", ") in - FStar_Util.print1 "Generalizing: %s\n" uu____9997 + FStar_All.pipe_right uu____10083 (FStar_String.concat ", ") in + FStar_Util.print1 "Generalizing: %s\n" uu____10082 else ()); (let univnames_lecs = FStar_List.map - (fun uu____10041 -> - match uu____10041 with + (fun uu____10126 -> + match uu____10126 with | (l,t,c) -> gather_free_univnames env t) lecs in let generalized_lecs = - let uu____10070 = gen env is_rec lecs in - match uu____10070 with + let uu____10155 = gen env is_rec lecs in + match uu____10155 with | FStar_Pervasives_Native.None -> FStar_All.pipe_right lecs (FStar_List.map - (fun uu____10169 -> - match uu____10169 with | (l,t,c) -> (l, [], t, c, []))) + (fun uu____10254 -> + match uu____10254 with | (l,t,c) -> (l, [], t, c, []))) | FStar_Pervasives_Native.Some luecs -> - ((let uu____10231 = + ((let uu____10316 = FStar_TypeChecker_Env.debug env FStar_Options.Medium in - if uu____10231 + if uu____10316 then FStar_All.pipe_right luecs (FStar_List.iter - (fun uu____10275 -> - match uu____10275 with + (fun uu____10360 -> + match uu____10360 with | (l,us,e,c,gvs) -> - let uu____10309 = + let uu____10394 = FStar_Range.string_of_range e.FStar_Syntax_Syntax.pos in - let uu____10310 = + let uu____10395 = FStar_Syntax_Print.lbname_to_string l in - let uu____10311 = + let uu____10396 = FStar_Syntax_Print.term_to_string (FStar_Syntax_Util.comp_result c) in - let uu____10312 = + let uu____10397 = FStar_Syntax_Print.term_to_string e in - let uu____10313 = + let uu____10398 = FStar_Syntax_Print.binders_to_string ", " gvs in FStar_Util.print5 "(%s) Generalized %s at type %s\n%s\nVars = (%s)\n" - uu____10309 uu____10310 uu____10311 - uu____10312 uu____10313)) + uu____10394 uu____10395 uu____10396 + uu____10397 uu____10398)) else ()); luecs) in FStar_List.map2 (fun univnames1 -> - fun uu____10354 -> - match uu____10354 with + fun uu____10439 -> + match uu____10439 with | (l,generalized_univs,t,c,gvs) -> - let uu____10398 = + let uu____10483 = check_universe_generalization univnames1 generalized_univs t in - (l, uu____10398, t, c, gvs)) univnames_lecs + (l, uu____10483, t, c, gvs)) univnames_lecs generalized_lecs) let check_and_ascribe: FStar_TypeChecker_Env.env -> @@ -3821,133 +3682,133 @@ let check_and_ascribe: if env2.FStar_TypeChecker_Env.use_eq then FStar_TypeChecker_Rel.try_teq true env2 t11 t21 else - (let uu____10441 = + (let uu____10526 = FStar_TypeChecker_Rel.get_subtyping_predicate env2 t11 t21 in - match uu____10441 with + match uu____10526 with | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None | FStar_Pervasives_Native.Some f -> - let uu____10447 = FStar_TypeChecker_Rel.apply_guard f e in + let uu____10532 = FStar_TypeChecker_Rel.apply_guard f e in FStar_All.pipe_left (fun _0_43 -> FStar_Pervasives_Native.Some _0_43) - uu____10447) in + uu____10532) in let is_var e1 = - let uu____10454 = - let uu____10455 = FStar_Syntax_Subst.compress e1 in - uu____10455.FStar_Syntax_Syntax.n in - match uu____10454 with - | FStar_Syntax_Syntax.Tm_name uu____10458 -> true - | uu____10459 -> false in + let uu____10539 = + let uu____10540 = FStar_Syntax_Subst.compress e1 in + uu____10540.FStar_Syntax_Syntax.n in + match uu____10539 with + | FStar_Syntax_Syntax.Tm_name uu____10543 -> true + | uu____10544 -> false in let decorate e1 t = let e2 = FStar_Syntax_Subst.compress e1 in match e2.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Tm_name x -> FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_name - (let uu___121_10475 = x in + (let uu___121_10560 = x in { FStar_Syntax_Syntax.ppname = - (uu___121_10475.FStar_Syntax_Syntax.ppname); + (uu___121_10560.FStar_Syntax_Syntax.ppname); FStar_Syntax_Syntax.index = - (uu___121_10475.FStar_Syntax_Syntax.index); + (uu___121_10560.FStar_Syntax_Syntax.index); FStar_Syntax_Syntax.sort = t2 })) FStar_Pervasives_Native.None e2.FStar_Syntax_Syntax.pos - | uu____10476 -> e2 in + | uu____10561 -> e2 in let env2 = - let uu___122_10478 = env1 in - let uu____10479 = + let uu___122_10563 = env1 in + let uu____10564 = env1.FStar_TypeChecker_Env.use_eq || (env1.FStar_TypeChecker_Env.is_pattern && (is_var e)) in { FStar_TypeChecker_Env.solver = - (uu___122_10478.FStar_TypeChecker_Env.solver); + (uu___122_10563.FStar_TypeChecker_Env.solver); FStar_TypeChecker_Env.range = - (uu___122_10478.FStar_TypeChecker_Env.range); + (uu___122_10563.FStar_TypeChecker_Env.range); FStar_TypeChecker_Env.curmodule = - (uu___122_10478.FStar_TypeChecker_Env.curmodule); + (uu___122_10563.FStar_TypeChecker_Env.curmodule); FStar_TypeChecker_Env.gamma = - (uu___122_10478.FStar_TypeChecker_Env.gamma); + (uu___122_10563.FStar_TypeChecker_Env.gamma); FStar_TypeChecker_Env.gamma_cache = - (uu___122_10478.FStar_TypeChecker_Env.gamma_cache); + (uu___122_10563.FStar_TypeChecker_Env.gamma_cache); FStar_TypeChecker_Env.modules = - (uu___122_10478.FStar_TypeChecker_Env.modules); + (uu___122_10563.FStar_TypeChecker_Env.modules); FStar_TypeChecker_Env.expected_typ = - (uu___122_10478.FStar_TypeChecker_Env.expected_typ); + (uu___122_10563.FStar_TypeChecker_Env.expected_typ); FStar_TypeChecker_Env.sigtab = - (uu___122_10478.FStar_TypeChecker_Env.sigtab); + (uu___122_10563.FStar_TypeChecker_Env.sigtab); FStar_TypeChecker_Env.is_pattern = - (uu___122_10478.FStar_TypeChecker_Env.is_pattern); + (uu___122_10563.FStar_TypeChecker_Env.is_pattern); FStar_TypeChecker_Env.instantiate_imp = - (uu___122_10478.FStar_TypeChecker_Env.instantiate_imp); + (uu___122_10563.FStar_TypeChecker_Env.instantiate_imp); FStar_TypeChecker_Env.effects = - (uu___122_10478.FStar_TypeChecker_Env.effects); + (uu___122_10563.FStar_TypeChecker_Env.effects); FStar_TypeChecker_Env.generalize = - (uu___122_10478.FStar_TypeChecker_Env.generalize); + (uu___122_10563.FStar_TypeChecker_Env.generalize); FStar_TypeChecker_Env.letrecs = - (uu___122_10478.FStar_TypeChecker_Env.letrecs); + (uu___122_10563.FStar_TypeChecker_Env.letrecs); FStar_TypeChecker_Env.top_level = - (uu___122_10478.FStar_TypeChecker_Env.top_level); + (uu___122_10563.FStar_TypeChecker_Env.top_level); FStar_TypeChecker_Env.check_uvars = - (uu___122_10478.FStar_TypeChecker_Env.check_uvars); - FStar_TypeChecker_Env.use_eq = uu____10479; + (uu___122_10563.FStar_TypeChecker_Env.check_uvars); + FStar_TypeChecker_Env.use_eq = uu____10564; FStar_TypeChecker_Env.is_iface = - (uu___122_10478.FStar_TypeChecker_Env.is_iface); + (uu___122_10563.FStar_TypeChecker_Env.is_iface); FStar_TypeChecker_Env.admit = - (uu___122_10478.FStar_TypeChecker_Env.admit); + (uu___122_10563.FStar_TypeChecker_Env.admit); FStar_TypeChecker_Env.lax = - (uu___122_10478.FStar_TypeChecker_Env.lax); + (uu___122_10563.FStar_TypeChecker_Env.lax); FStar_TypeChecker_Env.lax_universes = - (uu___122_10478.FStar_TypeChecker_Env.lax_universes); + (uu___122_10563.FStar_TypeChecker_Env.lax_universes); FStar_TypeChecker_Env.failhard = - (uu___122_10478.FStar_TypeChecker_Env.failhard); + (uu___122_10563.FStar_TypeChecker_Env.failhard); FStar_TypeChecker_Env.nosynth = - (uu___122_10478.FStar_TypeChecker_Env.nosynth); + (uu___122_10563.FStar_TypeChecker_Env.nosynth); FStar_TypeChecker_Env.tc_term = - (uu___122_10478.FStar_TypeChecker_Env.tc_term); + (uu___122_10563.FStar_TypeChecker_Env.tc_term); FStar_TypeChecker_Env.type_of = - (uu___122_10478.FStar_TypeChecker_Env.type_of); + (uu___122_10563.FStar_TypeChecker_Env.type_of); FStar_TypeChecker_Env.universe_of = - (uu___122_10478.FStar_TypeChecker_Env.universe_of); + (uu___122_10563.FStar_TypeChecker_Env.universe_of); FStar_TypeChecker_Env.use_bv_sorts = - (uu___122_10478.FStar_TypeChecker_Env.use_bv_sorts); + (uu___122_10563.FStar_TypeChecker_Env.use_bv_sorts); FStar_TypeChecker_Env.qname_and_index = - (uu___122_10478.FStar_TypeChecker_Env.qname_and_index); + (uu___122_10563.FStar_TypeChecker_Env.qname_and_index); FStar_TypeChecker_Env.proof_ns = - (uu___122_10478.FStar_TypeChecker_Env.proof_ns); + (uu___122_10563.FStar_TypeChecker_Env.proof_ns); FStar_TypeChecker_Env.synth = - (uu___122_10478.FStar_TypeChecker_Env.synth); + (uu___122_10563.FStar_TypeChecker_Env.synth); FStar_TypeChecker_Env.is_native_tactic = - (uu___122_10478.FStar_TypeChecker_Env.is_native_tactic); + (uu___122_10563.FStar_TypeChecker_Env.is_native_tactic); FStar_TypeChecker_Env.identifier_info = - (uu___122_10478.FStar_TypeChecker_Env.identifier_info); + (uu___122_10563.FStar_TypeChecker_Env.identifier_info); FStar_TypeChecker_Env.tc_hooks = - (uu___122_10478.FStar_TypeChecker_Env.tc_hooks); + (uu___122_10563.FStar_TypeChecker_Env.tc_hooks); FStar_TypeChecker_Env.dsenv = - (uu___122_10478.FStar_TypeChecker_Env.dsenv); + (uu___122_10563.FStar_TypeChecker_Env.dsenv); FStar_TypeChecker_Env.dep_graph = - (uu___122_10478.FStar_TypeChecker_Env.dep_graph) + (uu___122_10563.FStar_TypeChecker_Env.dep_graph) } in - let uu____10480 = check env2 t1 t2 in - match uu____10480 with + let uu____10565 = check env2 t1 t2 in + match uu____10565 with | FStar_Pervasives_Native.None -> - let uu____10487 = + let uu____10572 = FStar_TypeChecker_Err.expected_expression_of_type env2 t2 e t1 in - let uu____10492 = FStar_TypeChecker_Env.get_range env2 in - FStar_Errors.raise_error uu____10487 uu____10492 + let uu____10577 = FStar_TypeChecker_Env.get_range env2 in + FStar_Errors.raise_error uu____10572 uu____10577 | FStar_Pervasives_Native.Some g -> - ((let uu____10499 = + ((let uu____10584 = FStar_All.pipe_left (FStar_TypeChecker_Env.debug env2) (FStar_Options.Other "Rel") in - if uu____10499 + if uu____10584 then - let uu____10500 = + let uu____10585 = FStar_TypeChecker_Rel.guard_to_string env2 g in FStar_All.pipe_left - (FStar_Util.print1 "Applied guard is %s\n") uu____10500 + (FStar_Util.print1 "Applied guard is %s\n") uu____10585 else ()); - (let uu____10502 = decorate e t2 in (uu____10502, g))) + (let uu____10587 = decorate e t2 in (uu____10587, g))) let check_top_level: FStar_TypeChecker_Env.env -> FStar_TypeChecker_Env.guard_t -> @@ -3961,152 +3822,152 @@ let check_top_level: FStar_TypeChecker_Rel.force_trivial_guard env g1; FStar_Syntax_Util.is_pure_lcomp lc in let g1 = FStar_TypeChecker_Rel.solve_deferred_constraints env g in - let uu____10530 = FStar_Syntax_Util.is_total_lcomp lc in - if uu____10530 + let uu____10615 = FStar_Syntax_Util.is_total_lcomp lc in + if uu____10615 then - let uu____10535 = discharge g1 in - let uu____10536 = lc.FStar_Syntax_Syntax.comp () in - (uu____10535, uu____10536) + let uu____10620 = discharge g1 in + let uu____10621 = FStar_Syntax_Syntax.lcomp_comp lc in + (uu____10620, uu____10621) else - (let c = lc.FStar_Syntax_Syntax.comp () in + (let c = FStar_Syntax_Syntax.lcomp_comp lc in let steps = [FStar_TypeChecker_Normalize.Beta] in let c1 = - let uu____10549 = - let uu____10550 = - let uu____10551 = + let uu____10628 = + let uu____10629 = + let uu____10630 = FStar_TypeChecker_Env.unfold_effect_abbrev env c in - FStar_All.pipe_right uu____10551 FStar_Syntax_Syntax.mk_Comp in - FStar_All.pipe_right uu____10550 + FStar_All.pipe_right uu____10630 FStar_Syntax_Syntax.mk_Comp in + FStar_All.pipe_right uu____10629 (FStar_TypeChecker_Normalize.normalize_comp steps env) in - FStar_All.pipe_right uu____10549 + FStar_All.pipe_right uu____10628 (FStar_TypeChecker_Env.comp_to_comp_typ env) in let md = FStar_TypeChecker_Env.get_effect_decl env c1.FStar_Syntax_Syntax.effect_name in - let uu____10553 = destruct_comp c1 in - match uu____10553 with + let uu____10632 = destruct_comp c1 in + match uu____10632 with | (u_t,t,wp) -> let vc = - let uu____10570 = FStar_TypeChecker_Env.get_range env in - let uu____10571 = - let uu____10572 = + let uu____10649 = FStar_TypeChecker_Env.get_range env in + let uu____10650 = + let uu____10651 = FStar_TypeChecker_Env.inst_effect_fun_with [u_t] env md md.FStar_Syntax_Syntax.trivial in - let uu____10573 = - let uu____10574 = FStar_Syntax_Syntax.as_arg t in - let uu____10575 = - let uu____10578 = FStar_Syntax_Syntax.as_arg wp in - [uu____10578] in - uu____10574 :: uu____10575 in - FStar_Syntax_Syntax.mk_Tm_app uu____10572 uu____10573 in - uu____10571 FStar_Pervasives_Native.None uu____10570 in - ((let uu____10582 = + let uu____10652 = + let uu____10653 = FStar_Syntax_Syntax.as_arg t in + let uu____10654 = + let uu____10657 = FStar_Syntax_Syntax.as_arg wp in + [uu____10657] in + uu____10653 :: uu____10654 in + FStar_Syntax_Syntax.mk_Tm_app uu____10651 uu____10652 in + uu____10650 FStar_Pervasives_Native.None uu____10649 in + ((let uu____10661 = FStar_All.pipe_left (FStar_TypeChecker_Env.debug env) (FStar_Options.Other "Simplification") in - if uu____10582 + if uu____10661 then - let uu____10583 = FStar_Syntax_Print.term_to_string vc in - FStar_Util.print1 "top-level VC: %s\n" uu____10583 + let uu____10662 = FStar_Syntax_Print.term_to_string vc in + FStar_Util.print1 "top-level VC: %s\n" uu____10662 else ()); (let g2 = - let uu____10586 = + let uu____10665 = FStar_All.pipe_left FStar_TypeChecker_Rel.guard_of_guard_formula (FStar_TypeChecker_Common.NonTrivial vc) in - FStar_TypeChecker_Rel.conj_guard g1 uu____10586 in - let uu____10587 = discharge g2 in - let uu____10588 = FStar_Syntax_Syntax.mk_Comp c1 in - (uu____10587, uu____10588)))) + FStar_TypeChecker_Rel.conj_guard g1 uu____10665 in + let uu____10666 = discharge g2 in + let uu____10667 = FStar_Syntax_Syntax.mk_Comp c1 in + (uu____10666, uu____10667)))) let short_circuit: FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.args -> FStar_TypeChecker_Common.guard_formula = fun head1 -> fun seen_args -> - let short_bin_op f uu___81_10612 = - match uu___81_10612 with + let short_bin_op f uu___87_10691 = + match uu___87_10691 with | [] -> FStar_TypeChecker_Common.Trivial - | (fst1,uu____10620)::[] -> f fst1 - | uu____10637 -> failwith "Unexpexted args to binary operator" in + | (fst1,uu____10699)::[] -> f fst1 + | uu____10716 -> failwith "Unexpexted args to binary operator" in let op_and_e e = - let uu____10642 = FStar_Syntax_Util.b2t e in - FStar_All.pipe_right uu____10642 + let uu____10721 = FStar_Syntax_Util.b2t e in + FStar_All.pipe_right uu____10721 (fun _0_44 -> FStar_TypeChecker_Common.NonTrivial _0_44) in let op_or_e e = - let uu____10651 = - let uu____10654 = FStar_Syntax_Util.b2t e in - FStar_Syntax_Util.mk_neg uu____10654 in - FStar_All.pipe_right uu____10651 + let uu____10730 = + let uu____10733 = FStar_Syntax_Util.b2t e in + FStar_Syntax_Util.mk_neg uu____10733 in + FStar_All.pipe_right uu____10730 (fun _0_45 -> FStar_TypeChecker_Common.NonTrivial _0_45) in let op_and_t t = FStar_All.pipe_right t (fun _0_46 -> FStar_TypeChecker_Common.NonTrivial _0_46) in let op_or_t t = - let uu____10665 = FStar_All.pipe_right t FStar_Syntax_Util.mk_neg in - FStar_All.pipe_right uu____10665 + let uu____10744 = FStar_All.pipe_right t FStar_Syntax_Util.mk_neg in + FStar_All.pipe_right uu____10744 (fun _0_47 -> FStar_TypeChecker_Common.NonTrivial _0_47) in let op_imp_t t = FStar_All.pipe_right t (fun _0_48 -> FStar_TypeChecker_Common.NonTrivial _0_48) in - let short_op_ite uu___82_10679 = - match uu___82_10679 with + let short_op_ite uu___88_10758 = + match uu___88_10758 with | [] -> FStar_TypeChecker_Common.Trivial - | (guard,uu____10687)::[] -> + | (guard,uu____10766)::[] -> FStar_TypeChecker_Common.NonTrivial guard - | _then::(guard,uu____10706)::[] -> - let uu____10735 = FStar_Syntax_Util.mk_neg guard in - FStar_All.pipe_right uu____10735 + | _then::(guard,uu____10785)::[] -> + let uu____10814 = FStar_Syntax_Util.mk_neg guard in + FStar_All.pipe_right uu____10814 (fun _0_49 -> FStar_TypeChecker_Common.NonTrivial _0_49) - | uu____10740 -> failwith "Unexpected args to ITE" in + | uu____10819 -> failwith "Unexpected args to ITE" in let table = - let uu____10750 = - let uu____10757 = short_bin_op op_and_e in - (FStar_Parser_Const.op_And, uu____10757) in - let uu____10762 = - let uu____10771 = - let uu____10778 = short_bin_op op_or_e in - (FStar_Parser_Const.op_Or, uu____10778) in - let uu____10783 = - let uu____10792 = - let uu____10799 = short_bin_op op_and_t in - (FStar_Parser_Const.and_lid, uu____10799) in - let uu____10804 = - let uu____10813 = - let uu____10820 = short_bin_op op_or_t in - (FStar_Parser_Const.or_lid, uu____10820) in - let uu____10825 = - let uu____10834 = - let uu____10841 = short_bin_op op_imp_t in - (FStar_Parser_Const.imp_lid, uu____10841) in - [uu____10834; (FStar_Parser_Const.ite_lid, short_op_ite)] in - uu____10813 :: uu____10825 in - uu____10792 :: uu____10804 in - uu____10771 :: uu____10783 in - uu____10750 :: uu____10762 in + let uu____10829 = + let uu____10836 = short_bin_op op_and_e in + (FStar_Parser_Const.op_And, uu____10836) in + let uu____10841 = + let uu____10850 = + let uu____10857 = short_bin_op op_or_e in + (FStar_Parser_Const.op_Or, uu____10857) in + let uu____10862 = + let uu____10871 = + let uu____10878 = short_bin_op op_and_t in + (FStar_Parser_Const.and_lid, uu____10878) in + let uu____10883 = + let uu____10892 = + let uu____10899 = short_bin_op op_or_t in + (FStar_Parser_Const.or_lid, uu____10899) in + let uu____10904 = + let uu____10913 = + let uu____10920 = short_bin_op op_imp_t in + (FStar_Parser_Const.imp_lid, uu____10920) in + [uu____10913; (FStar_Parser_Const.ite_lid, short_op_ite)] in + uu____10892 :: uu____10904 in + uu____10871 :: uu____10883 in + uu____10850 :: uu____10862 in + uu____10829 :: uu____10841 in match head1.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Tm_fvar fv -> let lid = (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in - let uu____10892 = + let uu____10971 = FStar_Util.find_map table - (fun uu____10905 -> - match uu____10905 with + (fun uu____10984 -> + match uu____10984 with | (x,mk1) -> if FStar_Ident.lid_equals x lid then - let uu____10922 = mk1 seen_args in - FStar_Pervasives_Native.Some uu____10922 + let uu____11001 = mk1 seen_args in + FStar_Pervasives_Native.Some uu____11001 else FStar_Pervasives_Native.None) in - (match uu____10892 with + (match uu____10971 with | FStar_Pervasives_Native.None -> FStar_TypeChecker_Common.Trivial | FStar_Pervasives_Native.Some g -> g) - | uu____10925 -> FStar_TypeChecker_Common.Trivial + | uu____11004 -> FStar_TypeChecker_Common.Trivial let short_circuit_head: FStar_Syntax_Syntax.term -> Prims.bool = fun l -> - let uu____10929 = - let uu____10930 = FStar_Syntax_Util.un_uinst l in - uu____10930.FStar_Syntax_Syntax.n in - match uu____10929 with + let uu____11008 = + let uu____11009 = FStar_Syntax_Util.un_uinst l in + uu____11009.FStar_Syntax_Syntax.n in + match uu____11008 with | FStar_Syntax_Syntax.Tm_fvar fv -> FStar_Util.for_some (FStar_Syntax_Syntax.fv_eq_lid fv) [FStar_Parser_Const.op_And; @@ -4115,7 +3976,7 @@ let short_circuit_head: FStar_Syntax_Syntax.term -> Prims.bool = FStar_Parser_Const.or_lid; FStar_Parser_Const.imp_lid; FStar_Parser_Const.ite_lid] - | uu____10934 -> false + | uu____11013 -> false let maybe_add_implicit_binders: FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.binders -> FStar_Syntax_Syntax.binders @@ -4124,61 +3985,61 @@ let maybe_add_implicit_binders: fun bs -> let pos bs1 = match bs1 with - | (hd1,uu____10958)::uu____10959 -> + | (hd1,uu____11037)::uu____11038 -> FStar_Syntax_Syntax.range_of_bv hd1 - | uu____10970 -> FStar_TypeChecker_Env.get_range env in + | uu____11049 -> FStar_TypeChecker_Env.get_range env in match bs with - | (uu____10977,FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.Implicit uu____10978))::uu____10979 -> bs - | uu____10996 -> - let uu____10997 = FStar_TypeChecker_Env.expected_typ env in - (match uu____10997 with + | (uu____11056,FStar_Pervasives_Native.Some + (FStar_Syntax_Syntax.Implicit uu____11057))::uu____11058 -> bs + | uu____11075 -> + let uu____11076 = FStar_TypeChecker_Env.expected_typ env in + (match uu____11076 with | FStar_Pervasives_Native.None -> bs | FStar_Pervasives_Native.Some t -> - let uu____11001 = - let uu____11002 = FStar_Syntax_Subst.compress t in - uu____11002.FStar_Syntax_Syntax.n in - (match uu____11001 with - | FStar_Syntax_Syntax.Tm_arrow (bs',uu____11006) -> - let uu____11023 = + let uu____11080 = + let uu____11081 = FStar_Syntax_Subst.compress t in + uu____11081.FStar_Syntax_Syntax.n in + (match uu____11080 with + | FStar_Syntax_Syntax.Tm_arrow (bs',uu____11085) -> + let uu____11102 = FStar_Util.prefix_until - (fun uu___83_11063 -> - match uu___83_11063 with - | (uu____11070,FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.Implicit uu____11071)) -> + (fun uu___89_11142 -> + match uu___89_11142 with + | (uu____11149,FStar_Pervasives_Native.Some + (FStar_Syntax_Syntax.Implicit uu____11150)) -> false - | uu____11074 -> true) bs' in - (match uu____11023 with + | uu____11153 -> true) bs' in + (match uu____11102 with | FStar_Pervasives_Native.None -> bs | FStar_Pervasives_Native.Some - ([],uu____11109,uu____11110) -> bs + ([],uu____11188,uu____11189) -> bs | FStar_Pervasives_Native.Some - (imps,uu____11182,uu____11183) -> - let uu____11256 = + (imps,uu____11261,uu____11262) -> + let uu____11335 = FStar_All.pipe_right imps (FStar_Util.for_all - (fun uu____11274 -> - match uu____11274 with - | (x,uu____11282) -> + (fun uu____11353 -> + match uu____11353 with + | (x,uu____11361) -> FStar_Util.starts_with (x.FStar_Syntax_Syntax.ppname).FStar_Ident.idText "'")) in - if uu____11256 + if uu____11335 then let r = pos bs in let imps1 = FStar_All.pipe_right imps (FStar_List.map - (fun uu____11329 -> - match uu____11329 with + (fun uu____11408 -> + match uu____11408 with | (x,i) -> - let uu____11348 = + let uu____11427 = FStar_Syntax_Syntax.set_range_of_bv x r in - (uu____11348, i))) in + (uu____11427, i))) in FStar_List.append imps1 bs else bs) - | uu____11358 -> bs)) + | uu____11437 -> bs)) let maybe_lift: FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.term -> @@ -4217,12 +4078,12 @@ let maybe_monadic: fun c -> fun t -> let m = FStar_TypeChecker_Env.norm_eff_name env c in - let uu____11390 = + let uu____11469 = ((is_pure_or_ghost_effect env m) || (FStar_Ident.lid_equals m FStar_Parser_Const.effect_Tot_lid)) || (FStar_Ident.lid_equals m FStar_Parser_Const.effect_GTot_lid) in - if uu____11390 + if uu____11469 then e else FStar_Syntax_Syntax.mk @@ -4241,18 +4102,18 @@ let mk_toplevel_definition: fun env -> fun lident -> fun def -> - (let uu____11413 = + (let uu____11492 = FStar_TypeChecker_Env.debug env (FStar_Options.Other "ED") in - if uu____11413 + if uu____11492 then (d (FStar_Ident.text_of_lid lident); - (let uu____11415 = FStar_Syntax_Print.term_to_string def in + (let uu____11494 = FStar_Syntax_Print.term_to_string def in FStar_Util.print2 "Registering top-level definition: %s\n%s\n" - (FStar_Ident.text_of_lid lident) uu____11415)) + (FStar_Ident.text_of_lid lident) uu____11494)) else ()); (let fv = - let uu____11418 = FStar_Syntax_Util.incr_delta_qualifier def in - FStar_Syntax_Syntax.lid_as_fv lident uu____11418 + let uu____11497 = FStar_Syntax_Util.incr_delta_qualifier def in + FStar_Syntax_Syntax.lid_as_fv lident uu____11497 FStar_Pervasives_Native.None in let lbname = FStar_Util.Inr fv in let lb = @@ -4267,63 +4128,63 @@ let mk_toplevel_definition: let sig_ctx = FStar_Syntax_Syntax.mk_sigelt (FStar_Syntax_Syntax.Sig_let (lb, [lident])) in - let uu____11426 = + let uu____11505 = FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_fvar fv) FStar_Pervasives_Native.None FStar_Range.dummyRange in - ((let uu___123_11432 = sig_ctx in + ((let uu___123_11511 = sig_ctx in { FStar_Syntax_Syntax.sigel = - (uu___123_11432.FStar_Syntax_Syntax.sigel); + (uu___123_11511.FStar_Syntax_Syntax.sigel); FStar_Syntax_Syntax.sigrng = - (uu___123_11432.FStar_Syntax_Syntax.sigrng); + (uu___123_11511.FStar_Syntax_Syntax.sigrng); FStar_Syntax_Syntax.sigquals = [FStar_Syntax_Syntax.Unfold_for_unification_and_vcgen]; FStar_Syntax_Syntax.sigmeta = - (uu___123_11432.FStar_Syntax_Syntax.sigmeta); + (uu___123_11511.FStar_Syntax_Syntax.sigmeta); FStar_Syntax_Syntax.sigattrs = - (uu___123_11432.FStar_Syntax_Syntax.sigattrs) - }), uu____11426)) + (uu___123_11511.FStar_Syntax_Syntax.sigattrs) + }), uu____11505)) let check_sigelt_quals: FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.sigelt -> Prims.unit = fun env -> fun se -> - let visibility uu___84_11442 = - match uu___84_11442 with + let visibility uu___90_11521 = + match uu___90_11521 with | FStar_Syntax_Syntax.Private -> true - | uu____11443 -> false in - let reducibility uu___85_11447 = - match uu___85_11447 with + | uu____11522 -> false in + let reducibility uu___91_11526 = + match uu___91_11526 with | FStar_Syntax_Syntax.Abstract -> true | FStar_Syntax_Syntax.Irreducible -> true | FStar_Syntax_Syntax.Unfold_for_unification_and_vcgen -> true | FStar_Syntax_Syntax.Visible_default -> true | FStar_Syntax_Syntax.Inline_for_extraction -> true - | uu____11448 -> false in - let assumption uu___86_11452 = - match uu___86_11452 with + | uu____11527 -> false in + let assumption uu___92_11531 = + match uu___92_11531 with | FStar_Syntax_Syntax.Assumption -> true | FStar_Syntax_Syntax.New -> true - | uu____11453 -> false in - let reification uu___87_11457 = - match uu___87_11457 with + | uu____11532 -> false in + let reification uu___93_11536 = + match uu___93_11536 with | FStar_Syntax_Syntax.Reifiable -> true - | FStar_Syntax_Syntax.Reflectable uu____11458 -> true - | uu____11459 -> false in - let inferred uu___88_11463 = - match uu___88_11463 with - | FStar_Syntax_Syntax.Discriminator uu____11464 -> true - | FStar_Syntax_Syntax.Projector uu____11465 -> true - | FStar_Syntax_Syntax.RecordType uu____11470 -> true - | FStar_Syntax_Syntax.RecordConstructor uu____11479 -> true + | FStar_Syntax_Syntax.Reflectable uu____11537 -> true + | uu____11538 -> false in + let inferred uu___94_11542 = + match uu___94_11542 with + | FStar_Syntax_Syntax.Discriminator uu____11543 -> true + | FStar_Syntax_Syntax.Projector uu____11544 -> true + | FStar_Syntax_Syntax.RecordType uu____11549 -> true + | FStar_Syntax_Syntax.RecordConstructor uu____11558 -> true | FStar_Syntax_Syntax.ExceptionConstructor -> true | FStar_Syntax_Syntax.HasMaskedEffect -> true | FStar_Syntax_Syntax.Effect -> true - | uu____11488 -> false in - let has_eq uu___89_11492 = - match uu___89_11492 with + | uu____11567 -> false in + let has_eq uu___95_11571 = + match uu___95_11571 with | FStar_Syntax_Syntax.Noeq -> true | FStar_Syntax_Syntax.Unopteq -> true - | uu____11493 -> false in + | uu____11572 -> false in let quals_combo_ok quals q = match q with | FStar_Syntax_Syntax.Assumption -> @@ -4435,71 +4296,71 @@ let check_sigelt_quals: (fun x -> (((reification x) || (inferred x)) || (visibility x)) || (x = FStar_Syntax_Syntax.TotalEffect))) - | FStar_Syntax_Syntax.Reflectable uu____11553 -> + | FStar_Syntax_Syntax.Reflectable uu____11632 -> FStar_All.pipe_right quals (FStar_List.for_all (fun x -> (((reification x) || (inferred x)) || (visibility x)) || (x = FStar_Syntax_Syntax.TotalEffect))) | FStar_Syntax_Syntax.Private -> true - | uu____11558 -> true in + | uu____11637 -> true in let quals = FStar_Syntax_Util.quals_of_sigelt se in - let uu____11562 = - let uu____11563 = + let uu____11641 = + let uu____11642 = FStar_All.pipe_right quals (FStar_Util.for_some - (fun uu___90_11567 -> - match uu___90_11567 with + (fun uu___96_11646 -> + match uu___96_11646 with | FStar_Syntax_Syntax.OnlyName -> true - | uu____11568 -> false)) in - FStar_All.pipe_right uu____11563 Prims.op_Negation in - if uu____11562 + | uu____11647 -> false)) in + FStar_All.pipe_right uu____11642 Prims.op_Negation in + if uu____11641 then let r = FStar_Syntax_Util.range_of_sigelt se in let no_dup_quals = FStar_Util.remove_dups (fun x -> fun y -> x = y) quals in let err' msg = - let uu____11581 = - let uu____11586 = - let uu____11587 = FStar_Syntax_Print.quals_to_string quals in + let uu____11660 = + let uu____11665 = + let uu____11666 = FStar_Syntax_Print.quals_to_string quals in FStar_Util.format2 "The qualifier list \"[%s]\" is not permissible for this element%s" - uu____11587 msg in - (FStar_Errors.Fatal_QulifierListNotPermitted, uu____11586) in - FStar_Errors.raise_error uu____11581 r in + uu____11666 msg in + (FStar_Errors.Fatal_QulifierListNotPermitted, uu____11665) in + FStar_Errors.raise_error uu____11660 r in let err msg = err' (Prims.strcat ": " msg) in - let err'1 uu____11595 = err' "" in + let err'1 uu____11674 = err' "" in (if (FStar_List.length quals) <> (FStar_List.length no_dup_quals) then err "duplicate qualifiers" else (); - (let uu____11599 = - let uu____11600 = + (let uu____11678 = + let uu____11679 = FStar_All.pipe_right quals (FStar_List.for_all (quals_combo_ok quals)) in - Prims.op_Negation uu____11600 in - if uu____11599 then err "ill-formed combination" else ()); + Prims.op_Negation uu____11679 in + if uu____11678 then err "ill-formed combination" else ()); (match se.FStar_Syntax_Syntax.sigel with - | FStar_Syntax_Syntax.Sig_let ((is_rec,uu____11605),uu____11606) -> - ((let uu____11622 = + | FStar_Syntax_Syntax.Sig_let ((is_rec,uu____11684),uu____11685) -> + ((let uu____11701 = is_rec && (FStar_All.pipe_right quals (FStar_List.contains FStar_Syntax_Syntax.Unfold_for_unification_and_vcgen)) in - if uu____11622 + if uu____11701 then err "recursive definitions cannot be marked inline" else ()); - (let uu____11626 = + (let uu____11705 = FStar_All.pipe_right quals (FStar_Util.for_some (fun x -> (assumption x) || (has_eq x))) in - if uu____11626 + if uu____11705 then err "definitions cannot be assumed or marked with equality qualifiers" else ())) - | FStar_Syntax_Syntax.Sig_bundle uu____11632 -> - let uu____11641 = - let uu____11642 = + | FStar_Syntax_Syntax.Sig_bundle uu____11711 -> + let uu____11720 = + let uu____11721 = FStar_All.pipe_right quals (FStar_Util.for_all (fun x -> @@ -4507,25 +4368,25 @@ let check_sigelt_quals: (inferred x)) || (visibility x)) || (has_eq x))) in - Prims.op_Negation uu____11642 in - if uu____11641 then err'1 () else () - | FStar_Syntax_Syntax.Sig_declare_typ uu____11648 -> - let uu____11655 = + Prims.op_Negation uu____11721 in + if uu____11720 then err'1 () else () + | FStar_Syntax_Syntax.Sig_declare_typ uu____11727 -> + let uu____11734 = FStar_All.pipe_right quals (FStar_Util.for_some has_eq) in - if uu____11655 then err'1 () else () - | FStar_Syntax_Syntax.Sig_assume uu____11659 -> - let uu____11666 = - let uu____11667 = + if uu____11734 then err'1 () else () + | FStar_Syntax_Syntax.Sig_assume uu____11738 -> + let uu____11745 = + let uu____11746 = FStar_All.pipe_right quals (FStar_Util.for_all (fun x -> (visibility x) || (x = FStar_Syntax_Syntax.Assumption))) in - Prims.op_Negation uu____11667 in - if uu____11666 then err'1 () else () - | FStar_Syntax_Syntax.Sig_new_effect uu____11673 -> - let uu____11674 = - let uu____11675 = + Prims.op_Negation uu____11746 in + if uu____11745 then err'1 () else () + | FStar_Syntax_Syntax.Sig_new_effect uu____11752 -> + let uu____11753 = + let uu____11754 = FStar_All.pipe_right quals (FStar_Util.for_all (fun x -> @@ -4533,11 +4394,11 @@ let check_sigelt_quals: (inferred x)) || (visibility x)) || (reification x))) in - Prims.op_Negation uu____11675 in - if uu____11674 then err'1 () else () - | FStar_Syntax_Syntax.Sig_new_effect_for_free uu____11681 -> - let uu____11682 = - let uu____11683 = + Prims.op_Negation uu____11754 in + if uu____11753 then err'1 () else () + | FStar_Syntax_Syntax.Sig_new_effect_for_free uu____11760 -> + let uu____11761 = + let uu____11762 = FStar_All.pipe_right quals (FStar_Util.for_all (fun x -> @@ -4545,17 +4406,17 @@ let check_sigelt_quals: (inferred x)) || (visibility x)) || (reification x))) in - Prims.op_Negation uu____11683 in - if uu____11682 then err'1 () else () - | FStar_Syntax_Syntax.Sig_effect_abbrev uu____11689 -> - let uu____11702 = - let uu____11703 = + Prims.op_Negation uu____11762 in + if uu____11761 then err'1 () else () + | FStar_Syntax_Syntax.Sig_effect_abbrev uu____11768 -> + let uu____11781 = + let uu____11782 = FStar_All.pipe_right quals (FStar_Util.for_all (fun x -> (inferred x) || (visibility x))) in - Prims.op_Negation uu____11703 in - if uu____11702 then err'1 () else () - | uu____11709 -> ())) + Prims.op_Negation uu____11782 in + if uu____11781 then err'1 () else () + | uu____11788 -> ())) else () let mk_discriminator_and_indexed_projectors: FStar_Syntax_Syntax.qualifier Prims.list -> @@ -4591,34 +4452,34 @@ let mk_discriminator_and_indexed_projectors: let tps = inductive_tps in let arg_typ = let inst_tc = - let uu____11772 = - let uu____11775 = - let uu____11776 = - let uu____11783 = - let uu____11784 = + let uu____11851 = + let uu____11854 = + let uu____11855 = + let uu____11862 = + let uu____11863 = FStar_Syntax_Syntax.lid_as_fv tc FStar_Syntax_Syntax.Delta_constant FStar_Pervasives_Native.None in - FStar_Syntax_Syntax.fv_to_tm uu____11784 in - (uu____11783, inst_univs) in - FStar_Syntax_Syntax.Tm_uinst uu____11776 in - FStar_Syntax_Syntax.mk uu____11775 in - uu____11772 FStar_Pervasives_Native.None p in + FStar_Syntax_Syntax.fv_to_tm uu____11863 in + (uu____11862, inst_univs) in + FStar_Syntax_Syntax.Tm_uinst uu____11855 in + FStar_Syntax_Syntax.mk uu____11854 in + uu____11851 FStar_Pervasives_Native.None p in let args = FStar_All.pipe_right (FStar_List.append tps indices) (FStar_List.map - (fun uu____11825 -> - match uu____11825 with + (fun uu____11904 -> + match uu____11904 with | (x,imp) -> - let uu____11836 = + let uu____11915 = FStar_Syntax_Syntax.bv_to_name x in - (uu____11836, imp))) in + (uu____11915, imp))) in FStar_Syntax_Syntax.mk_Tm_app inst_tc args FStar_Pervasives_Native.None p in let unrefined_arg_binder = - let uu____11838 = projectee arg_typ in - FStar_Syntax_Syntax.mk_binder uu____11838 in + let uu____11917 = projectee arg_typ in + FStar_Syntax_Syntax.mk_binder uu____11917 in let arg_binder = if Prims.op_Negation refine_domain then unrefined_arg_binder @@ -4634,52 +4495,52 @@ let mk_discriminator_and_indexed_projectors: (FStar_Ident.set_lid_range disc_name p) FStar_Syntax_Syntax.Delta_equational FStar_Pervasives_Native.None in - let uu____11847 = - let uu____11848 = - let uu____11849 = - let uu____11850 = + let uu____11926 = + let uu____11927 = + let uu____11928 = + let uu____11929 = FStar_Syntax_Syntax.mk_Tm_uinst disc_fvar inst_univs in - let uu____11851 = - let uu____11852 = - let uu____11853 = + let uu____11930 = + let uu____11931 = + let uu____11932 = FStar_Syntax_Syntax.bv_to_name x in FStar_All.pipe_left FStar_Syntax_Syntax.as_arg - uu____11853 in - [uu____11852] in - FStar_Syntax_Syntax.mk_Tm_app uu____11850 - uu____11851 in - uu____11849 FStar_Pervasives_Native.None p in - FStar_Syntax_Util.b2t uu____11848 in - FStar_Syntax_Util.refine x uu____11847 in - let uu____11856 = - let uu___124_11857 = projectee arg_typ in + uu____11932 in + [uu____11931] in + FStar_Syntax_Syntax.mk_Tm_app uu____11929 + uu____11930 in + uu____11928 FStar_Pervasives_Native.None p in + FStar_Syntax_Util.b2t uu____11927 in + FStar_Syntax_Util.refine x uu____11926 in + let uu____11935 = + let uu___124_11936 = projectee arg_typ in { FStar_Syntax_Syntax.ppname = - (uu___124_11857.FStar_Syntax_Syntax.ppname); + (uu___124_11936.FStar_Syntax_Syntax.ppname); FStar_Syntax_Syntax.index = - (uu___124_11857.FStar_Syntax_Syntax.index); + (uu___124_11936.FStar_Syntax_Syntax.index); FStar_Syntax_Syntax.sort = sort } in - FStar_Syntax_Syntax.mk_binder uu____11856) in + FStar_Syntax_Syntax.mk_binder uu____11935) in let ntps = FStar_List.length tps in let all_params = - let uu____11872 = + let uu____11951 = FStar_List.map - (fun uu____11894 -> - match uu____11894 with - | (x,uu____11906) -> + (fun uu____11973 -> + match uu____11973 with + | (x,uu____11985) -> (x, (FStar_Pervasives_Native.Some FStar_Syntax_Syntax.imp_tag))) tps in - FStar_List.append uu____11872 fields in + FStar_List.append uu____11951 fields in let imp_binders = FStar_All.pipe_right (FStar_List.append tps indices) (FStar_List.map - (fun uu____11955 -> - match uu____11955 with - | (x,uu____11967) -> + (fun uu____12034 -> + match uu____12034 with + | (x,uu____12046) -> (x, (FStar_Pervasives_Native.Some FStar_Syntax_Syntax.imp_tag)))) in @@ -4691,59 +4552,59 @@ let mk_discriminator_and_indexed_projectors: FStar_Syntax_Util.mk_discriminator lid in let no_decl = false in let only_decl = - (let uu____11981 = + (let uu____12060 = FStar_TypeChecker_Env.current_module env in FStar_Ident.lid_equals - FStar_Parser_Const.prims_lid uu____11981) + FStar_Parser_Const.prims_lid uu____12060) || - (let uu____11983 = - let uu____11984 = + (let uu____12062 = + let uu____12063 = FStar_TypeChecker_Env.current_module env in - uu____11984.FStar_Ident.str in - FStar_Options.dont_gen_projectors uu____11983) in + uu____12063.FStar_Ident.str in + FStar_Options.dont_gen_projectors uu____12062) in let quals = - let uu____11988 = - let uu____11991 = - let uu____11994 = + let uu____12067 = + let uu____12070 = + let uu____12073 = only_decl && ((FStar_All.pipe_left Prims.op_Negation env.FStar_TypeChecker_Env.is_iface) || env.FStar_TypeChecker_Env.admit) in - if uu____11994 + if uu____12073 then [FStar_Syntax_Syntax.Assumption] else [] in - let uu____11998 = + let uu____12077 = FStar_List.filter - (fun uu___91_12002 -> - match uu___91_12002 with + (fun uu___97_12081 -> + match uu___97_12081 with | FStar_Syntax_Syntax.Abstract -> Prims.op_Negation only_decl | FStar_Syntax_Syntax.Private -> true - | uu____12003 -> false) iquals in - FStar_List.append uu____11991 uu____11998 in + | uu____12082 -> false) iquals in + FStar_List.append uu____12070 uu____12077 in FStar_List.append ((FStar_Syntax_Syntax.Discriminator lid) :: (if only_decl then [FStar_Syntax_Syntax.Logic] - else [])) uu____11988 in + else [])) uu____12067 in let binders = FStar_List.append imp_binders [unrefined_arg_binder] in let t = let bool_typ = - let uu____12024 = - let uu____12025 = + let uu____12103 = + let uu____12104 = FStar_Syntax_Syntax.lid_as_fv FStar_Parser_Const.bool_lid FStar_Syntax_Syntax.Delta_constant FStar_Pervasives_Native.None in - FStar_Syntax_Syntax.fv_to_tm uu____12025 in - FStar_Syntax_Syntax.mk_Total uu____12024 in - let uu____12026 = + FStar_Syntax_Syntax.fv_to_tm uu____12104 in + FStar_Syntax_Syntax.mk_Total uu____12103 in + let uu____12105 = FStar_Syntax_Util.arrow binders bool_typ in FStar_All.pipe_left (FStar_Syntax_Subst.close_univ_vars uvs) - uu____12026 in + uu____12105 in let decl = { FStar_Syntax_Syntax.sigel = @@ -4756,16 +4617,16 @@ let mk_discriminator_and_indexed_projectors: FStar_Syntax_Syntax.default_sigmeta; FStar_Syntax_Syntax.sigattrs = [] } in - (let uu____12029 = + (let uu____12108 = FStar_TypeChecker_Env.debug env (FStar_Options.Other "LogTypes") in - if uu____12029 + if uu____12108 then - let uu____12030 = + let uu____12109 = FStar_Syntax_Print.sigelt_to_string decl in FStar_Util.print1 "Declaration of a discriminator %s\n" - uu____12030 + uu____12109 else ()); if only_decl then [decl] @@ -4778,98 +4639,98 @@ let mk_discriminator_and_indexed_projectors: FStar_All.pipe_right all_params (FStar_List.mapi (fun j -> - fun uu____12083 -> - match uu____12083 with + fun uu____12162 -> + match uu____12162 with | (x,imp) -> let b = FStar_Syntax_Syntax.is_implicit imp in if b && (j < ntps) then - let uu____12107 = - let uu____12110 = - let uu____12111 = - let uu____12118 = + let uu____12186 = + let uu____12189 = + let uu____12190 = + let uu____12197 = FStar_Syntax_Syntax.gen_bv (x.FStar_Syntax_Syntax.ppname).FStar_Ident.idText FStar_Pervasives_Native.None FStar_Syntax_Syntax.tun in - (uu____12118, + (uu____12197, FStar_Syntax_Syntax.tun) in FStar_Syntax_Syntax.Pat_dot_term - uu____12111 in - pos uu____12110 in - (uu____12107, b) + uu____12190 in + pos uu____12189 in + (uu____12186, b) else - (let uu____12122 = - let uu____12125 = - let uu____12126 = + (let uu____12201 = + let uu____12204 = + let uu____12205 = FStar_Syntax_Syntax.gen_bv (x.FStar_Syntax_Syntax.ppname).FStar_Ident.idText FStar_Pervasives_Native.None FStar_Syntax_Syntax.tun in FStar_Syntax_Syntax.Pat_wild - uu____12126 in - pos uu____12125 in - (uu____12122, b)))) in + uu____12205 in + pos uu____12204 in + (uu____12201, b)))) in let pat_true = - let uu____12144 = - let uu____12147 = - let uu____12148 = - let uu____12161 = + let uu____12223 = + let uu____12226 = + let uu____12227 = + let uu____12240 = FStar_Syntax_Syntax.lid_as_fv lid FStar_Syntax_Syntax.Delta_constant (FStar_Pervasives_Native.Some fvq) in - (uu____12161, arg_pats) in + (uu____12240, arg_pats) in FStar_Syntax_Syntax.Pat_cons - uu____12148 in - pos uu____12147 in - (uu____12144, + uu____12227 in + pos uu____12226 in + (uu____12223, FStar_Pervasives_Native.None, FStar_Syntax_Util.exp_true_bool) in let pat_false = - let uu____12195 = - let uu____12198 = - let uu____12199 = + let uu____12274 = + let uu____12277 = + let uu____12278 = FStar_Syntax_Syntax.new_bv FStar_Pervasives_Native.None FStar_Syntax_Syntax.tun in FStar_Syntax_Syntax.Pat_wild - uu____12199 in - pos uu____12198 in - (uu____12195, + uu____12278 in + pos uu____12277 in + (uu____12274, FStar_Pervasives_Native.None, FStar_Syntax_Util.exp_false_bool) in let arg_exp = FStar_Syntax_Syntax.bv_to_name (FStar_Pervasives_Native.fst unrefined_arg_binder) in - let uu____12211 = - let uu____12214 = - let uu____12215 = - let uu____12238 = - let uu____12241 = + let uu____12290 = + let uu____12293 = + let uu____12294 = + let uu____12317 = + let uu____12320 = FStar_Syntax_Util.branch pat_true in - let uu____12242 = - let uu____12245 = + let uu____12321 = + let uu____12324 = FStar_Syntax_Util.branch pat_false in - [uu____12245] in - uu____12241 :: uu____12242 in - (arg_exp, uu____12238) in + [uu____12324] in + uu____12320 :: uu____12321 in + (arg_exp, uu____12317) in FStar_Syntax_Syntax.Tm_match - uu____12215 in - FStar_Syntax_Syntax.mk uu____12214 in - uu____12211 FStar_Pervasives_Native.None p) in + uu____12294 in + FStar_Syntax_Syntax.mk uu____12293 in + uu____12290 FStar_Pervasives_Native.None p) in let dd = - let uu____12252 = + let uu____12331 = FStar_All.pipe_right quals (FStar_List.contains FStar_Syntax_Syntax.Abstract) in - if uu____12252 + if uu____12331 then FStar_Syntax_Syntax.Delta_abstract FStar_Syntax_Syntax.Delta_equational @@ -4882,55 +4743,55 @@ let mk_discriminator_and_indexed_projectors: then t else FStar_Syntax_Syntax.tun in let lb = - let uu____12260 = - let uu____12265 = + let uu____12339 = + let uu____12344 = FStar_Syntax_Syntax.lid_as_fv discriminator_name dd FStar_Pervasives_Native.None in - FStar_Util.Inr uu____12265 in - let uu____12266 = + FStar_Util.Inr uu____12344 in + let uu____12345 = FStar_Syntax_Subst.close_univ_vars uvs imp in { - FStar_Syntax_Syntax.lbname = uu____12260; + FStar_Syntax_Syntax.lbname = uu____12339; FStar_Syntax_Syntax.lbunivs = uvs; FStar_Syntax_Syntax.lbtyp = lbtyp; FStar_Syntax_Syntax.lbeff = FStar_Parser_Const.effect_Tot_lid; - FStar_Syntax_Syntax.lbdef = uu____12266 + FStar_Syntax_Syntax.lbdef = uu____12345 } in let impl = - let uu____12270 = - let uu____12271 = - let uu____12278 = - let uu____12281 = - let uu____12282 = + let uu____12349 = + let uu____12350 = + let uu____12357 = + let uu____12360 = + let uu____12361 = FStar_All.pipe_right lb.FStar_Syntax_Syntax.lbname FStar_Util.right in - FStar_All.pipe_right uu____12282 + FStar_All.pipe_right uu____12361 (fun fv -> (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v) in - [uu____12281] in - ((false, [lb]), uu____12278) in - FStar_Syntax_Syntax.Sig_let uu____12271 in + [uu____12360] in + ((false, [lb]), uu____12357) in + FStar_Syntax_Syntax.Sig_let uu____12350 in { - FStar_Syntax_Syntax.sigel = uu____12270; + FStar_Syntax_Syntax.sigel = uu____12349; FStar_Syntax_Syntax.sigrng = p; FStar_Syntax_Syntax.sigquals = quals; FStar_Syntax_Syntax.sigmeta = FStar_Syntax_Syntax.default_sigmeta; FStar_Syntax_Syntax.sigattrs = [] } in - (let uu____12300 = + (let uu____12379 = FStar_TypeChecker_Env.debug env (FStar_Options.Other "LogTypes") in - if uu____12300 + if uu____12379 then - let uu____12301 = + let uu____12380 = FStar_Syntax_Print.sigelt_to_string impl in FStar_Util.print1 "Implementation of a discriminator %s\n" - uu____12301 + uu____12380 else ()); [decl; impl])) in let arg_exp = @@ -4944,102 +4805,102 @@ let mk_discriminator_and_indexed_projectors: FStar_All.pipe_right fields (FStar_List.mapi (fun i -> - fun uu____12343 -> - match uu____12343 with - | (a,uu____12349) -> - let uu____12350 = + fun uu____12422 -> + match uu____12422 with + | (a,uu____12428) -> + let uu____12429 = FStar_Syntax_Util.mk_field_projector_name lid a i in - (match uu____12350 with - | (field_name,uu____12356) -> + (match uu____12429 with + | (field_name,uu____12435) -> let field_proj_tm = - let uu____12358 = - let uu____12359 = + let uu____12437 = + let uu____12438 = FStar_Syntax_Syntax.lid_as_fv field_name FStar_Syntax_Syntax.Delta_equational FStar_Pervasives_Native.None in FStar_Syntax_Syntax.fv_to_tm - uu____12359 in + uu____12438 in FStar_Syntax_Syntax.mk_Tm_uinst - uu____12358 inst_univs in + uu____12437 inst_univs in let proj = FStar_Syntax_Syntax.mk_Tm_app field_proj_tm [arg] FStar_Pervasives_Native.None p in FStar_Syntax_Syntax.NT (a, proj)))) in let projectors_ses = - let uu____12376 = + let uu____12455 = FStar_All.pipe_right fields (FStar_List.mapi (fun i -> - fun uu____12408 -> - match uu____12408 with - | (x,uu____12416) -> + fun uu____12487 -> + match uu____12487 with + | (x,uu____12495) -> let p1 = FStar_Syntax_Syntax.range_of_bv x in - let uu____12418 = + let uu____12497 = FStar_Syntax_Util.mk_field_projector_name lid x i in - (match uu____12418 with - | (field_name,uu____12426) -> + (match uu____12497 with + | (field_name,uu____12505) -> let t = - let uu____12428 = - let uu____12429 = - let uu____12432 = + let uu____12507 = + let uu____12508 = + let uu____12511 = FStar_Syntax_Subst.subst subst1 x.FStar_Syntax_Syntax.sort in FStar_Syntax_Syntax.mk_Total - uu____12432 in + uu____12511 in FStar_Syntax_Util.arrow - binders uu____12429 in + binders uu____12508 in FStar_All.pipe_left (FStar_Syntax_Subst.close_univ_vars - uvs) uu____12428 in + uvs) uu____12507 in let only_decl = - (let uu____12436 = + (let uu____12515 = FStar_TypeChecker_Env.current_module env in FStar_Ident.lid_equals FStar_Parser_Const.prims_lid - uu____12436) + uu____12515) || - (let uu____12438 = - let uu____12439 = + (let uu____12517 = + let uu____12518 = FStar_TypeChecker_Env.current_module env in - uu____12439.FStar_Ident.str in + uu____12518.FStar_Ident.str in FStar_Options.dont_gen_projectors - uu____12438) in + uu____12517) in let no_decl = false in let quals q = if only_decl then - let uu____12453 = + let uu____12532 = FStar_List.filter - (fun uu___92_12457 -> - match uu___92_12457 + (fun uu___98_12536 -> + match uu___98_12536 with | FStar_Syntax_Syntax.Abstract -> false - | uu____12458 -> true) + | uu____12537 -> true) q in FStar_Syntax_Syntax.Assumption - :: uu____12453 + :: uu____12532 else q in let quals1 = let iquals1 = FStar_All.pipe_right iquals (FStar_List.filter - (fun uu___93_12471 -> - match uu___93_12471 + (fun uu___99_12550 -> + match uu___99_12550 with | FStar_Syntax_Syntax.Abstract -> true | FStar_Syntax_Syntax.Private -> true - | uu____12472 -> + | uu____12551 -> false)) in quals ((FStar_Syntax_Syntax.Projector @@ -5067,19 +4928,19 @@ let mk_discriminator_and_indexed_projectors: FStar_Syntax_Syntax.sigattrs = attrs } in - ((let uu____12491 = + ((let uu____12570 = FStar_TypeChecker_Env.debug env (FStar_Options.Other "LogTypes") in - if uu____12491 + if uu____12570 then - let uu____12492 = + let uu____12571 = FStar_Syntax_Print.sigelt_to_string decl in FStar_Util.print1 "Declaration of a projector %s\n" - uu____12492 + uu____12571 else ()); if only_decl then [decl] @@ -5094,9 +4955,9 @@ let mk_discriminator_and_indexed_projectors: all_params (FStar_List.mapi (fun j -> - fun uu____12540 + fun uu____12619 -> - match uu____12540 + match uu____12619 with | (x1,imp) -> let b = @@ -5106,92 +4967,92 @@ let mk_discriminator_and_indexed_projectors: (i + ntps) = j then - let uu____12564 + let uu____12643 = pos (FStar_Syntax_Syntax.Pat_var projection) in - (uu____12564, + (uu____12643, b) else if b && (j < ntps) then - (let uu____12580 + (let uu____12659 = - let uu____12583 + let uu____12662 = - let uu____12584 + let uu____12663 = - let uu____12591 + let uu____12670 = FStar_Syntax_Syntax.gen_bv (x1.FStar_Syntax_Syntax.ppname).FStar_Ident.idText FStar_Pervasives_Native.None FStar_Syntax_Syntax.tun in - (uu____12591, + (uu____12670, FStar_Syntax_Syntax.tun) in FStar_Syntax_Syntax.Pat_dot_term - uu____12584 in + uu____12663 in pos - uu____12583 in - (uu____12580, + uu____12662 in + (uu____12659, b)) else - (let uu____12595 + (let uu____12674 = - let uu____12598 + let uu____12677 = - let uu____12599 + let uu____12678 = FStar_Syntax_Syntax.gen_bv (x1.FStar_Syntax_Syntax.ppname).FStar_Ident.idText FStar_Pervasives_Native.None FStar_Syntax_Syntax.tun in FStar_Syntax_Syntax.Pat_wild - uu____12599 in + uu____12678 in pos - uu____12598 in - (uu____12595, + uu____12677 in + (uu____12674, b)))) in let pat = - let uu____12615 = - let uu____12618 = - let uu____12619 = - let uu____12632 = + let uu____12694 = + let uu____12697 = + let uu____12698 = + let uu____12711 = FStar_Syntax_Syntax.lid_as_fv lid FStar_Syntax_Syntax.Delta_constant (FStar_Pervasives_Native.Some fvq) in - (uu____12632, + (uu____12711, arg_pats) in FStar_Syntax_Syntax.Pat_cons - uu____12619 in - pos uu____12618 in - let uu____12641 = + uu____12698 in + pos uu____12697 in + let uu____12720 = FStar_Syntax_Syntax.bv_to_name projection in - (uu____12615, + (uu____12694, FStar_Pervasives_Native.None, - uu____12641) in + uu____12720) in let body = - let uu____12653 = - let uu____12656 = - let uu____12657 = - let uu____12680 = - let uu____12683 = + let uu____12732 = + let uu____12735 = + let uu____12736 = + let uu____12759 = + let uu____12762 = FStar_Syntax_Util.branch pat in - [uu____12683] in + [uu____12762] in (arg_exp, - uu____12680) in + uu____12759) in FStar_Syntax_Syntax.Tm_match - uu____12657 in + uu____12736 in FStar_Syntax_Syntax.mk - uu____12656 in - uu____12653 + uu____12735 in + uu____12732 FStar_Pervasives_Native.None p1 in let imp = @@ -5199,12 +5060,12 @@ let mk_discriminator_and_indexed_projectors: binders body FStar_Pervasives_Native.None in let dd = - let uu____12691 = + let uu____12770 = FStar_All.pipe_right quals1 (FStar_List.contains FStar_Syntax_Syntax.Abstract) in - if uu____12691 + if uu____12770 then FStar_Syntax_Syntax.Delta_abstract FStar_Syntax_Syntax.Delta_equational @@ -5216,19 +5077,19 @@ let mk_discriminator_and_indexed_projectors: else FStar_Syntax_Syntax.tun in let lb = - let uu____12698 = - let uu____12703 = + let uu____12777 = + let uu____12782 = FStar_Syntax_Syntax.lid_as_fv field_name dd FStar_Pervasives_Native.None in FStar_Util.Inr - uu____12703 in - let uu____12704 = + uu____12782 in + let uu____12783 = FStar_Syntax_Subst.close_univ_vars uvs imp in { FStar_Syntax_Syntax.lbname - = uu____12698; + = uu____12777; FStar_Syntax_Syntax.lbunivs = uvs; FStar_Syntax_Syntax.lbtyp @@ -5237,29 +5098,29 @@ let mk_discriminator_and_indexed_projectors: = FStar_Parser_Const.effect_Tot_lid; FStar_Syntax_Syntax.lbdef - = uu____12704 + = uu____12783 } in let impl = - let uu____12708 = - let uu____12709 = - let uu____12716 = - let uu____12719 = - let uu____12720 = + let uu____12787 = + let uu____12788 = + let uu____12795 = + let uu____12798 = + let uu____12799 = FStar_All.pipe_right lb.FStar_Syntax_Syntax.lbname FStar_Util.right in FStar_All.pipe_right - uu____12720 + uu____12799 (fun fv -> (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v) in - [uu____12719] in + [uu____12798] in ((false, [lb]), - uu____12716) in + uu____12795) in FStar_Syntax_Syntax.Sig_let - uu____12709 in + uu____12788 in { FStar_Syntax_Syntax.sigel - = uu____12708; + = uu____12787; FStar_Syntax_Syntax.sigrng = p1; FStar_Syntax_Syntax.sigquals @@ -5270,24 +5131,24 @@ let mk_discriminator_and_indexed_projectors: FStar_Syntax_Syntax.sigattrs = attrs } in - (let uu____12738 = + (let uu____12817 = FStar_TypeChecker_Env.debug env (FStar_Options.Other "LogTypes") in - if uu____12738 + if uu____12817 then - let uu____12739 = + let uu____12818 = FStar_Syntax_Print.sigelt_to_string impl in FStar_Util.print1 "Implementation of a projector %s\n" - uu____12739 + uu____12818 else ()); if no_decl then [impl] else [decl; impl]))))) in - FStar_All.pipe_right uu____12376 FStar_List.flatten in + FStar_All.pipe_right uu____12455 FStar_List.flatten in FStar_List.append discriminator_ses projectors_ses let mk_data_operations: FStar_Syntax_Syntax.qualifier Prims.list -> @@ -5301,39 +5162,39 @@ let mk_data_operations: fun se -> match se.FStar_Syntax_Syntax.sigel with | FStar_Syntax_Syntax.Sig_datacon - (constr_lid,uvs,t,typ_lid,n_typars,uu____12779) when + (constr_lid,uvs,t,typ_lid,n_typars,uu____12858) when Prims.op_Negation (FStar_Ident.lid_equals constr_lid FStar_Parser_Const.lexcons_lid) -> - let uu____12784 = FStar_Syntax_Subst.univ_var_opening uvs in - (match uu____12784 with + let uu____12863 = FStar_Syntax_Subst.univ_var_opening uvs in + (match uu____12863 with | (univ_opening,uvs1) -> let t1 = FStar_Syntax_Subst.subst univ_opening t in - let uu____12806 = FStar_Syntax_Util.arrow_formals t1 in - (match uu____12806 with - | (formals,uu____12822) -> - let uu____12839 = + let uu____12885 = FStar_Syntax_Util.arrow_formals t1 in + (match uu____12885 with + | (formals,uu____12901) -> + let uu____12918 = let tps_opt = FStar_Util.find_map tcs (fun se1 -> - let uu____12871 = - let uu____12872 = - let uu____12873 = + let uu____12950 = + let uu____12951 = + let uu____12952 = FStar_Syntax_Util.lid_of_sigelt se1 in - FStar_Util.must uu____12873 in - FStar_Ident.lid_equals typ_lid uu____12872 in - if uu____12871 + FStar_Util.must uu____12952 in + FStar_Ident.lid_equals typ_lid uu____12951 in + if uu____12950 then match se1.FStar_Syntax_Syntax.sigel with | FStar_Syntax_Syntax.Sig_inductive_typ - (uu____12892,uvs',tps,typ0,uu____12896,constrs) + (uu____12971,uvs',tps,typ0,uu____12975,constrs) -> FStar_Pervasives_Native.Some (tps, typ0, ((FStar_List.length constrs) > (Prims.parse_int "1"))) - | uu____12915 -> failwith "Impossible" + | uu____12994 -> failwith "Impossible" else FStar_Pervasives_Native.None) in match tps_opt with | FStar_Pervasives_Native.Some x -> x @@ -5347,45 +5208,45 @@ let mk_data_operations: (FStar_Errors.Fatal_UnexpectedDataConstructor, "Unexpected data constructor") se.FStar_Syntax_Syntax.sigrng in - (match uu____12839 with + (match uu____12918 with | (inductive_tps,typ0,should_refine) -> let inductive_tps1 = FStar_Syntax_Subst.subst_binders univ_opening inductive_tps in let typ01 = FStar_Syntax_Subst.subst univ_opening typ0 in - let uu____12988 = + let uu____13067 = FStar_Syntax_Util.arrow_formals typ01 in - (match uu____12988 with - | (indices,uu____13004) -> + (match uu____13067 with + | (indices,uu____13083) -> let refine_domain = - let uu____13022 = + let uu____13101 = FStar_All.pipe_right se.FStar_Syntax_Syntax.sigquals (FStar_Util.for_some - (fun uu___94_13027 -> - match uu___94_13027 with + (fun uu___100_13106 -> + match uu___100_13106 with | FStar_Syntax_Syntax.RecordConstructor - uu____13028 -> true - | uu____13037 -> false)) in - if uu____13022 + uu____13107 -> true + | uu____13116 -> false)) in + if uu____13101 then false else should_refine in let fv_qual = - let filter_records uu___95_13045 = - match uu___95_13045 with + let filter_records uu___101_13124 = + match uu___101_13124 with | FStar_Syntax_Syntax.RecordConstructor - (uu____13048,fns) -> + (uu____13127,fns) -> FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Record_ctor (constr_lid, fns)) - | uu____13060 -> + | uu____13139 -> FStar_Pervasives_Native.None in - let uu____13061 = + let uu____13140 = FStar_Util.find_map se.FStar_Syntax_Syntax.sigquals filter_records in - match uu____13061 with + match uu____13140 with | FStar_Pervasives_Native.None -> FStar_Syntax_Syntax.Data_ctor | FStar_Pervasives_Native.Some q -> q in @@ -5397,26 +5258,26 @@ let mk_data_operations: iquals else iquals in let fields = - let uu____13072 = + let uu____13151 = FStar_Util.first_N n_typars formals in - match uu____13072 with + match uu____13151 with | (imp_tps,fields) -> let rename = FStar_List.map2 - (fun uu____13137 -> - fun uu____13138 -> - match (uu____13137, - uu____13138) + (fun uu____13216 -> + fun uu____13217 -> + match (uu____13216, + uu____13217) with - | ((x,uu____13156),(x',uu____13158)) + | ((x,uu____13235),(x',uu____13237)) -> - let uu____13167 = - let uu____13174 = + let uu____13246 = + let uu____13253 = FStar_Syntax_Syntax.bv_to_name x' in - (x, uu____13174) in + (x, uu____13253) in FStar_Syntax_Syntax.NT - uu____13167) imp_tps + uu____13246) imp_tps inductive_tps1 in FStar_Syntax_Subst.subst_binders rename fields in @@ -5424,4 +5285,4 @@ let mk_data_operations: iquals1 fv_qual refine_domain env typ_lid constr_lid uvs1 inductive_tps1 indices fields)))) - | uu____13175 -> [] \ No newline at end of file + | uu____13254 -> [] \ No newline at end of file