Caml1999T037K%r C/Value_rec_check*ocaml.text&_none_@@A Static checking of recursive declarations, as described in A practical mode system for recursive definitions Alban Reynaud, Gabriel Scherer and Jeremy Yallop POPL 2021 Some recursive definitions are meaningful {[ let rec factorial = function 0 -> 1 | n -> n * factorial (n - 1) let rec infinite_list = 0 :: infinite_list ]} but some other are meaningless {[ let rec x = x let rec x = x+1 ]} Intuitively, a recursive definition makes sense when the body of the definition can be evaluated without fully knowing what the recursive name is yet. In the [factorial] example, the name [factorial] refers to a function, evaluating the function definition [function ...] can be done immediately and will not force a recursive call to [factorial] -- this will only happen later, when [factorial] is called with an argument. In the [infinite_list] example, we can evaluate [0 :: infinite_list] without knowing the full content of [infinite_list], but with just its address. This is a case of productive/guarded recursion. On the contrary, [let rec x = x] is unguarded recursion (the meaning is undetermined), and [let rec x = x+1] would need the value of [x] while evaluating its definition [x+1]. This file implements a static check to decide which definitions are known to be meaningful, and which may be meaningless. In the general case, we handle a set of mutually-recursive definitions {[ let rec x1 = e1 and x2 = e2 ... and xn = en ]} Our check (see function [is_valid_recursive_expression] is defined using two criteria: Usage of recursive variables: how does each of the [e1 .. en] use the recursive variables [x1 .. xn]? Static or dynamic size: for which of the [ei] can we compute the in-memory size of the value without evaluating [ei] (so that we can pre-allocate it, and thus know its final address before evaluation). The "static or dynamic size" is decided by the classify_* functions below. The "variable usage" question is decided by a static analysis looking very much like a type system. The idea is to assign "access modes" to variables, where an "access mode" [m] is defined as either m ::= Ignore (* the value is not used at all *) | Delay (* the value is not needed at definition time *) | Guard (* the value is stored under a data constructor *) | Return (* the value result is directly returned *) | Dereference (* full access and inspection of the value *) The access modes of an expression [e] are represented by a "context" [G], which is simply a mapping from variables (the variables used in [e]) to access modes. The core notion of the static check is a type-system-like judgment of the form [G |- e : m], which can be interpreted as meaning either of: - If we are allowed to use the variables of [e] at the modes in [G] (but not more), then it is safe to use [e] at the mode [m]. - If we want to use [e] at the mode [m], then its variables are used at the modes in [G]. In practice, for a given expression [e], our implementation takes the desired mode of use [m] as *input*, and returns a context [G] as *output*, which is (uniquely determined as) the most permissive choice of modes [G] for the variables of [e] such that [G |- e : m] holds. 9typing/value_rec_check.mlSg@@@@@@3@@@@@@#intA;@@#intA@@@@@;@A@$charB;@@$charA@@@@@A@A@&stringQ;@@&stringA@@@@@G@@@%bytesC;@@%bytesA@@@@@M@@@%floatD;@@%floatA@@@@@S@@@$boolE;@@%falsec@@]@$trued@@c@@@A@@@@@d@A@$unitF;@@"()e@@n@@@A@@@@@o@A@ #exnG;@@@A@@@@@s@@@#effH;@@O@A@A@@@@@@|@@@,continuationI;@@Q@@P@B,continuationA@nY@@@@@@@@@%arrayJ;@@R@A%arrayA@@@@@@@@@ $listK;@@S@A"[]f@@@"::g@@@T@@@ @@A@Y@@@@@@@@&optionL;@@V@A$Noneh@@@$Somei@@@@@A@Y@@@@@@@@)nativeintM;@@)nativeintA@@@@@@@@%int32N;@@%int32A@@@@@@@@%int64O;@@%int64A@@@@@@@@&lazy_tP;@@X@A&lazy_tA@Y@@@@@@@@ 5extension_constructorR;@@5extension_constructorA@@@@@@@@*floatarrayS;@@*floatarrayA@@@@@@@@&iarrayT;@@Y@A&iarrayA@Y@@@@@@@@ *atomic_locU;@@Z@A*atomic_locA@@@@@@ @@@ .Assert_failure`#@@@@@J@@@@@@@@[@@A!=ocaml.warn_on_literal_pattern%@&@0Division_by_zero]#@@@A+ . .@+End_of_file\#$@@@A366@'FailureY#,@'@@A<??@0Invalid_argumentX#5@0@@AE$H#H@-Match_failureV#>@@=@9@;@@a@@AV5Y4Y@)Not_foundZ#O@@@A^=a<a@-Out_of_memoryW#W@@@AfEiDi@.Stack_overflow^#_@@@AnMqLq@.Sys_blocked_io_#g@@@AvUyTy@)Sys_error[#o@j@@A^]@:Undefined_recursive_modulea#x@@w@s@u@@h@@Aon@:Continuation_already_takenb#@@@Awv@&Stdlib@@Р(Asttypes(Asttypesii@@ 3@@@@@A3@@@i@@ @Р)Typedtree)Typedtreejj@@ 3@@@@@A3@@@j@@ @3@@@Р%Types%Typeskk@@ 3@@@@@A3@@@k@@ @3@@@될< {1 Static or dynamic size} mm'@@@@@@3@@@A+"sdAo).o)0@@;@@@A/Value_rec_types6recursive_binding_kind@@@@@@@o))o)Y@@A@DA@@Aг /Value_rec_typeso)3o)B@o)C@@@3@B&;@@@A.@@@@@@@@@@@@@@@@@@7@ఠ&is_ref,q[_-q[e@EEA@б@гq1value_description%Types@q[hAq[m@ Dq[nEq[@@@@@@3GFFGGGGG@x\V@@ @@г $boolTq[Uq[@@ @@@@@@@@@@ @@43A@@@/@@@@@@@@@@ @@ঠ%Typesyrzr@(val_kind~rr@@3(val_kind%Types1value_description@@@s*value_kind@@@o@@A3(val_type)type_expr@@@n@@@@A0typing/types.mli@@@@@@@3'val_loc(Location!t@@@p@@B@A@@@@@@#@3.val_attributes*)Parsetree*attributes@@@q@@C%@A@@@A@@1@3'val_uid89#Uid!t@@@r@@D2@A*A A$+A A3@@>@@A.@@/@@@@B@Ġ%Typesss@(Val_primss@@;(Val_primQ@@@@)Primitive+description@@@t@A@AD@AQAARAA@@@e@ঠ)Primitivess@)prim_namess@@3)prim_name)Primitive+description@@@0&stringQ@@@)@@@3*prim_arity#intA@@@*@@A @@4typing/primitive.mli^^@@K@3*prim_alloc$boolE@@@+@@B@@ __@@#L@30prim_native_name*"@@@,@@C @@`?C`?\@@-M@35prim_native_repr_args4$listK:+native_repr@@@.@@@-@@D2@@)a*a@@?N@34prim_native_repr_resF @@@/@@E;@@2b3b@@HO@@@6]7]@@LJ@,%makemutableXsYs@@[s\s@@U@@@E@3_^^_____@;fq[[gv&4@@@@*prim_arityntot @_Attut@@e@@@E@@@@|s}t@@@@@E@!@@@@@@@@%@@@rt@@U@@@-@@@ภ$trueu!u%@;DT@@@M@@@AB@@A@@G@ @@Z@@@@@@v&*v&+@@@@@I@@@ภ%falsev&/K@;e@@@@B@@A@@d@N@@S@@A%param q[R@@@S@б@г5@<@@@g}@г+{z@/@@@nw@@@@@@rv@nA@@@@@@@@@@@@@B@@A@|@|{@@ఠ1is_abstracted_arg zz@FA@б@В@гe)arg_labelzz@@ @@@3@@@@@@@@@@@@@@@@@@@гj)apply_argzz@@ @@@@@@@$@ @@#) @@г栐$bool1z2z@@ @@@0@@@@@@@5; @@POA@@@@K@@@Ѡ@4@@@@@@@#@@@@@J@@@@[{\{@@c@@@3^]]^^^^^@\yezf|@@@@@Ġ'Omittedo{p{@;'Omitted)Typedtree.arg_or_omitted!a@ c!b@ d@@@ @@AA@B@A4typing/typedtree.mli}6v6x}6v6@@@@Ġ"(){{@;7A@@@N@@@@A@@A@@:@@ @@$unitF@@@A@@@4@@@@@F@@{{@@@Q@@@@@@@@@U@@@ภ'{{@&@@@z@@@ a@@@||@@o@@@ n@@Ġ#Arg||@;#Argh@a@A@@B@AV|6h6jW|6h6u@@@i@@||@@s*expression@@@@@@@@I@@@@@||@@@@@@@X@@@@@@@@ภS|@R@@@G@@APz@@@@б@В@г@@@@@@гx@|@@@@@@@ @@@гj@n@@@@@@@@@@-A@@@@D@@@)٠@-@@@)@@)@@)@@@)@@)B@)@A@@@D@ఠ3classify_expressionU~  V~  @nJA@б@г*expression)Typedtreei~ #j~ ,@ m~ -n~ 7@@@@@@)3pooppppp@n@@@@@ˠ@m@@@@@@@\@@@@@@@@@!@@г"sd~ ;~ =@@ @@@)#@@@+@@)@@)(3 @@HGA@@@C@@@)@@)@@@)@@)4@Aఠ3classify_expression@KA@@@%Ident#tbl@@@G,C@Gu@@@GC@)@@*&@@@@*LC@*@@*%@@@*$@@*#@@*"c@࣠@#envA@OA@@,3@v=@8@@)@)@@*4@@@*D@*@@*D@)@@)D@)@H@I7classify_value_bindings@(Asttypes(rec_flag@@@,C@*@@*@`C@GC@G+C@* @@* @$listK-value_binding@@@G.F@F@@@GC@* @@*C@*@@*D@* @@* D@*@@*D@)@23@@KLA-classify_path@C@*@@*@$Path!t@@@-C@*@@*V6recursive_binding_kind@@@*@@*D@*@@*D@)@V#,#2W#,#?@@oMA:classify_module_expression@C@*@@*@+module_expr@@@GC@*@@*@@@*!D@*@@* D@*@@*D@)@w''x'(@@NA@@@@@@!eA@PA@@3@@@@@@@@@ఐ!e@@@@@3@!@@@(exp_desc@3(exp_desc@@@ &6/expression_desc@@@ @@@ 3'exp_loc (Location!t@@@ @@A @A2(,3(@@@Ex@3)exp_extra$listK@V)exp_extra@@@ @!t@@@ !@e*attributes@@@ "@@ @@@ @@B0@AWAEXA{@@jy@3(exp_type>%Types)type_expr@@@ #@@C>@Ae|f|@@xz@3'exp_envL#Env!t@@@ $@@DL@Ast@@{@3.exp_attributesZ(@@@ %@@EU@A|}@@|@@A   '@@w@ti@@c@@@*Ks@Ġ(Texp_let!'!/@;(Texp_lett@@@ @@@@ 4f@@@ 6@@@ 5H@@@ 7@CBA_@AU@@@@ఠ(rec_flag=!1>!9@VQA@@:@@@*T3A@@AAAAA@@@@ఠ"vbL!;M!=@eRA@@+)@@@*V@@@*U@ఠ!e^!?_!@@wSA@@|@@@*W!@@@Mf!A@@@@@*X&@@@@@*Y)@@@@ఠ#env)wEQxET@]A@@hC@,3zyyzzzzz@HA@B@C:3@4@5)"@#@$@@@ఐ7classify_value_bindingsEWEn@@@@@@,@@@,@|@@,l@@,@@,@@,@@ఐi(rec_flagEoEw@'@@,@@ఐՠ#envExE{@+@@9@@ఐt"vbE|E~@@@@C@G0C@,I@@:@@J@A@EM@@ఐ!3classify_expression@@@@ @@,@@@,@@@,@@,@@,3@doh@i@j@@@@ఐv#env@ @@u@@ఐ!e@y@@/H@,@@.@@@@@,H@,&@? @@@@@,@Ġ*Texp_ident@;*Texp_ident@@@@ /#loc)Longident!t@@@ 1@@@ 0H1value_description@@@ 2@C@A_@A_c_@@@@ఠ$path>?@WTA@@@@@*a3BAABBBBB@@@@@IJ@@.,@@@*c@@@*b @@UV@@+@@@*d@@@G[@@@@@*e@@@@@*f@@@ఐ2-classify_pathkl@6@@@4@@,@1@@,'@@@,@@,@@,3vuuvvvvv@A:@;@<@@@@ఐ#env@@@@@ఐU$path@@@O@@,@@@Ġ-Texp_sequence@;-Texp_sequence@@@@ w@@@ x@BPA_@A)))*))@@@<@@@@@@@*l3@ @@@ఠ!e@UA@@@@@*tI@*m@@@+@@&@@@*n@@@Ġ0Texp_struct_item"2@;0Texp_struct_item@l.structure_item@@@ @@@ @B^A_@Ab,--c,--8@@@u@@45@@@@@*s9@8!e78@ VA@@5C@@@& 9@@X@@@*uH@@H@@b@@\@@@*xL@@@ఐ`3classify_expression =E =X@)@@@_@@-@N@@-W@@@- @@- @@- 3        @aZ@[@\@@@@ఐN#env ,=Y -=\@@@v@@ఐu!e 9=] :=^@@@nH@- @@.@@8 @Ġ.Texp_construct I`f J`t@;.Texp_construct0@G#loc1!t@@@ U@@@ T*Data_types7constructor_description@@@ V@@@ X@@@ W@CHA_@A$$$$@@@@@ t`v u`w@@(&@@@*@@@*3 z y y z z z z z@@@@ঠ(cstr_tag `z `@3(cstr_tag*Data_types7constructor_description@@@*/constructor_tag@@@*@@E;3)cstr_name&stringQ@@@*@@@ @A5typing/data_types.mliWW@@C@3(cstr_res%Types)type_expr@@@*@@A@AX X @@$D@31cstr_existentials+$listK)type_expr@@@*@@@*@@B*@A!YIM"YIo@@6E@3)cstr_args=$)type_expr@@@*@@@*@@C:@A1Z2Z@@FF@3*cstr_arityM#intA@@@*@@DF@A=[>[@@RG@Y3+cstr_constsY @@@*@@FP@AG]TXH]Ti@@\I@3.cstr_nonconstsc@@@*@@GZ@AQ^R^@@fJ@30cstr_generalizedm$boolE@@@*@@Hf@A]_^_ @@rK@3,cstr_privatey(Asttypes,private_flag@@@*@@It@Ak`8<l`8W@@L@3(cstr_loc(Location!t@@@*@@J@Aya}za}@@M@3/cstr_attributes)Parsetree*attributes@@@*@@K@Abb@@P@3,cstr_inlined&optionL0type_declaration@@@*@@@*@@L@Acc@@Q@3(cstr_uid#Uid!t@@@*@@M@Add@@S@@A\\0@@H@Ġ,Cstr_unboxed U` V`@;,Cstr_unboxed@@@*@@@@AC@Ajj@@@V@@@  @@@@@*@@@ f`y g`@@@@@*H@*@Ġ":: t` u`A;   @@U@ B@AA@A @@ ؠఠ!e# `@ WA@@@@@+ @Ġ"[] A; @@@@AA@A @@ @@A@ @@@+ @@@+ @@@ `'@@8@@@+ @@@+ &@@@[ `@@@@@+ +@@@@@+.@@@ఐ3classify_expression  @̰@@@@@-'@@@-&@@@-%@@-$@@-#3        @'E?@@@A@@@@ఐ#env  @G@@@@ఐY!e  @@@H@-8@@.@@ @Ġ.Texp_construct  @@  @@@@@+@@@+}@@ @@@@+@@@@@@+@@@+@@@@@`@@@+@@c@@@+@@@ภ&Static  @;&Static/Value_rec_types6recursive_binding_kind@@@@@@@B@@A:typing/value_rec_types.mliUU@@@ A@@@@!@Ġ+Texp_record 2 3@;+Texp_record@@@@ @AJA_@A%%&R&W@@;@@&fields@@%arrayJ@1label_description@@@ ^@7record_label_definition@@@ _@@ ]@@@ \%%%%@@@.representation@@5record_representation@@@ `%%%&"@@@3extended_expression@@&optionL@@@ b@@@ a&#&)&#&Q@@ @@JA@@@@@ @@@ AA@ঠ&fields 3 9@3L[@@@+&N@@@310@@AA*@'3$#@@BA@A9@6A@@ ? @@@R@@@+:3        @ @@@@Ġ*Overridden B L@;*OverriddenZ@@@ @#loc!t@@@ @@@ נ@@@ @BA@B@AAm44Bm45@@@T@@ N O@@@@@+A@@@+@2@ఠ!e$ P Q@ XA@@@@@+B@@@@8 R@@@@@+CE@@K@@@M@ @@+DL@@ < U@@@@@@+G@@@@+H@@+F@@@+E_@.representation   @3@@@+$@@A3@@@A@3@@BA@A@Ġ.Record_unboxed   @;.Record_unboxed 5record_representation@@@@$boolE@@@@A@BC@A FTT FTT@@@ @@ 2 3@@@@@+O@@@@@@@@+P@@@ < =W@@ @@@+RH@+Q@@@@@@@@+S@@@@@+T@@@ఐ3classify_expression S[c T[v@k@@@@@-G@@@-F@@@-E@@-D@@-C3 ^ ] ] ^ ^ ^ ^ ^@@@@@@@ఐ#env n[w o[z@@@@@ఐ!e {[{ |[|@@@H@-X@@.@@z @Ġ+Texp_record } }@Y@ } }@@[@@@+Y@@@ @@@@@+Z@@@@@+[@@@ภ&Static  @@@@@Ġ,Texp_variant  @;,Texp_variant@%label@@@ YM@@@ [@@@ Z@BIA_@AD%[%]E%[%@@@W@@  @@@@@+b1@@@@@@+d@@@+c:@@@*@@8@@@+e>@@>@Ġ*Texp_tuple  @;*Texp_tuple@2@&stringQ@@@ R@@@ Q@ @@@ S@@ P@@@ O@AGA_@A"""#)@@@@@  @@#@"!@@@+p@@@+o@>@@@+q@@+n@@@+m@@@=@@@@@+r@@@@v@@@@@+s@Ġ/Texp_atomic_loc 8 9@;/Texp_atomic_loc@W@@@ c:#loc$!t@@@ e@@@ d1label_description@@@ f@CKA_@A (((0(q@@@@@ \ ]@@x@@@+z@@@" @@@+|@@@+{@@@@@@+}@@@8@@@@@+~@@@@@@@@@+@Ġ:Texp_extension_constructor  @;:Texp_extension_constructorf@}#locg!t@@@ @@@ J!t@@@ @B]A_@A +,, +,-@@@ $@@  @@@@@+@@@+@@ @@@@+@@@/@@@@@+ @@ @@@@ @@@+@Ġ-Texp_constant   @;-Texp_constant@(constant@@@ 3@AAA_@A A B@@@ T@@  @@@@@+.@@@@@,@@@+2@@2@@" @@0@@@+6@@@ภ&Static  (  .@@@@?@Ġ(Texp_for 06 0>@;(Texp_for@%Ident!t@@@ {)Parsetree'pattern@@@ | &@@@ } *@@@ ~ .direction_flag@@@  4@@@ @FRA_@A )) *T*f@@@ @@%0?&0@@@-@@@+@@@)@@@+@@ @ K@@@+@@@ P@@@+@@@'@@@+@@@ Z@@@+@@@O@@@@@+@@@Ġ-Texp_setfieldOAGPAT@;-Texp_setfield6@ n@@@ kQ#loc;!t@@@ m@@@ l 1label_description@@@ n @@@ o@DMA_@A (( ())@@@ @@wAUxAV@@ @@@+@@@&$@@@+@@@+@@@"@@@+@@@ @@@+@@@A@@@@@+@@@@@@@@@+@Ġ*Texp_whileW]Wg@;*Texp_while@ @@@ y @@@ z@BQA_@A %)) &))@@@ 8@@WhWi@@ @@@+@@@ @@@+@@@ @@@@@+@@@@@@@@@+@Ġ/Texp_setinstvarjpj@;/Texp_setinstvar@!t@@@ !t@@@ #loc@@@ @@@  @@@ @DVA_@A h*+ i*+>@@@ {@@jj@@&@@@+U@@@$@@@+Z@@ @" @@@+@@@+c@@@ %@@@+h@@@B@@f@@@+l@@l@@@@j@@@+p@@@ภ&Static@@@@y@Ġ0Texp_unreachable)*@;0Texp_unreachable@@@@A_@A *,, *,,@@@ @@@  @@@@@+@@@@@+@@@ภ&Static?@@*@@@;@Ġ*Texp_applyLM@;*Texp_apply3@ k@@@ ;@ V)arg_label@@@ >@ )apply_arg@@@ ?@@ =@@@ <@BDA_@A ^` ^@@@ @ঠ(exp_descxy@Ġ*Texp_ident@l@@@ @@@@+3@@@@@@@sq@@@+@@@+ @ఠ"vd%@YA@@v@@@+@@@&@@@@@+ @@@@@ @@@+H@+(@@@@b@a@@@+栠@_@@@+@@+@@@+=@@@| @@ @@@+B@@ #@@@+E@@ఐ &is_ref!,!2@ Ӱ@@@ @@@-v@@-u @@@-t@@-s3@ KNG@H@I@@@@ఐU"vd!3!5@ @@ @@@-H@-H@-@@% @@@@@-H@-}@ภ&Static 9A 9G@@@@'@Ġ*Texp_applyHNHX@ˠ@HZH[@@ 8@@@+3@ @@@ఠ$args&)H\*H`@BZA@@ؠ@@@@+@@@@+@@+@@@+@@@'>Ha@@ @@@+!@@ @@@+$@@డ$List&existsSbmTbq@ WbrXbx@@@@!a@.@@1$boolE@@@1@@1@@1@ O@@@1@@1@@@1@@1@@1@(list.mli$$$$@@,Stdlib__Liste@.)@@@@@ @@@2@ ~@@@2@@2G@2@@20@@@2@@2@@2@-@@@2@@2,@@@2@@2@@23@ {@|@}@@@@ఐ Š1is_abstracted_argbyb@ ?@@@@ @@@2@ @@@2@@2@@2 @@@2@@2#@@ఐ$argsbb@-@@hS@@@2H@3H@28@@ @@@@@3H@2>@ภ&Static@@@@G@Ġ*Texp_apply@@@@ @@@,@@@@@@@,@@@@,@@,@@@,@@@@@ j@@@,@@ m@@@,@@@ภ'Dynamic @;'Dynamic @@@AB@@AYY@@@ B@@  @@ "@Ġ*Texp_array34@;*Texp_array @ 1,mutable_flag@@@ p  \@@@ r@@@ q@BNA_@A )*), )*)Z@@@ @@NO@@@@@,2@@@ r@@@,@@@,;@@@*@@ @@@,?@@ @@@,B@@@ภ&Staticij@T@@@ eK@Ġ)Texp_packvw@;)Texp_pack ]@ @@@ @A[A_@A "+, "+,@@@ @ఠ$mexp'@[A@@ #@@@,3@ @@@@@@@ @@@,@@ @@@,@@@ఐ E:classify_module_expression(@ I@@@ G@@3@ D@@3 ;@@@3@@3@@33@ ,%@&@'@@@@ఐ ߠ#env),@ 5@@ @@ఐ@$mexp-1@@@ dC@3*@@-@@ @Ġ-Texp_function282E@;-Texp_function @  o.function_param@@@ 9@@@ 8 v-function_body@@@ :@BCA_@A h i1@@@ {@@2F2G@@@@@,!@@@, n@@ @@@@,"s@@@,@@ \@@@,#w@@ _@@@,$z@@@ภ&StaticKSKY@@@@ @Ġ)Texp_lazyZ`Zi@;)Texp_lazy @ =@@@ @AYA_@A  ++  ++@@@ @ఠ!e(2Zj3Zk@K\A@@ P@@@,) @@@@@ @@@,* @@ @@@,+ @@@డ'Typeopt6classify_lazy_argument'TypeoptQR@ UV@@@)Typedtree*expression@@@3@@3Р%Other@4Constant_or_function@=Float_that_cannot_be_shortcut@*IdentifierР%Other@-Forward_value@@@@3A@@@3@@@3A@@@3@@3@2typing/typeopt.mlia++eA@@'TypeoptR@<7@@@4@@@3@@3Р/@.@-@,Р+@*@@@@3A@@@3@@@3A@@@3@@33@ |@}@~@@@@ఐ!e@ @@f@@@3I@3I@3@@v @@Рb@a@`@_Р^@]@@@@3A@@@3@@@3A@@@33@4Constant_or_function@Р@@@Р@~@@@@3A@@@3@@@3A@@@@@3Y@@Р@@@Р@@@@@3A@@@3@@@3A@@@3t@@@ఐ {3classify_expression,-@ D@@@ z@@4@ i@@4 r@@@4@@4@@4@@ఐ f#envDE@ @@ @@ఐ!eQR@@@ I@4@@+@@ U@@@4@=Float_that_cannot_be_shortcut@Р@@@Р@@@@@4 A@@@4 @@@4 A@@~@@@4 @@@*Identifier-Forward_value@Р@@@@@4'A@@@@ @4&@Р3@2@1@0Р/@.@@@@4A@@@4@@@4A@@@@@4@@@@:"@@РS@R@Q@PРO@N@@@@40A@@@4/@@@4.A@@@4-$@@@ภ&Static%@@@@-@*Identifier%Other@Рm@l@@@@4NA@@&:&@@@ @4MF@Р@@@Р@@@@@4CA@@@4B@@@4AA@@&.@@@4@d@@Р@@@Р@@@@@4SA@@@4R@@@4QA@@@4P@@@ఐ3classify_expression7DN8Da@O@@@@@4@t@@4}@@@4@@4@@4@@ఐq#envODbPDe@ ǰ@@@@ఐ*!e\Df]Dg@@@I@4@@+@@ @%Other@Р@@@Р@@@@@4eA@@@4d@@@4cA@@hphv@@@4b@@Р#@"@!@ Р@@@@@4jA@@@4i@@@4hA@@@4g@@@ภ&Static@ @@@U@@@A@@ @Ġ(Texp_new@;(Texp_new @!t@@@ #loc !t@@@ @@@ 1class_declaration@@@ @CTA_@Af**g**@@@y@@@@$@@@,3]@@@" @@@,5@@@,4f@@@@@@,6k@@@;@@_@@@,7o@@o@Ġ,Texp_instvar@;,Texp_instvar @!t@@@ !t@@@ #loc.@@@ @@@ @CUA_@A****@@@@@89@@"@@@,>@@@ @@@,?@@ @@@@,A@@@,@@@@9@@@@@,B@@@@@@@@@,C@Ġ+Texp_object[ \@;+Texp_objectB@/class_structure@@@ m@@@ @@@ @BZA_@A!++!++@@@@@wx@@@@@,I@@@@@@,K@@@,J@@@+@@@@@,L@@@@@@@@@,M@Ġ*Texp_match'@;*Texp_match|@@@@ @ߠ/$case4+computation@@@ C@@@ B@@@ AC%value@@@ F@@@ E@@@ DK'partial@@@ G@DEA_@A=  >  @@@P@@()@@@@@,X4@@@431@@@,[@@@,Z@@@,YA@@@0@/@@@,^@@@,]@@@,\N@@"@.@@@,_S@@@[$@@G@@@,`W@@W@@'(@@K@@@,a[@Ġ/Texp_ifthenelse*0*?@;/Texp_ifthenelse@@@@ s"@@@ t *@@@ v@@@ u@COA_@A)[)])[)@@@@@*@*A@@8@@@,h@@@=@@@,i@@ @E@@@,k@@@,j@@@1@@@@@,l@@@@g@@@@@,m@Ġ)Texp_send?BH@BQ@;)Texp_send&@^@@@ $meth@@@ @BSA_@A*g*i*g*@@@@@UBRVBS@@q@@@,r@@@@@@,s@@@! @@@@@,t@@@@@@@@@,u@Ġ*Texp_fieldoTZpTd@;*Texp_fieldV@@@@ gq#loc[!t@@@ i@@@ h *1label_description@@@ j@CLA_@A(r(t((@@@@@TeTf@@@@@,|@@@" @@@,~@@@,}@@@@@@, @@@8@@@@@,@@@@@@@@@,@Ġ+Texp_assertgmgx@;+Texp_assert@@@@ !t@@@ @BXA_@A?++@++@@@R@@gygz@@@@@,6@@@@@@,;@@@" @@/@@@,?@@?@@@@3@@@,C@Ġ(Texp_try{{@;(Texp_try@@@@ H1RA@@@ K@@@ J@@@ I>_N@@@ N@@@ M@@@ L@CFA_@A"("*"("f@@@@@{{@@-@@@,z@@@(yh@@@,@@@,@@@,@@@(u@@@,@@@,@@@,@@@J@@@@@,@@@@h#@@@@@,@Ġ-Texp_override@A@;-Texp_override'@!t@@@ @ Z!t@@@ @U#loc d@@@ @@@ @@@@ @@ @@@ @BWA_@A+?+A+?+@@@@@tu@@1@@@,@@@/@.@@@,@+)@@@,@@@,@@@@,@@,@@@,@@@U @@@@@,@@@@$@@@@@,@Ġ*Texp_letop@;*Texp_letop@@@@ @A\A_@A(#,,)),,@@;@@$let_@@F*binding_op@@@ 7$,/,58$,/,G@@J@$ands@@@@@ @@@ G%,H,NH%,H,e@@Z@%param@@ !t@@@ U&,f,lV&,f,|@@h@$body@@B1@@@ @@@ d',},e',},@@w@'partial@@5@@@ o(,,p(,,@@@@\A@@@@@@@@@A@@@@Y@@@,i@@@b@@]@@@,m@@m@@= @@a@@@,q@@@ภ'Dynamic@@@@z@@@A@г"sd!"@@`@@@F.@*G3%$$%%%%%@@@ @@@@@JA@@x@@F@@g@@F?p@@@F>@@F=@@F@?@@@࣠@#env9A!! !!@8fA@@*3      @9'!!(""@@@@@  @@"vb:A3!!4!!@LgA@@-343344444@!A@@@@@@@@ఐ"vbI!!J!!@B@@@@C3JIIJJJJJ@#@@@&vb_patS!!T!!@3&vb_pat-@@@ 'pattern@@@ @@@ 3'vb_expr |@@@ @@A@AFF"FF6@@@3+vb_rec_kind/Value_rec_types6recursive_binding_kind@@@ @@B@AF7F;F7Fo@@@3-vb_attributes"@@@ @@C@AFpFtFpF@@@3&vb_loc+!t@@@ @@D)@AFFFF@@@@AF F F F@@@H=@@7@@@F{G@(pat_desc!!!"@3(pat_desc),pattern_data!a@ }@@@ @@@ 3'pat_loc !t@@@ @@A @A(r)r @@;\@3)pat_extra@J)pat_extra@@@ @!t@@@ @@@@ @@ @@@ @@B*@AIs Js G@@\]@3(pat_type:)type_expr@@@ @@C6@AUtHLVtHf@@h_@3'pat_envF!t@@@ @@DB@Aaugkbugz@@tc@3.pat_attributesR@@@ @@EK@Ajv{kv{@@}d@@Anqoq@@[@a@@,pattern_descM@t@F@F@@@FJ@F@Ġ(Tpat_var""""@;(Tpat_vare@@@ @@@ @ &!t@@@  #loc /@@@ @@@ #Uid!t@@@ @C@ALAAQ E GQ E @@@k@ఠ"id;E""F""@^hA@@)@@@F@ఠ$_loc<S""T"""@liA@@0.@@@F@@@F@ఠ$_uid=e""$f""(@~jA@@7@@@F@@@Ym"")@@r@@@F@@@F(@ @y@@@F@@@F/@@@@ఠ$size>"-";"-"?@kA@@@@@FL@F3@ERK@L@ME>@?@@4-@.@/@@@ఐ3classify_expression"-"B"-"U@@@@@@F@@@F@@@F@@F@@F@@ఐ䠐'old_env"-"V"-"]@@@+@@ఐ"vb"-"^"-"`@}@@:@'vb_expr"-"a"-"h@o @@M@FC@@4@@GD@A@"-"7@@డ%Ident#add%Ident"l"v"l"{@ "l"|"l"@@@5!t@@@A@@A@!a@@@@A@F @@@A@@AJ@@@A@@A@@A@@A@0typing/ident.mligg@@NX@+&@@@#@@@F@@F@@@F@c#@@@F@@Fg'@@@F@@F@@F@@F3#""#####@@@@@@@ఐ"id3"l"4"l"@@@J@@@FL@FL@F@@ఐ$sizeG"l"H"l"@!@@J$@@ఐ8#envT"l"U"l"@@@^1@@t@@]2@@@J@@_""`""@@e@@@F@@@F@ @l@@@F@@@F"@@@ఐZ#envv""O@>P@@i+@@@Ay!!R@@k3wvvwwwww@-@@@]TA@G@F[@A@X@డ$List)fold_left"""#@ "#"# @@@@#acc@/l@@10@!a@/o@@1/ @@1.@@1-@@1,@@@1+@@@@1*@@1)@@1(@@1'@@1&@ 933 :3r@@ 8]@-(@@@@F@F@@G@@@F@@F@@F@@F@ @@F@@@@F@@F@@F@@F@@F3@@@@@@@ఐ1add_value_binding"# "#@ @@@+$@@@G%@@@G$@@G(@@@@G'@@G&@@G#@@G""@@ఐ#env"#"#"@@@/@@ఐ(bindings "## "#+@Y@@<@@@@O=@@@P@-@@Q9@@@R:@A@@@@GK@@@GJ@@@GI@@GH@@GG@@GFC@G@@@@"@@@@@@*1@@@*0@@@*/@@*.@@*-310011111@@@@࣠@#env?A@#,#@A#,#C@YlA@@3A@@AAAAA@_@@@@@@Ġ$PathQ#}#R#}#@&PidentV#}#W#}#@@;&Pident$Path!t@@@52@%Ident!t@@@5+@A@@D@A/typing/path.mliSTVSTi@@@B@ఠ!x@y#}#z#}#@mA@@@@@G_3}||}}}}}@IE@@@A@@@@@3 @@AD@G]D@GV@@@డ)find_same%Ident####@ ####@@@@@@A@@A@!a@@@@@A@@A@@A@@A@hh@@Y@ @@@@@@Gy@@Gx@@@@Gw@@Gv@@Gt@@Gs3@GSL@M@N@@@@ఐZ!x####@ @@@@@GG@GG@G@@ఐ#env####@g@@$@@T@@(%@Ġ)Not_found####@;)Not_found#exnG@@@ @@@Z A@A&_none_@@A@@^I@@@@@@@@GC@@@ภ'Dynamic&&&&@ @@@@@@GQ@@@##&&@@@@@GqW@Ġ$Path+'','' @$Pdot0'' 1''@@;$Pdot@@@@5,&stringQ@@@5-@BA@D@AUU@@@C@@H''I''@@@@@Gc@@@@@@Gd@@@( @@@Ġ$Path[''\''@&Papply`''a''@@;&Papply @ @@@5.@@@5/@BB@D@AWW@@@D@@u'' v''!@@@@@Gh@@@!@@@Gi@@@% @@@@V @@@Ġ$Path''$''(@)Pextra_ty'')''2@@;)Pextra_ty8@9@@@50=(extra_ty@@@51@BC@D@A1Y2Y5@@@BE@@''3''4@@L@@@Gm*@@@@@@Gn/@@@' @@,0@@ @@-1@@@ภ'Dynamic''''@ @@@:@@AA#,#t@б@@>B#,#F#,#G@@г/Value_rec_types#,#K#,#Z@}#,#[#,#q@@@@@@GD@GWY @@@@@G @@GD@GY`@@@*A@@@@G@@@G@@@G@@G@@GC@G@@@#,#.9@@~@@@@*6@@@*5@@@*4@@*3@@*23@@@@࣠@#envBA'('(@'nA@@3@-@@@@@@$mexpCA'('(@6oA@@3@=@@@@@@@@ఐ$mexp1(%(/2(%(3@@@@@321122222@!@@@(mod_desc;(%(4<(%(<@3(mod_desc@@@ B0module_expr_desc@@@ =@@@ 3'mod_loc !t@@@ >@@A @A====@@@3(mod_typer+module_type@@@ ?@@B@A====@@@3'mod_env#p!t@@@ @@@C!@A====@@@3.mod_attributes/@@@ A@@D*@A===> @@@@A====@@@I>@@8@@@GH@Ġ*Tmod_ident(B(H(B(R@;*Tmod_identI@@@ \@H!t@@@ L#locy!t@@@ N@@@ M@B@@G@A????@@@/@ఠ$pathD(B(T(B(X@pA@@#@@@G3@@@@@(B(Z(B([@@%#@@@G@@@G @@@<(B(\@@@@@G@@@@@G@@@ఐ-classify_path(`(h(`(u@@@@@@H@@@H@@@H@@H@@H3@92@3@4@@@@ఐ㠐#env(`(v(`(y@Ͱ@@@@ఐM$path(`(z(`(~@@@H@H,@@.@@@@@H$@Ġ.Tmod_structure (( ((@;.Tmod_structure@)structure@@@ O@AA@G@A????@@@@@! ((" ((@@@@@Gq@@@@@@@@Gu@@@@@Gx@@@ภ&Static3!((4!((@@@@5@Ġ,Tmod_functor@"((A"((@;,Tmod_functor@1functor_parameter@@@ P@@@ Q@BB@G@A???@ @@@@@V"((W"((@@@@@G@@@@@@G@@@! @@@@@G@@"@@@G@@@ภ&Staticm#((n#((@X@@@o@Ġ*Tmod_applyz$(({$((@;*Tmod_apply@@@@ R@@@ S/module_coercion@@@ T@CC@G@A@ @ @ @H@@@@@$(($((@@+@@@G@@@0@@@G@@ @@@@G@@@*@@b@@@G@@e@@@G@@@ภ'Dynamic%((%((@@@@@Ġ/Tmod_apply_unit&((&() @;/Tmod_apply_unit6@W@@@ U@AD@G@A?@I@K@@I@k@@@R@@&() &() @@d@@@G@@@@@@@@G!@@@@@G$@@@ภ'Dynamic'))'))@@@@-@Ġ/Tmod_constraint() )&() )5@;/Tmod_constrainte@@@@ V+module_type@@@ W6module_type_constraint@@@ X{@@@ Y@DE@G@A@l@n@@@@@@ఠ$mexpE () )7 () );@ *qA@@@@@H3        @@@@@ () )= () )>@@)@@@H @@ $() )@ %() )A@@*@@@H@ఠ#coeF 0() )C 1() )F@ IrA@@@@@H@@@L 8() )G@@@@@H $@@@@@H '@@@ఐ#coe H))K)_ I))K)b@@@@@@@@HK3 L K K L L L L L@E>@?@@' @@@Ġ,Tcoerce_none ]*)h)r ^*)h)~@;,Tcoerce_none@@@ @@@@AD@A FF FF@@@@@@  @@@@@HO@@@@@HP!@@@ఐ:classify_module_expression y+)) z+))@ @@@@@H@@@H@@@H@@H@@H8@@ఐ#env +)) +))@p@@2E@@ఐ$mexp +)) +))@N@@8J@HT@@+@@@@@HX@Ġ1Tcoerce_structure ,)) ,))@;1Tcoerce_structureT@@#intA@@@ @?@@@ @@ @@@  @!t@@@ @@@@ @Z@@@ @@ @@@ @B@AD@A_ FF`G GJ@@@r@@ ,)) ,))@@9@8@@@H_@t@@@H`@@H^@@@H]@@@6@5@@@Hc@2@@@Hd@@@@He@@Hb@@@Ha@@@f)@@@@@Hf@@@@@Hg@@@ภ&Static!#-))!$-))@@@@@Ġ/Tcoerce_functor!0.))!1.))@;/Tcoerce_functor@@@@ @@@ @BAAD@AGKGMGKG@@@@@!D.)*!E.)*@@@@@Hm@@@@@@Hn@@@ @@@@@Ho@@@@@Hp@@@ภ&Static![/**!\/**@F@@@@Ġ1Tcoerce_primitive!h0**"!i0**3@;1Tcoerce_primitive @2primitive_coercion@@@ @ABAD@AGGGG@@@@@!z0**4!{0**5@@@@@Hu0@@@@@@@@Hv4@@@@@Hw7@@@డ$Misc+fatal_error$Misc!1*9*E!1*9*I@ !1*9*J!1*9*U@@@&stringQ@@@J@@J!a@J@@J@.utils/misc.mliYY@@$Misc@@@@@@@@L@@L@@@LJ@L@@Lo@@ &letrec: primitive coercion on a module!1*9*W!1*9*}@@!1*9*V!1*9*~@@.@@@LJ@LJ@L@@> @@/@Ġ-Tcoerce_alias!2**!2**@;-Tcoerce_alias@!t@@@ !t@@@ i@@@ @CCAD@AmHHnHH@@@@@!2**!2**@@@@@H~@@@@@@H@@ @@@@H@@@.@@@@@H@@@@@H@@@డ+fatal_error$Misc"3**"3**@ ""3**"#3**@@@@@@@@L@@L.@@@LJ@L@@L@@ "letrec: alias coercion on a module":3**";3**@@"=3**">3**@@@@@LJ@LJ@L@@) @@@@@A"H))K)S"I4**@@I@Ġ+Tmod_unpack"T5**"U5**@;+Tmod_unpack@s@@@ Zy+module_type@@@ [@BF@G@AAIAKAIAz@@@@ఠ!eG"o5**"p5**@"sA@@@@@HA@@"y5*+"z5*+@@@@@HI@@@+"5*+@@>@@@HN@@A@@@HQ@@@ఐޠ3classify_expression"6++"6++!@@@@@@MY@@@MX@@@MW@@MV@@MU3""""""""@i4-@.@/@@@@ఐ#env"6++""6++%@@@K@@ఐH!e"6++&"6++'@@@H@Mj@@.@@ @@@A"(%()@г"sd"'( "'("@@Z@@@Ob@G3""""""""@@@ @@@@@A@@v@@Ot@s@@Osj@@@Or@@Oq@@OpC@Ok@@@"'')@@ఐ93classify_expression"7+(+-"7+(+@@@@@6/@@@O}@@@O|@@O{@@@@Oz@@Oy:@@@Ox@@Ow@@Ov3""""""""@@@@@డ/%empty%Ident#7+(+A#7+(+F@ #7+(+G#7+(+L@@^!a@@@@@A@fqqfq@@eW@@@oh@@@O@@@OC@OC@O/@@H@@@!@@@)@@)!R@@@)@@)B@OC@OA@ .@б@г@@@@)@г@@@@)@@@@)@@)@ &IA@@@@@@O@@O@@@O@@OB@O@A@#l~  W@@X@## " {1 Usage of recursive variables} #}:+O+O#~:+O+v@@@@@@3#|#{#{#|#|#|#|#|@ 0@(@@@)@@)@@@)@@)@4@5@@$ModeB#<+x+#<+x+@#DA@БA+!tC#@,G,N#@,G,O@@;@@&Ignore@@#A,R,V#A,R,^@)ocaml.doc# [Ignore] is for subexpressions that are not used at all during the evaluation of the whole program. This is the mode of a variable in an expression in which it does not occur. #B,_,c#D,-'@@@@@@@#uA%Delay@@#F-)--#F-)-4@ A [Delay] context can be fully evaluated without evaluating its argument , which will only be needed at a later point of program execution. For example, [fun x -> ?] or [lazy ?] are [Delay] contexts. #G-5-9#I-.@@@@@@@#vA%Guard@@#K..#K..$@0  A [Guard] context returns the value as a member of a data structure, for example a variant constructor or record. The value can safely be defined mutually-recursively with their context, for example in [let rec li = 1 :: li]. When these subexpressions participate in a cyclic definition, this definition is productive/guarded. The [Guard] mode is also used when a value is not dereferenced, it is returned by a sub-expression, but the result of this sub-expression is discarded instead of being returned. For example, the subterm [?] is in a [Guard] context in [let _ = ? in e] and in [?; e]. When these subexpressions participate in a cyclic definition, they cannot create a self-loop. #L.%.)#Z1=1C@@@@@@@$wA&Return@@#\1E1I#\1E1Q@G  A [Return] context returns its value without further inspection. This value cannot be defined mutually-recursively with its context, as there is a risk of self-loop: in [let rec x = y and y = x], the two definitions use a single variable in [Return] context. $]1R1V$`222w@@@@@@@$xA+Dereference@@$ b2y2}$b2y2@^ A [Dereference] context consumes, inspects and uses the value in arbitrary ways. Such a value must be fully defined at the point of usage, it cannot be defined mutually-recursively with its context. $c22$e33l@@@@@@@$4yA@@A@@@@@$@,G,I@o For an expression in a program, its "usage mode" represents static information about how the value produced by the expression will be used by the context around it. $,=++$-?,,F@@@@@@@A@$EtA@#$4A,R,X@t@@@$F@@@@@@#$EF-)-/}@n@@@$W~}@}}@@@}@}@#yy$VK..w@h@@@z$hxw@ww@@@w@w@#ss$g\1E1Kq@b@@@t$yrq@qq@@@q@q@#mm$xb2y2k@\@@@n$lk@kk@@@k@k@@A@g$fe@ee@@@e@e@@r@3$$$$$$$$@@@@ఠ%equal$g3n3t$g3n3y@$zA@б@г!t$g3n3$g3n3@@ @@@O3$$$$$$$$@4 @@@@б@г!t$g3n3$g3n3@@ @@@O@@г$$bool$g3n3$g3n3@@ @@@O@@@@@O@@O# @@@+@@O @@O(.@@?>A@@@:@@@O@@O@0@@@O@@O&@@@O@@O@@O;@డ#a!=$g3n3}$g3n3@@!a@@@@@@$boolE@@@@@@@&%equalBA l@@@@ ly my@@ kQ@@б@гzrq@@@@Onl@б@гkj@@@@Oxg@г$栐fe@@@@Ob@@@@O@@Oa@@@@O@@O`@%;g3n3|%<g3n3@@@@@@@O@@O@@@@O@@O@@@O@@O@@OD@O@A@%Qg3n3p@@@@ఠ$rank%^n4O4U%_n4O4Y@%w{A@@@@@@PD@O@@O$b@@@PD@O@@OD@O3%p%o%o%p%p%p%p%p@@@@@O@@O@@@@O@@O@@@O@@O@@O@@@@@@Ġ&Ignore%o4e4k%o4e4q@;+@@@O@@@@E@@A@@@@@23%%%%%%%%@(A%n4O4Q%s44@@@@@@@%o4e4u%o4e4v@@8 @Ġ%Delay%p4w4}%p4w4@;@@@AE@@A@@@@@K@@@A%p4w4%p4w4@@K@Ġ%Guard%q44%q44@;/@@@BE@@A@@@@@^,@@@B%q44%q44@@^2@Ġ&Return%r44%r44@;B@@@CE@@A@@@@@q?@@@C%r44%r44@@qE@Ġ+Dereference%s44%s44@;U@@@DE@@A@@@@@R@@@D%s44R@@W@@A"<%n4O4\U@@@V@@D@P]@A@Z@ZY@@ఠ$join&z5S5Y&z5S5]@&|A@@@@@@PGD@P@@P@ D@P!@@P" D@P#@@P$D@P@@PD@P3&&&&&&&&@@@@@@࣠@!mA&*z5S5^&+z5S5_@&C}A@@!3&+&*&*&+&+&+&+&+@0&2z5S5U&3{5e5@@@@@  @@"m'A&>z5S5`&?z5S5b@&W~A@@*3&?&>&>&?&?&?&?&?@!8@@@@@@@@డ$">=&R{5e5s&S{5e5u@@!a@@@4@@@3^@@@2@@1@@0-%greaterequalBA Ƞ@@@@  @@ V@@@@%g@@@PEF@P,@@P-@ @@P+@@@P*@@P)@@P(3&|&{&{&|&|&|&|&|@>Jj@A@B@@@@ఐ0$rank&{5e5l&{5e5p@r@@@+@@@P>@@P=%@@@P<@@P;@@ఐ~!m&{5e5q&{5e5r@c@@)@@@@4*@@ఐW$rank&{5e5v&{5e5z@@@@R@@@PM@@PL%@@@PK@@PJC@@ఐ"m'&{5e5{&{5e5}@M@@P@@@@]H@PTS@@E@@@@@PXG@P7Y@ఐ!m&{5e5&{5e5@@@c@ఐ"m'&{5e5@j@@m@&{5e5i@@o@A@D@P\@A@@@֠@ఠ'compose&77&77@'A@@@@@@PtD@P^@@P_@@@@PzD@Pd@@Pe@@@PD@Pf@@PgD@P`@@PaD@P]3''''''''@@@@@@࣠@"m'A'*77'+77@'C@A@@'3'+'*'*'+'+'+'+'+@6'277'38 8A@@@@@  @@!mA'>77 '?77!@'WAA@@03'?'>'>'?'?'?'?'?@!>@@@@@@@@@ఐ-"m''T77*'U77,@@@P3'T'S'S'T'T'T'T'T@"H@@@@@@ఐ(!m'c77.'d77/@ @@T@@@@@d@[@@Pn@@Ġ&Ignore'}757;'~757A@@@@@y@Pp3'~'}'}'~'~'~'~'~@*@@@@@'757C'757D@@xD@Pl@Pq @@@@@@ @@Pu@@@@@'757G'757H@@@Pv@@Ġ&Ignore'757J'757P@@@@@@Pw)@@@@@@@@P{0@@0@@5 @@@@@@P}7@@@ภ&Ignore'757T'757Z@,@@@@@@Ġ+Dereference'7[7a'7[7l@@@@@@PS@@@'7[7n'7[7o@@@P[@@@@@@ @@Pb@@@@@@Ph@@@ภ+Dereference'7[7s'7[7~@@@@q@@Ġ%Delay(77(77@R@@@@@P@@@( 77( 77@@@P@@@@@@ @@P@@@@@@P@@@ภ%Delay( 77(!77@r@@@ @@Ġ%Guard(177(277@p@@@@-@P@@Ġ&Return(>77(?77@j@@@@/@P@@@@@@ @@P@@@@@@P@@@ภ%Guard(V77(W77@@@@B@@Ġ%Guard(g77(h77@@@@@c@P3(i(h(h(i(i(i(i(i@@@@@Ġ+Dereference({77(|77@@@@@l@P@Ġ%Guard(77(77@@@@@ @@@@ @Ġ%Delay(77(77@@@@@'@@(77(77@@*@!m(77(77@(BA3@@@P(77(77@@%7@@=@@@>@,@@P>@@@D@2@@PD@@@ఐ!m(77(77@@!@@@3((((((((@e'@@@@Ġ&Return(77(77@@@@@@Pd@@Ġ&Return(77(77@@@@@@Pq@@@@@@ @@Px@@@@@@P~@@@ภ&Return(78(78 @@@@@@Ġ&Return)8 8)8 8@-@@@@@P@@Ġ+Dereference)8 8)8 8%@-@@@@@P@Ġ%Guard)8 8() 8 8-@^@@@@ @@@@ @Ġ%Delay))8 80)*8 85@{@@@@@@)-8 8).8 86@@@!m)38 8:)48 8;@)LCA@@@P):8 8);8 8<@@%@@<@@@=@,@@P@@@C@2@@P@@@ఐ!m)P8 8@@@ @ @@<3)P)O)O)P)P)P)P)P@&@@@@@A)V77$$@@@@.%A@WD@Q",@A@)@)(@?@A@@C@dE@le@f@g@@3)c)b)b)c)c)c)c)c@Ko@@)i<+x+)j8B8E@@@)m<+x+x@@𠰣A+$modeD)x8G8L)y8G8P@@;@@&Ignore@@)8G8\)8G8b@@)FA%Delay@@)8G8c)8G8j@@)GA%Guard@@)8G8k)8G8r@@)HA&Return@@)8G8s)8G8{@@)IA+Dereference@@)8G8|)8G8@@)JA@@A!t@@@Q<@@@@)8G8G @@A@)EA@#8865@4@@@8@#44)8G8e2@1@@@5@#11)8G8m/@.@@@2@#..)8G8u,@+@@@/@#++)8G8~)@(@@@,@@Aг($Mode)8G8S)8G8W@/)8G8X)8G8Y@@@73))))))))@dS@GAA@Qu@@@@@@X|;@@@A@@@QB@Q#@@@@I@@@G@@ @@J@@JT@3))))))))@@@#EnvE*88*88@*A@Б!MBF*==*==@*1KA@гР(#Map$Make**==*+==@ *.==*/==@@@3*0*/*/*0*0*0*0*0@R@@@#Ord㐡+Stdlib__Map+OrderedType#key@;@@@A!t@@@S@@@@'map.mlis;/;Xs;/;h@@@@s@A@!t@;!a@S@A@A+Stdlib__Map$Make1@@SI@B@@@I V ZI V e@@@@2D@A@%empty#!a@S@@@S@0L  1L  @@DE@@#add@K@@@S@@S@!a@S@@S@& @@@S@@S*@@@S@@S@@S@@S@UO  VO  @@iF@@+add_to_list@%@@@S@@S@!a@S@@S@J$listK@@@S@@@S@@SU @@@S@@@S@@S@@S@@S@X  X  @@G@@&update@U@@@S@@S@@&optionL!a@S@@@S@@S  @@@S@@S@@S@@@@S@@S@@@S@@S@@S@@S@^^@@H@@)singleton@@@@S@@S@!a@S@@S@@@S@@S@@S@jW[jW{@@I@@&remove@@@@S@@S@ !a@S@@@S@@Sʠ@@@S@@S@@S@oo@@ J@@%merge@@@@@S@@S@p!a@S@@@S@@S@}!b@S@@@S@@S!c@S@@@S@@S@@S@@S@@S@ "@@@S@@S@@@@S@@S@@@S@@S@@S@@S@@vY]Ax@@TK@@%union@@@@@S@@S@!a@S@@S@@@Sà @@@S@@S@@S@@S@@S@B@@@S@@S@J@@@S@@SN @@@S@@S@@S@@S@yfjzf@@L@@(cardinal@_!a@S@@@S@@S#intA@@@S@@S@@@M@@(bindings@z!a@S}@@@S@@S~5@t@@@S|@@@S{@@@Sz@@Sy@8<8a@@N@@+min_binding@!a@Sv@@@Sx@@Sw@@@@Su@@@St@@Ss@bfb@@O@@/min_binding_opt@!a@Sp@@@Sr@@SqM@@@@So@@@Sn@@@Sm@@Sl@JNJ|@@ P@@+max_binding@ޠ!a@Si@@@Sk@@Sj@@@@Sh@@@Sg@@Sf@484[@@*Q@@/max_binding_opt@!a@Sc@@@Se@@Sd@@@@Sb@@@Sa@@@S`@@S_@9: @@MR@@&choose@!a@S\@@@S^@@S]@@@@S[@@@SZ@@SY@WX@@kS@@*choose_opt@=!a@SV@@@SX@@SWϠ@7@@@SU@@@ST@@@SS@@SR@z{@@T@@$find@J@@@SQ@@SP@g!a@SM@@@SO@@SN@@SL@@SK@@@U@@(find_opt@f@@@SJ@@SI@!a@SF@@@SH@@SG @@@SE@@SD@@SC@IMIs@@V@@*find_first@@@@@SB@@SA$boolE@@@S@@@S?@@S>@!a@S;@@@S=@@S<@@@@S:@@@S9@@S8@@S7@    D@@W@@.find_first_opt@@@@@S6@@S5/@@@S4@@S3@@S2@۠!a@S/@@@S1@@S0m@@@@S.@@@S-@@@S,@@S+@@S*@"*"."*"l@@,X@@)find_last@@@@@S)@@S(a@@@S'@@S&@@S%@ !a@S"@@@S$@@S#@@@@S!@@@S @@S@@S@E#_#cF#_#@@YY@@-find_last_opt@@@@@S@@S@@@S@@S@@S@:!a@S@@@S@@S̠@4@@@S@@@S@@@S@@S@@S@w$y$}x$y$@@Z@@$iter@@K@@@S@@S@!a@S @@S$unitF@@@S @@S @@S @@S @v@@@S@@S@@@S@@S@@S@%%%& @@[@@$fold@@y@@@S@@S@!a@R@@S@#acc@R@@S@@R@@R@@R@@R@@@@R@@R@@@R@@R@@R@@R@'%')'3'l@@\@@#map@@!a@R@@R!b@R@@R@@R@ˠ@@@R@@RϠ@@@R@@R@@R@(e(i(e(@@]@@$mapi@@@@@R@@R@!a@R@@R!b@R@@R@@R@@R@@@@R@@R@@@R@@R@@R@&))'))@@:^@@&filter@@@@@R@@R@!a@R@@Rw@@@R@@R@@R@@R@#@@@R@@R'@@@R@@R@@R@R**S**@@f_@@*filter_map@@&@@@R@@R@!a@R@@RѠ!b@R@@@R@@R@@R@@R@T@@@R@@RX@@@R@@R@@R@ ,, ,,?@@`@@)partition@@W@@@R@@R@!a@R@@R@@@R@@R@@R@@R@@@@R@@R@@@@R@@@@R@@R@@R@@R@.../%@@a@@%split@@@@R@@R@!a@R@@@R@@R@ @@@R@B@@@R@@@@R@@R@@R@@R@$0'0+$0'0\@@b@@(is_empty@Р!a@R@@@R@@R4@@@R@@R@022!022;@@c@@,is_singleton@!a@R@@@R@@RM@@@R@@R@32l2p32l2@@0d@@#mem@@@@R@@R@ !a@R@@@R@@Rm@@@R@@R@@R@<822=823@@Pe@@%equal@@!a@R@@R@@@R@@@R@@R@@R@@R@6@@@R@@R@>@@@R@@R@@@R@@R@@R@@R@m<3j3nn<3j3@@f@@'compare@@!a@R~@@R@@@R@@@R@@R@@R@@R@g@@@R@@R@o@@@R}@@R| @@@R{@@Rz@@Ry@@Rx@B44B44@@g@@'for_all @@r@@@Rw@@Rv@!a@Rp@@Ru@@@Rt@@Rs@@Rr@@Rq@@@@Ro@@Rn@@@Rm@@Rl@@Rk@F5r5vF5r5@@h@@&exists @@@@@Rj@@Ri@!a@Rc@@Rh@@@Rg@@Rf@@Re@@Rd@Ǡ@@@Rb@@Ra'@@@R`@@R_@@R^@K66"K66Q@@ i@@'to_list @ܠ!a@R[@@@R]@@R\@@@@RZ@@@RY@@@RX@@RW@R66R67@@-j@@'of_list @@@@@RV@!a@RR@@RU@@@RT@@RS@@@RQ@@RP@<V7]7a=V7]7@@Pk@@&to_seq @"!a@RM@@@RO@@RN&Stdlib#Seq!t@"@@@RL@@@RK@@@RJ@@RI@e\888<f\888a@@yl@@*to_rev_seq@K!a@RF@@@RH@@RG)#Seq!t@H@@@RE@@@RD@@@RC@@RB@`88`88@@m@@+to_seq_from@[@@@RA@@R@@x!a@R=@@@R?@@R>V#Seq!t@u@@@R<@@@R;@@@R:@@R9@@R8@d9;9?d9;9p@@n@@'add_seq@t#Seq!t@@@@R7@!a@R1@@R6@@@R5@@R4@ @@@R3@@R2@@@R0@@R/@@R.@i: :i: :=@@o@@&of_seq@#Seq!t@@@@R-@!a@R)@@R,@@@R+@@R*@@@R(@@R'@ m:: m::@@ p@@@@,>@.*,@Р%Ident1f==1g==@@z;@@@A@@@R%@@@@kRYYlRY_@@@@+@@A@Ӡ!T@@vTaiwTa@,Identifiables@@@%equal@!t@@@R$@@R#@  @@@R"@@R!$boolE@@@R @@R@@R@"@/Stdlib__Hashtblb@@$hash@@@@R@@R#intA@@@R@@R@7@c@@&output@&Stdlib+out_channel@@@R@@R@?>@@@R@@R$unitF@@@R@@R@@R@W@TC@@%print@!&Format)formatter@@@R@@R@^]@@@R@@R@@@R@@R @@R @t@qD@@Ӡ#Set@@|yu@@@Ӡ#Map@@v@@@Ӡ#Tbl@@w@@@)doc_print*Format_doc'printer@@@R @@@R @[(([(K@@,bB@@0print_with_scope'printer@@@R @@@R@(\LL)\Lw@@,uC@@-create_scoped%scope#intA@@@R@@R@&stringQ@@@R@@R7@@@R@@R@@R@JaKa"@@,D@@,create_local@@@@R@@QK@@@Q@@Q@^b##_b#@@@,E@@1create_persistent@*@@@Q@@Q_@@@Q@@Q@rcAAscAc@@,F@@-create_predef@>@@@Q@@Qs@@@Q@@Q@ddddd@@,G@@&rename@@@@Q@@Q@@@Q@@Q@ff@@,H@@$name@@@@Q@@Qh@@@Q@@Q@kRRkRg@@,I@@+unique_name@@@@Q@@Q|@@@Q@@Q@lhhlh@@-J@@4unique_toplevel_name@@@@Q@@Q@@@Q@@Q@mm@@-"K@@*persistent@@@@Q@@Q$boolE@@@Q@@Q@nn@@-8L@@$same@@@@Q@@Q@@@@Q@@Q@@@Q@@Q@@Q@oo@@-SM@@-compare_stamp@@@@Q@@Q@ @@@Q@@Q@@@Q@@Q@@Q@!v"v @@-nN@@'compare@@@@Q@@Q@%@@@Q@@Q@@@Q@@Q@@Q@@ @ @ @ @@@U=@@U< @@@U;@@U:@ @ @ @ @@@U9@@U8 @@@@U7@ @@U6@@@U5@@U4@ @ @  @+ @@@U3@@U2@&@@@U1@ @@U0@@U/@ @ @ !@@ @@@U.@@U- @>@@@U,@ @@U+@@@U*@@U)@ @ @ "@Y @@@U(@@U'@T@@@U&@ @@U%@@U$@ @ |@ {#@n z@@@U#@@U" v@l@@@U!@ @@U @@@U@@U@ u@ r@ q$@ p@@@U@@U@@@@U@ z@@U@@U@ l@ i@ h%@ g@@@U@@U c@@@@U@ t@@U@@@U@@U@ b@ _@ ^&@@@@U@@U@ ]@@@U@@U ^@@U@@U @ Y@ V@ U'@@@@U @@U @Ϡ T@@@U @@U  P X@@@U@@U@@U@ O@ L@ K(@@@@@U@@U J@@@U@@U@@U@ G@@@U@@T@@@@T@ Q@@T@@T@@T@ C@ @@ ?)@@@@@T@@T >@@@T@@T@@T@ =@@@T@@T 9@@@@T@ J@@T@@@T@@T@@T@ 8@ 5@ 4*@@ @@@T@@T 3@@@T@@T@@T@7 2@@@T@@T@2@@@T砠@ <@@T@@T@@T@ .@ +@ *+@@C@@@T@@T )@@@T@@T@@T@Z (@@@T@@T $@X@@@Tܠ@ 5@@T@@@T@@T@@T@ #@ @ ,@@j@@@T@@T@ @@T @@@T@@T@@T@@T@ (@@@T@@T @@@T@@T@@T@ @ @ -@@@@@T@@T@ @@T@ @@T @@T@@T@@T@@T@ @@@T@@T@ @@T @@T@@T@@T@ @ @ .@@ @@T @@T@@T@ @@@T@@Tà @@@T@@T@@T@ @ @ /@@@@@T@@T@ @@T @@T@@T@@T@ޠ @@@T@@T @@@T@@T@@T@ @ @ 0@@@@@T@@T@ @@T @@@T@@T@@T@@T@ @@@T@@T @@@T@@T@@T@ @ @ 1@@@@@T@@T@ @@T ܠ @@@T@@T@@T@@T@# @@@T@@T' @@@T@@T@@T@ @ @ 2@@*@@@T@@T@ @@T @@@T@@T@@T@@T@E @@@T@@T@M @@@T@S @@@T@@T@@T@@T@ @ @ 3@R@@@T@@T@f @@@T@@T@n @@@T~@ Ġ @@@T@z @@@T@@T}@@T|@@T{@ @ @ 4@ @@@Tz@@Ty @@@Tx@@Tw@ @ @ 5@ @@@Tv@@Tu @@@Tt@@Ts@ @ @ 6@@@@Tr@@Tq@ @@@Tp@@To @@@Tn@@Tm@@Tl@ @ @ 7@@ @@Tk@ @@Tj @@@Ti@@Th@@Tg@@Tf@ɠ @@@Te@@Td@Ѡ @@@Tc@@Tb @@@Ta@@T`@@T_@@T^@ @ @ 8@@ @@T]@ @@T\ @@@T[@@TZ@@TY@@TX@ @@@TW@@TV@ @@@TU@@TT @@@TS@@TR@@TQ@@TP@ @ @ 9@@@@@TO@@TN@ @@TM @@@TL@@TK@@TJ@@TI@ @@@TH@@TG @@@TF@@TE@@TD@ @ @ :@@@@@TC@@TB@ @@TA {@@@T@@@T?@@T>@@T=@9 @@@T<@@T; z@@@T:@@T9@@T8@ y@ v@ u;@H t@@@T7@@T6 p@F@@@T5@ @@T4@@@T3@@T2@ o@ l@ k<@ j@[@@@T1@ i@@T0@@@T/@@T.n m@@@T-@@T,@ e@ b@ a=@z `@@@T+@@T* \ Y X@z@@@T)@ o@@T(@@@T'@@T&@ W@ T@ S>@ R@@@T%@@T$ w N M@@@@T#@ a@@T"@@@T!@@T @ L@ I@ H?@@@@T@@T@ G@@@T@@T  C B@@@@T@ V@@T@@@T@@T@@T@ A@ >@ =@@  < ;@@@@T@ :@@T@@@T@@T@ B@@@T@@T F@@@T@@T@@T@ 6@ 3@ 2A@  1 0@@@@T @ /@@T @@@T @@T  3@@@T @@T@ +@ (@@R@@:==(@)@UA+!tCH:==:==@@;@@8A!t!t@@@W@@@W!@@@@:==:=> @ 8 A "t" maps each rec-bound variable to an access status :==:==@@@@@@@@@:LA@@Aг !M:=>:=>@':=>@@г)$Mode:==:=>@0:=>:=>@@@83::::::::@@wvA@onA@cb@\[@BA@! @@@@@ts@gf@PO@=<@&%@@@@@@@@fe@ED@ @@@@@@lk@BA@@@@@@@@ih@RQ@;:@"!@ @@@@@;@@@A@@@[@U@@@@@@@@rm@@@ks@@;O@@@@@@@@3;H;G;G;H;H;H;H;H@w@@@ఠ%equal;W> >;X> >@;pMA@@@R@@@\NI@\@@@\2@@\1@@@@\0@@\/ @@@\.@@\-@@\,I@\ 3;v;u;u;v;v;v;v;v@@@@డn%equal!M;> >;> >@ ;> >;> > @@@@ @@V@ @@V @@@V@@V@@V@@V@B @@@V@@V@J @@@V@@V @@@V@@V@@V@@V@ @ +&@@@@U@@\@Y@@\ @@@\@@\@@\@@\@ec@@@\@@\@mk@@@\@@\ @@@\@@\ @@\ @@\ \@@డK%equal$Mode;> >!;> >%@ ;> >&;> >+@@@@@@Q+@@Q*@@@@Q)@@Q(5@@@Q'@@Q&@@Q%@\@]@@@@@@\G@@\F@@@@\E@@\DG@@@\C@@\B@@\A@@'@@@A@<> > )@@*@@ఠ$find<>->3<>->7@<6NA@@@!R!t@@@\\I@\V@@\W@@@@\fI@\`@@\a@@@\I@\b@@\cI@\X@@\YI@\U3<><=<=<><><><><>@@@@@@࣠@"idA->9->;@->=<_>->B@4->C->D@@@<@@@\Z3->/Q>@@@ @@->8->E@@@I @@@@#tblA<|>->G<}>->J@<PA@гL!t<>->L<>->M@@T@@@\d3<<<<<<<<@'Hh@@@\]@B@C@@  @@<>->F<>->N@@@a @@@@డ$find!M<>Q>Y<>Q>Z@ <>Q>[<>Q>_@@@Tt@@@V@@V@\@@@V@@V@@V@@V@@ڰ@@@@@@\q@@\p@lI@\K@\m@@@\o@@\n@@\l@@\k3<<<<<<<<@Ga@@@\g@[@\@@@@ఐ"id<>Q>`<>Q>b@V@@4@@@\L@\@@ఐ}#tbl<>Q>c<>Q>f@"@@@@@\(@@T@@-)@Ġ)Not_found=>Q>l=>Q>u@ @@@@< @@@\7@@@ภ&Ignore=>Q>y@;@@@QH@@@@E@@A@@@@@D@@@=>Q>U@@JF@A@I@\@A@@@ݠ@ఠ%empty=)>>=*>>@=BQA@@Π@@\@@@\I@\3=2=1=1=2=2=2=2=2@@@@@@డ)%empty!M=C>>=D>>@ =G>>=H>>@@@@@U@@ΰ @@!@A@=Q>> @@ @@ఠ$join=^>>=_>>@=wRA@@@@@@\I@\@@\@@@@\I@\@@\@@@]I@\@@\I@\@@\I@\3=}=|=|=}=}=}=}=}@L]V@W@X@@@࣠@!xA=>>=>>@=SA@г+!t=>>=>>@@3@@@\3========@!G=>>=?8?A@@@  @@=>>=>>@@@@ @@@@!yA=>>=>>@=TA@гE!t=>>=>>@@M@@@\3========@'A_@@@\@;@<@@  @@=>>=>>@@@Z @@@@డ$fold!M=>>=>>@ =>>=>>@@@@:@@@Vh@@Vg@@@Vf@@@Ve@@Vd@@Vc@@Vb@@Va@@@@V`@@V_@@@V^@@V]@@V\@@V[@@(#@@@@Z@@@\@@\@!t@@@] K@\@@\@K@\@@\@@\@@\@@\@@\@Ǡ@@@\@@\@@@\@@\@@\@@\3>->,>,>->->->->-@k@@@\@@@@@@࣠@"idA>D>>>E>>@>]UA@г#t!t%Ident>V>>>W>>@ >Z>>>[>>@@@@@@\3>]>\>\>]>]>]>]>]@0@@ @@>c>>>d>>@@@@@@]@@@@!vA>r>>>s>>@>VA@гa$Mode>>>>>>@h>>>>>>@@@p@@@] 3>>>>>>>>@\PC@@@\@J@K@@ @@>>>>>>@@@} @@@@#tblA>>>>>>@>WA@г*!t>>>>>>@@2@@@]3>>>>>>>>@'H@@@]@B@C@@  @@>>>>>>@@@? @@@@@ఠ"v'>>>>>>@>XA@@@@@]3P@]3>>>>>>>>@ :W@@@]@4@5@@@ఐ $find>>?>>?@@@@@@@]#@@]"@@@@]!@@] @@@]@@]@@]#@@ఐ"id>>?>>?@r@@@@@]7Q@]9Q@]87@@ఐu#tbl?>? ?>? @A@@@@@]5Q@]AQ@]@K@@= @@OL@A@?>> @@డ#add!M?+???,??@ ?/???0??@@@@@@U@@U@@@U@@@@U@@U@@@U@@U@@U@@U@@ @@@@@@]L@@]K@@@@]O@]G@@]J@ @@@]I@@]H@@@]F@@]E@@]D@@]C3?d?c?c?d?d?d?d?d@@@@@@@ఐ3"id?t???u??!@@@@@@]kP@]j@@డ$join$Mode???#???'@ ???(???,@@@0@@@Q2@@Q4@@@Q3@@Q1@@Q0@@@@@<@@@]s@@]u@@@]t@@]r@@]qD@@ఐF!v???-???.@@@fQ@]Q@]Q@]W@@ఐ"v'???/???1@a@@sd@@???"???2@@g@@ఐ<#tbl???3???6@@@_@@@]w@@@@~@@@]b|@ @@@?>>???7@@@:@@@\@@\@@@\@@@\@@\@@\@@\L@]L@]@@ఐy!x@?8?>@?8??@>@@@@@]@@ఐc!y@?8?@p@q@@@@@]@@;u@@@svA@I@]}@A@z@zy@@ఠ)join_list@)?C?I@*?C?R@@BYA@@@:@@@^"J@]@@@^I@]@@]@@@^$I@]@@]I@]3@@@?@?@@@@@@@@@@@@@@@@࣠@"liA@Q?C?S@R?C?U@@jZA@@"3@R@Q@Q@R@R@R@R@R@1@Y?C?E@Z?C?t@@@@@  @@డ>$List)fold_left@j?C?X@k?C?\@ @n?C?]@o?C?f@@$߰@@@@@@ఐ!mA??A??@@@K@@A??A??@@@^@@@^@@^a@@@^~@@^}X@@ఐ#envA??@a@@d@@@@e@A@I@^@A@@@Ҡ@ఠ&singleA??A??@B^A@@@?@@@^I@^@@^@@^I@^@@^@@@^I@^@@^I@^@@^I@^3BBBBBBBB@,%@&@'@@@࣠@"idAB??B??@B-_A@@&3BBBBBBBB@5B??B??@@@@@  @@$modeAB(??B)??@BA`A@@/3B)B(B(B)B)B)B)B)@!=@@@@@@@@డ$#add!MB>??B???@ BB??BC??@@@@@@@@^@@^@R@@^@Y@@@^@@^]@@@^@@^@@^@@^3BZBYBYBZBZBZBZBZ@2>c@5@6@@@@ఐY"idBj??Bk??@>@@{@@ఐR$modeBw??Bx??@@@}@@ఐ[%emptyB??h@i@@%L@^@@@^/@@Op@@0@zqA@I@^x@A@u@ut@@ఠ)unguardedB??B??@BaA@@@q@@@_HI@^@@^@<@@@_JK@^@@@_I@^@@^< @@@_I@^@@^I@^@@^I@^3BBBBBBBB@@@@@@࣠@#envAB??B??@BbA@@03BBBBBBBB@?B??B?@9@@@@@  @@"liAB??B??@BcA@@93BBBBBBBB@!G@@@@@@@@డAf$List&filterB??B??@ C??C?@@@@@!a@.@@12@@@1@@1@@1@e@@@1@@1]@@@1@@1@@1@2^-)-)2^-)-X@@2o@)$@@@@v@@^@@@^@@^@@^@@@@^@@^y@@@^@@^@@^3C9C8C8C9C9C9C9C9@S_@V@W@@@@࣠@"idACM?@CN?@@CfdA@@3CNCMCMCNCNCNCNCN@@@@@@@డA!>C]?@$C^?@%@@!a@@@*@@@)i@@@(@@'@@&,%greaterthanBA*Ӡ@@@@**@@*T@@@@Br@@@_,M@_@@_@ @@_@@@_@@_@@_3CCCCCCCC@OF@=@>@@@@డ $rank$ModeC?@ C?@@ C?@C?@@@@A@@@Q/@@Q.B@@@Q-@@Q,@N@O@@@L@@@_%@@_$B@@@_#@@_"0@@ఐ$findC?@C?@@@@@@@@_6@@_5@@@@_4@@_3@@@_2@@_1@@_0P@@ఐ"idC?@C?@@Z@@0]@@ఐ"#envC?@C?@"@@@Nj@@C?@C?@#@@@@@_Fp@@^@@{q@@డ s$rank$ModeD ?@&D ?@*@ D?@+D?@/@@n@@@@@@_Z@@_YC @@@_X@@_W@@ภ%GuardD&?@0D'?@5@;@@@BE@@A@@@@@@@@_i@@$@@O@_a@@ @@$@@@_lN@_@D8?@D9?@6@@@@@_2@@@_@@_L@_qL@_n@@ఐl"liDO?@7u@v@@@@Vw@@@xA@I@_x@A@|@|{@@ఠ)dependentDa@;@ADb@;@J@DzeA@@@6@@@_I@_z@@_{@ŠT@@@_K@_@@@_I@_@@_Ġ @@@_I@_@@_I@_|@@_}I@_y3DDDDDDDD@@@@@@࣠@#envAD@;@KD@;@N@DfA@@.3DDDDDDDD@=D@;@=D@T@@@@@@  @@"liAD@;@OD@;@Q@DgA@@73DDDDDDDD@!E@@@@@@@@డC)$List&filterD@T@XD@T@\@ D@T@]D@T@c@@ð@@@@T@@_@@@_@@_@@_@#^@@@_@@_b@@@_@@_@@_3DDDDDDDD@2>k@5@6@@@@࣠@"idAD@T@iD@T@k@EhA@@x3DDDDDDDD@@@@@@@డClD@T@D@T@@@@@C@@@_M@_@@_@ @@_@@@_@@_@@_3EE E EEEEE@4+@"@#@@@@డ!$rank$ModeE$@T@oE%@T@s@ E(@T@tE)@T@x@@@@@ @@@_@@_D%@@@_@@_%@@ఐ %$findEB@T@zEC@T@~@ @@@ @@@_@@_@ @@@_@@_ @@@_@@_@@_E@@ఐt"idE`@T@Ea@T@@O@@R@@ఐ۠#envEm@T@En@T@@@@_@@Eq@T@yEr@T@@@ 6@@@_e@@S@@pf@@డ!$rank$ModeE@T@E@T@@ E@T@E@T@@@@@@ +@@@_@@_D@@@_@@_@@ภ&IgnoreE@T@E@T@@@@@ h@@@`@@"@@O@_@@ @@@@@` N@_@E@T@dE@T@@@@A@@_@@@_@@_L@`L@` @@ఐ#"liE@T@,@-@@U@@ .@@I@8/A@hI@`6@A@3@32@I@ఠ&removeàE@@E@@@EiA@@@ 0@@@`@@`@ @`@@@`@@` @@@`@@`@@`I@`3EEEEEEEE@o@@@@@డ&remove!MF@@F@@@ F@@F@@@@@ Z@@@U@@U@ @@@U@@U @@@U@@U@@U@@ذ@@>*@A@F @@@@@-@ఠ$takeĠF-@@F.@@@FFjA@@@ @@@`tI@` @@`!@ @@@`HI@`&@@`'@ @@@`FI@`,@  @@`I@`W@@@`mI@`-@@`.I@`(@@`)I@`"@@`#I@`3F]F\F\F]F]F]F]F]@l@@@@@࣠@"idAFn@@Fo@@@FkA@@;3FoFnFnFoFoFoFoFo@JFv@@Fw@@@@@@@  @@#envAF@@F@@@FlA@@D3FFFFFFFF@!R@@@@@@@@@ఐ {$findF@@F@@@ c@@@ v@@@`6@@`5@ o@@@`4@@`3 l@@@`2@@`1@@`03FFFFFFFF@'3m@*@+@@@@ఐN"idF@@F@@@3@@@@ఐG#envF@@F@@@@@@@2@@{@@ఐ&removeF@@F@@@u@@@ '@@@`[@@`Z@ @@@`Y@@`X @@@`V@@`U@@`T?@@ఐ"idF@@F@@@o@@L@@ఐ#envG@@G@@@V@@Y@@1@@Z@@G@@@@@@@@`b@A@I@`@A@@@@ఠ+remove_listȠG@@G@@@G6mA@@@A y@@@`K@`@@@`I@`@@`@ ٠ @`@@@`I@`@@`I@`@@`I@`@@`I@`3G>G=G=G>G>G>G>G>@@@@@@࣠@!lAGO@@GP@@@GhnA@@,3GPGOGOGPGPGPGPGP@;GW@@GXAA<@@@@@  @@#envAGc@@Gd@A@G|oA@@/3GdGcGcGdGdGdGdGd@!C@@@@@@@@డE$List)fold_leftGyAAGzAA @ G}AA G~AA@@+@@@@QK@`@@`@c@@`@@`@@`@@`@ @@`@Aun@@@`@@`@@`@@`@@`3GGGGGGGG@5Af@8@9@@@@࣠@#envAGAAGAA@GpA@@'3GGGGGGGG@@@@@@@"idAGAA GAA"@GqA@@3GGGGGGGG@%9@@@@@@@@డ&remove!MGAA&GAA'@ GAA(GAA.@@ΰ@@@ (@@@`@@`@ @@@`@@` @@@`@@`@@`3GGGGGGGG@.:@1@2@@@@ఐA"idGAA/GAA1@ @@@@ఐ]#envHAA2HAA5@G@@@@9@@ @@@`"@HAAHAA6@@@@@`@@@`@@`@@`L@aL@am@@ఐǠ#envH'AA7H(AA:@@@@@ఐ蠐!lH4AA;@̰@@@@@@@A@I@a@A@@@@*@@ $@@  A@  @ + @ ! @ @%=@pD@j@@[@}@-@?8@9@:@@3HVHUHUHVHVHVHVHV@B@@H\==H]A=A@@$3H\H[H[H\H\H\H\H\@,@@@!tI;@@FoA@@@@@Hg88Hh88@@@@HrAA@&single@-!t@@@a@@a@$!t@@@a@@a#@@@a@@a@@a@H88H88@$ِ J Create an environment with a single identifier used with a given mode. H88H99@@@@@@@HsA@%empty>@@@a@H99!H99.@$ * An environment with no used identifiers. H9/91H9/9`@@@@@@@HtA@$find@-!t@@@a@@a@g@@@a@@a%>!t@@@a@@a@@a@H9b9dH9b9@%# V Find the mode of an identifier in an environment. The default mode is Ignore. H99H99@@@@@@@HuA@)unguarded@@@@a@@a(@Hl.!!t@@@a @@@a"@@a&Hw.,!t@@@a#@@@a%@@a'@@a)@I 99I 9:@%\ o unguarded e l: the list of all identifiers in l that are dereferenced or returned in the environment e. I::I:h:@@@@@@@I2vA@)dependent@@@@a*@@a3@H.Z!t@@@a+@@@a-@@a1H.e!t@@@a.@@@a0@@a2@@a4@ID::IE::@% Y dependent e l: the list of all identifiers in l that are used in e (not ignored). IR::IS;;%@@@@@@@IkwA@$join@@@@a5@@a:@@@@a6@@a8 @@@a7@@a9@@a;@Io;';)Ip;';?@@IxA@)join_list@H@@@a<@@@a>@@a@$@@@a?@@aA@I;@;BI;@;]@%ڐ > Environments can be joined pointwise (variable per variable) I;^;`I;^;@@@@@@@IyA@'compose@&!t@@@aB@@aG@M@@@aC@@aEQ@@@aD@@aF@@aH@I;;I;;@& j Environment composition m[G] extends mode composition m1[m2] by composing each mode in G pointwise I;;I< <7@@@@@@@IzA@&remove@.!t@@@aI@@aN@z@@@aJ@@aL~@@@aK@@aM@@aO@I<9<;I<9=@'0J񐠠=<@<<@@@<@<@J::J9b9hJ9b9l@б@г9%IdentJ9b9oJ9b9t@@K9b9uK9b9v@@@H3KKKKKKKK@)lj@A @@б@гC!tK9b9zK9b9{@@K @@гH$ModeK9b9K9b9@OK9b9M@N@@VO@@_P@@j&Q@@l@SR@'tK5RQ@QQ@@@Q@Q@+_OOK699K799@б@гN!tK@99KA99@@V3K?K>K>K?K?K?K?K?@>@A@@б@гS$listKM9:KN9:@гX%IdentKX99KY9:@_K\9:K]9:@@@g@@@l @@гb$listKg9:\@гf%IdentKq9: Kr9:@mKu9:Kv9:@@@u6@@@z7 n@@8#o@@9<p@@@rq@'Kqp@pp@@@p@p@F~nnK::K::@б@гm!tK::K::@@u3KKKKKKKK@Y@A@@б@гr$listK::K::@гw%IdentK::K::@~K::K::@@@@@@ @@г$listK::{@г%IdentK::K::@K::K::@@@6@@@7 @@8#@@9<@@@@($K吠@@@@@@FK;';-K;';1@б@г!tK;';4K;';5@@3KKKKKKKK@Y@A@@б@г!tK;';9K;';:@@ @@г!tL;';>@@@@ @@@@@@@L;@;FL;@;O@б@г$listL;@;TL;@;X@г!tL$;@;RL%;@;S@@3L#L"L"L#L#L#L#L#@5@A@@@@@г!tL0;@;\@@ @@ @@@@(LD@@@@@@LE;;LF;;@б@г$ModeLQ;;LR;;@LU;;LV;;@@@3LULTLTLULULULULU@3@A @@б@г!tLc;;Ld;;@@ @@г!tLl;;@@@@ @@@@@@(L@@@@@@$ǠL<9@A @@б@г!tL<9  @A @@б@гР!tL<<L<<@@ @@В@гՠ$ModeL<<L<<@ܰL<<L<<@@@!@@@гߠ!tL<<@@+@@@,@@-#@@.6@@ @@)QM@@@@@@;򠰐M<=M<=@б@г᠐$listM<=M<=@г校%IdentM(<=M)<=@M,<=M-<=@@@3M,M+M+M,M,M,M,M,@^;9@A @@@ @@б@г!tM;<=!M<<="@@@@г!tMD<=&@@@@ @@ @@@@)MY@@@@@@%MZ=l=rM[=l=w@б@г!tMd=l=zMe=l={@@3McMbMbMcMcMcMcMc@897@A@@б@г!tMq=l=Mr=l=@@ @@г$boolMz=l=@@@@ @@@@@@@@3M|M{M{M|M|M|M|M|@ @A!3M~M}M}M~M~M~M~M~@#N@@M88M==@@G@C@B@H@I@D@E@F@J@K@L@A@@#@@@M88E@B!@@M88G@H@$@ఠ*remove_patܠMABAFMABAP@MA@@@II/general_pattern@e1@@@eAJ@d@@d@#k@@@e'J@d@@d@@@e%J@d@@dJ@d@@dJ@d3MMMMMMMM@##@xvA@qo@DB@+)@@@@us@OM@$"@@@@@@Q#@@@࣠@#patAMABAQMABAT@NA@@H3MMMMMMMM@.WNABABNA[A@@@@@  @@#envANABAUNABAX@N+A@@M3NNNNNNNN@!_@@@@@@@@డ$ +remove_list#EnvN(A[A]N)A[A`@ N,A[AaN-A[Al@@@@@@e @@@e@@e@u@@@e@@ex@@@e@@e@@e@@@@@@@e@@@e@@e@@@@e@@e@@@e@@e@@e3NYNXNXNYNYNYNYNY@GS@J@K@@@@డL0pat_bound_identsNkA[AnNlA[A~@@!k@@@@@@G@!t@@@@@@@@@It-t-It-te@@J@@@@Ҡ@@@e0@@e/@@@e.@@@e-@@e,=@@ఐ#patNA[ANA[A@@@J@@NA[AmNA[A@@wy@@@e*@@@e)M@eJN@e9X@@ఐ#envNA[A@a@@d@@@@e@A@J@eP@A@@@𠰡@ఠ.remove_patlistNAANAA@NA@@@H&@e@@@eL@ef@@@eJ@eR@@eS@%@@@eJ@eX@@eYJ@eZ@@e[J@eT@@eUJ@eQ3NNNNNNNN@!KD@E@F@@@࣠@$patsAOAAOAA@OA@@-3OOOOOOOO@<O AAO AA@@@@@  @@#envAOAAOAA@O0A@@-3OOOOOOOO@!D@@@@@@@@డM$List*fold_rightO-AAO.AA@ O1AAO2AA@@@@!a@/c@@1;@#acc@/_@@1:@@19@@18@@17@q@@@16@@15@@@14@@13@@12@@11@>>@@>^@-(@@@@@@ek@xL@eb@@ej@@ei@@eh@@eg@@@@ee@@ed@@@ec@@ea@@e`@@e_3OqOpOpOqOqOqOqOq@Zf@]@^@@@@ఐѠ*remove_patOAAOAA@@@@̠@@@e@@e@@@@e@@e@@@e@@e@@e"@@ఐ$patsOAAOAA@@@/@@ఐ#envOAA@8@@;@@@@J<@A@J@e@A@@@A+)term_judgJOG)G.OG)G7@@;@@MA@,8!t@@@e@@e%!t@@@e@@e@@@@OG)G)OG)GI@@@@OA@@Aб@г$ModeOG)G:OG)G>@OG)G?OG)G@@@@"3OOOOOOOO@@@2;@@@A:@@@e@e@@@@#@@@ @@@@г*#EnvOG)GDOG)GG@1PG)GH/@0@@81@@C%2@@4@@43@3PPPPPPPP@@@A+)bind_judgKPGJGOPGJGX@@;@@NA@,!t@@@e@@e@&%!t@@@e@@e&+!t@@@e@@e@@e@@@@P/GJGJP0GJGs@@@@PHA@@Aб@г$ModeP=GJG[P>GJG_@$PAGJG`PBGJGa@@@,3PAP@P@PAPAPAPAPA@^;;@@@AC@@@e@e@@@@"@@@@@@@б@г1#EnvP[GJGeP\GJGh@8P_GJGiP`GJGj@@@@@@г;#EnvPkGJGnPlGJGq@BPoGJGr@@A@@I-B@@T.C@@_/7D@@F@@FE@3PrPqPqPrPrPrPrPr@0@@@ఠ&optionPGuGyPGuG@PA@Ш!a@б@б@А!a @e3PPPPPPPP@R@@PGuGPGuG@@г堐)term_judgPGuGPGuG@@ @@@e@@@@@e@@e @@б@гP &optionPGuGPGuG@А!a)&PGuGPGuG@@@/@@@e- @@г)term_judgPGuGPGuG@@ @@@e:@@@@@e@@e? @@@2@@e @@eDPGuG@@L@@eIPGuGA@a`A@@@@Y@f@@fR@@@f@@f @@f @E @@@f @@f 4@@@f @@f@@f@@ff@࣠@!fAQGGQGG@Q A@@@|@f@@f-v@@@f,@@f+3QQQQQQQQ@QGuGuQGG@@@@@@@!oAQ$GGQ%GG@Q=A@@y@@@f:3Q)Q(Q(Q)Q)Q)Q)Q)@.@$@@f*@@@f)@@f(@,@-@@@@@@!mAQ@GGQAGG@QYA@@@@@fF3QDQCQCQDQDQDQDQD@,>@@@f9@'@(@@@@@@ఐ8!oQYGGQZGG@@@P@@@fK3Q]Q\Q\Q]Q]Q]Q]Q]@)@@@fE@#@$@@@Ġ$NoneQpGGQqGG@;PPPː@@W@@@@AA@AQ@@P@@ @@ʠm@@@fP3QzQyQyQzQzQzQzQz@@@@@Ϡr@@@fQ@@@డ'%empty#EnvQGGQGG@ QGGQGG@@@@@d@ @@@@@fZ@Ġ$SomeQGGQGG@;P6@PA@AA@AQ@@Pఠ!vQGGQGG@QA@@S@fUW@@@@@ @@@fV\@@ @@@fW`@@@ఐŠ!fQGGQGG@@@@@@f`5@@@f_@@f^3QQQQQQQQ@t(!@"@#@@@@ఐ/!vQGGQGG@ @@.@@ఐ!mQGG@@@.@@@fwR@fyR@fx%@@0@@`&@@@AQGG@@0@@@f@QGG@@@@@@fo@@@f@@f@@f@b@@@f@@fQ@@@f@@f@@fL@f@A@@@@ఠ$listR$GHR%GH@R=A@Ш!a@б@б@А!a @f3R6R5R5R6R6R6R6R6@@@@e@@f@@@fM@f@@f@@e@@@@e@@e@@@fM@e@@e@@e@@@@RYGHRZGH@@г)term_judgRbGHRcGH@@ @@@f.@@@6@@f@@f3 @@б@гQ砐$listRvGH%RwGH)@А!aFCR}GH"R~GH$@@@L@@@fJ @@гΠ)term_judgRGH-RGH6@@ @@@fW@@@@@f@@f\ @@@2@@f @@faRGH @@i@@ffRGH A@~}A@@@@v@g@@g R@@@g @@g@@g@E @@@g@@g4@@@g@@g@@g@@g@࣠@!fARH9H?RH9H@@RA@@@@g @@g(v@@@g'@@g&3RRRRRRRR@RGGRHIH@@@@@@@"liARH9HARH9HC@RA@@y@@@g53RRRRRRRR@.@$@@g%@@@g$@@g#@,@-@@@@@@!mASH9HDSH9HE@SA@@?@@@gA3SSSSSSSS@,>@@@g4@'@(@@@@@@డQ$List)fold_leftSHIHMSHIHQ@ S!HIHRS"HIH[@@7@@@@f@@@gO@gO@gI@@gR@kO@gL@@gQ @@gP@@gO@@gN@@@gM@M  @@@gK@@gJ@@gH@@gG@@gF3SCSBSBSCSCSCSCSC@@O@@@g@@I@J@@@@࣠@#envASZHIHaS[HIHd@SsA@@13S[SZSZS[S[S[S[S[@@@@@@@$itemASiHIHeSjHIHi@SA@@53SjSiSiSjSjSjSjSj@(C@@@@@@@@డ)w$join#EnvSHIHmSHIHp@ SHIHqSHIHu@@@@@@d@@d@@@@d@@d@@@d@@d@@d@ *@ '@@@@@@g@@g~@@@@g}@@g|@@@g{@@gz@@gy3SSSSSSSS@>Ju@A@B@@@@ఐ`#envSHIHvSHIHy@J@@@@ఐ!fSHIH{SHIH|@ڰ@@@@@gr@@@g@@g&@@ఐt$itemSHIH}SHIH@0@@3@@ఐꠐ!mSHIHSHIH@@@)@@@gT@gT@gI@@SHIHzSHIH@@/@@@g@gT@gS@@ @@S@gV@THIH\THIH@@@@@gk@@@gj@@gi@@ghP@gP@g@@డ*%empty#EnvTHIHTHIH@ T!HIHT"HIH@@@@P@g@@ఐP"liT1HIHY@)Z@@N@@@geP@gP@g@@c@@@T=H9H;e@@@@y@@g@@@g@@g@@g@@@@g@@g@@@g@@g@@gL@g@A@@~@@ఠ%arrayTbHHTcHH@T{A@Ш!a@б@б@А!a @h3TtTsTsTtTtTtTtTt@?Y@@L@f@@f+@@@fM@f@@f@@f@@@@f@@f@@@fM@f@@f@@f@o@p@@THHTHH@@г㠐)term_judgTHHTHH@@ @@@h.@@@6@@h@@h3 @@б@гT0%arrayTHHTHH@А!aFCTHHTHH@@@L@@@hJ @@г )term_judgTHHTHH@@ @@@hW@@@@@h@@h\ @@@2@@h @@haTHH@@i@@hfTHHA@~}A@@@@v@h?@@hHR@@@hG@@hF@@hE@E @@@hD@@hC4@@@hB@@hA@@h@@@h>@࣠@!fAUHHUHH@UA@@@@hI@@hfv@@@he@@hd3UUUUUUUU@UHHUHI*@@@@@@@"arAU"HHU#HH@U;A@@y@@@hs3U'U&U&U'U'U'U'U'@.@$@@hc@@@hb@@ha@,@-@@@@@@!mAU>HHU?HH@UWA@@}@@@h3UBUAUAUBUBUBUBUB@,>@@@hr@'@(@@@@@@డS%Array)fold_leftU[HHU\HH@ U_HHU`HH@@@@#acc@i@@ku@!a@i@@kt @@ks@@kr@@kq@@@kp@%arrayJ@@@ko@@kn@@km@@kl@@kk@)array.mli    @@-Stdlib__ArrayY@2-@@@@@@@lO@lO@lf@@lo@O@li@@ln @@lm@@ll@@lk@@@lj@+ @@@lh@@lg@@le@@ld@@lc3UUUUUUUU@jy@@@h~@s@t@@@@࣠@#env,AUHHUHH@UA@@13UUUUUUUU@@@@@@@$item-AUHHUHI@UA@@53UUUUUUUU@(C@@@@@@@@డ+$join#EnvUHIUHI@ UHI UHI @@h@@@(@@@l@@l@/@@@l@@l2@@@l@@l@@l3UUUUUUUU@,8c@/@0@@@@ఐN#envV HIVHI@8@@{@@ఐ!fVHIVHI@@@@@@l@@@l@@l&@@ఐb$itemV0HIV1HI@0@@3@@ఐ!mV=HIV>HI@@@@@@lT@lT@lI@@VJHIVKHI@@@@@l@lT@lS@@m @@S@lV@VWHHVXHI@@@@@l@@@l@@l@@lP@lP@l@@డ,k%empty#EnvVsHIVtHI!@ VwHI"VxHI'@@@@P@l@@ఐh"arVHI(q@Ar@@@@@lP@lP@l@@7{@@@VHH}@@@@@@m@@@m@@m@@m@@@@m@@l@@@l@@l@@lL@l@A@@@6@ఠ&single.VI,I0VI,I6@VA@б@г;!t%IdentVI,I9VI,I>@ VI,I?VI,I@@@@@@@m,3VVVVVVVV@`z@@m@h2@@h;L@@@h@@@m=@@m<=@డ-&single#EnvWI,IPWI,IS@ W"I,ITW#I,IZ@@@@@@d@@d@@@@d@@d k@@@d@@d@@d@@б@г@R@@@n=@@n<H@@@n;@@n:@@n9L@n1@A@@@n@ఠ$join4Y"IIY"II@Y,A@б@гX$listY#"IIY$"II@г p)term_judgY-"IIY."II@@ @@@nB3Y/Y.Y.Y/Y/Y/Y/Y/@@@@@m@@@m@@m@@@@m@@m@@@m@@m@@m@@@@@@@/@@@nD#,@@г )term_judgYW"IIYX"II@@ @@@nE*@@@@@nF@@nG/5 @@POA@@@KD@@@n[@@@nZ@@nY@@@nX@@nW?@࣠@"li6AY|#IIY}#II@YA@@X @@@nq@@@np3YYYYYYYY@X{Y"IIY#IJ"@@@@@@@!m7AY#IIY#II@YA@@ @@@n}3YYYYYYYY@-#"@@@no@@@nn@+@,@@@@@@డ/)join_list#EnvY#IIY#II@ Y#IIY#IJ@@@J @@@d@@@d@@d @@@d@@d@GD6@@@Y @@@n@@@n@@n @@@n@@n3YYYYYYYY@?N @@@n|@H@I@@@@డX^$List#mapY#IJY#IJ @ Y#IJ Y#IJ@@@@!a@/@@0!b@/@@0@@0@S@@@0@@0S@@@0@@0@@0@II@@IW@+&@@@@@@@nO@n@@n g@@@nO@nO@nO@n@@n@@n@)@@@n@@n(@@@n@@n@@nc@@࣠@!f8AZO#IJZP#IJ@ZhA@@,3ZPZOZOZPZPZPZPZP@u@@@@@@ఐ!fZ_#IJZ`#IJ@;@@@@<3Z`Z_Z_Z`Z`Z`Z`Z`@@@@@ఐ٠!mZo#IJZp#IJ@@@ @M@nO@n@@ @@OO@n@Z|#IJZ}#IJ@@@_@@nZ@@nP@nP@n3@@ఐ"liZ#IJZ#IJ!@@@s@@@nP@nP@n@@Z#IJ@@&r@@@nO@nP@nR@@@@ @@@nO@nX@Z#II@б@г2г3@7@@@n\5t@@>@@@n^9s@г rq@@@@n_An@@@@n`@@naEm@#AA@@@@@@n@@@n@@n@@@n@@nL@nV@A@S@SR@@ఠ%empty9Z%J$J(Z%J$J-@[A@@@@@nL@n@@n 0@@@nL@n@@nL@n3ZZZZZZZZ@@@@@nV@@@nU@@nT@@@nS@@nR@@@@@࣠@%param;A@[%J$J4[%J$J5@@%3[[[[[[[[@4[%J$J$[%J$JB@@@@@ @@డ1%%empty#Env[-%J$J9[.%J$J<@ [1%J$J=@@ @@9@[5%J$J0@@GL@n@A@@@;@ఠ"<<<[D*KK[E*KK@[]A@б@г )term_judg[T*KK[U*KK'@@ @@@n3[V[U[U[V[V[V[V[V@\tm@n@o@@ @@б@г7!t$Mode[j*KK+[k*KK/@ [n*KK0[o*KK1@@@@@@n @@г )term_judg[|*KK5[}*KK>@@ @@@n(@@@@@n@@n- @@@5@@n @@n28@@IHA@@@D@@@o@@o@9@@@o@@o&@@@o@@o@@oE@࣠@!f>A[+KAKG[+KAKH@[A@@ @@@o-3[[[[[[[[@Yr[*KK[+KAK@@@@@@@*inner_mode?A[+KAKI[+KAKS@[A@@88f@@@o:3[[[[[[[[@* @@@o,@$@%@@@@@@࣠@*outer_mode@A[+KAK[[+KAKe@[A@@ @@@oF3[[[[[[[[@,"@@@o9@&@'@@@@ @@ఐO!f[+KAKi[+KAKj@+@@K@@@oK3[[[[[[[[@' 9@@@oE@!@"@@@@డ8y'compose$Mode\+KAKl\+KAKp@ \+KAKq\+KAKx@@@@@ @@@oe@@od@ @@@oc@@ob @@@oa@@o`@@o_/@@ఐZ*outer_mode\4+KAKy\5+KAK@9@@ @@@ouQ@owQ@ovC@@ఐ*inner_mode\H+KAK\I+KAK@d@@ @@@osQ@oyQ@oxW@@\S+KAKk@@ @@@o]@ozQ@oqb@@i@@ @@@o{P@o[h@\d+KAKW@@ @@@oN@o}@\l+KAKC@б@гŠ$#@@@@o@б@г@@@@o@г@"@@@o @@@@o@@o @@@@o@@o @)A@@@N@@@o@@o@C@@@o@@o0@@@o@@o@@oL@o@A@@@P@ఠ">>A\1LrLv\1LrLz@\A@б@г )bind_judg\1LrL}\1LrL@@ @@@o3\\\\\\\\@q@@@@o@@o @x@@@o @@o e@@@o @@o @@o@@@@@@б@г *)term_judg\1LrL\1LrL@@ @@@o#@@г 7)term_judg\1LrL\1LrL@@ @@@o0@@@@@o@@o5 @@@=@@o @@o:@@@QPA@@@L@@@o@@o@0@@@o@@o&@@@o@@o@@oM@࣠@&binderCA]!2LL]"2LL@]:A@@ @@@o3]&]%]%]&]&]&]&]&@az]-1LrLr].2LL@@@@@@@$termDA]92LL]:2LL@]RA@@ @@@o3]>]=]=]>]>]>]>]>@)@@@o@#@$@@@@@@$modeEA]Q2LL]R2LL@]jA@@ @@@p3]U]T]T]U]U]U]U]U@(@@@o@"@#@@@@ @@ఐK&binder]i2LL]j2LL@(@@G@@@p3]l]k]k]l]l]l]l]l@' @@@p@!@"@@@@ఐ1$mode]2LL]2LL@@@ n@@@p"P@p$P@p#@@ఐa$term]2LL]2LL@?@@]@@@p&.@@ఐY$mode]2LL]2LL@8@@ @@@p8Q@p:Q@p9D@@]2LL@@ @3@p @p;Q@p6N@@U@@ @@@p0class_field_kind@@@p@@p:@@@p@@p@^mq^m@@_A&modexpL@]S+module_expr@@@p@@pO@@@p@@p@_ /3_ /9@@_#A$pathM@$Path!t@@@p@@pf@@@p@@p@_!fj_"fn@@_:A)structureN@])structure@@@q@@p{@@@p@@p@_6_7@@_OA.structure_itemO@].structure_item@@@q@@q=@@@q@@q @_K,_L,@@_dA.module_bindingP@@^D!t@@@q,@@@q+@]+module_expr@@@q-@@q*@@q)c@@@q(@@q'@_qe_c_re_q@@_A0open_declarationQ@]0open_declaration@@@q=@@q<x@@@q;@@q:@_vim_vi}@@_A9recursive_module_bindingsR@_@^D!t@@@q^@@@q]@]+module_expr@@@q_@@q\@@@q[@@qZ@@@qY@@qX@_|_|@@_A*class_exprS@^*class_expr@@@qo@@qn @@@qm@@ql@__@@_A5extension_constructorT@^$5extension_constructor@@@q@@q~ @@@q}@@q|@__@@_A.value_bindingsU@^P(rec_flag@@@q@@q@_f^F-value_binding@@@q@@@q@@q@@@q@@q@@q@__@@`A$caseV@^\$case!k@q@@@q@@q@6@@@q@@q@6$!t@@@qˠ@6@@@q@@q@@qN@q@@q@`. `/ @@`GA'patternW@^/general_pattern!k@q@@@q@@q@6K!t@@@q@@q6@@@q@@qN@q@@q@`S@D`T@K@@`lA8is_destructuring_patternX@^/general_pattern!k@r @@@r @@r `%@@@rN@r @@r @`n2RV`o2Rn@@`A@@@@  @@ఐ#exp`~:MM`:MM@@@@r@@@@[@@@s@s3````````@. @@@(exp_desc`:MM`:MM@Y@@Y@@@s @Ġ*Texp_ident`;MM`;MM@Xఠ#pthZ`;MM`;MM@`A@@Zf@@@s3````````@&@@@@`;MM`;MM@@XX@@@s@@@s @@`;MM`;MM@@X@@@s@@@&`;MM@@Z@@@s@@Z!@@@s@@@ఐŠ$path`<MM`<MM@ɰ@@@@@@uB@@uA@@@u@@@u?3````````@Z@9@:@;@@@@ఐG#pth`<MM`<MN@ @@@@@uVP@uXP@uW@@% @@E@@@u=@Ġ(Texp_leta =NNa =NN@Yఠ(rec_flag[a=NNa=NN@a+A@@[@@@s3aaaaaaaa@@@@ఠ(bindings\a!=NNa"=NN$@a:A@@ZZ@@@s@@@s@ఠ$body]a3=NN&a4=NN*@aLA@@\Q@@@s!@@@2a;=NN+@@Z@@@s &@@Z@@@s!)@@@ఐ">>aKDNNaLDNN@#@@@@@@ua@@u`@y@@@u_@@u^o@@@u]@@u\@@u[3a\a[a[a\a\a\a\a\@UN@O@PG@@A@B6/@0@1@@@@ఐ.value_bindingsarDNNasDNN@@@@@@@u@@u@@@@u@@@u@@u@@@u@@u@@u+@@ఐ(rec_flagaDNNaDNN@3@@@@@uR@uR@u?@@ఐ(bindingsaDNNaDNN@F@@@@@u@@@uR@uR@uW@@E@@@@@u[@@ఐ*expressionaDNNaDNO@F@@@@@@u@@u@@@u@@ut@@ఐ$bodyaDNOaDNO@z@@@@@uR@uR@u@@" @@@@@u@@z@@@Ġ*Texp_matchaEO OaEO O@Laఠ!e^aEO ObEO O@bA@@]@@@s-3bbbbbbbb@|@@@ఠ%cases_bEO ObEO O#@b'A@@LtLsLq@@@s0@@@s/@@@s.@ఠ)eff_cases`b$EO O%b%EO O.@b=A@@LyLLx@@@s3@@@s2@@@s1-@@b6EO O0b7EO O1@@Lz@@@s45@@@Fb<EO O2@@[@@@s5:@@[@@@s6=@@@࣠@$modeAbNLP"P-bOLP"P1@bgA@@@@@v3bRbQbQbRbRbRbRbR@^W@X@YPI@J@K;4@5@6@@@@@@@@ఠ(pat_envsblMP5PAbmMP5PI@bA@@\PW@@@vkQ@v@@@v,Q@v3bybxbxbybybybyby@(7@@@v @1@2@@@@ఠ)pat_modesbMP5PKbMP5PT@bA@@\nm@@@vlQ@v@@@v-Q@v@@/@@@/@@@v%@డa$List%splitbNPWPabNPWPe@ bNPWPfbNPWPk@@@\@!a@-ࠠ@!b@-@@2@@@2@@2~@_@@@2|@G@@@2}@@2{@@2z@Ra==Rb==@@R`@@2-@@@*@u@Y@@v!@@@v @@v@@@@v@hg@@@v@@v@@v3bbbbbbbb@@@@@డaw$List#mapc NPWPmcNPWPq@ cNPWPrcNPWPu@@ @@@@M}@@@vR@v\@@@vpR@v8@@v;@@@@v0R@vR@vjR@v5@@v:@@v9@ (@@@v7@@v6 '@@@v4@@v3@@v2D@@࣠@!cAcNNPWP{cONPWP|@cgA@@5@@@@ఐX$casec]NPWPc^NPWP@\@@@\E@@@v[@@vZ@S@@@vY@@vX@R@@@vV@O@@@vW@@vU@@vT@@vS3cxcwcwcxcxcxcxcx@6a@-@.@@@@ఐ=!ccNPWPcNPWP@ @@n@@ఐJ$modecNPWPcNPWP@@@@@@vuU@vt"@@A@@t#@cNPWPvcNPWP@@@@@vM@@vLS@v}S@v{-@@ఐ%casescNPWPcNPWP@[@@ @@@vJS@vS@v@@cNPWPlcNPWP@@ @@@v/R@vS@vHM@@ @@@`@D@@vR@v+V@A@cMP5P=@@@ఠ%env_ecOPPcOPP@cA@@@@@vQ@v3cccccccc@o}@~@g`@a@b@@@ఐ*expressioncOPPcOPP@w@@@@@@v@@v@@@v@@v@@ఐ!edOPPdOPP@@@@@@vR@vR@v/@@డb$List)fold_leftd(OPPd)OPP@ d,OPPd-OPP@@H@@@@'@@@vR@v@@v@ R@v@@v @@v@@v@@v@@@v@^( @@@v@@v@@v@@v@@ve@@డ@$join$Moded\OPPd]OPP@ d`OPPdaOPP@@$а@@@)@@@v@@v@@@v@@v@@v@@ภ&IgnoredxOPPdyOPP@'h@@@(>@@@v@@ఐ)pat_modesdOPPdOPP@@@^mQ@@@vS@vS@v@@dOPPdOPP@@^@@@@@A@dOPP@@@@ఠ(eff_envsdPPPdPPP@dA@@;@@@wDQ@v@@@wQ@v3dddddddd@@@@@@@ఠ)eff_modesdPPPdPPQ@dA@@7@@@wEQ@v@@@wQ@v@@*@@@*@@@v!@డcN$List%splitdQQ QdQQ Q@ dQQ QdQQ Q@@6@@@6@G@/@@v@@@v@@v@Q@@@v@t=@@@v@@v@@v3eeeeeeee@R@@@@డc$List#mapeQQ QeQQ Q#@ eQQ Q$eQQ Q'@@ %@@@@#Oz@@@wZR@w5@@@wIR@w@@w@@v@@w R@w]R@wCR@w@@w@@w@ 4@@@w@@w 3@@@w @@w @@w D@@࣠@!cAeZQQ Q-e[QQ Q.@esA@@5@@@@ఐd$caseeiQQ Q2ejQQ Q6@h@@@hE@@@w4@@w3@_@@@w2@@w1@^@@@w/@[@@@w0@@w.@@w-@@w,3eeeeeeee@6a@-@.@@@@ఐ=!ceQQ Q7eQQ Q8@ @@n@@ఐV$modeeQQ Q9eQQ Q=@%@@@@@wNU@wM"@@A@@t#@eQQ Q(eQQ Q>@@@@@w&@@w%S@wVS@wT@@ఐ)eff_caseseQQ Q?eQQ QH@f@@ @@@w#S@w[S@wX@@eQQ QeQQ QI@@@@@wR@w\S@w!@@ @@@1@@@w^R@w(@A@ePPP@@@ఠ%eff_eeRQMQYeRQMQ^@fA@@%@@@w{Q@w_3eeeeeeee@AUN@O@P<5@6@7@@@ఐ*expressionfRQMQafRQMQk@@@@@@@wd@@wc@@@wb@@wa@@ఐ!efRQMQlfRQMQm@ð@@@@@wxR@wR@w~/@@డd$List)fold_leftf4RQMQof5RQMQs@ f8RQMQtf9RQMQ}@@J@@@@* @@@wR@w@@w@ R@w@@w @@w@@w@@w@@@w@`4 @@@w@@w@@w@@w@@we@@డB$join$ModefhRQMQ~fiRQMQ@ flRQMQfmRQMQ@@&ܰ@@@+ @@@w@@w@@@w@@w@@w@@ภ&IgnorefRQMQfRQMQ@)t@@@*J@@@w@@ఐӠ)eff_modesfRQMQfRQMQ@@@`yQ@@@wS@wS@w@@fRQMQnfRQMQ@@^@@@@@A@fRQMQU@@డ<)join_list#EnvfSQQfSQQ@ fSQQfSQQ@@ @@@C@@@w@@@w@@w@@@w@@w3ffffffff@@@@@@@ภ"::fTQQfTQQ@\`డ<)join_list#EnvfTQQfTQQ@ fTQQfTQQ@@ +@@@u(@@@w@@@w@@w,@@@w@@w2@@ภ/gTQQgTQQ@\ఐ.%env_eg TQQg TQQ@V@@J@@@wR@wR@wR@wP@ఐ(pat_envsg TQQg!TQQ@6@@f@@@wR@wR@wc@@g,TQQg-TQQ@@@@@wR@wl@@g5TQQg6TQQ@@r@@@wQ@w@wR@wx@ภsgFTQQgGTQQ@\Ҡఐf%eff_egPTQQgQTQQ@@@Q@xQ@x Q@x@ఐ(eff_envsgaTQQgbTQQ@k@@fɠ@@@xQ@x Q@x @@gmTQQgnTQQ@@fҠ9@@@wQ@x@@gvTQQgwTQQ@@@@@@wQ@w@@@@@@@xQ@w@@@@@@@@@@@@  @gLP"P(gTQQ@@6@Ġ(Texp_forgUQRgUQR @Y@gUQR gUQR @@Y@@@s@3gggggggg@@@@@gUQRgUQR@@Y@@@sA @ఠ#lowagUQRgUQR@gA@@b@@@sB@ఠ$highbgUQRgUQR@gA@@b@@@sC%@@gUQRgUQR@@Y@@@sD-@ఠ$bodycgUQRgUQR#@gA@@b@@@sE;@@@FgUQR$@@a3@@@sF@@@a6@@@sGC@@@ఐؠ$joing]RRg]RR@ @@@֠@@@x@@@x@@x@@@x@@x3gggggggg@uUN@O@PHA@B@C3,@-@.@@@@ภ"::h ^RRh aSbSiA]ఐ Ԡ"<<h^RSh^RS @ O@@@ @@@xL@@xK@ @@@xJ@@xI @@@xH@@xG@@xF0@@ఐ .*expression,h8^RS@ .@@@ +@@@xr@@xq @@@xp@@xoH@@ఐ#lowhN^RShO^RS@P@@ B@@@xT@xT@x\@@M @@ @@@x`@@ภ+Dereferencehe^RS hf^RS@;>+U@@@DE@@A>@@>@@@,-@@@xq@@b@@ @@@xu@ภlhw_SS kA^ఐ >"<<h_SS0h_SS2@ @@@ <@@@x@@x@ 1@@@x@@x @@@x@@x@@x@@ఐ *expression+h_SS*@ !-@@@ @@@x@@x n@@@x@@x@@ఐ$highh_SS+h_SS/@@@ @@@yT@yT@y@@L @@ @@@y @@ภ+Dereferenceh_SS3h_SS>@j@@@,@@@y@@_@@ a@@@y$@ภ԰h`S@SHA^jఐ "<<h`S@SXh`S@SZ@ !@@@ @@@yF@@yE@ @@@yD@@yC @@@yB@@yA@@y@@@ఐ *expression+i `S@SR@ -@@@ @@@yl@@yk @@@yj@@yi@@ఐM$bodyi `S@SSi!`S@SW@ @@ @@@yT@yT@y.@@L @@ @@@y2@@ภ%Guardi7`S@S[i8`S@S`@%@@@,@@@yA@@_@@ @@@yE@ภ"[]iHaSbShP@xk@@ih]RR\@@OH@@@x5@@@x4P@x<v@@f@@xw@Ġ-Texp_constanti}bSjSpi~bSjS}@[@ibSjS~ibSjS@@[@@@sL@@@ @@b@@@sM@@b@@@sN@@@ఐ%emptyicSSicSS@<@@@Ġ(Texp_newidSSidSS@Tՠఠ#pthdidSSidSS@iA@@T@@@sV3iiiiiiii@ (@@@@idSSidSS@@TߠT@@@sX@@@sW @@idSSidSS@@T@@@sY@@@&idSS@@c @@@sZ@@c#@@@s[@@@ఐ"<<ijTT#ijTT%@ @@@@@@y@@y@@@@y@@yt@@@y@@y@@y3iiiiiiii@ cG@@A@B@@@@ఐ ꠐ$pathijTTijTT@ @@@ @@@y@@y @@@y@@y@@ఐg#pthjjTTjjTT"@&@@ @@@z R@z R@z 0@@" @@ @@@z4@@ภ+Dereferencej)jTT&j*jTT1@@@@-@@@z#C@@5@@ 5D@Ġ,Texp_instvarj:kT2T8j;kT2TD@U'ఠ)self_pathejCkT2TFjDkT2TO@j\A@@U/@@@sc3jGjFjFjGjGjGjGjG@ @@@ఠ#pthfjRkT2TQjSkT2TT@jkA@@U7@@@sd@ఠ)_inst_vargj`kT2TVjakT2T_@jyA@@U>U<@@@sf@@@se!@@@2jlkT2T`@@c@@@sg&@@c@@@sh)@@@ఐi$joinj|lTdTlj}lTdTp@~@@@g`@@@z,@@@z+@@z*:@@@z)@@z(3jjjjjjjj@ RK@L@MD=@>@?70@1@2@@@@ภjlTdTrjlTdTA`(ఐd"<<jlTdTjlTdT@ ߰@@@b@@@zY@@zX@W@@@zW@@zVD@@@zU@@zT@@zS/@@ఐ $path,jlTdTv@ .@@@ @@@z@@z~ @@@z}@@z|G@@ఐ)self_pathjlTdTwjlTdT@O@@ @@@zT@zT@z[@@M @@ @@@z_@@ภ+DereferencejlTdTjlTdT@@@@.@@@zn@@`@@@@@zr@ภklTdTiA`ఐ $path klTdT@  @@@ @@@z@@z @@@z@@z@@ఐԠ#pthk&lTdTk'lTdT@@@ @@@zR@zR@z@@, @@ @@@z@ภA`@A@j@@@z@@@zP@{@@@A@j$@@@zJ@@@zKP@z@@kOlTdTq@@6/@@@zB@@@zAP@zI@@@@ _@Ġ*Texp_applykdmTTkemTT@\ঠ(exp_desckomTTkpmTT@dĠ*Texp_identkwmTTkxmTT@cc@k|mTTk}mTT@@e7@@@s{3k~k}k}k~k~k~k~k~@ @@@@kmTTkmTT@@cjch@@@s}@@@s| @ఠ"vdhkmTTkmTT@kA@@cm@@@s~@@@&kmTT@@d@@@s @@@kmTTkmTT@@f@@@sP@s(@Ġa<kmTTkmTTAa;@@ kmTT@@\\@@@s;@@Ġ#ArgkmTTkmTT@fఠ#argikmTTkmTT@kA@@f@@@sS@@@@@\q@@@sW@@* @@@$@ @@s^@ĠaV5AaU@@6A@kG@\@@@s@\@@@s@@s@@@su@@@kmTTH@@\@\@@@s@\@@@s@@s@@@s@@@l mTT@@ea@@@s@@ed@@@s@@ఐi&is_reflnTTlnTT@h@@@i@@@{@@{i@@@{@@{3l$l#l#l$l$l$l$l$@ @@b[@\@]@@@@ఐ"vdl6nTTl7nTT@@@j@@@{P@{P@{@@' @@\C@@@{P@{@ఐ "<<lOtUSUhlPtUSUj@@@@ @@@{%@@{$@@@@{#@@{"@@@{!@@{ @@{<@@ఐe*expressionlotUSUYlptUSUc@ @@@c@@@{K@@{J<@@@{I@@{HU@@ఐ#argltUSUdltUSUg@]@@z@@@{_R@{aR@{`i@@" @@T@@@{gm@@ภ%GuardltUSUkltUSUp@(w@@@0c@@@{x|@@5@@ }@Ġ*Texp_applyluUqUwluUqU@]bఠ!ejluUqUluUqU@lA@@g@@@s3llllllll@ 4@@@ఠ$argskluUqUluUqU@lA@@]u@]t@@@s@]r@@@s@@s@@@s@@@-luUqU@@f3@@@s!@@f6@@@s$@@@Aఠ*split_argslX*X:lX*XD@mA@@/has_omitted_arg\@@@{P@{}@@{@b@@@{@h/@{P@{h@@@{P@{@@@{P@{@@{P@{@@@{P@{@@{@lP@|@@@| P@{@bP@{@@@{P@{@@{@@{@@{3m0m/m/m0m0m0m0m0@ |@}@~un@o@p@@@࣠JJANmBX*XFmCX*XU@m[A@@P3mCmBmBmCmCmCmCmC@`[Y@@{~@V@@{@9@1@@{Q@{@@{Q@{@@{Q@{|@n@o@@@@m^X*XE@@Ġ"[]mhXaXmmiXaXo@b@@@@l3mhmgmgmhmhmhmhmh@&1x@)@*@@@@@@ภmwXaXsmxXaXu@b@@@ch@@@{@@ภmXaXwmXaXy@b@@@cxP@{@@@{"@@@@@p@h@@{)@Ġ"::mXzXmXzX@c(@@mXzXmXzX@@3mmmmmmmm@<@@@@Ġ'OmittedmXzXmXzX@iAĠi&mXzXmXzX@i%@@@@@@@ @@@@mXzXmXzX@@@@@@{@ఠ$restmXzXmXzX@mA@@m1P@{@@@{.@@@ @@/@@@ఐ*split_argsmXzXmXzX@@@@@{@@@{@̠@@@{@@{@@{3mmmmmmmm@*#@$@%@@@ภjgmXzXmXzX@jf@@@ P@{T@{@@ఐ?$restn XzXn XzX@@@P@{ @@2@@!@Ġ}nXXnXX@c@@n!XXn"XX@@P@{3n"n!n!n"n"n"n"n"@@@@@Ġ#Argn.XXn/XX@iWఠ#argn7XXn8XX@nPA@@(P@{@@@@@/P@{@@n@XXnAXX@@@#@ @@{#@ఠ$restnOXXnPXX@nhA@@mRP@{@@@{4@@@ @@[5@@@@@ఠ'appliednhXXniXY@nA@@JT@{3njnininjnjnjnjnj@=6@7@8&@ @!@@@@ఠ'delayednzXYn{XY @nA@@TP@|T@{@@@@@@ @@{@ఐ*split_argsnXYnXY@K@@@@{@@@{@~@v@@{@@{@@{5@ఐl/has_omitted_argnXYnXY)@A@@B@@ఐj$restnXY*nXY.@J@@P@{Q@@.@@@Y@I@@{U@{Z@A@nXX@@ఐ/has_omitted_argnY2YAnY2YP@g@@3nnnnnnnn@jtm@n@oc\@]@^@@@@ఐ}'appliednYQYbnYQYi@@@|@@ภnYQYonYQYq@d{ఐ #argnYQYknYQYn@@@'@ఐ'delayedoYQYroYQYy@-@@2@@@@3@@$@@@@@@|:@@ภFoYzYoYzY@dఐ점#argo#YzYo$YzY@@@Q@ఐƠ'appliedo.YzYo/YzY@X@@\@@@@P@| _@@ఐà'delayedo=YzYo>YzY@f@@k@@@@:S@|n@oDY2Y>@@<p@~@@@@AkoHX*XX @@@ A@\Z@@|f@U@@|e@6@.@@|d@@|c@@|bP@|]@@@o[X*X2@@@@ఠ'appliedojYYokYY@o A@@nѠj@@@|P@|r@@@|P@|h3oxowowoxoxoxoxox@5@@@@ఠ'delayedoYYoYY@o A@@e@@@|P@|i@@% @@@%@ @@|l@ఐ*split_argsoYYoYY@X@@_@@@|{@@|z@e5@`X@@@|P@|w@kGJk(@@@|y@@@|x@@|v@@@|u@@|t@o(W@@@|q@eV]@@@|s@@|p@@|o@@|nV@ภl)oYYoYY@l)@@@_@@@|Q@|f@@ఐ%$argsoYYoYY@@@e{@F@kki@@@|@@@|@@|@@@|Q@|Q@|@@g@@@@@@|Q@|@A@pYY#@@@ఠ-function_modepYZpYZ@p2 A@@3@@@|P@|3pppppppp@@@@@@@@ఐƠ'appliedp0ZZ#p1ZZ*@ @@okP@@@|@@@|@ĠܰpCZ0Z<pDZ0Z>@e@@@@okc@@@|@@@|+@@okj@@@|@@@|2@@@ภ%GuardpZZ0ZBp[Z0ZG@,4@@@@;@Ġ˰pfZHZVpgZHZX@e@pkZHZTplZHZU@@k@@@|N@@psZHZYptZHZZ@@o֠k@@@|@@@|Z@@@ @@oޠk@@@|@@@|b@@ok@@@|@@@|i@@@ภ+DereferencepZHZ^pZHZi@,@@@wr@@@ApZZ@@yt@A@pYY@@ఐ$joinpZuZ}pZuZ@@@@@@@}-@@@},@@}+_@@@}*@@})3pppppppp@@@@@@@ภpZuZpZ[AfIఐ"<<pZuZpZuZ@@@@@@@}Z@@}Y@x@@@}X@@}We@@@}V@@}U@@}T+@@ఐߠ*expression,pZuZ@h.@@@@@@}@@}@@@}~@@}}C@@ఐH!epZuZqZuZ@˰@@@@@}T@}T@}W@@M @@@@@}[@@ఐ-function_modeqZuZqZuZ@e@@4@@@}k@@a@@@@@}o@ภ q'ZZjAfఐ"<<q2ZZq3ZZ@i@@@@@@}@@}@@@@}@@}@@@}@@}@@}@@ఐ.$list+qRZZ@ڰ-@@@@K@@@~5S@}@@}@@@}@@}@@}@@@@}@@}@@@}@@}@@}@@ఐo*expressionqyZZqzZZ@@@@m@@@~1@@~0F@@@~/@@~.@@ఐ&'appliedqZZqZZ@m@@(>@@@~T@~8T@~6@@u @@@@@~>@@ภ+DereferenceqZZqZZ@ C@@@5n@@@~O@@@@:@@@~W@ภ qZZAgCఐ"<<qZZqZ[@@@@}@@@~y@@~x@r@@@~w@@~v_@@@~u@@~t@@~s%@@ఐ$list+qZZ@k-@@@@@@@~S@~@@~@@@~@@~@@~@@@@~@@~y@@@~@@~@@~N@@ఐ*expressionr ZZr ZZ@@@@@@@~@@~@@@~@@~e@@ఐ'delayedr!ZZr"ZZ@@@>@@@~T@~T@~z@@u @@@@@~~@@ภ%Guardr9Z[r:Z[@.@@@5@@@~@@@@@@@~@ภ Ag@A@q)@@@~j@@@~kP@@@A@q3@@@}@@@}P@~i@@7A@q=@@@}K@@@}LP@}@@rhZuZ@@OH@@@}C@@@}BP@}J@@@@z@@@P@}@@@@W@l@@@ @@H@Ġ*Texp_tupler[[r[[@eఠ%exprslr[[r[[@rA@@e@ee@@@s@@@sȠ@m@@@s@@s@@@s3rrrrrrrr@@@@@@#@@k@@@s@@l@@@s@@@ఐs"<<r["[Mr["[O@@@@q@@@"@@!@f@@@ @@S@@@@@@@3rrrrrrrr@BC<@=@>@@@@ఐ $listr["[(r["[,@c@@@@@@@Q@J@@N @@@M@@L@@K@ @@@I@@H q@@@G@@F@@E-@@ఐ*expressions["[-s["[7@@@@@@@@@@@@~@@}D@@డq$List#maps["[9s ["[=@ s#["[>s$["[A@@+@@@@@f>f=@@@@@@R@@]R@R@@@R@@@R@@@@@@9@@@@@8 @@@@@@@@@డq#snds[["[Bs\["[E@@@!a@⠠@!b@@@@@@@'%field1AAZӠ@@@Z nnZ nn9@@Z@@@@P@@;@@S@@@ఐ%exprss["[Fs["[K@@@d@@@S@S@@@s["[8s["[L@@!,@@@iR@S@@@ @@!@@@@@ภ%Guards["[Ps["[U@/@@@7r@@@@@@@@Ġ/Texp_atomic_locs[V[\s[V[k@fఠ$exprms[V[ms[V[q@sA@@n@@@s3ssssssss@C@@@@s[V[ss[V[t@@ff@@@s@@@s @@s[V[vs[V[w@@f@@@s@@@&s[V[x@@m;@@@s@@m>@@@s@@@ఐ"<<s[|[s[|[@*@@@@@@@@@@@@@@@@@@@@@3tttttttt@~G@@A@B@@@@ఐ *expressiont[|[t[|[@@@@ @@@@@@@@@@@@ఐg$exprt-[|[t.[|[@&@@!@@@ R@R@0@@" @@@@@4@@ภ%GuardtD[|[tE[|[@0@@@8 @@@&C@@5@@PD@Ġ*Texp_arraytU[[tV[[@c"@tZ[[t[[[@@c$@@@s3t\t[t[t\t\t\t\t\@@@@ఠ%exprsntg[[th[[@tA@@c-o@@@s@@@s@@@ts[[@@m@@@s@@m@@@s@@@@ఠ*array_modet[[t[[@t A@@8M@@@,P@*3tttttttt@,%@&@'@@@డbP*array_kind'Typeoptt[[t[[@ t[[t[[@@@bN*expression@@@3@@3&Lambda*array_kind@@@3@@3@b3[b4[6@@b2N@@@@@@@0@@/@@@.@@-;@@ఐp#expt[[t[[@T@@.@@@R@R@O@@> @@,@@@S@Ġ&Lambdat[[t[\@+Pfloatarrayt[\t[\@@;+Pfloatarray&Lambda*array_kind@@@@@@CD@@A1lambda/lambda.mli@@@ @@@@@T@@@{@@W@@@~@@@ภ+Dereferenceu\N\Zu\N\e@ @@@@Ġ&Lambdau \f\pu!\f\v@)Pgenarrayu%\f\wu&\f\@@;)Pgenarray4@@@@D@@A,-@@@4@@@ @@@@@@@@@@ @@@ภ+Dereferenceu<]]*u=]]5@ @@@@Ġ&LambdauM]6]@uN]6]F@*PaddrarrayuR]6]GuS]6]Q@@;*Paddrarraya@@@AD@@AYZ@@@a@@@ @@@@@$@@@Ġ&Lambdauj]6]Tuk]6]Z@)Pintarrayuo]6][up]6]d@@;)Pintarray~@@@BD@@Avw@@@~@@@ @@@@@'@@@@1@@@@@)@@@ภ%Guardu]]u]]@1a@@@@@@Au[[@@@A@u[[@@ఐS"<<u]]u]]@ΰ@@@Q@@@B@@A@F@@@@@@?3@@@>@@=@@<3uuuuuuuu@-&@'@(@@@@ఐ#$listu]]u]]@!C@@@@@@@Q@j@@n#o@@@m@@l@@k@#b@@@i@@h#Q@@@g@@f@@e-@@ఐؠ*expressionu]]u]]@b@@@@@@@@@@@@@D@@ఐ%exprsu]]u]]@l@@#>@@@R@R@Y@@K @@#@@@]@@ఐ*array_modev]]v]]@g@@9@@@m@@_@@ @@@P@Ys@ @@$@Ġ.Texp_constructv)]]v*]^@l@v.]^v/]^@@ll@@@s@@@s3v4v3v3v4v4v4v4v4@@@@ఠ$descov?]^ v@]^@vXA@@l@@@s@ఠ%exprspvM]^vN]^@vfA@@lqn@@@s@@@s!@@@0vY]^@@o@@@s&@@o@@@s)@@@@ఠ2access_constructorvj^^$vk^^6@vA@@@@@P@3vpvovovpvpvpvpvp@;4@5@6.'@(@)@@@ఐD$descv^9^Gv^9^K@@@l@@@@3vvvvvvvv@@@@(cstr_tagv^9^Lv^9^T@m @@m@@@ @Ġ.Cstr_extensionv^Z^dv^Z^r@;.Cstr_extensionlK@$Path!t@@@*Ϡl@@@*@BBAC@Amk  mk  &@@@m'W@ఠ#pthv^Z^tv^Z^w@vA@@@@@:@@v^Z^yv^Z^z@@@@@B@@@.v^Z^{@@m<@@@G@@m?@@@J@@@ఐ"<<v^^v^^@@@@@@@@@@@@@@@z@@@@@@@3vvvvvvvv@:3@4@5@@@@ఐ$pathw^^w^^@@@@@@@@@@@@@@@@ఐZ#pthw^^w^^@&@@ @@@U@U@0@@" @@@@@4@@ภ+Dereferencew/^^w0^^@@@@:@@@,C@@5@@D@@w<^^w=^^@@m@@@@@m@@@@@@ఐ`%emptywK^^wL^^@@@@@@AwO^9^A@@@A@wQ^^ @@@ఠ"m'w\^^w]^^@wuA@@;%@@@^P@<3wbwawawbwbwbwbwb@@@@@@ఐ4$descws^^wt^^@@@m@@@A@?@(cstr_tagw^^w^^@m@@m@@@@ @Ġ,Cstr_unboxedw^^w^^@m:@@@@m@@@E0@@n@@@F3@@@ภ&Returnw__ w__@;N:@@@CE@@AN@@N@@@C>@Ġ-Cstr_constantw__w__)@;-Cstr_constantm\@m@@@*@A@AC@Anh"nh6@@@n/T@@w__*w__+@@@@@Kb@@@@@n5@@@Lf@@f@Ġ*Cstr_blockw__.w__8@;*Cstr_blockm~@n@@@*@AAAC@An@@@T@!T@@@u @@&H@@@'@@ఐ}"m'x__x__@@@<@@@3@@@@k@@@<@ภx__AnZ@A@xN@@@@@@P@M@@A@xX@@@@@@P@@@x_j_u@@@@@@@@P@@@@@@@@YP@@@@@@@@Ġ,Texp_varianty__y__@ld@y __y!__@@lf@@@s3y"y!y!y"y"y"y"y"@@@@ఠ"eoqy-__y.__@yFA@@lotN@@@s@@@s@@@y9__@@r@@@s@@r@@@s@@@ఐ"<<yI`Z`uyJ`Z`w@@@@@@@a@@`@@@@_@@^@@@]@@\@@[3yZyYyYyZyZyZyZyZ@6/@0@1@@@@ఐ(렐&optionyl`Z``ym`Z`f@'3@@@@f@@@Q@@@(@@@@@@@@(Ԡ@@@@@(@@@@@@@-@@ఐ*expressiony`Z`gy`Z`q@@@@@@@@@a@@@@@D@@ఐ~"eoy`Z`ry`Z`t@N@@)>@@@R@R@Y@@K @@(@@@]@@ภ%Guardy`Z`xy`Z`}@5@@@=@@@l@@^@@m@Ġ+Texp_recordy`~`y`~`@nঠ&fieldsy`~`y`~`@3nn@@@tn@@@3nn@@AndAnz@nw3ntns@@BneAni@nfneAn@nఠ"esry`~`y`~`@zA@@n@n@@@t@n@@@t@@t@@@t3yyyyyyyy@x@@@.representationz ``z ``@3nn@@@t n@@A3nn@@@nAn@n3nn@@BnAn@nnAn@nఠ#repsz``z``@z1A@@n@@@t@3extended_expressionz%`~`z&`~`@3nn@@@tn@@B3nn@@@nAn@n3nn@@AnAn@nnAn@nఠ"eotz4`~`z5`~`@zMA@@nàuU@@@t@@@t=@@@z@`~`zA``@@o @@@t P@tE@@@t@@s@@@t!I@@s@@@t"L@@@@ఠ*field_modezX``zY``@zqA@@>!@@@P@3z^z]z]z^z^z^z^z^@{t@u@vRK@L@M70@1@2@@@ఐY#repzq`azr`a @ @@o @@@@Ġ,Record_floatzaazaa'@;,Record_floatng@@@ABC@AwESSwESS@@@x@@@  @@o$@@@-@@o'@@@0@@@ภ+Dereferencezaa+zaa6@2@@@>9@Ġ.Record_unboxedza7aCza7aQ@n@za7aRza7aS@@n@@@M@@@ @@oH@@@Q@@oK@@@T@@@ภ&Returnza7aWza7a]@@@@b]@Ġ.Record_regularza^ajza^ax@;.Record_regularn@@@@BC@Ax9DSqSux:DSqS@@@xM@@@  @@oo@@@x@@x@Ġ.Record_inlinedza^a{za^a@;.Record_inlinedn@#intA@@@@AABC@AxUGTQTSxVGTQTj@@@xi@@za^aza^a@@@@@@@@@@o@@@@@@@2 @@o@@@@Ġ0Record_extension{ aa{ aa@;0Record_extensionn@$Path!t@@@@ABBC@AxHTTxHTT@@@x@@{aa{aa@@@@@@@@@@o@@@@@@@\ @@o@@@@@@ภ%Guard{1aa{2aa@7 @@@@@@A{5`a@@@A@{7``@@@ఠ%field{Baa{Caa@{[A@@@@@@@o@@@"P@@@P@@@ @@@JP@@@P@3{]{\{\{]{]{]{]{]@@@ @@@࣠@ TA@ఠ&_label{saa{taa@{A@@%3{t{s{s{t{t{t{t{t@:{{aa{|bbE@@@@@ఠ)field_def{aa{aa@{A@@3@@{aa{aa@@@>@<@@@@ @@ఐ)field_def{aa{aa@J@@@@K3{{{{{{{{@,5S@/@0$@@@Ġ$Kept{ab{ab @;$Keptp@t)type_expr@@@ ՠu,mutable_flag@@@ @B@@B@Aw:l44w;l44@@@wM@@{ab {ab@@@@@%3{{{{{{{{@,@@@@ @@@@&@@@% @@~@@~@@@ఐ %empty{ab{ab@ @@@Ġ*Overridden{bb${bb.@p9@{bb0{bb1@@p8p6@@@,@@@+U@ఠ!e{bb3{bb4@|A@@w@@@-c@@@|bb5@@e@@e@@@ఐ*expression|bb9|bbC@@@@@@@8@@7@@@6@@53||||||||@|%@@ @@@@ఐ,!e|)bbD@ @@@@@LT@NT@M@@$@@@@@A|4aa@@h@A@P@@A@@ఐ#.$join|AbQbY|BbQb]@!C@@@#,#%@@@@@@@@"@@@@@3|O|N|N|O|O|O|O|O@@@@@@@ภR|]b`bj|^bbAqఐ!%"<<|ib`by|jb`b{@@@@!#@@@-@@,@!@@@+@@*!@@@)@@(@@'+@@ఐ('%array,|b`bo@%.@@@@@qJ@@@S@@qG@@@@@S@U@@Y( @@@X@@W@@V@'@@@T@@S'@@@R@@Q@@P_@@ఐy%field|b`bp|b`bu@i@@@@-@qo@@@@@@@@@@@@|@@ఐꠐ"es|b`bv|b`bx@u@@(2O@@@tT@T@@@ @@("@@@@@ఐ*field_mode|b`b||b`b@@@@@@@@@@@!@@@@ภ}bbArఐ!Ƞ"<<} bb} bb@ C@@@!@@@@@@!@@@@@!@@@@@@@@@ఐ,&option+},bb@*-@@@@%@@@7S@@@,@@@@@@@@,@@@@@,@@@@@@@@@ఐI*expression}Sbb}Tbb@Ӱ@@@G@@@3@@2 @@@1@@0@@ఐ6"eo}jbb}kbb@@@, >@@@T@:T@8#@@u @@,@@@@'@@ภ+Dereference}bb}bb@@@@AH@@@Q6@@@@"@@@Y:@ภK}bb5As@6A@|$s@@@@@@P@jK@@@A@}$}@@@@@@P@U@@}bQb^K@@$$@@@@@@P@`@@rU@@@@@vP@f@>[@@Y@\@@Y@Ġ/Texp_ifthenelse}bb}bb@gŠఠ$condu}bb}bb@}A@@x@@@t*3}}}}}}}}@J@@@ఠ$ifsov}bb}bb@}A@@x@@@t+@ఠ%ifnotw}bb}bb@~A@@gy @@@t-@@@t,!@@@2}bb@@wN@@@t.&@@wQ@@@t/)@@@ఐ$$join~cc~cc@#@@@$$@@@|@@@{@@z$@@@y@@x3~~~~~~~~@RK@L@MD=@>@?70@1@2@@@@ภ~&dd~'dbdiAsఐ""<<~2dd~3dd@!i@@@"@@@@@@"@@@@@"@@@@@@@/@@ఐ H*expression,~Rdd@Ѱ.@@@ E@@@@@ @@@@@G@@ఐ$cond~hdd~idd@O@@ \@@@T@T@[@@M @@ 6@@@_@@ภ+Dereference~dd~dd&@@@@BE@@@n@@`@@#@@@r@ภ~d(d0iAtఐ *expression ~d(d:@  @@@ @@@#@@" f@@@!@@ @@ఐԠ$ifso~d(d;~d(d?@@@ @@@7R@9R@8@@, @@ ~@@@?@ภ~dAdIAtOఐ.N&option ~dAdO@, @@@@ @@@Q@`@@d.C@@@c@@b@@a@.6@@@_@@^.%@@@]@@\@@[@@ఐ 점*expression~dAdP~dAdZ@ v@@@ @@@@@ @@@@@@@ఐ#%ifnot dAd[dAd`@@@.e>@@@R@R@@@U @@.U@@@@ภ۰"dbdhAt@A@~&@@@R@@@SP@@@jA@~& @@@@@@P@Q @@A@~&@@@@@@P@*@@Bcc@@&)&"@@@@@@P@5@@G&@@R6@Ġ-Texp_setfieldWdjdpXdjd}@qఠ"e1x`djdadjd@yA@@z~@@@t83dccddddd@@@@@kdjdldjd@@qq@@@t:@@@t9 @@wdjdxdjd@@q@@@t;@ఠ"e2ydjddjd@A@@z@@@t<#@@@4djd@@x@@@t=(@@x@@@t>+@@@ఐ&$joineeee@$@@@&&@@@@@@@@&Y@@@@@3@$SL@M@N1*@+@,@@@@ภeef)f0AuEఐ$"<<eeee@"@@@$@@@@@@$t@@@@@$a@@@@@@@-@@ఐ!۠*expression,ee@!d.@@@!@@@@@!@@@@@E@@ఐ"e1eeee@N@@!@@@-T@/T@.Y@@M @@!@@@5]@@ภ+Dereferenceeeef@@@@C@@@Fl@@`@@$@@@Np@ภ"ff iAuఐ$預"<<-ff.ff@#d@@@$@@@p@@o@$@@@n@@m$@@@l@@k@@j@@ఐ"C*expression+Mff@!̰-@@@"@@@@@@"@@@@@@@ఐࠐ"e2cffdff@@@"W@@@T@T@@@L @@"1@@@@@ภ+Dereferencezff{ff'@@@@D@@@@@@_@@% @@@@ภCf)f/Au@A@'k@@@a@@@bP@@@tA@'u@@@@@@P@`@@ee@@''@@@@@@P@@@@@@Ġ-Texp_sequencef1f7f1fD@xఠ"e1zf1fFf1fH@A@@{@@@tD3@ ;@@@ఠ"e2{f1fJf1fL@A@@{@@@tE@@@ f1fM@@z-@@@tF@@z0@@@tG@@@ఐ'Ҡ$joingggg@%@@@'Р'@@@@@@@@'@@@@@3@ n?8@9@:1*@+@,@@@@ภg"g*gYg`Avఐ%ˠ"<<g"g8g"g:@$F@@@%@@@@@@%@@@@@%@@@@@@@-@@ఐ#%*expression,/g"g4@".@@@#"@@@A@@@"@@@?@@>E@@ఐ"e1Eg"g5Fg"g7@N@@#9@@@UT@WT@VY@@M @@#@@@]]@@ภ%Guard\g"g;]g"g@@=6@@@E"@@@nl@@`@@%@@@vp@ภalgBgJiAvఐ#m*expression wgBgT@" @@@#j@@@@@#C@@@@@@@ఐ"e2gBgUgBgW@@@#@@@R@R@@@, @@#[@@@@ภZgYg_Aw@A@(@@@@@@P@@@AA@(@@@ @@@ P@@@gg @@((@@@@@@P@ @@@@ @Ġ*Texp_whilegagggagq@s-ఠ$cond|gagsgagw@A@@|@@@tM3@!R@@@ఠ$body}gagygag}@A@@}@@@tN@@@ gag~@@{D@@@tO@@{G@@@tP@@@ఐ(預$joinh,h2h,h6@&@@@((@@@@@@@@(@@@@@3        @!?8@9@:1*@+@,@@@@ภh9hAhhAwఐ&⠐"<<&h9hQ'h9hS@%]@@@&@@@@@@&@@@@@&@@@@@@@-@@ఐ$<*expression,Fh9hK@#Ű.@@@$9@@@'@@&$@@@%@@$E@@ఐ$cond\h9hL]h9hP@N@@$P@@@;T@=T@<Y@@M @@$*@@@C]@@ภ+Dereferencesh9hTth9h_@@@@F9@@@Tl@@`@@'@@@\p@ภxhahiiAxఐ'J"<<hahyhah{@%Ű@@@'H@@@~@@}@'=@@@|@@{'*@@@z@@y@@x@@ఐ$*expression+hahs@$--@@@$@@@@@$z@@@@@@@ఐࠐ$bodyhahthahx@@@$@@@T@T@@@L @@$@@@@@ภ%Guardhah|hah@>@@@F@@@@@_@@'m@@@@ภhhAx\@A@P)@@@o@@@pP@@@tA@Z)@@@@@@P@n@@h,h7@@))@@@@@@P@@@@@"@Ġ)Texp_sendhhhh@lנఠ"e1~hh hh@8A@@~=@@@tV3#""#####@"@@@@*hh+hh@@l@@@tW @@@0hh@@|@@@tX@@|@@@tY@@@ఐ*-$join@i#i)Ai#i-@(B@@@*+*$@@@@@@@@)@@@@@3NMMNNNNN@"81@2@3@@@@ภQ\ i0i8] iUi\Axఐ($"<<h i0iFi i0iH@&@@@("@@@)@@(@(@@@'@@&(@@@%@@$@@#+@@ఐ%~*expression, i0iB@%.@@@%{@@@O@@N%T@@@M@@LC@@ఐ"e1 i0iC i0iE@M@@%@@@cT@eT@dW@@M @@%l@@@k[@@ภ+Dereference i0iI i0iT@P@@@G{@@@|j@@`@@(G@@@n@ภ~ iUi[iAy6@jA@**@@@@@@P@@@i#i.u@@**@@@@@@P@@@@@"@Ġ*Texp_field i]ic i]im@mwఠ!e i]io i]ip@A@@ @@@ta3@#l@@@@ i]ir i]is@@mm@@@tc@@@tb @@ i]iu i]iv@@m@@@td@@@&  i]iw@@}d@@@te@@}g@@@tf@@@ఐ(ؠ"<<iiii@'S@@@(@@@@@@(@@@@@(@@@@@@@3-,,-----@#G@@A@B@@@@ఐ&5*expression?ii@ii@%@@@&3@@@@@& @@@@@@@ఐg!eViiWii@&@@&J@@@R@R@0@@" @@&$@@@4@@ภ+Dereferencemiinij@@@@H3@@@C@@5@@#yD@Ġ/Texp_setinstvar~jjjj@uఠ#pthjjjj@A@@u@@@to3@$@@@@jjjj@@u@@@tp @@jjjj @@uu@@@tr@@@tq@ఠ!ejj!jj"@A@@@@@ts#@@@4jj#@@~ @@@tt(@@~ @@@tu+@@@ఐ+$joinjjjj@)İ@@@++@@@@@@@@+@@@@@3@$KSL@M@N1*@+@,@@@@ภհjjjjAzlఐ)"<<jjjj@(#@@@)@@@2@@1@)@@@0@@/)@@@.@@-@@,-@@ఐ%$path, jj@%.@@@%@@@X@@W%@@@V@@UE@@ఐ#pth"jj#jj@N@@&@@@lT@nT@mY@@M @@&@@@t]@@ภ+Dereference9jj:jj@@@@H@@@l@@`@@)@@@p@ภ>IjjiAzԠఐ*"<<TjjUjj@(@@@*@@@@@@*@@@@@)@@@@@@@@@ఐ'j*expression+tjj@&-@@@'g@@@@@'@@@@@@@@ఐࠐ!ejjjj@@@'~@@@T@T@@@L @@'X@@@@@ภ+Dereferencejjjj@<@@@Ig@@@@@_@@*3@@@ @ภjjjA{"@A@,@@@@@@P@@@tA@ ,@@@#@@@$P@@@jj@@,,@@@@@@P@"@@@@$@Ġ+Texp_assertjjjj@o&ఠ!ejjjj@A@@@@@t{3@%b@@@@jjjk@@o3@@@t| @@@jk@@N@@@t}@@Q@@@t~@@@ఐ* "<<$kk$kk@)=@@@*@@@/@@.@*@@@-@@,*@@@+@@*@@)3@%;4@5@6@@@@ఐ(*expression)$kk*$kk@'@@@(@@@U@@T'@@@S@@R@@ఐ[!e@$kkA$kk@&@@(4@@@iR@kR@j0@@" @@(@@@q4@@ภ+DereferenceW$kkX$kk@@@@J@@@C@@5@@%cD@Ġ)Texp_packh%kki%kk@tఠ$mexpq%kkr%kk@A@@ @@@t3uttuuuuu@%@@@@@@@@@@t@@@@@t@@@ఐ'&modexp+lHlN+lHlT@'@@@'@@@@@'@@@@@3@& +$@%@&@@@@ఐ2$mexp+lHlU+lHlY@ @@'@@@P@P@@@% @@%@Ġ+Texp_object,lZl`,lZlk@q]ఠ(clsstrct,lZlm,lZlu@A@@qe@@@t3@&>@@@@,lZlw,lZlx@@qhqg@@@t@@@t @@@,lZly@@.@@@t@@1@@@t@@@ఐ()/class_structure-l}l-l}l@(-@@@(-@@@@@(*@@@@@3@&j81@2@3@@@@ఐ?(clsstrct-l}l-l}l@ @@(G@@@P@P@@@% @@&@Ġ(Texp_try.ll.ll@p.ఠ!e.ll.ll@7A@@<@@@t3"!!"""""@&@@@ఠ%cases-.ll..ll@FA@@pAqq@@@t@@@t@@@t@ఠ)eff_casesC.llD.ll@\A@@pJqq@@@t@@@t@@@t-@@@>S.ll@@@@@t2@@@@@t5@@@@ఠ(case_envd8mne8mn@}A@@@'hJA@@@@P@@@@'d@@@P@@@'a@@@P@@@P@@@P@3@&oh@i@jaZ@[@\LE@F@G@@@࣠@!c A8mn8mn@A@@-3@<8mn8mn$@@@@@  @@!m A8mn8mn@A@@43@!D@@@@@@@@డ*#fst8mn8mn@@@!a@䠠@!b@@@@@ @@'%field0AAo5@@@o4mmo5mm@@o3~@@@@@cR@͠@'@@@R@@@@@ @@3@>Jt@A@B@@@@ఐ'$case8mn8mn@'@@@'@@@@@@'@@@@@@'@@@ܠ@'@@@@@@@@@-@@ఐ!c#8mn $8mn!@t@@:@@ఐ!m08mn"18mn#@D@@G@@48mn@@@Z@X@@S@T@S@@@@]T@A@P@@A@@ఐ/9$joinL9n(n.M9n(n2@-N@@@/7/0@@@@@@@@/ @@@@@3ZYYZZZZZ@@@@@@@ภ ]h:n5n=i=nnA}ఐ*j*expression t:n5nG@)@@@*g@@@/@@.*@@@@-@@,#@@ఐl!e:n5nH:n5nI@@@*~@@@CR@ER@D7@@- @@*X@@@K;@ภ ;nKnS6A~)ఐ6$list ;nKnW@41 @@@@(s@@@Q@@@@Q@l@@p6c@@@o@@n@@m@6V@@@k@@j6E@@@i@@h@@go@@ఐr(case_env;nKnX;nKn`@y@@@(ՠ(@@@@@@(@@@@@(@@@@@@@@@ఐȠ%cases;nKna;nKnf@m@@6L@@@R@R@@@c @@6}@@@@ภ  <nhnpA~ఐ6$list <nhnt@4 @@@@)sp@@@&Q@@@@Q@@@6@@@@@@@@6 @@@@@6@@@@@@@@@ఐޠ(case_envB<nhnuC<nhn}@@@@)A(@@@@@@)8@@@@@)3@@@@@@@@@ఐ)eff_casesa<nhn~b<nhn@ذ@@6L@@@R@'R@$@@c @@6@@@-@ภ /v=nnA~@A@۠0W@@@@@@P@>$@@xA@0a@@@^@@@_P@.@@#A@0k@@@#@@@$P@]8@@9n(n3.@@0}0v@@@@@@P@"C@@U8@@(@@@JP@I@>@@("@Ġ-Texp_override>nn>nn@rqఠ#pth>nn>nn@A@@ry@@@t3@)7@@@ఠ&fields>nn>nn@A@@r@r@@@t@r}r{@@@t@@@t@@@@t@@t@@@t%@@@6>nn@@?@@@t*@@B@@@t-@@@@ఠ%field IppIpp@A@@@@@@P@@@Q@+@@@pP@R@@SP@L@@M+@@@nP@N@@OP@K3@)g`@a@bYR@S@T@@@࣠@/A@@+Ipp,Ipp@@%3*))*****@:1Ipp2Ipp@@@@@@7Ipp8Ipp@@- @@ఠ#argAIppBIpp@ZA@@5@@FIppGIpp@@@D@B@@@@U#@@  @@ఐ,Q*expression[Ipp\Ipp@+۰@@@,O@@@\@@[,(@@@Z@@Y3eddeeeee@<-[@'@(@@@@ఐ4#arguIppD@ E@@g@@F@@a@3GA@}P@sN@A@K@ఐ1q$joinJppJpp@/@@@1o1h@@@y@@@x@@w1B@@@v@@u3@|@@@@@@ภ"KppMq)q0A,ఐ/h"<<KppKpp@-@@@/f@@@@@@/[@@@@@/H@@@@@@@+@@ఐ+$path,Kpp@+.@@@+@@@@@+@@@@@C@@ఐ(#pthKppKpp@ǰ@@+@@@T@T@W@@M @@+@@@[@@ภ+DereferenceKppKpp@"@@@N@@@j@@`@@/@@@n@ภ" LpqiAఐ/Р"<<LpqLpq@.K@@@/@@@#@@"@/@@@!@@ /@@@@@@@@@ఐ9$list+4Lpq @6-@@@@@s@@@S@y@ss@@@@@@S@z@-C@@@@@S@K@@O8@@@N@@M@@L@8%@@@J@@I8@@@H@@G@@F@@ఐy%fieldqLpq rLpq@ܰ@@@@8@3@-m@@@@@@@-F@@@@@@@ఐǠ&fieldsLpqLpq@t@@9(\@@@jT@T@@@ @@9@@@ @@ภ+DereferenceLpqLpq'@#C@@@On@@@@@@@0:@@@@ภ"qMq)q/A)@A@2@@@@@@P@.@@#A@'2@@@@@@P@8@@Jpp.@@22@@@@@@P@C@@U8@@*@@@P@I@>@@*@Ġ-Texp_functionNq1q7Nq1qD@zఠ¶msNq1qFNq1qL@ A@@zz@@@t@@@t3@+s@@@ఠ$bodyNq1qNNq1qR@A@@z @@@t@@@$ Nq1qS@@e@@@t@@h@@@t@@@@ఠ)param_patWrIrSWrIr\@7A@@@zH@@@P@@@r@@@P@@@P@3/../////@+G@@A@B5.@/@0@@@࣠@%paramABWrIr]CWrIrb@[A@@3CBBCCCCC@-JWrIrOKbsXs@@@@@  @@ఐ%paramY`ss%Z`ss*@4@@@@53ZYYZZZZZ@$@@@'fp_kindc`ss+d`ss2@3'fp_kindz@@@ 3function_param_kind@@@ @@C3,fp_arg_label k)arg_label@@@ @@@@A=.I.M=.I.e@@@3(fp_param~!t@@@ @@A@A>.f.j>.f.|@@@3*fp_partial"v@@@ @@B@AB..B./@@@+3+fp_newtypes+Ӡ#loc@@@ @@@ @@@ @@D2@AI//I//@@-@3&fp_loc@!t@@@ @@E>@A&N00'N00@@9@@A*H/t/x+H/t/@@=@]R@@L@@@\@Ġ*Tparam_patas8sBas8sL@;*Tparam_pat]@@@ @sq@@@ @A@@B@AHU1g1iIU1g1@@@[@ఠ#patas8sMas8sP@A@@s@@@3@@@@@@ @@y@@@@@|@@@@@@ఐ#patas8sTas8sW@@@@@3@ @@@Ġ7Tparam_optional_defaultbsXsbbsXsy@;7Tparam_optional_default=@s@@@ Š#@@@ @BA@B@AW11W11@@@@ఠ#patbsXs{bsXs~@1A@@s@@@@@"bsXs#bsXs@@>@@@@@@((bsXs@@@@@@@@@@@@@ఐ#pat6bsXs@@@@@ 365566666@'@@@@@A<`ss@@3:99:::::@@@@A@P@@A@@@ఠ-param_defaultKhssLhss@d A@@@{u@@@P@@@/@@@P@@@P@3\[[\\\\\@.G@@A@B@@@࣠@%paramAmhssnhss@!A@@3nmmnnnnn@+uhssvvuXui@@@@@  @@ఐ%paramist ist@2@@@@33@$@@@'fp_kindistist@+ @@'@@@ @Ġ7Tparam_optional_defaultjtt'jtt>@@jtt@jttA@@tK@@@ @ఠ'defaultjttCjttJ@"A@@@@@.@@@jttK@@N@@@3@@Q@@@6@@@ఐ/*expressionpttptt@/G@@@/@@@@@/@@@@@3@M+$@%@&@@@@ఐ2'defaultpttptt@ @@/@@@T@T@@@% @@@Ġ*Tparam_patqttqtt@3@qttqtt@@t@@@x@@@ @@@@@|@@@@@@@@ఐ3#%emptyvuXud@2@@@@@Aist@@3@@@@A@P@@A@@@ఠ(patterns xusu}!xusu@9#A@@4t@@@P@@@@P@3,++,,,,,@@@@@@డ$List#map?xusu@xusu@ CxusuDxusu@@4K@@@@|o@@@P@@@+@@@@@4H @@@@@4G6@@@@@@@1@@ఐL)param_patjxusukxusu@ @@@|@@@@@u@@@@@H@@ఐ¶msxusuxusu@N@@4x<@@@Q@Q@]@@N @@g^@A@xusuy @@@ఠ(defaultsyuuyuu@$A@@40g@@@P@@@@P@3@z@@@@@డ"$List#mapyuuyuu@ yuuyuu@@4İ@@@@|@@@P@@@+@@@@@4 @@@@@46@@@@@@@1@@ఐ-param_defaultyuuyuu@@@@}@@@@@0@@@@@H@@ఐ¶msyuuyuu@ǰ@@4<@@@Q@Q@]@@N @@g^@A@yuu @@@ఠ$bodyzuuzuu@+%A@@0}L@~L@ 3@r@@@@@ఐ0-function_body%zuu&zuu@0@@@0@@#0@@"@@ఐ1$body6zuu7zuu@@@0 @@@@0!@A@;zuu@@@ఠ!fF{vv G{vv @_&A@@3@@@IP@*3LKKLLLLL@7C<@=@>@@@ఐ4"<<[{vv(\{vv*@2@@@4@@@2@@1@4 @@@0@@/3@@@.@@-@@, @@ఐ6h$join{{vv|{vv@4}@@@6f6_@@@Y@@@X@@W69@@@V@@U=@@ภ({vv{vv@ ఐ$body{vv{vv@O@@R@ఐ(defaults{vv{vv&@@@1@@@xS@S@e@@{vv{vv'@@66@@@o@@@nS@vq@@F @@6q@@@u@@ภ%Delay{vv+{vv0@;fHR@@@AE@@AfG@@fD@@@S@@@@@[@@@A@{vv @@࣠@!mA|v4v?|v4v@@'A@@@"@@@3@@@@@@@  @@@ఠ#env}vDvQ}vDvT@(A@@@4@@@Q@3@*@B@@@@$@%@@@ఐ͠!f}vDvW}vDvX@)@@4@@@@@ఐC!m#}vDvY$}vDvZ@@@@e@+@R@R@*@@ @@0+@A@0}vDvM @@ఐAj.remove_patlist:~v^vg;~v^vu@@R@@@AeBz@@@P@@@@@@@@@@B@@@@@@@@@3TSSTTTTT@Td]@^@_@@@@ఐD(patternsd~v^vve~v^v~@@@AB*@@@@@@Q@Q@@@ఐ#env}~v^v~~v^v@&@@@@@@Q@Q@Q@2@@P @@3@[ @@@|v4v:~v^v@@/@@@O@@@@E@Z@@|@ @@@  @@ h@# @@ 9@O @@/g@Ġ)Texp_lazyvvvv@~ఠ!evvvv@A@@@@@t3@0)@@@@@@@ @@@t@@@@@t@@@@ఠ)lazy_modew!w+w!w4@)A@@T@@@P@3@0E(!@"@#@@@డ~6classify_lazy_argument'Typeoptw!w=w!wD@ w!wEw!w[@@~@@@~@@@@@Р~@~@~@~Р~@~@@@@A@@@@@@ A@@@ @@ <@@ఐh!ew!w\w!w]@F@@~@@@ R@"R@!P@@? @@Р~@~@~@~Р~@~@@@@A@@@@@@A@@@l@4Constant_or_function@Р~ߐ@~ސ@~ݐ@~ܐР~ې@~ڐ@@@@4A@@@3@@@2A@@`wcwmawcw@@@1@@@*Identifier@lwwmww@@Р~@~@@@@GA@@@F@Р@@@Р@ @@@@DA@@@C@@@BA@@ww'@@@A@@@@7*@@Р2@1@0@/Р.@-@@@@KA@@@J@@@IA@@@H@=Float_that_cannot_be_shortcut@РQ@P@O@NРM@L@@@@YA@@@X@@@WA@@wwww@@@V@@@@w@@Рr@q@p@oРn@m@@@@bA@@@a@@@`A@@@_$@@@ภ&Returnwwww@Z@@@2-@%Other@Р@@@Р@@@@@tA@@@s@@@rA@@wwww@@@qS@@Р@@@Р@@@@@yA@@@x@@@wA@@@vn@@@ภ%DelayBwwCww@u@@@|w@@@AFw!w7@@~y@A@Hw!w'@@ఐ7"<<RxxSxx@5@@@7 @@@@@@7@@@@@6@@@@@@@3cbbccccc@@@@@@@ఐ4k*expressionuxx vxx@3@@@4i@@@@@4B@@@@@@@ఐࠐ!exxxx@@@4@@@R@R@0@@" @@4Z@@@4@@ఐߠ)lazy_modexxxx$@>@@Vj@@@D@@6@@1@@@P@J@i @@1@Ġ*Texp_letopx%x+x%x5@{ঠ$let_x%x6x%x:A3{{ @@@t{@@@3{ {@@AzA{@z3zz@@BzAz@z3zz@@CzAz@z3zz@@DzAz@zzA{@{ఠ@A@{@@@t3@2P@@@$andsx%x<x%x@A3{{;@@@t{!@@A3{1{0@@@zA{+@{(3{{@@BzA{@{ 3{{@@CzA{@z3zz@@DzAz@zzA{@{ఠ@A@{,{<@@@t@@@t@$bodyx%xBx%xFA3{{Y@@@t{!@@C3{O{N@@@{ A{I@{F3{C{B@@A{A{:@{73{4{3@@B{A{-@{*3{{@@D{A{@{{A{@{ఠ@&A@}n}]@@@t@@@t=@@A\x%xJ@@{r@@@tP@tD@@@d@@v@@@tH@@y@@@tK@@@@ఠ(case_env /xNxZ0xNxb@H*A@@@33V @@@@P@@@@3/@@@P@@@3,@@@P@@@P@@@P@3MLLMMMMM@2~@@gd@f@eJG@I@H@@@࣠@!c"AbxNxccxNxd@{+A@@-3cbbccccc@<jxNxVkxNxw@@@@@  @@!m#AvxNxewxNxf@,A@@43wvvwwwww@!D@@@@@@@@డ#fstxNxixNxl@ ˰@@@@HR@@3p@@@R@@@@@ @@3@#/Y@&@'@@@@ఐ3$casexNxnxNxr@3@@@3w@@@@@@3@@@@@@3@@@@3@@@@@@@@@-@@ఐt!cxNxsxNxt@Y@@:@@ఐm!mxNxuxNxv@D@@G@@xNxmz@@@Z@X@@S@ T@S@@h@@]T@A@P@$@A@@ఐ:預$joinx{xx{x@8@@@::@@@*@@@)@@(:@@@'@@&3        @@@@@@@ภ, xxxxAఐ8ࠐ"<<$xx%xx@7[@@@8@@@W@@V@8@@@U@@T8@@@S@@R@@Q+@@ఐB $list,Dxx@?̰.@@@@5@@@S@@@A@@@@@@@@A@@@~@@}A@@@|@@{@@zT@@ఐ5à*binding_opkxxlxx@5ǰ@@@5@@@@@5@@@@@k@@ภ-xxxx@ ఐ$let_xxxx@8@@?T@@ఐ$andsxxxx@D@@SU@@@@T@T@@@xxxx@@B:^@@@T@@@@@B*@@@@@ภ+Dereferencexxxx@,U@@@X@@@@@@@9L@@@@ภ,xxAUఐ9"<<xxxx@8 @@@9@@@@@@9@@@@@9q@@@@@@@@@ఐƠ(case_env+xx@-@@@4J@@@AS@/@@@.@@-@4@@@,@@+4@@@*@@)@@(@@ఐ$bodyxxxx@İ@@5$@@@?T@BT@@@@Z @@@5@@@F@@E5 @@@D@@C!@@ภ%Delay7xx8xx@j@@@X@@@W0@@t@@9@@@_4@ภ,Gxx/A@0A@<(@@@@@@P@pE@@:A@<2@@@H@@@IP@O@@]x{xE@@>\yy]yy@84@@@9@@@@@@9@@@@@9@@@@@@@3mllmmmmm@5A:@;@<4-@.@/@@@@ఐ7D.structure_itemyyyy@7H@@@7H@@@@@7E@@@@@@@ఐb"siyyyy@'@@7_@@@0R@2R@12@@" @@7]@@@;6@@ఐ8*expressionyyyy@82@@@8@@@W@@V8@@@U@@TO@@ఐ!eyyyy@W@@8@@@kR@mR@lc@@" @@8@@@sg@@W@@5h@@@A:MM@@5@@@3@6S@@@:MM@б@г8|88Π888@8@@@r88@г588@5@@@r88@@@@r@@r88@1A@@@8@@@@@8@@@@@L@8@@@9MuMu?@888n8m@8l8o@@8}@@r8x@@r3@8@@@࣠@$bodyAzz$ zz(@8-A@@83      @8@@@@@@ఐ$body/z+z30z+z7@8@@@@830//00000@8@@@Ġ.Tfunction_body?z=zA@z=zO@;.Tfunction_bodyZ@@@ @a@@@ @A@@B@A]22]23@@@@ఠ$bodyVz=zPWz=zT@o.A@@t@@@3ZYYZZZZZ@*@@@@@ @@8@@8@@@ఐ9^*expressionh{{i{{#@8@@@9\@@@@@95@@@@@3rqqrrrrr@C%@@ @@@@ఐ,$body{{${{(@ @@9v@@@ P@P@@@% @@8@Ġ/Tfunction_cases{){-{){<@;/Tfunction_casesX@@@@ @AA@B@A^33f34@@;@@%cases@@@@@ @@@ @@@ ɰ1_33 2_337@@D@'partial@@@@@ ̰<`383@=`383Q@@O@%param@@!t@@@ ͰJa3R3ZKa3R3i@@]@#loc@@(!t@@@ ΰXb3j3rYb3j3@@k@)exp_extra@@r"@@@ @@@ ϰhc33ic33@@{@*attributes@@@@@ Ѱsd33td33@@@@AA@@@@@ @@@BA@ঠ%cases {){? {){DA3bq@@@d@@@3SR@@AAO@L3IH@@BAB@?3<;@@CA5@23/.@@DA&@#3  @@EA@A^@[ఠ@2/A@p}l@@@@@@@@@@@A({){=){){I@@@@@P@@@@@@9@@9@@@ఐ?&$join9||:||@=;@@@?$?@@@&@@@%@@$>@@@#@@"3GFFGGGGG@41@3@2@@@@డ$List#map]||^||@ a||b||@@>i@@@@8g@@@P@{@@@P@D@@G?V@@@P@aP@A@@F@@E@>s@@@C@@B>r@@@@@@?@@>A@@࣠@!cA||||@0A@@03@S@@@@@@$modeA||||@1A@@8@@@P@^3@h!G@@@@@@  @@డ,#fst||||@@@@@I@@@P@P@S@f@8@@@S@i@@h@@g@@e3@,=3@4@5@@@@ఐ8栐$case||||@8@@@8@@@z@@y@8@@@x@@w@8@@@u@8@@@v@@t@@s@@r-@@ఐ}!c||||@b@@:@@ఐ{$mode ||!||@D@@wG@@$||%||@@@d@Y@@pT@U@T@@r @@gU@2||3||@@@@@Y@@XQ@Q@@@ఐ*%casesF||G||@@@?=@@@VQ@Q@@@ @@@:@3@@<@@@;P@Q@T@@#@@:@@@A^z+z-%@@:3\[[\\\\\@,@@@B'A@@:@@:@@L@D@@@hzz/@:ɠ:ɰ::@::б@г:ɠ)Typedtree|||}||@:а||||@@@:@@@p3@;^@@ @@г:נ)term_judg||||@@:@@@p @@@@@p@@p @@::A@@@:@@@r@@r:@@@r@@r@࣠@#bopA|}|}@2A@@;@@@3@;J@@@@  @@ఐ@$join}} }}@>ư@@@@@@@@@@@@@@@@@@@3@;h/%@@@@)@*@@@@ภ1ذ}}}}?Aoఐ:ޠ$path }}@:@@@:@@@@@:@@@@@&@@ఐ[#bop}}}}@2@@S@@@@:@+bop_op_path}}}}&@3+bop_op_path^@@@ !t@@@ @@@ 3+bop_op_name #loc+@@@ @@@ @@A @Ar5256r525O@@@3*bop_op_valO1value_description@@@ @@B@As5P5Ts5P5y@@@3+bop_op_type([)type_expr@@@ @@C%@At5z5~t5z5@@@3'bop_exp4e@@@ @@D.@Aw66w66*@@@3'bop_loc=!t@@@ @@E:@Ax6+6/x6+6D@@@@Aq55q551@@@\O@@;S@@@P@P@@@W@@;O@@@"@ภ2it}}(Aఐ@@ఐ렐#bop}}3}}6@°@@@@@Y@W@'bop_exp}}7}}>@\@@<@@@UP@ZP@X@@: @@&@@ @@г=u)term_judgV}}W}}@@=}@@@p @@@@@p@@p @@==A@@@=@@@r@@r=@@@r@@r@࣠@"cfAw}}x}}@4A@@=@@@3}||}}}}}@>@@@@  @@ఐ"cf}}}}@@@@@@@@@@@@3@>-, @@@'cf_desc}}}~@3'cf_desc@@@ 40class_field_desc@@@ @@@ 3&cf_loc !t@@@ @@A @A.::/::@@A@3-cf_attributes@@@ @@B@A7::8:;@@J@@A;::<::@@N@9&@@ @@@0@Ġ+Tcf_inherit~~ ~~@;+Tcf_inherit1@@@ <@-override_flag@@@ "o*class_expr@@@ #s@@@ %@@@ $3@@@@ (@!t@@@ )@@ '@@@ &I@@@@ ,@!t@@@ -@@ +@@@ *@E@@F@A;;;<@@@@@%~~&~~@@K@@@ 3'&&'''''@@@@ఠ"ce2~~3~~@K5A@@T@@@!@ఠ&_super@~~ A~~&@Y6A@@\[@@@#@@@"!@ఠ)_inh_varsR~~(S~~1@k7A@@d@c@@@&@b@@@'@@%@@@$<@ఠ*_inh_methsm~~3n~~=@8A@@i@h@@@*@g@@@+@@)@@@(W@@@~~>@@@@@,\@@@@@-_@@@ఐBN"<<~B~V~B~X@@ɰ@@@BL@@@u@@t@BA@@@s@@rB.@@@q@@p@@o3@}v@w@xpi@j@k_X@Y@ZE>@?@@@@@@ఐ>*class_expr~B~H~B~R@>@@@>@@@@@>@@@@@"@@ఐ"ce~B~S~B~U@)@@>@@@R@R@6@@" @@>@@@:@@ภ+Dereference~B~Y~B~d@5@@@a@@@I@@5@@N:@@@mN@Ġ'Tcf_val~e~k~e~r@;'Tcf_val*@#loc @@@ /@@@ .,mutable_flag@@@ 0!t@@@ 10class_field_kind@@@ 2$boolE@@@ 3@EA@F@A@@@:@ఠ#cfk\~e~]~e~@u;A@@E@@@;%@@f~e~g~e~@@G@@@<-@@@nl~e~@@@@@=2@@@@@>5@@@ఐ?0class_field_kind|~~}~~@?@@@?@@@@@?@@@@@3@^W@X@YLE@F@G70@1@2@@@@ఐ>#cfk~~~~@ @@?@@@P@P@@@) @@@Ġ*Tcf_method~~~~@;*Tcf_method@#loc@@@ 5@@@ 4,private_flag@@@ 6@@@ 7@CB@F@AB<<C<<@@@U@@~~~~@@@@@G@@@F3@?@@@@~~~~@@ @@@H @ఠ#cfk~~~~@A@@A@@@3@B2@@@@  @@ఐ#cfk@@@@@@@@@@@3@BI( @@@Ġ,Tcfk_virtual@;,Tcfk_virtual@@@ !@@@@ @A@@B@AG; ;"H; ;=@@@Z@@@@@@@3@$@@@@@@@A@@@@@D@@@@@@ఐE%empty@E@@Q6@@@@Ġ-Tcfk_concrete@;-Tcfk_concrete8@-override_flag@@@ @@@ @BA@B@A;>;@;>;m@@@@@@@@@@_@ఠ!e@5?A@@:@@@m@@@*$@@@@@r@@@@@u@@@ఐE"<<4 5 !@Dk@@@E@@@@@@E@@@@@E@@@@@@@3EDDEEEEE@2+@,@-@@@@ఐCM*expressionW X @Bװ@@@CK@@@@@C$@@@@@@@ఐR!en o @&@@Cb@@@%R@'R@&0@@" @@C<@@@-4@@ภ+Dereference " -@9 @@@eK@@@>C@@5@@D@@@A@@@@@@ @б@г<;B85@@@@3@г21@@@@ .@@@@@@ -@(A@@@B@@@@@B@@@@@L@@@@mm6@BȠBȰBB@BBб@гBȠ)Typedtree/</E@Bϰ/F/Q@@@B@@@p3@C@@ @@гB֠)term_judg/U/^@@B@@@p @@@@@p@@p @@BBA@@@B@@@r@@rB@@@r@@r@࣠@$mexpAagak@@A@@ZC@@@3@C@@@@  @@ఐ$mexpauay@@@@@@@@@@@@3"!!"""""@C, @@@(mod_desc+az,a@@@@@@ @Ġ*Tmod_ident;<@ఠ#pthDE@]AA@@@@@3HGGHHHHH@&@@@@OP@@@@@@@@ @@@Y@@@@@@@@@@@@@ఐCX$pathij@C\@@@C\@@@@@CW@@@@@3srrsssss@R81@2@3@@@@ఐ?#pth@ @@Cv@@@,P@.P@-@@% @@R@@@@Ġ.Tmod_structure@ఠ!s@BA@@@@@3@@@@@@@@l@@@@@o@@@@@@ఐC)structure@C@@@C@@@4@@3C@@@2@@13@+$@%@&@@@@ఐ2!s@ @@C@@@HP@JP@I@@% @@T@Ġ,Tmod_functor@@@@@@@3@@@@ఠ!e@CA@@@@@@@@@@@@@@@@@@@@@ఐGҠ"<< @FM@@@G@@@S@@R@G@@@Q@@PG@@@O@@N@@M3'&&'''''@2+@,@-@@@@ఐD=&modexp9: @DA@@@DA@@@y@@xD>@@@w@@v@@ఐR!eP Q @&@@DX@@@R@R@0@@" @@DV@@@4@@ภ%Delaygh@@@@g-@@@C@@5@@D@Ġ*Tmod_applyxy%@ఠ!f'(@DA@@@@@3@c@@@ఠ!p*+@EA@@)@@@@@-.@@@@@@@@(/@@_@@@@@b@@@@@@ఐJ$join393=@H@@@JJ@@@@@@@@Jn@@@@@3@G@@A@B92@3@4@@@@ภ;ð@HAZఐH"<<@Q@S@G@@@H@@@@@@H@@@@@Hv@@@@@@@-@@ఐD&modexp,@N@E.@@@E@@@@@D@@@@@E@@ఐ!f@O@P@N@@E@@@T@T@Y@@M @@E@@@]@@ภ+Dereference'@T(@_@;@@@g@@@/l@@`@@H@@@7p@ภ<,7aiiA ఐH"<<BarCat@Gy@@@H@@@Y@@X@H@@@W@@VH@@@U@@T@@S@@ఐEf&modexp+bao@Ei-@@@Ei@@@@@~Ef@@@}@@|@@ఐ蠐!pxapyaq@@@E@@@T@T@@@L @@E~@@@@@ภ+Dereferenceaua@<*@@@hU@@@@@_@@I!@@@@ภ;XA@A@K@@@J@@@KP@@@tA@K@@@@@@P@I@@3>@@KK@@@@@@P@@@@@2@Ġ/Tmod_apply_unit@ ఠ!f@FA@@l@@@3@@@@@@@@@@@@@@@@@@@ఐI"<<@H"@@@I@@@@@@I@@@@@I@@@@@@@3@2+@,@-@@@@ఐF&modexp@F@@@F@@@@@F@@@@@@@ఐR!f%&@&@@F-@@@R@R@0@@" @@F+@@@4@@ภ+Dereference<=@<@@@i@@@,C@@5@@D@Ġ/Tmod_constraintMN@aఠ$mexpVW@oGA@@@@@3ZYYZZZZZ@8@@@@ab@@n@@@ @@ij@@o@@@@ఠ#coeuv@HA@@@@@@@@0}@@<@@@$@@?@@@'@@@Aఠ(coercion@JA@@@@@@JP@1@@<@@ij@@@vP@q@@rJ7@@@P@s@@tP@5@@;P@7@@:@@93@b[@\@]D=@>@?@@@࣠@#coeA@KA@@/3@=@8@@2@5@@6$@@8Q@3@@4Q@0@C@D@@@@@@!kA  @LA@@C3@*O@!@"@@@@@@ఐ2#coe@@@]3@W@@@@@Ġ,Tcoerce_none&2@@@@@m3@@@@@n@@@ఐ2!k 6@6A@@@q @@ภ&Return6B6H@.{@@@i@@@w@@@@p@Ġ1Tcoerce_structure,IS-Id@{@1Ie2If@@}@|@@@W@@@@X@@V@@@U@@@@z@y@@@[@v@@@\@@@@]@@Z@@@YW@@@/)@@X@@X@Ġ/Tcoerce_functorcgqdg@3@hgig@@@@@aj@@@@@@bo@@@ @@p@@p@@H @@q@@@ఐ!k}LW~LX@@@}@@ภ+DereferenceLYLd@>$@@@jO@@@|@@@@@Ġ1Tcoerce_primitiveeoe@2@ee@@4@@@e@@@ @@@@@@@ఐӠ!k@@@@@ภ&Ignore@i@@@j@@@@@@@@Ġ-Tcoerce_alias   @@ " #@@@@@j@ఠ#pth % (@MA@@@@@k@ఠ#coe * -@NA@@g@@@l@@@' .@@]@@]@@@ఐn(coercion@7@@@m@@@h@@W@@@@3@2+@,@-%@@ @@@@ఐ,#coe@ @@U@3@@@@@࣠@!mA*+@COA@@@@@@ఐK"<<9:@Jp@@@K@@@@@@K@@@@@K@@@@@@@3JIIJJJJJ@G,@#@$@@@@ఐHK$path\]@HO@@@HO@@@@@HJ@@@@@@@ఐ#pthst@k@@Hf@@@Y@Y@0@@" @@Hb@@@4@@ఐd!m@>@@A@@3@@B@@@P@y@@@@z@@@A @@@A@@@@z@@@y@@x@@wP@s@@@@@ఐ(coercion@@@@-@@@@@@@k@@@@@LM@@@~@@@@@@}@@|3@@@@@ఐ[#coe@@@P@@@P@P@3@@@@@࣠@!mA  @PA@@k@@@@@@@ఐL"<<@K2@@@L@@@@@@L@@@@@L@@@@@@@3        @K/k@@@@)@*@@@@ఐI%&modexp!"@I)@@@I)@@@@@I&@@@@@@@ఐ⠐$mexp89@@@I@@@@T@T@3@@" @@I>@@@7@@ఐj!mPQ @A@@l@@@G@@6@@L@@@ R@M@]^!@@@l*@@@@@@@@P@@@P@P@ @@@@@@@@Ġ+Tmod_unpack{"(|"3@'ఠ!e"5"6@IA@@@@@f@@"8"9@@3@@@n@@@":@@S@@@s@@V@@@v@@@ఐJ*expression>D>N@J$@@@J@@@@@Jq@@@@@3@3,@-@.@@@@ఐ:!e>O>P@ @@J@@@,P@.P@-@@% @@;@@@Aao @@=@@@%3@@@@ac@б@гРI @@@@@гR@V@@@@@@@@@@-A@@@I@@@6@@5I@@@4@@3L@/@@@//;@IIII@II࠰б@гI񠡠$Path fqfu@Ifvfw@@@J@@@p3@J@@ @@гI)term_judgf{ f@@J@@@p @@@@@p@@p @@J J A@@@J@@@r@@rJ@@@r@@r@࣠@#pthA@A@YQA@@J0J.@@@E3FEEFFFFF@J@@@@  @@ఐ#pthUV@@@@D@@@@@@@J3\[[\\\\\@J( @@@Ġ$Pathmn@&Pidentrs@@ఠ!x|}@RA@@@@@O3@$@@@@@@@A@@@P@@D@@@Q@@@ఐRܠ&single@Q@@@R@@@y@@xR@@@w@@v3@C+$@%@&@@@@ఐ2!x@ @@R@@@P@P@@@% @@Z@@@t@Ġ$Path@$Pdot@@ఠ!t@SA@@@@@W3@@@@@@@@@@X @@@ @@@@@Y@@@@@Z@@@ఐN"<<@M0@@@N@@@@@@N@@@@@N@@@@@@@3        @;4@5@6@@@@ఐK $path@K@@@K@@@@@K @@@@@@@ఐ[!t34@&@@K&@@@R@R@0@@" @@K"@@@4@@ภ+DereferenceJK@A@@@n@@@C@@5@@D@Ġ$Path]^@&Papplyb c@@ఠ!flm@TA@@@@@`3pooppppp@@@@ఠ!p{|@UA@@$@@@a@@@&@@@@@@b@@C@@@c@@@ఐQ$join"&@O@@@Q~Qw@@@@@@@@QQ@@@@@3@G?8@9@:1*@+@,@@@@ภB)3ktA=ఐOy"<<):)<@M@@@Ow@@@!@@ @Ol@@@@@OY@@@@@@@-@@ఐK̠$path,)7@Kϰ.@@@K@@@G@@FK@@@E@@DE@@ఐ!f)8)9@N@@K@@@[T@]T@\Y@@M @@K@@@c]@@ภ+Dereference )= )H@B@@@n@@@tl@@`@@O@@@|p@ภCJTiAఐO᠐"<<%J[&J]@N\@@@O@@@ž@@@O@@@œ@@›O@@@š@@™@@˜@@ఐL4$path+EJX@L7-@@@L7@@@@@L2@@@@@@@ఐࠐ!p[JY\JZ@@@LN@@@T@T@@@L @@LJ@@@@@ภ+DereferencerJ^sJi@C @@@o8@@@@@_@@P@@@@ภB;ksA@A@Rc@@@@@@P@ @@tA@Rm@@@@@@P@Ž@@'@@RRx@@@ @@@ P@@@@@@Ġ$Pathu{u@)Pextra_tyuu@@&ఠ!puu@VA@@g@@@if@ఠ&_extrauu@WA@@8@@@jt@@@%u@@@@@ky@@@@@l|@@@ఐLӠ$path@Lװ@@@L@@@@@L@@@@@3@:3@4@5-&@'@(@@@@ఐB!p@@@L@@@/P@1P@0@@' @@R@@@A  @@T@@@I3        @@@@@б@гԠM @@@@7 @гi @m@@@8@@@@9@@:@-A@@@M @@@Z@@YM@@@X@@WL@S@@@;ff;@MMM M @M M б@гM)TypedtreeOP@M#ST@@@M+@@@p3VUUVVVVV@N1@@ @@гM*)term_judgab@@M2@@@p @@@@@p@@p @@M7M6A@@@MF@@@r@@rMC@@@r@@r@࣠@!sA&&@XA@@M[@@@i3@N@@@@  @@!mA&&@YA@@\@@@u3@N0$@@@h@@@@@@ @@డ$List*fold_right''@ ' '@@]@@@@M@@@N@Á@@Æ@]@@@N@N@}@@Å@@Ä@@Ã@@Â@]@@@À@@@@@~@@|@@{@@z3@BQ]@@@t@K@L@@@@࣠@"itA''@ ZA@@43@@@@@@@#envA''@[A@@:3@(F@@@@@@@@ఐM֠.structure_item'#'1@Mڰ@@@M@@@ð@@ïM@@@î@@í3@(X@@ @@@@ఐ>"it-'2.'4@(@@n@@ఐ!m:'5;'6@\@@])@@@R@R@&@@ఐR#envP'7Q':@0@@3@@A@@R@6@W'X';@@@@@ß@@@Þ@@Ý@@ÜO@O@o@@ఐ!sq(<Br(<C@԰@@b@@@@@)str_items}(<D~(<M@3)str_itemsm@@@ aŠ@@@ ^@@@ ]@@@3(str_type)signature@@@ _@@A @AAAAA@@!@3-str_final_env!t@@@ `@@B@AAAAA@@-@@AAAAA@@1@9,@@^Ҡ@@@ÚO@O@@@డ%empty#Env(<N(<Q@ (<R(<W@@\3@@O@@@@@@&@б@гLN@S@@@[Q@г^&@@@@\Y~@@@@]@@^]}@$A@@@N@@@ @@N@@@@@L@j@@@2@N N°NN@NNб@гN )Typedtree , ,@Nɰ,,@@@N@@@q3@O@@ @@гNР)bind_judg,,@@N@@@q @@@@@q@@q @@NNA@@@N@@@r@@rN@@@r@@r@࣠@!sA=->-@V\A@@O@@@3CBBCCCCC@O@@@@  @@!mAQ-R-@j]A@@^=@@@'3UTTUUUUU@O$@@@@@@@@@ @@#envAh-i-@^A@@^J@@@43lkklllll@'^Z@@@&@!@"@@@@ @@ఐH!s--@*@@@@@<@:3@+^k@@@3@%@&@@@(str_desc-- @3(str_desc@@@ e(3structure_item_desc@@@ b@@@ 3'str_loc !t@@@ c@@A @A"B$B(#B$B=@@5@3'str_env!t@@@ d@@B@A.B>BB/B>BQ@@A@@A2BB3BB#@@E@<)@@#@@@;7@Ġ)Tstr_eval..@;)Tstr_eval4@@@ @@@@ f@@@ g@B@@N@ATBqBuUBqB@@@g@ఠ!e.!."@_A@@@@@B3@c@@@@.$.%@@@@@C @@@,.&@@]@@@D@@`@@@E@@@@ఠ&judg_e7 7@!kA@@S@@@R@3  @1*@+@,@@@ఐS٠"<<7'7)@RT@@@S@@@@@@S@@@@@S@@@@@@@ @@ఐQ3*expression=7>7$@P@@@Q1@@@%@@$Q @@@#@@"9@@ఐn!eT7%U7&@C@@QH@@@9U@;U@:M@@" @@Q"@@@AQ@@ภ%Guardk7*l7/@kE@@@s1@@@R`@@5@@da@A@s7 @@డy$join#Env83983<@ 83=83A@@\@@@a@@@\@@[@a@@@Z@@Ya@@@X@@W@@V3@@@@@@@ఐ&judg_e83C83I@@@T7@@@n@@ఐk!m83J83K@J@@_@@@ŀS@łS@Ł+@@83B83L@@b@@@l@ŃS@~5@@ఐt#env83M83P@O@@b@@@jR@ŅR@ńI@@c @@_@@@ņR@hO@w@@_@@@@Ġ*Tstr_value9QW9Qa@;*Tstr_value,@(rec_flag@@@ hC@@@ j@@@ i@BA@N@ABBBB@@@@ఠ(rec_flag9Qc9Qk@/`A@@@@@L3@@@@ఠ(bindings%9Qm&9Qu@>aA@@'@@@N@@@M@@@:19Qv@@@@@O@@@@@P@@@ఐP_.value_bindingsA:zB:z@Pc@@@Pc@@@ŏ@@Ŏ@PaP`@@@ō@@@Ō@@ŋP]@@@Ŋ@@ʼn@@ň3VUUVVVVV@JC@D@E<5@6@7@@@@ఐR(rec_flagh:zi:z@@@P@@@ųR@ŽR@ż@@ఐW(bindings|:z}:z@!@@PP@@@ű@@@ŰR@R@ž1@@ఐF!m:z:z@%@@`@@@ŻR@R@G@@ఐE#env:z:z@ @@`@@ŹR@R@\@@u @@]@Ġ+Tstr_module;;@;+Tstr_module@R.module_binding@@@ q@AF@N@ADCkCmECkC@@@W@ঠ%mb_id;;A3%mb_id@@@ j!t@@@ @@@ @@@3'mb_name#loc}@@@ @@@ @@@ @@A@AuE8E=vE8EX@@ @3&mb_uid&!t@@@ @@B@AEYE^EYEl@@ @3+mb_presence1)/module_presence@@@ @@C)@AEmErEmE@@ @3'mb_expr=@@@ @@D2@AEEEE@@ @3-mb_attributesFJ@@@ @@E;@AEEEE@@@3&mb_locOz!t@@@ @@FG@AEEEE@@@@ADDDE @@ @ఠfgfe@UbA@`_@@@[@@@Z3CBBCCCCC@@@@'mb_exprM;N;A8ఠ@kcA@@@@_@@@Y;Z;@@@@@aR@`@@@@@@@@b@@@@@c!@@@ఐR.module_bindingp<q<@R"@@@@R"R!@@@@@@̠@R@@@@@@@R@@@@@3@RO@Q@P=:@<@;@@@@@ఐ^%mb_id<<@@@RKRJ@@@@@@R@R@!@@ఐ_'mb_expr<<@(@@RU@@@R@R@4@@<<@@@#@@@R@?@@ఐ!m<<@d@@a@@@R@R@U@@ఐ#env<<@_@@a@@R@ R@j@@ @@ k@Ġ.Tstr_recmodule== @;.Tstr_recmodule4@EC@@@ s@@@ r@AG@N@ACCCC@@@@ఠ#mbs==@1dA@@Z@@@j@@@i3      @@@@@@& @@@@@k@@@@@l@@@@ఠ(bindings5>6>'@NlA@@X&@gf@@@;@@@:R@7@@@@@@@డ$List#mape>*f>.@ i>/j>2@@Xq@@@@@@@.R@@@<@@@@@Xn @@@@@XmG@@@@@@@ 3@1@@@@࣠@W{Aঠ%mb_id>9>>Aఠ@mA@@@@0@@@/R@'mb_expr>@>GAఠ@nA@J@@@3c@@@>8>H@@FU@+h@@@@@ఐ*%mb_id>M>R@-@/@.@@3@{5 @@@@@@ఐ&'mb_expr>T>[@ @@@@>L>\@@@@@@=@>3>]@@@}@@(@@'S@AS@?@@ఐ䠐#mbs>^>a@@@X@@@%S@ES@C@@ @@@A@ > @@ఐS9recursive_module_bindings?ek?e@S@@@S@SS@@@M@@@L@S@@@N@@K@@@J@@IS@@@H@@G3.--.....@@@@@@@ఐ (bindings>?e??e@ @@S@SS@@@p@@@o@S@@@q@@n@@@mR@R@z(@@ఐ!mc?ed?e@@@cR@@@yR@ƅR@Ƅ>@@ఐ#envy?ez?e@@@c^@@wR@ƇR@ƆS@@r @@c_@@@ƈR@uY@@@6@Ġ.Tstr_primitive@@@;.Tstr_primitive@'1value_description@@@ k@AB@N@ABBBB@@@,@@@@@@@@@q@@@@@@@@r@@@@@s@@@ఐU#envAA@0@@@Ġ)Tstr_typeBB@;)Tstr_type@(rec_flag@@@ lc0type_declaration@@@ n@@@ m@BC@N@AVBBWBC#@@@i@@BB@@@@@z@@@@@@|@@@{@@@,@@X@@@}@@[@@@~@@@ఐ#envGG @v@@@Ġ+Tstr_typext H!'H!2@;+Tstr_typextB@.type_extension@@@ o@AD@N@AC$C&C$CE@@@@ঠ2tyext_constructors%H!4&H!F@32tyext_constructors@@@m5extension_constructor@@@@@@@@C3*tyext_path!t@@@@@@ @A````@@@3)tyext_txt>#loc(!t@@@@@@@@A@A````@@@3,tyext_params.@*@@@@@a(variance@@@@h+injectivity@@@@@@@@@@@@B?@A```a"@@@R3-tyext_privateRt,private_flag@@@@@DJ@A aWa[ aWaw@@ @3)tyext_loc]!t@@@@@EV@A axa| axa@@@30tyext_attributesi@@@@@F_@A aa aa@@!@@A a#a' a#aV@@%@ఠ$extsH!IH!M@eA@@{z@@@ĉ@@@Ĉ3@$@@@@AH!3H!Q@@@@@ċR@Ċ @@@@@@@@Č @@ @@@č@@@@ఠ'ext_idsàIU_IUf@oA@@Z!t@@@ƳR@ƒ@@@ƥR@ƍ3@Q=6@7@8@@@డT$List#mapIUiIUm@ IUnIUq@@Z@@@@@@@ƯR@ƕ@@Ƙ.@@Ɨ@@Ɩ@Z @@@Ɣ@@ƓZ9@@@Ƒ@@Ɛ@@Ə3@1@@@@࣠@ZAঠ&ext_idIUxIU~@3&ext_id@@@Q@@@@@@ 3(ext_name ##loc2@@@@@@@@A @Ab|bb|b@@@3(ext_typeV5extension_constructor@@@@@B@Abbbb@@@3(ext_kind%:extension_constructor_kind@@@@@C$@Abbbb@@@3'ext_loc0!t@@@@@D0@Abbbc@@@3.ext_attributes<@@@@@E9@Acc cc&@@@@Abgbkbgb{@@@ఠ"idĠnIUoIU@pA@@@@@ư@@AvIUwwIU@@~U@ƭ@@@@ఐ"idIUIU@@@@@3@@@@IUrIU@@@@@ƪ@@ƩS@ƷS@Ƶ@@ఐ$extsIUIU@İ@@[@@@ƧS@ƻS@ƹ@@ @@@A@IU[ @@డ$join#EnvJJ@ JJ@@b:@@@g@@@@@@h@@@@@h@@@ƿ@@ƾ@@ƽ3@ @ @ @@@@ఐc$listKK@aj@@@@V@@@R@@@c@@@@@@@@c@@@@@cx@@@@@@@-@@ఐV<5extension_constructor K K@V@@@@V@@@@@@V=@@@@@D@@ఐ}$exts K!K@F@@c>@@@S@S@Y@@ఐ砐!m5K6K@ư@@fw@@@S@S@o@@BKCK@@h}@@@@S@y@@డS+remove_list#Env[L\L@ _L`L@@h3@@@l1h3@@@(@@@'@@&@h@@@%@@$h@@@#@@"@@!@@ఐ'ext_idsLL@@@lShU@@@:@@@9S@=S@;@@ఐ5#envLL@@@h@@@7S@@S@?@@LL@@h@@@@AS@5@@ @@f@@@BR@@ @@@Ġ.Tstr_exceptionMM @;.Tstr_exception@Q.type_exception@@@ p@AE@N@ACCFCHDCFCj@@@V@ঠ1tyexn_constructorMM@31tyexn_constructor@@@@@@@@@ 3)tyexn_loc 3!t@@@@@A @Acbbdbb@@v@30tyexn_attributes1@@@@@@@@B@Aqbb rbbA@@@@Auaavab@@@ఠ#extM"M%@fA@@@@@Ė3        @@@@@AM M)@@O@@@ĘR@ė @@@X@@|@@@ę @@@@@Ě@@@డ"$join#Env*N-3+N-6@ .N-7/N-;@@c@@@ik@@@J@@I@ir@@@H@@Giu@@@F@@E@@D3@??@@@@@@C<@=@>@@@@ఐW5extension_constructorRO<ESO<Z@W@@@W@@@_@@^W@@@]@@\@@ఐc#extiO<[jO<^@&@@W@@@sS@zS@y0@@ఐ /!m}O<_~O<`@ @@g@@@xS@|S@{F@@O<DO<a@@i@@@Z@}S@vP@@డ&remove#EnvPbkPbn@ PboPbu@@@mm@@@d@@d@i@@@d@@di@@@d@@d@@d@mmmʰ@@@@@@Dž@@DŽ@i@@@ǃ@@ǂj@@@ǁ@@ǀ@@@@ఐՠ#extPbvPby@@@@@@Ǚ@Ǘ@&ext_idPbzPb@ʰ@@?@@@ǕS@ǚS@ǘ@@ఐ #envPbPb@ q@@j7@@@ǓS@ǜS@Ǜ@@PbjPb@@jA@@@X@ǝS@Ǒ@@ @@&@Ġ,Tstr_modtypeQQ@;,Tstr_modtype S@7module_type_declaration@@@ t@AH@N@ACCCC@@@@@0Q1Q@@@@@ğ(@@@@@ @@@Ġ,@@,@Ġ/Tstr_class_typeARBR@;/Tstr_class_type v@@T!t@@@ }@O#loc^@@@ @@@ ~@6class_type_declaration@@@ @@ |@@@ {@AK@N@AD>D@D>D@@@@@pRqR@@,@+@@@ī@(&@@@ĭ@@@Ĭ@%@@@Į@@Ī@@@ĩ~@@@K@@ @@@į@@@@r@@ @@@İ@Ġ.Tstr_attributeSS@;.Tstr_attribute @@@@ @AM@N@ADDDD@@@0@@SS@@@@@Ĵ@@@@@ @@@ĵ@@@@ @@ @@@ķ@@@ఐ Z#envTT@ 5@@@Ġ)Tstr_openUU@;)Tstr_open @^0open_declaration@@@ u@AI@N@APCCQCD@@@c@ఠ"odUU@gA@@@@@ļ3@ _@@@@@@@ P@@@Ľ@@ S@@@ľ@@@ఐY0open_declarationVV@Y@@@Y@@@ǥ@@ǤY@@@ǣ@@Ǣ3@ ~+$@%@&@@@@ఐ2"odVV@ @@Y@@@R@R@@@ఐ ڠ!m(V)V@ @@i@@@R@R@-@@ఐ ٠#env>V ?V @ @@i#@@R@R@B@@P @@ `C@Ġ*Tstr_classTW UW @;*Tstr_class @@1class_declaration@@@ x@o@@@ z@@@ y@@ w@@@ v@AJ@N@ADDDD=@@@@ఠ'classes~W W %@hA@@)@(@@@ɠ@&%@@@@@@@@@@@3@ @@@@@D@@ @@@@@ @@@@@@@ఠ)class_idsƠX)5X)>@qA@@_!t@@@R@@@@R@3@ 1B;@<@=@@@@ఠ(class_idǠYAOYAW@rA@@@@f+class_infos|@@@@S@٠@@@@@S@@@3@@@S@@@S@/@࣠@^A@ঠ+ci_id_classYAZYAe@3+ci_id_class&!a@l@@@T@@@@@C/3'ci_virt,virtual_flag@@@@@@@APh%h)Ph%h?@@@3)ci_paramsY@@@@ @@"(variance@@@ @)+injectivity@@@ @@ @@@@@@@A,@AQh@hDQh@h{@@@3*ci_id_name=5#locD@@@@@@ @@B<@ARh|hRh|h@@@M30ci_id_class_typeMR!t@@@@@DH@AThhThh@@@3,ci_id_objectY^!t@@@@@ET@AUhhUhh@@@3'ci_expreb@@FZ@AVhhVhh@@@3'ci_declk1class_declaration@@@@@Gf@AWiiWii%@@@3,ci_type_declw6class_type_declaration@@@@@Hr@AXi&i*Xi&iV@@@3&ci_loc!t@@@@@I~@AYiWi[YiWin@@@3-ci_attributes@@@@@J@A Ziois Zioi@@@@AShhShh@@!@ఠ"idɠYAhYAj@sA@@@@@3@䐰YAKYAw@@@@@AYAYYAn@@U@ @@@YApYAq@@@@YAXYAr@@@@@@@@ @@ఐ*"idYAu@(@)@*!@@3@'3@@@$A@S@+@A@(@డH$List#mapZ{Z{@ Z{Z{@@`@@@@@@@@R@@@@@@@@R@ @@R@@@S@@@@@`@@@@@`^@@@@@@@3        @WOH@I@J@@@@ఐV(class_idZ{Z{@ @@@@OK@9@R@ @@@@9@@@@@@@@@ '@@ఐà'classesAZ{BZ{@@@a8]@@@S@S@<@@o @@=@ @@@A@OX)1@@@ఠ1class_declarationˠZ[[[@stA@@@@[@@@lR@)@@@*R@%@@@&@@'R@!@@"@k@@@qR@/@@0m@@@JR@1@@2R@#@@$R@ 3@@@@@@࣠@`A@ঠ'ci_expr[[A@ఠ͠@uA@93@S[\@@@@@A[[@@GT@( @@@[[@@B@@[[@@@@K@@,@@ @@!mA[[@vA@@Q3@).d@-@,@@@@@@డ+remove_list#Env\\@ \\@@m@@@qm@@@=@@@<@@;@n.@@@:@@9n1@@@8@@7@@63@0<@3@4@@@@ఐd)class_ids \ \@@@qݠm@@@O@@@NU@RU@P@@ఐ\n*class_expr&\'\@\r@@@\r@@@X@@W\o@@@V@@U4@@ఐ'ci_expr=\>\ @m@@A@@ఐ!mJ\K\@K@@N@@N\@@n@@@L@tV@oW@@u@@X@A@R@x@A@@డ_$join#Envg]h]@ k] l]$@@h@@@n@@@Ȁ@@@n@@@~@@}n@@@|@@{@@z3}||}}}}}@,%@&@'@@@@ఐjk$list^%0^%4@h@@@@@A@@@R@ࠠ@A@@@@@@@R@@@R@ȗ@@țjU@@@Ț@@ș@@Ș@jH @@@Ȗ@@ȕj7@@@Ȕ@@ȓ@@Ȓ>@@ఐn1class_declaration^%5^%F@H@@@@]@@@@@@נ@5@@@@@m@@@@@o@@@@@@@f@@ఐr'classes^%G^%N@6@@j`@@@ȶS@S@{@@ఐ!m^%O^%P@@@mG@@@ȿS@S@@@^%/^%Q@@oM@@@Ȑ@S@Ƚ@@డ#+remove_list#Env+_R],_R`@ /_Ra0_Rl@@o@@@so@@@@@@@@@ow@@@@@oz@@@@@@@@@ఐ)class_idsR_RmS_Rv@ǰ@@s#o%@@@ @@@ S@S@@@ఐ#envj_Rwk_Rz@@@o@@@ S@S@@@u_R\v_R{@@o@@@Ȏ@S@@@ @@mY@@@R@Ȍ@@@@7@@ @Ġ,Tstr_include`|`|@;,Tstr_include@"3include_declaration@@@ @AL@N@ADDDD@@@'@ঠ(incl_mod`|`|@3(incl_mod9-include_infos!a@ N@@@@@@ 3)incl_type )signature@@@ @@A @A8SS9SS@@KY@3(incl_loc!t@@@@@B@ADSSESS@@WZ@3/incl_attributes%@@@@@@@@C#@ARSSSSS@@e[@@AVSSWSS@@iX@ఠ$mexp`|`|@iA@@@@@d@)incl_type`|`|@?ఠ#mty`|`|@jA@@G@@@y@@A`|`|@@s@@@R@@@@|@@q@@@@@t@@@@@@@ఠ,included_idsРaa@5wA@@d %Ident!t@@@>R@@@@.R@3-,,-----@PI@J@K<5@6@7@@@డ$List#mapBaCa@ FaGa@@dN@@@@.signature_item@@@@R@@@!4@@ @@@dM@@@@@dL?@@@@@@@5@@డ1signature_item_id%Typessata@ waxa@@@+@@@>@@=[@@@<@@;@ddde@@B@@@@:@@@<@@;j@@@:@@9d@@ఐ#mtyaa@l@@@@@At@@c@@u@A@a@@డ$join#Envbb@ bb @@k5@@@p@@@M@@L@p@@@K@@Jp@@@I@@H@@G3@@@@@@@ఐ_ࠐ&modexpb b@_@@@_@@@b@@a_@@@`@@_@@ఐ $mexpbb@°@@_@@@vS@}S@|0@@ఐ!mbb@@@oI@@@{S@S@~F@@b b@@qO@@@]@ɀS@yP@@డ%+remove_list#Env-b.b@ 1b2b*@@q@@@uq@@@ɉ@@@Ɉ@@ɇ@qy@@@Ɇ@@Ʌq|@@@Ʉ@@Ƀ@@ɂ}@@ఐ8,included_idsTb+Ub7@@@u%q'@@@ɛ@@@ɚS@ɞS@ɜ@@ఐ#envlb8mb;@@@q@@@ɘS@ɡS@ɠ@@wbxb<@@q@@@[@ɢS@ɖ@@ @@o[@@@ɣR@Y@@@W@@@A-@@oa@@@@3@@@@-@б@гS`W@Z@@@ X@гo@@@@ `@@@@ @@ d@3A@@@`q@@@k@@j`n@@@i@@hL@dq@@@,A@`o`o`N`M@`L`Oб@В@г`o&optione_}e_@г`t%Idente_ue_z@`{e_{e_|@@@`@@@q3@a@@ @@@`@@@q@@@г`)Typedtreee_e_@`e_e_@@@`@@@q @@@@@ @@q"- @@г`)bind_judg e_ e_@@`@@@q.@@@@@q@@q3e_t @@``A@@@@`Ƞ`@@@r@@@r@`@@@r@@r@@r`@@@r@@rM@࣠@e!A@ఠ"idѠ@fAf@YyA@@q`@@@Ύ@@@΍3KJJKKKKK@a@@@@ఠ$mexpҠWfXf@pzA@@`@@@Ώ@@afbf@@@#"@@@Γ@@@Β@@@@Δ@@Α%@@@@!mA}f~f@{A@@pi@@@Τ3@bKD@E@F5.@/@0@@@@  @@#envAff@|A@@pu@@@α3@&p@@@Σ@ @!@@@@ @@@@ఠ&judg_EՠlS]lSc@}A@@eA@@@P@ζ3@ /p@@@ΰ@)@*@@@@ఠ#env֠lSelSh@~A@@p@@@7P@η@@! @@@!@ @@κ@ఐ"idmkymk{@[@@@@@ν@@@μ3@1@@@Ġ$Nonenn@o@@@@@@@@@@F@@@@@@@@M@@@@ఐeϠ"<<nn@dJ@@@e@@@@@@e@@@@@e@@@@@@@n@@ఐb7&modexp3n4n@b;@@@b;@@@@@b8@@@@@@@ఐ$mexpJnKn@İ@@bR@@@U@U@@@" @@bP@@@#@@ภ%Guardanbn@};@@@'@@@4@@5@@@@ఐ᠐#envqnrn@@@@@B@@@Š@@@@Ġ$Someoo@oߠఠ"idנoo@A@@J@@@@@@@@RQ@@@@@@@@YX@@@@@@@@@@@ఠ"mMؠpp@A@@ww@@@WS@:3@4-@.@/@@@@ఠ#env٠pp@A@@t@@@XS@;@@ @@@@ @@>@డ$take#Envpp@ pp@@@ww@@@e@@e@t-@@@d@@d@G@@@d@t9@@@d@@d@@d@@d@www۰$@@@@@@H@@G@tH@@@F@@E@b@@@C@tT@@@D@@B@@A@@@f@@ఐ"id,p-p@p@@C@@@\T@^T@]z@@ఐ#env@pAp@@@t|@@@ZT@`T@_@@g @@@@@@aT@V@A@Tp@@@ఠ&judg_Eڠ_q`q@xA@@f@@@ρS@b3eddeeeee@@@@@@@@ఐg2"<<vqwq@e@@@g0@@@j@@i@g%@@@h@@gg@@@f@@e@@d"@@ఐc&modexp–q—q @c@@@c@@@ϐ@@Ϗc@@@ώ@@ύ;@@ఐV$mexp­q ®q@'@@c@@@ϤV@ϦV@ϥO@@" @@c@@@ϬS@@డ3$join$Modeqq@ qq@@?@@@o@@@ϻ@@Ͻ@@@ϼ@@Ϻ@@Ϲv@@ఐ6"mMqq @@@@@@U@U@U@@@ภ%Guardq!q&@~@@@@@qq'@@@@n@@@A@q@@@ఐ&judg_Er+5r+;@@@@@aR@3@@@@@ఐ[#env"r+=#r+@@@@ZR@@@@@@@ @@@* @@@ @@t@@@A1mks@@@@m@@@A@9lSY@@డ?$join#EnvGtJPHtJS@ KtJTLtJX@@oȰ@@@u@@@@@@u@@@@@u@@@@@@@3]\\]]]]]@@@@@@@@@ఐ&judg_EqtJZrtJ`@@@g@@@@@ఐ!mÁtJaÂtJb@@@s@@@Q@Q@-@@ÎtJYÏtJc@@u@@@@Q@7@@ఐڠ#envátJdâtJg@?@@u@@@P@P@K@@e @@s@@@P@Q@y@@@óf@б@В@гyгzdh@@@@l~@@@@@n@@гwdo@~@@@o@@@@ @@p@гs٠@@@@q@@@@r@@s@<MA@@@@dd@@@L@@@K@d@@@M@@J@@Id@@@H@@GL@@@@@ e__h@dddd@ddб@гd)Typedtreevivi@d!vi"vi@@@d@@@q.3$##$$$$$@e@@ @@гd)bind_judg/vi0vi@@d@@@q/ @@@@@q0@@q1 @@ddA@@@d@@@r@@rd@@@r@@r@࣠@i6Aঠ)open_exprSwTw@3)open_expr*open_infos!a@ Z@@@@@@ 30open_bound_items )signature@@@ @@A @AvRPRUvRPRw@@S@3-open_overridei-override_flag@@@@@B@AwRxR}wRxR@@T@3(open_env$!t@@@@@C @AxRRxRR@@ U@3(open_loc0!t@@@@@D,@AyRRyRR@@V@3/open_attributes<Ԡ$@@@@@@@@E:@AzRRzRR@@'W@@AuR<RAuR<RO@@+R@ఠ$mexpܠĩwĪw@A@@B@@@e3ĭĬĬĭĭĭĭĭ@fB@@@0open_bound_itemsķwĸw@Wఠ"sgݠĿww@A@@_@@@m@@Aww@@eN@@@p@@@@!mAww@A@@t@@@Ѐ3@fs=6@7@8(!@"@#@@@@  @@#envAww@A@@t@@@Ѝ3@&t@@@@ @!@@@@ @@@ఠ&judg_Exx@ A@@f@@@ШP@Б3        @+t@@@Ќ@%@&@@@ఐf#&modexpx x@f'@@@f'@@@Ж@@Еf$@@@Д@@Г@@ఐ$mexp6x7x@V@@f>@@@ЪQ@ЬQ@Ы0@@" @@41@A@Bx @@@ఠ)bound_idsMy Ny @fA@@k>1@@@P@в@@@P@Э3YXXYYYYY@M[T@U@V@@@డ$List#maply  my $@ py %qy (@@kx@@@@*@@@P@е@@и+@@з@@ж@ku @@@д@@гkt6@@@б@@а@@Я1@@డ1signature_item_id%Typesśy )Ŝy .@ şy /Šy @@@(@@@S@@@@@@@@@@Q@@ఐ"sgŷy AŸy C@ְ@@V@@@a@@R@@kb@A@ſy @@డ$join#EnvzGMzGP@ zGQzGU@@rN@@@x@@@@@@x@@@@@x@@@@@@@3@@@@@@@ఐ&judg_EzGWzG]@@@f@@@@@ఐ0!mzG^zG_@@@vG@@@Q@ Q@ +@@zGVzG`@@xM@@@@ Q@5@@డ#+remove_list#Env+zGb,zGe@ /zGf0zGq@@x@@@|x@@@@@@@@@xw@@@@@xz@@@@@@@ b@@ఐ)bound_idsRzGrSzG{@l@@|#x%@@@&@@@%Q@)Q@'z@@ఐ#envjzG|kzG@Z@@x@@@#Q@,Q@+@@uzGavzG@@x@@@@-Q@!@@ @@vY@@@.P@@@@)@D@@v@Ƈw@б@гĠxwgtq@@@@No@гvon@@@@Ok@@@@P@@Qj@.A@@@g/@@@Y@@Xg,@@@W@@VL@R@@@Ʊvii<@g-g-gg@ggб@гg-$list}}@В@гg2&option}}@гg7%Ident}}@g>}}@@@gF@@@q>3@h@@ @@@gO@@@q@@@@гgI)Typedtree}}@gP}}@@@gX@@@qA @@@@@ @@qB"- @@@gx @@@qD' }J@@гgb)bind_judg}}@@gj@@@qE4@@@@@qF@@qG9 @@gognA@@@g@gg@@@r@@@rĠ@g@@@r@@r@@@r@@rg@@@r@@rV@࣠@*m_bindingsAF~G~@_A@@ @ƭg@@@с@@@р@Ųg@@@т@@@@@~3a``aaaaa@h@@@@ @@!mAo~p~@LjA@@w[@@@ё3srrsssss@i 9/@.-@@@|@@@{@+@@@}@@z@@@y@D@E@@@@@@#envAǗ~ǘ~@ǰA@@wy@@@ў3ǛǚǚǛǛǛǛǛ@)8w@@@ѐ@2@3@@@@ @@@ఠ$midsǰDZ@A@@f@@@P@ѧ@@@ѼP@Ѣ3ǽǼǼǽǽǽǽǽ@#2w@@@ѝ@,@-@@@డ=$List*filter_map @ @@@@!a@/@@1&optionL!b@/@@@1 @@1 @@1 @Ԡ@@@1 @@1 E@@@1@@1@@1@@@Z@1,@@@@@-]@@@P@Š@@@@P@@@P@Ѫ@@Ѯ8h@@@ѭ@@Ѭ@@ѫ@1@@@ѩ@@Ѩut@@@Ѧ@@ѥ@@Ѥo@@డƦ#fst9:@@|@@@@2@,@@@@4@@@@ఐ *m_bindingsPQ(@ڰ@@aN@@@ѾQ@Q@@@ @@@A@] @@@ఠ'bindingh,4i,;@ȁA@@@@w@@@dP@@@@P@ڠ@i@@@ҩP@@@P@@@@x@@@P@@@z@@@P@@@P@@@P@3ȚșșȚȚȚȚȚ@@@@@@࣠@mA@ఠ#midȰ,=ȱ,@@A@@<3ȱȰȰȱȱȱȱȱ@Qȸ,0ȹ6@@@@@ఠ$mexp,B,F@A@@@@@,<,G@@@U@I@@@@ @@!mA,H,I@A@@L3@+4i@.@/#\@@@@@@  @@@ఠ&judg_ELVL\@A@@m@@@S@3@'i@@@@@ఐS#mid_m_p@%@@3@@@@Ġ$Nonevv@w@@@@@@@@@ఐm٠"<<vv@lT@@@m@@@@@@m@@@@@m@@@@@@@:@@ఐjA&modexp=v>v@jE@@@jE@@@@@jB@@@@@S@@ఐ$mexpTvUv@u@@`@@@@jS@@@8d@@ภ%Guarddvev@>@@@*@@@Is@@.@@yt@Ġ$Someuv@wϠఠ#mid~@ɗA@@P@eP@@@@@@@@@@@@ఠ"mMɐɑ@ɩA@@@@@`V@L3ɗɖɖɗɗɗɗɗ@"@@@@@డ$find#Envɪɫ@ ɮɯ@@@7@@@d@@d@{@@@d@@d*@@@d@@d@@d@@@@I@@@T@@S@|@@@R@@Q<@@@P@@O@@N;@@ఐa#mid@E@@`H@@ఐX#env@,@@|(@@@bW@gW@f\@@M @@a]@A@ @@ఐn"<<@m9@@@n@@@o@@n@n@@@m@@ln@@@k@@j@@i3@}@@@@@@ఐk)&modexp%&@k-@@@k-@@@ҕ@@Ҕk*@@@ғ@@Ғ@@ఐz$mexp<=@]@@)@@@@k;@@@Ұ-@@డ$join$ModeST@ WX@@ǰ@@@@@@ҿ@@@@@@@Ҿ@@ҽP@@ఐࠐ"mMpq@Z@@<@@@W@W@W@f@@ภ%Guardʅʆ@_@@@r@@ʉʊ@@u@@g@@V@҆x@@@@@@Aʐ_g@@@A@ʒLR @@డ+remove_list#Envʠʡ@ ʤʥ&@@|x@@@v|x@@@@@@@@@|@@@@@|@@@@@@@3ʺʹʹʺʺʺʺʺ@@@@@@@ఐ$mids'+@-@@|@@@@@@S@S@@@ఐ&judg_E-3@'@@or@@@-@@ఐ!m45@@@f:@@,@@@}2@@@@T@C@@aH@@gD@pI@@h @<JA@P@Q@A@N@డ $join#Env>B>E@ >F>J@@w@@@}S@@@!@@ @}Z@@@@@}]@@@@@@@3(''(((((@@@@@@@ఐy$list:>L;>P@vð@@@@@yؠ@@@Ӄ@@@ӂ@lU@@@ӄ@@ӁP@8@@<x@@@;@@:@@9@x@@@7@@6x@@@5@@4@@3:@@ఐ'bindingo>Qp>X@D@@@@z@@@y@@@x@l@@@z@@w@@v@{@@@u@@t}@@@s@@r@@qe@@ఐW*m_bindings˚>Y˛>c@$@@y2_@@@WQ@ӏQ@ӊz@@ఐC!m˯>d˰>e@@@{@@@`Q@ӑQ@Ӑ@@˼>K˽>f@@}@@@1@ӒQ@^@@డ+remove_list#Env>h>k@ >l>w@@}@@@}@@@ӛ@@@Ӛ@@ә@~!@@@Ә@@ӗ~$@@@Ӗ@@ӕ@@Ӕ@@ఐL$mids>x>|@_@@͠}@@@ӭ@@@ӬQ@ӰQ@Ӯ@@ఐ#env>}>@T@@~P@@@ӪQ@ӳQ@Ӳ@@>g >@@~Z@@@/@ӴQ@Ө@@ @@|@@@ӵP@-@w@@@@@p@1~@б@гzyВ@гvuгrqlnk@@@@Zi@@@@@\h@@гgflc`@@@@]_@@@@ @@^^@@ @@@`]@г|`\[@@@@a X@@@@b@@cW@EVA@@@l@ll@@@@@@@l@@@@@@@@@@l@@@@@L@/@@@̔|u@llll@ll֠б@гl堡)Typedtreę̩@l̬̭@@@l@@@q`3̯̮̮̯̯̯̯̯@n@@ @@гl)term_judg̺̻@@l@@@qa @@@@@qb@@qc @@mlA@@@m@@@r@@rm @@@r@@r@࣠@"ceA@A@@3m$@@@3@nv@@@@  @@ఐ"ce@@@@@@@@0@@@@3@n, @@@'cl_desc@3'cl_desc0&@@@ Ș/class_expr_desc@@@ @@@ 3&cl_loc b!t@@@ @@A @AȒ7"7'ȓ7"7:@@ȥ@3'cl_type;*class_type@@@ @@B@AȞ7;7@ȟ7;7Z@@ȱ@3&cl_env#9!t@@@ @@C!@AȪ7[7`ȫ7[7n@@Ƚ@3-cl_attributes/_@@@ @@D*@Aȳ7o7tȴ7o7@@@@Aȷ77ȸ77!@@@Q>@@8@@@H@Ġ)Tcl_identPQ@;)Tcl_identI@@@ @!t@@@ X#locB!t@@@ @@@ ƭ.;@@@ @@@ @C@@G@A7777@@@@ఠ#pth̀́@͙A@@,@@@3̈́̓̓̈́̈́̈́̈́̈́@@@@@͋͌@@.,@@@@@@ @@͗͘@@-.g@@@@@@@@@Q͡@@@@@@@@@@!@@@ఐrm"<<ͱ Ͳ @p@@@rk@@@ԉ@@Ԉ@r`@@@ԇ@@ԆrM@@@ԅ@@Ԅ@@ԃ3@KD@E@F@@@@ఐnà$path@nǰ@@@n@@@ԯ@@Ԯn@@@ԭ@@Ԭ@@ఐk#pth @&@@n@@@R@R@0@@" @@n@@@4@@ภ+Dereference @e@@@@@@C@@5@@~S@@@ԁH@Ġ-Tcl_structure,@;-Tcl_structure@@@@ @AA@G@Aə77ɚ78 @@@ɬ@ఠ"cs+-,/@DA@@@@@3/../////@4@@@@@@@)@@@@@,@@@@@@ఐo/class_structureC3;D3J@o@@@o@@@@@o@@@@@3MLLMMMMM@S+$@%@&@@@@ఐ2"cs]3K^3M@ @@o@@@P@P@@@% @@_@Ġ'Tcl_funrNTsN[@;'Tcl_fun"@p)arg_label@@@ #@@@  @!t@@@ @ɫ@@@ @@ @@@ 1@@@ @@@ @EB@G@A8 88S8o@@@*@@ΥN]ΦN^@@0@@@)3ΧΦΦΧΧΧΧΧ@@@@@ήN`ίNa@@V@@@* @ఠ$argsκNcλNg@A@@=@<@@@-@@@@.@@,@@@+$@ఠ"ceNiNk@A@@1@@@/2@@NmNn@@#@@@0:@@@sNo@@@@@1?@@@@@2B@@@@ఠ#idsss@A@@tx@@@%P@@@@P@3@ RK@L@M81@2@3@@@డ́$List#mapss@ ss@@u#@@@@@.P@@L@@@&P@@@"P@@@6@@@@@u)@@@@@u(A@@@@@@@<@@డ͸#fstKsLs@G@@@-@@U@@Q@ O@@ఐ$args^s_s@X@@uUA@@@Q@'Q@#d@@S @@ne@A@ks{ @@ఐx*remove_idsuv@vC@@@xw@@@0@@@/@@.@w@@@-@@,w@@@+@@*@@)3ϊωωϊϊϊϊϊ@@@@@@@ఐ#idsϚϛ@ @@x&x@@@M@@@LP@PP@N@@ఐtp"<<ϴϵ@r@@@tn@@@_@@^@tc@@@]@@\tP@@@[@@Z@@Y;@@ఐp*class_expr@p @@@p @@@Յ@@Մp@@@Ճ@@ՂT@@ఐ"ce@@@p7@@@ՙT@՛T@՚h@@" @@p5@@@աl@@ภ%Delay@@5@@@@@@ղ{@@  @@t@@@պ@@@@@@@P@H@ @@ @Ġ)Tcl_apply @;)Tcl_apply@3B@@@ i@))arg_label@@@ @@@@ @@ @@@ @BC@G@A˵8p8r˶8p8@@@@ఠ"ceGH@`A@@3i@@@;3KJJKKKKK@P@@@ఠ$argsVW@oA@@2@1@@@>@@@@?@@=@@@<@@@Lk@@a@@@@!@@d@@@A$@@@@ఠ#arg|}@ЕA@@@@@@̠@r@@@P@ՠ@@@P@@@@P@@@P@@@rf@@@P@@@P@3УТТУУУУУ@f_@`@aXQ@R@S@@@࣠@uA@@зи@@-3жеежжжжж@Bно<]@@@@@ఠ#arg@A@@;@@@@@F@D@@@@ @@ఐ#arg@R@@@@S3@+"@@@Ġ'Omitted(/@̀Ġe02@d@@@@_3@@@@@@ @@l@@l@@@ఐv%empty6;@u@@e @Ġ#Arg<H<K@9ఠ!e<L<M@2A@@P@P@=@@@@@>@@>@@@ఐs *expression*<Q+<[@r@@@s@@@@@r@@@@@343344444@U$@@@@@@ఐ+!eD<\@ @@)@@@@@@@AH @@O@~A@P@_@A@@ఐxB$joinUiqViu@vW@@@x@x9@@@e@@@d@@cx@@@b@@a3cbbccccc@@@@@@@ภifqxrAఐv9"<<}x~x@t@@@v7@@@֒@@֑@v,@@@֐@@֏v@@@֎@@֍@@֌+@@ఐq堐*class_expr,ѝx@q.@@@q@@@ָ@@ַq@@@ֶ@@ֵC@@ఐl"ceѳxѴx@ @@q@@@T@T@W@@M @@q@@@[@@ภ+Dereferencexx@ie@@@@@@j@@`@@v\@@@n@ภiϰiAeఐv"<<@u@@@v@@@@@@v@@@ @@ v@@@ @@ @@ @@ఐ᠐$list+@}-@@@@@@@@~S@e@º@@@S@y@@xS@7@@;@@@:@@9@@8@@@@6@@5@@@4@@3@@2@@ఐ#arg9:@Ӱ@@@@/@Ӡt6@@@sͷ@@@t@@@r@@q@@pt@@@o@@n@@ఐ$args^_@@@Y@@@VT@׀T@|@@ @@@@@׊@@ภ+Dereferencevw@j@@@<@@@כ@@@@w@@@ף@ภi?҆A@A@yg@@@@@@P@״+@@ A@yq@@@փ@@@քP@5@@Ҝiv+@@yy|@@@{@@@zP@ւ@@@R5@@@@@P@xF@;@@@Ġ'Tcl_letҷҸ@;'Tcl_letg@̵(rec_flag@@@ ̜@@@ @@@  @!t@@@ @@@@ @@ @@@ 5@@@ @DD@G@A]88^89@@@p@ఠ(rec_flag@A@@7@@@M3@@@@ఠ(bindings@A@@@@@@O@@@N@@  @@C@B@@@R@4@@@S@@Q@@@P(@ఠ"ce%&@>A@@6G@@@T6@@@v-@@#@@@U;@@&@@@V>@@@ఐv">>=&>(@u@@@v@@@@@@vk@@@@@va@@@@@@@3NMMNNNNN@Vjc@d@e\U@V@W6/@0@1@@@@ఐs.value_bindingsde@s@@@s@@@@@@ss@@@@@@@@s@@@@@@@+@@ఐ(rec_flagӆӇ@3@@s@@@R@R@?@@ఐ(bindingsӚӛ%@F@@ss@@@@@@R@R@W@@E@@s@@@([@@ఐt*class_exprӸ)ӹ3@t@@@t@@@D@@Ct@@@B@@At@@ఐ"ce46@z@@t@@@XR@ZR@Y@@" @@t@@@`@@z@@@Ġ.Tcl_constraint7=7K@;.Tcl_constraint@7 @@@ |ς*class_type@@@ @@@ =@@@ @@@ G @@@ @@@ -'MethSet!t@@@ @EE@G@Aϒ99ϓ9l9@@@ϥ@ఠ"ce$7M%7O@=A@@7F@@@b3(''(((((@-@@@@/7Q07R@@@?@@@d@@@c @@;7T<7U@@A@@@@f@@@e@@G7WH7X@@CB@@@h@@@g%@@S7ZT7[@@E@@@i-@@@qY7\@@O@@@j2@@R@@@k5@@@ఐt*class_expri`hj`r@t@@@t@@@q@@pt@@@o@@n3srrsssss@yXQ@R@S@@@@ఐ_"ceԃ`sԄ`u@ @@t@@@؅P@؇P@؆@@% @@@Ġ(Tcl_openԘv|ԙv@;(Tcl_openH@*0open_description@@@ 7@@@ @BF@G@A 99!99@@@3@@Ԯvԯv@@@@@q@ఠ"ceԺvԻv@A@@7@@@r@@@*v@@@@@s@@@@@t@@@ఐu*class_expr@u@@@u@@@؍@@،u@@@؋@@؊3@+$@%@&@@@@ఐ2"ce@ @@u8@@@ءP@أP@آ@@% @@@@@A @@@@@3@@@@@б@г%dcuL`]@,@@@*[@гZY@ @@@1V@@@@@@5U@-A@@@ue@@@@@ub@@@@@L@B@@@';@ucucuSuR@uQuTб@гuc)Typedtree;<@uj?@@@@ur@@@qp3BAABBBBB@w@@ @@гuq)term_judgMN@@uy@@@qq @@@@@qr@@qs @@u~u}A@@@u@@@r@@ru@@@r@@r@࣠@"ec0Ano@ՇA@@u@@@3tssttttt@w @@@@  @@ఐ"ecՅՆ@@@@@@@@!^@@@@3ՎՍՍՎՎՎՎՎ@w$, @@@(ext_kind՗՘@ U@@ T@@@ @Ġ)Text_declէը$@;)Text_decl e@@@@Ϭ#locȻ@@@@@@@@@ˠL5constructor_arguments@@@ΠP6@@@@@@@C@@B@AG!cMcQH!cMc@@@Z@@%&@@('%@@@*@@@)@@@(3@Q@@@@@&@@@+@@@%6@@@-@@@,@@@K@@ @@@.@@ @@@/@@@ఐ{%empty*0*5@z@@L@@@>$@Ġ+Text_rebind6<6G@;+Text_rebindi@!t@@@Ѡ#loc!t@@@@@@@BA@B@AѢ"ccѣ"cc@@@ѵ@ఠ#pth146I56L@MA@@#@@@6@ఠ$_lid2B6NC6R@[A@@*(@@@8@@@7@@@>N6S@@! @@@9@@! @@@:@@@ఐwM$path^W]_Wa@wQ@@@wQ@@@M@@LwL@@@K@@J3hgghhhhh@>7@8@91*@+@,@@@@ఐF#pthzWb{We@@@wm@@@aP@cP@b@@' @@@@@Aֆ @@@@@߷@֋@б@г^]vZW@&@@@$U@гTS@@@@ +P@@@@ @@ /O@,A@@@v@@@@@v@@@@@L@<@@@ִ:@v۠v۰vv@vvб@гv۠vܰ@@v@@@q3@x@@@@б@гvࠐ$list@гv堡)Typedtree@v@@@v@@@q @@@v@@@q$@@гv)bind_judg@@v@@@q0@@@@@q@@q5! @@@=@@q @@q:@@@wwA@@@w%@@@r@@r@w#w"@@@r@@@r@@rw@@@r@@r@@rQ@࣠@(rec_flag3A&'@?A@@ՕwE@@@3+**+++++@x@@@@  @@(bindings4A9:@RA@@ֵՕwO@@@@@@3DCCDDDDD@x* @@@@$@%@@@@@@$mode5AWX@pA@@C@@@3[ZZ[[[[[@.$#@@@@@@@,@-@@@@@@)bound_env6Ars@׋A@@T@@@3vuuvvvvv@+d@@@@%@&@@@@ @@@ఠ.all_bound_pats7׋ ׌  @פA@@}|<@@@9Q@@@@.Q@3חזזחחחחח@"1{@@@@+@,@@@డ$List#map׭ #׮ '@ ױ (ײ +@@}@@@@ѕ@@@:Q@@@!.@@ @@@} @@@@@}9@@@@@@@3@4@@@@࣠@"vb8A 1 3@A@@$G@@@@ఐ"vb 7 9@2@@@@33@W@@@&vb_pat : @@ @@c @ , A@@@G@@3p@@2R@>R@<j@@ఐؠ(bindings B J@@@~[@@@0R@BR@@K@@m @@@A@  @@@ఠ)outer_env9&NV'N_@?A@@a@@@XQ@C3,++,,,,,@@@@@@ఐk.remove_patlist;Nb<Np@S@@@f”@@@cQ@L@@@K@@@J@@I@@@@G@@H@@F@@E)@@ఐנ.all_bound_patsbNqcN@3@@'@@@\@@@[R@_R@]B@@ఐ )bound_env{N|N@@@VR@qR@pS@@H@@WT@A@؄NR @@@ఠ,bindings_env:؏ؐ@بA@@@@@gQ@r3ؗؖؖؗؗؗؗؗ@lzs@t@u@@@ఐ(rec_flagئا@_@@@@@t3ةببةةةةة@@@@Ġ,Nonrecursiveطظ@;,Nonrecursive(Asttypes(rec_flag@@@@@@@B@@A4parsing/asttypes.mli``@@@ I@@@@@@@@x3@3@@@@@@@y@@@@ఠ+binding_env;@A@@@ҽ@@@T@@@@@@@T@@@,@@@T@@@T@@@T@`@࣠@}AAঠ&vb_pat Aఠ=@&A@@@@3@z=(]@@@@'vb_expr Aఠ>@=A@A@@@@@A+,@@HV@@@@@!m?A9:@RA@@M3:99:::::@,41@3@2@@@@@@  @@@ఠ"m'@NO@gA@@@@@W@3TSSTTTTT@'j@@@@@డ'compose$Modegh@ kl@@@@@ @@@@@@@@@@@@@@@@@@)@@ఐT!mيً @3@@6@@ఐyd'patternٙ ٚ@yh@@@yh@@@X@@@@@@@yg@@@@@yd@@@@@@@^@@ఐ&vb_patٿ@@@h@@m@@ఐ_)bound_env#@4@@y@@@Y@Y@@@ $@@y@@@@@x@@@A@@@ఐ:*remove_pat(4(>@@@@5@@@@V@@@@@@@5@@@@@8@@@@@@@3@@@@@@@ఐ&vb_pat(?(E@հ@@@@@@ఐ|*expression$(G%(Q@{@@@|@@@@@{@@@@@+@@ఐ'vb_expr;(R<(Y@@@|/@@@,X@3X@2?@@ఐ"m'O(ZP(\@I@@@@@1X@5X@4U@@\(FE@@@@@@6X@/^@@{M@@n_@N@@o@<OA@T@:V@A@S@ఐN$listraksao@@@@@U@@@S@A@@E'@@@D@@C@@B@@@@@@@? @@@>@@=@@<3ڍڌڌڍڍڍڍڍ@@@@@@@ఐ +binding_envڝapڞa{@ @@@z@@@}@@|@C@@@{@@z@@@y@@x@@w!@@ఐ(bindingsڻa|ڼa@]@@SH@@@`T@T@6@@ఐ|$modeaa@W@@@B@iT@T@K@@j @@GL@ @@JC@Ġ)Recursive@;)Recursive0@@@AB@@A(`)`@@@0J@@@  @@@@@}H@@@@@~K@@@@ఠ+binding_envBuu@A@@@@@@T@@@@M@@@T@Ⳡ@ z@@@@@@T@@@T@@@T@Y@࣠@NAঠ&vb_pat4u5u@ఠ#x_iD<u=u@UA@@@@@3@??@@@@@@GGuH@@@@'vb_exprOuPu@ఠ#e_iEWuXu@pA@@u@@@@@A_u`u@@VV@ @@@@@ఠ'mbody_iFop@ۈA@@{'@@@V@3uttuuuuu@7C<@=@>)"@#@$@@@ఐ{Q'patternۆۇ@{U@@@{U@@@V@@@@@@@{T@@@@@{Q@@@@@@@*@@ఐp#x_iۭ۬@3@@U@@9@@ఐL)bound_envۻۼ@!@@{z@@@W@W@M@@@ @@QN@A@ @@@ఠ)rhs_env_iG  %@A@@ @@@V@3@ftm@n@o@@@ఐ}ߠ*expression ( 2@}i@@@}@@@@@}@@@@@@@ఐ#e_i 3 6@@@}@@@W@W@-@@డ'compose$Mode 8 <@  = D@@@@@@@@@@@@@@@@@@@@@@@V@@ఐ預$mode= E> I@İ@@@@@ X@ X@ j@@ఐ⠐'mbody_iQ JR Q@t@@|@@@z@@X 7Y R@@@@@X@@@z @@@A@d  @@@ఠ,mutual_modesHop@܈A@@`|,@@@~V@Y@@@lV@3{zz{{{{{@@@@@@@ఠ'mdef_ijI܋܌@ܤA@@@m@@@W@@@|N@@@7W@@@W@!@࣠@LAঠ&vb_patܭܮ@Zఠ#x_jKܵܶ@A@@_@@@3ܹܸܸܹܹܹܹܹ@?6@@@@@A@@0Y@ @@@@ఐ|'pattern@|@@@|(@@@DX@'@@@&@@%@|@@@$@@#|@@@"@@!@@ 3@3?8@9@:@@@@ఐF#x_j@ @@ä@@@@@ఐ8)rhs_env_i J@K@@|@@@9Y@RY@Q%@@BS@@x&@RTA@W@T[@A@X@డێ$List#map$%@ ()@@0@@@@ @@@V@\@@_@@^@@]@- @@@[@@Z,@@@X@@W@@V3BAABBBBB@@@@@@@ఐǠ'mdef_ijRS@ @@@/@@@|@@{}@@@z@@y@@ఐ3(bindingsi j@ @@`?@@@nW@W@/@@Q @@0@ @@@A@w@@@ఠ%env_iM݂*:݃*?@ݛA@@@@@V@3݈݈݈݈݈݈݇݇@"@@@@@ఐǠ.remove_patlistݗ*Bݘ*P@@@@ @@@V@@@@@@@@@@@@@@@@@@@)@@ఐ3.all_bound_patsݾ*Qݿ*_@@@ '@@@@@@W@W@B@@ఐ)rhs_env_i*`*i@Y@@VW@W@S@@H@@WT@A@*6 @@@ఐj%env_i@i@j@k@@3@ft@@@@ఐ,mutual_modes@p@@@@@@@젠@@@@'@@|@@@@@@ ,@C@@ @A@T@@A@@@@ఠ#envO@4A@@{[@@@ T@@@@T@3'&&'''''@/(@)@*@@@@ఠ$mdefP56@NA@@{+}@@@ @@@ T@@@@T@@@.@@@.@@@%@డ$List%split\]@ `a@@{@@@{@K@3@@@@@@@@|U@@@Š@{A@@@@@@@V@@డ$List#mapސޑ@ ޔޕ@@@@@@x@@@ U@@@@@s@@U@U@U@@@@@@@@@@@@@@@@@@@@ఐƠ+binding_env@@@@ؤ@@@@@@ @@@@Š~@@@@@@@@@@@@ఐ(bindings@@@U@@@V@V@@@@@|CU@@@U@V@@@ @@@頠@@@U@@A@ @@Aఠ2transitive_closureQ  .@/A@@@[@@@7U@@@@T@@@ e@@@>@@@=T@@@310011111@  @@@@@@@࣠@#envRAD /E 2@]A@@*3EDDEEEEE@8@3@@'@@U@@8@9@@@@ @@@ఠ/transitive_depsS]5E^5T@vA@@@@@@CV@ @@!@R@@@Z@a@@@~V@&@@'@@@?V@(@@)V@"@@#V@3߁߀߀߁߁߁߁߁@=Ii@@@A@@@࣠@%env_iUAߒ5Uߓ5Z@߫A@@/3ߓߒߒߓߓߓߓߓ@>ߚ5Aߛ@@@@@  @@&mdef_iVAߦ5[ߧ5a@߿A@@83ߧߦߦߧߧߧߧߧ@!F@@@@@@@@డ$join#Env߼߽@ @@=@@@@@@3@@2@@@@1@@0@@@/@@.@@-3@,8f@/@0@@@@ఐS%env_i@8@@~@@డ)join_list#Env@ @@<@@@9@@@J@@@I@@H=@@@G@@F6@@డޅ$List$map2@  @@@@!a@/F@@1V@!b@/C@@1U!c@/@@@1T@@1S@@1R@ˠ@@@1Q@@1P@%@@@1O@@1N @@@1M@@1L@@1K@@1J@@@`@:5@@@@@@f@AT@T@Z@^@@e@@@UZ@Z@Z@[@@d@@c@@b@@@@`@@_@5@@@]@@\T@@@Z@@Y@@X@@W@@డ'compose#Env@ @@@$@@@d@@d@@@@d@@d@@@d@@d@@d@@@@6@@@@@@@@@@@@@@@@@@@@ఐ$&mdef_i@@@X@@ఐ#env@P@@@@@@ct@@@TZ@[@z @@I@@@@@A@Z@R@@0Q@@k@[RA@V@Y@A@V@@ఠ$env'W@A@@Ӡ9@@@V@@@@V@3@@@@@@డ߂$List$map2 @ !%@@@@@@V@@@@@@@V@@@@V@@@7@@@@@@@ɠ@@@@@@@@@@@J@@@@@@@@@E@@ఐ/transitive_depsW&X5@O@@@@@@@@@@@@@@@@@@@@@@@@g@@ఐ8#envy6z9@@@^t@@ఐQ$mdef:>@P@@Fb@@@W@W@@@z @@@A@ @@డ $List(for_all2BQBU@ BVB^@@@@!a@.@@1@!b@.@@1X@@@1@@1@@1@@1@@@@1@@1@ۭ@@@1@@1m@@@1@@1@@1@@1@^%%_%%@@]f@:5@@@@@@@ @@@5U@@@/@@@@@@@@@@ՠ@@@@@@.@@@@@-@@@@@@@@@3@ @ @ @@@@డ %equal#EnvB_Bb@ BcBh@@@V@@@e@@e@]@@@e@@e @@@e @@e @@e @@@@@h@@@0@@/@o@@@.@@-@@@,@@+@@*<@@ఐ #envJBiKBl@ư@@/I@@ఐ^$env'WBmXBq@S@@x@@@V@;V@9^@@ @@e@@@5--?5--@@Q@ఠCYDHB@A@@L@[O@@@@3@k@@@'c_guard + 2A4ఠZ@A@8@@@@@@@%c_rhs 4 9A;ఠ[@A@@@@ '@@@  ;@@2L@@@@ /@@@@@ఠ$judg\@-A@@@@@0N@3@VS@U@T>;@=@<*'@)@(@@@ఐ$join- .@/@@@@@@@@@@@@@@@@!@@ภ};FG^eAҠఐ"<<R4S6@@@@ @@@J@@I@@@@H@@G@@@F@@E@@DI@@ఐ&option,r @8.@@@@k@@@R@r@@v@@@u@@t@@s@٠@@@q@@p@@@o@@n@@mr@@ఐ*expression!+@@@@@@@@@f@@@@@@@ఐȠ'c_guard,3@@@>@@@S@S@@@v @@@@@@@ภ+Dereference7B@}c@@@@@@@@@@Z@@@@ภ}ͰDLAcఐ٠*expression DV@b @@@@@@@@@@@@@@@ఐ%c_rhsDWD\@ذ@@@@@Q@Q@@@, @@@@@ @ภ|ư ^dA~@A@r@@@@@@O@@@AA@|@@@;@@@>?????@&4-@.@/@@@@  @@@ఠ#env^QwRw@jA@@@@@FO@43YXXYYYYY@*F@@@-@$@%@@@ఐW$judgkwlw@)@@@@@6@@ఐC!m{w|w@@@e@@@I%@@@@+&@A@w~@@@ఐ᠐*remove_pat@@@@ܠ@@@Z@@Y@@@@X@@W@@@V@@U@@T3@K[T@U@V@@@@ఐ䠐%c_lhs@@@@@@p@@ఐs#env@@@@@@iO@O@~(@@@@@@@O@g0@@డM'compose$Mode@ @@^@@@@@@@@@@@@@@@@@@@@@X@@ఐР!m @@@@@@h@@ఐ堐'pattern@@@@N@@@@@@@@@@@@@@@@@@@@ఐj%c_lhs9:@@@m@@@@@ఐ#envJK@@@ @@@P@P@@@UV@@ @@@@@v@@4@@@O@@@ @@@@ @@@@@ @iimj@@@X@@@@@@W@@@ޠ@T@@@@@@@M@>@R@@d@ @@@@@@@@@x@@@@@@w@@@@t@@@@@@@@@L@@@@ 8@uuUT@SVШn@б@гxy@Y@h@А!k~@q3@@@@W@X@@@ @@@q@@б@г#Env@l@o@@p@q@@@@@@q @@г$mode@u@y@@@@@q)@@@@@q@@q. @@@/@@q @@q32@@9@@q7@A@@@àC@r@@@r@@r@@@@r@@r@@@r@@r@@r @@rN@࣠@#pataA@@@/A@@n`N@@@@@@3!  !!!!!@;@@@A@@@A@)@S*@T@@@@BA@@@@@@#envbA6@7@@OA@@=@@@+3<;;<<<<<@2('@@@@@@@0@1@@@@@@@ఠ%m_patcU'OUV'OZ@nA@@@@@TQ@/3[ZZ[[[[[@ 1'@@@*@+@,@@@ఐ8is_destructuring_patterno'O`p'Ox@@@@]@@@DQ@5@@@4@@3@@@2@@1$@@ఐy#pat'Oy'O|@M@@u@@@C5@@%@@ؖ@@@RR@<;@ภ+Dereference(}(}@:@@@e@@@UG@ภ%Guard))@@@@Q@XS@'O]@@U@A@'OQ@@@ఠ%m_envd++@A@@@@@Q@Y3@kyr@s@t@@@డD$List)fold_left. . @ . . "@@O@@@@@@@S@p@@y@ S@s@@x @@w@@v@@u@@@t@ڠ @@@r@@q@@o@@n@@m3@8@@@@డw$join$Mode. #. '@ . (. ,@@@@@@@@@@@@@@@@@"@@ภ&Ignore+. -,. 3@@@@@@@1@@X@@@F@@@@@P@@:@@డ$List#mapL-M-@ P-Q-@@X@@@@ @@@T@@@@@@T@@@@@@Z@@@@@Y@@@@@@@r@@࣠@"ideA--@A@@(@@@@డ$find#Env--@ --@@@@@! @@@@@@@@@@@ @@@@@@@3@5S@,@-@@@@ఐ<"id--@ @@`@@ఐ#env-- @h@@@@@W@W@$@@> @@n%@-- @@@@@{@@U@U@@@ @@@Ѡ@@@@@Р@@@@@!@@డB0pat_bound_idents,,@@@@@@@@.S@@@@@@@@@@@@@@D@@ఐ#pat,,@װ@@@@@-U@@)@@!@@@@@@S@S@j@@>@@nk@A@4+ @@డƪ$join$ModeB09;C09?@ F09@G09D@@@@@@@@G@@I@@@H@@F@@E3RQQRRRRR@@@@@@@ఐ %m_patb09Ec09J@@@(@@@V@@ఐ%m_envr09Ks09P@@@8@@@Z#@@7@@Q@S&@H @@@ @@@+ AA@б@гlO֠гmհ@@r@@@o@@y@@@s@б@г_РT@f@@@@г2@@@@@@@@@@@@ @@@@@6@@@@@@@@@@{@@@@@x@@@@@@@L@@@@@@X@yycb@adШr@б@г|}2R|2R@А!k@q3@@@2Rz2R{@@@ @@@q@@г$bool2R2R@@@@@q@@@@@q@@q @@@@q@A@@@)@r@@@r@@r@@@r@@r@@r-@࣠@#patgA33@7A@@vŠfN@@@@@@3)(()))))@;@@@A@@@A@12Rv22Rw@@@@JA@@@@@@ఐ&#patA3B3@"!@@@@@@@*@+  @@*)@@@@@@3POOPPPPP@(>@@@(pat_descY3Z3@@@b@@@P@@Ġ(Tpat_anyo4p4@;(Tpat_anyw@@@ @@@ @@@@ALAAO  O  3@@@i@@@@@ф]@@@@@@3@4@a;@@@A@@@@@AP@@@A@A@@@ѕn@@@@@@@@@ภ44@@@@\@@@ @Ġ(Tpat_var55@њ@55@@ѕ@@@3@e@;@@@AJ@@@@@AP@@@A@A@@@55@@Ѡў@@@@@@@@55@@ѡ@@@@@@)5@@ܠ@@@@@@'@ @@@@@@@.@@@ภ;55@;@@@N6@Ġ*Tpat_alias66@;*Tpat_aliasI@@@ @@@ @HQ@@@ @@@ Ġ!t@@@ Ơ #loc@@@ @@@ Ǡ!t@@@ ɠ@)type_expr@@@ @EAALAAS  U  @@@l@ఠ#path6676 @OA@@~և@@@ @@@ 3>==>>>>>@@;@@@A֐@@@ @@APW@@@aA@A@@@N6 O6 @@D@@@ @@V6W6@@EC@@@@@@ @@b6c6@@F@@@&@@j6k6@@H@@@.@@@xp6@@uN@@@@@@7@ @|U@@@@@@>@@@ఐ.8is_destructuring_pattern663@2@@@2@@@,Q@@@@@@/@@@@@3@Ikd@e@f\@@@ఐr#pat6467@ @@@@@+@@(@@@Ġ-Tpat_constant78>78K@;-Tpat_constant  @@@ @@@ @(constant@@@ @ABALAAEW ( *FW ( Z@@@Xm@@78L78M@@@@@!3@@;@@@Aj'@@@ @@AP@@@A@A@@@@)@@@@@#@@@"@@@@@%@@@$@@@ภb78Q78U@a@@@Y!@Ġ*Tpat_tuple8V\8Vf@;*Tpat_tuple T@@@ @@@ @P@ᢠ@@@ @@@ Ҡ@fo@@@ @@@ @@ @@@ @ACALAAY  Z  @@@n@@28Vg38Vh@@%@$#@@@:@@@9@ב@@@<@@@;@@8@@@73IHHIIIII@@&;@@@Aכ@@@6@@APb@@@lA@A@@@@T$@@[4@@@>@@@=@@b;@@@@@@@?@@@ภְj8Vlk8Vp@@@@!@Ġ.Tpat_constructw9qwx9q@;.Tpat_construct@@@ @@@ @|#locf!t@@@ @@@ ؠ57constructor_description@@@ ڠؠߠ@@@ @@@ @@@ ۠/@#loc߻!t@@@ @@@ @@@ ࠠ@N@@@ @@ @@@ @DDALAA=a  >d@@@Po@@9q9q@@JH@@@Y@@@X3@@;@@@Af#@@@W@@AP@@@A@A@@@@P@@@Z@@@N,5@@@]@@@\@@@[@@(@N@MLJ@@@b@@@a@@@`@N@@@c@@_@@@^6@@@?@@@@@e@@@d>@@@@@g@@@fE@@@ภꊰ9q9q@@@@M@Ġ,Tpat_variant+:,:@;,Tpat_variant3|@@@ @@@ @0%label@@@ Ƞ؎@@@ @@@ @@@ &Stdlib#refn(row_desc@@@ @@@ @CEALAAmoqo@@@p@@a:b:@@,@@@y3cbbccccc@@@;@@@Aص@@@x@@AP|@@@A@A@@@@5@@@|@@@{@@@z@@@50@@@~@@@} @@@\%@@ԋd@@@@@@(@@Ԓk@@@@@@/@@@ภ::@@@@7@Ġ+Tpat_record;;@;+Tpat_recordԯ@@@ @@@ @@#loc!t@@@ @@@ @n1label_description@@@ @@@@ @@@ @@ @@@ +closed_flag@@@ @BFALAAYu}Z{ '@@@lq@@;;@@6@53@@@@@@阠@0@@@隠@BK@@@@@@@@@@@3@@;@@@AU@@@@@AP@@@&A@A@@@;;@@;@@@@@@r;@@@@@@@@@ @%@@@@@@"@@@ภ뙰-;.;@@@@*@Ġ*Tpat_array:<;<@;*Tpat_arrayBً@@@ @@@ @?,mutable_flag@@@ 荠ٝ@@@ @@@ @@@ @BGALAA @@@r@@`<a<@@@@@3baabbbbb@@?;@@@Aٴ@@@@@AP{@@@A@A@@@@%@@@@@@@@@@@@C@@ՁZ@@@@@@@@Ոa@@@@@@&@@@ภ<<@@@@.@Ġ)Tpat_lazy==@;)Tpat_lazyե@@@ @@@ @@@@ @@@ @AHALAA*.0+.i@@@=s@@==@@@@@@@@3@n@;@@@AS@@@@@AP@@@A@A@@@@/@@Р@@@@@@@@נ@@@@@@@@@ภK==@J@@@B!@Ġ*Tpat_value> >@;*Tpat_valueL@@@ @@@ @3tpat_value_argument@@@ @AIALAAwx@@@t@ఠ#pati > >@"A@@@@@3        @@;@@@An@@@@@AP&@@@0A@A@@@@/@@@@@@@@@@&@@@@@@@@@ఐؠ8is_destructuring_pattern2>3>3@ܰ@@@ܠڈ@@@Q@g@@@f@@e@@@d@@c3DCCDDDDD@D=@>@?9@@@ఐK#patT>5U>8@ @@г'patterna><b>C@@ @@@u@@h>4i>D@@@@*@v%@@;@@&@Ġ.Tpat_exceptionw?EKx?EY@;.Tpat_exception@@@ @@@ @Ǡ@@@ @@@ @AJALAACEC@@@u@@?EZ?E[@@ؠ@@@@@@3@H@u;@@@A-@@@@@AP@@@A@A@@@@/@@֪@@@@@@@@ֱ@@@@@@@@@ภ ?E_?Ed@ @@@!@Ġ'Tpat_or@ek@er@;'Tpat_orΠ!k@ m@@@ @ @@@ @@@ h(row_desc@@@ @@@ @CKALAAbc/@@@uv@ఠ!lj@et@eu@ A@@<@@@@@@@ఠ!rk@ev@ew@A@@N@@@@@@@@@ex@ey@@98@@@@@@@@@X@ez@@#@@@@@@@ @*@@@@@@@@@డ"||6A~7A~@@:@@@]@@\@B@@@[@@ZF@@@Y@@X@@W'%sequorBAذ@@@@ذر@@د^@! @@@@@@@@@@@@@@@@@@@@@3eddeeeee@{t@u@vjc@d@e@@@@ఐ8is_destructuring_patternyA~zA~@#@@@#_@@@R@@@@@@ @@@@@$@@ఐ!lA~A~@-@@ݠ@@@5@@%@@e@@@@S@=@@ఐW8is_destructuring_patternA~A~@[@@@[@@@R@@@@@@X@@@@@\@@ఐȠ!rA~A~@d@@@@@m@@%@@@@@@S@u@@e@@>v@@@A3@@@@@@3@@@@wA@б@гˠг̠@@@@@@@ؠ@@@@г^@b@@@ @@@@@@ @%@@@@@@@@@@@@@@L@@@@2RRK@@[L@󠰡@ఠ=is_valid_recursive_expressionl&C'C@?A@@@@@@@@@L@@@@/@@@]L@@@^@@@@@@L@@@L@@@L@3MLLMMMMM@@@@࣠@&idlistnA\C]C@uA@@03]\\]]]]]@?dCeUKu@@@@@  @@$exproApCqC@A@@43qppqqqqq@!G@@@@@@@@ఐ$exprDD@G@@@@H3@!@@@(exp_descD D@ @@@@@ @Ġ-Texp_functionEE(@Š@E)E*@@Ǡ@@@@@@3@$@@@@ @@@@@@@@@ @@@ @@ @@@ @@@ภ$SomeGzGz@ภ&StaticGzGz@@@@@@@P@$@@@@@@@@@@,@@HH@@7@@@[@@:@@@^@@@@ఠ%rkindpII@ A@@l@@@Q@M@ఐ3classify_expressionII@σ@@@@@@@@@@@@@c@@ఐ$exprII@@@p@@@@'q@A@I@@@ఠ(is_validq)J*J@BA@@,@@@Q@3/../////@HA@B@C@@@ఐN%rkind>K?K@ @@@@@3A@@AAAAA@@@@Ġ&StaticOLPL@:@@@@@@@3RQQRRRRR@#@@@@@@@@@@@ఠ"tyrcN<IdN<K@|A@@@@@T@<@ఐm*expressionwN<NxN<X@@@@k@@@@@D@@@@@R@@ఐ!$exprN<YN<]@ @@Q_@@ภ&ReturnN<^N<d@{@@@`@@@n@@*@@8o@A@N<E@@డ!=OhOh@θ@@@@@@6@@@5S@@@@@@ξ@@@@@ @@ 3@g`@a@b@@@@డ)unguarded#EnvOhqOht@ OhuOh~@@@@@@d@@d@@@@d@@@d@@d=@@@d@@@d@@d@@d@ް#@@@3@@@'@@&@@@@%@@@$@@# W@@@"@@@!@@ @@O@@ఐ"tyOhOh@Y@@Y@@@;U@=U@<c@@ఐؠ&idlist1Oh2Oh@@@p@@^@@q@@ภְ=Oh>Oh@@@@S@C~@@l@@@@@@Ġ'DynamicNPOP@/@@@@@@@@@@@@@@@@ఠ"tysaRbR@zA@@@@@`T@D@ఐk*expressionuRvR@@@@i@@@I@@HB@@@G@@F-@@ఐ$exprRR@@@O:@@ภ&ReturnRR@|@@@^@@@iI@@*@@8J@A@R@@డ"&&S#S%@@Ϯ@@@V@@U@϶@@@T@@SϺ@@@R@@Q@@P(%sequandBA$@@@@$%@@#]@! @@@@@@s@@r@@@@q@@p@@@o@@n@@m3@z@{@|@@@@డX?ASS@@@@>@@@@@@T@@@@ @@@@@@@@@%@@డ )unguarded#EnvSS @ S S@@:@@@R@@@@@@0:@@@@@@@@,v@@@@@@@@@@V@@ఐ۠"ty<S=S@`@@x@@@V@V@j@@ఐ&idlistPSQS@ܰ@@#w@@C@@ax@@ภ\S ]S"@@@@nT@@@Q@@@@@@U@@@డɠ˰tS>uS?@Ѐ@@@EDC@@@@@@T@@@@@@І@@@@@@@@@డ˔)dependent#EnvS&S)@ S*S3@@@@@@d@@d@}@@@d@@@d@@d~9@@@d@@@d@@d@@d@zwi"@@@@@@@@@@@@@@@@@S@@@@@@@@@@@@ఐ"tyS4S6@@@@@@V@V@@@ఐ&idlistS7S=@@@@@]@@|@@ภS@SB@s@@@T@*@@k@@R@@@@U@2@@ @@T@5@r@@@@@AK@@@A@J@@ఐ(is_validUKS UK[@@@@@%@@@P@3%$$%%%%%@ @@@ภ$Some0UKa1UKe@ఐJ%rkind:UKf;UKk@@@@@@P@ P@ @@ @@Ҡ@@@!@ภ$NonePUKq@@@@P@,@UUKP@@.@B@@%@:@@@@@AYD@г&optioncCdC@г"sdlCmC@@#°@@@(ð @@@@)@ A@GL@@A@@@$@ఠ3is_valid_class_exprtaRVaRi@A@@@@@@@@@L@@@@*class_expr@@@L@#@@$ @@@L@%@@&L@@@ L@3@8~@@@@@࣠@&idlistvAaRjaRp@A@@.3@=aRR@@@@@  @@"cewAaRqaRs@A@@33@!E@@@@@@@@Aఠ*class_exprxbvbv@A@б@гr$modebvbv@@ @@@*3@%1Z@(@)@@ @@б@г[)Typedtreebvbv@bbvbv@@@j@@@+ @@г !t#Envbvbv@ bvbv@@@@@@,. @@@@@-@@.3& @@@;@@/ @@08>@@ONA@@@J@@@S@@R@@@@Q@@P/@@@O@@N@@MK@࣠@$modeyAEcFc@^A@@@@@k3JIIJJJJJ@_y@q@@@E@@D@@@@C@@BV@@@A@@@@@?@@@@@@@@"cezAkclc@A@@@@@x3qppqqqqq@(8.@@@j@2@3@@@@@@ఐ"cecc@@@@w@@ @@Z@@@@~3@ 1 @@@'cl_desccc@*@@*@@@ @Ġ)Tcl_identdd@*Y@dd@@*X@@@3@ @@@@dd@@*Z*X@@@@@@ @@dd@@*YX@@@@@@@@@$d@@*@@@@@*@@@!@@@డ%empty#Envi=Ei=H@ i=Ii=N@@R@@@@@9@Ġ-Tcl_structurejOWjOd@)ߠ@jOejOf@@@@@M@@@ @@*@@@Q@@*@@@T@@@డ %empty#Envoo@ oo@@@@3g@Ġ'Tcl_fun$p%p@)@)p*p@@)@@@{@@1p2p@@@@@@@9p:p@@)@)@@@򦠠@a@@@@@@@@@@NpOp@@[n@@@@@VpWp@@@@@@@@8\p@@+R@@@@@+U@@@@@@డf%empty#Envnpop@ rpsp@@@@@Ġ)Tcl_applyuemuev@(a@uexuey@@[@@@@@ue{ue|@@(g@(f@@@򷠠@7@@@@@@@@@@@ ue}@@+@@@@@+@@@@@@డΪ%empty#Envueue@ ueue@@%@@@Ġ'Tcl_letvv@& ఠ(rec_flag{vv@A@@&@@@3@A@@@ఠ(bindings|vv@A@@&@@@@@@@@vv@@&!@& @@@ˠ@@@@@@@@@(@ఠ"ce}vv@A@@\%@@@6@@@G v@@,@@@;@@,@@@>@@@ఐ9.value_bindingsww@=@@@=@@@@@@;:@@@@@@@@7@@@@@@@30//00000@ng@h@i`Y@Z@[:3@4@5@@@@ఐw(rec_flagDwEw@@@f@@@)T@3T@2@@ఐ|(bindingsXwYw@"@@qp@@@'@@@&T@6T@43@@ఐ.$modepwqw@@@*@@@8C@@ఐ*class_exprww@5@@@@@@C@@B@@@@A@@@@@@?@@>@@=c@@ఐ^$modeww@,@@@@@SU@WU@Vw@@ఐ"ceww@}@@!@@@QU@YU@X@@ww@@@@@/@ZU@O@@ @@@Ġ.Tcl_constraintxx@%ఠ"ce~xx@A@@]@@@3@R@@@@xx@@%%@@@@@@ @@xx@@%%@@@@@@@@xx @@%%@@@@@@%@@ x"x#@@%@@@-@@@>x$@@- @@@2@@- @@@5@@@ఐI*class_expr#y(0$y(:@ְ@@@G@@@c@@b@@@@a@@`,@@@_@@^@@]343344444@_X@Y@Z@@@@ఐ$modeDy(;Ey(?@а@@h@@@sT@wT@v@@ఐz"ceXy(@Yy(B@!@@@@@qT@yT@x+@@@ @@|,@Ġ(Tcl_openmzCKnzCS@%ՠ@rzCUszCV@@%@@@@ఠ"ce~zCXzCZ@A@@]@@@@@@zC[@@-|@@@@@-@@@@@@ఐ*class_expr{_g{_q@I@@@@@@@@@ @@@@@@@@~@@}@@|3@2+@,@-@@@@ఐu$mode{_r{_v@C@@@@@T@T@@@ఐM"ce{_w{_y@!@@8@@@T@T@+@@@ @@,@@@Ac @@@@@x(@c@б@г@@@@T@б@г|T@@@@U@г@@@@V@@@@W@@X@@!@@Y@@Z@,C@@@L @>A@|@@Hڠ@@#@^@\@Rʠ@砰@A;FA@AI@@@ H************************************************************************A@@A@L@ H BMMBM@ H OCaml CC@ H DD3@ H Jeremy Yallop, University of Cambridge E44E4@ H Gabriel Scherer, Project Parsifal, INRIA Saclay FF@ H Alban Reynaud, ENS Lyon GG@ H HHg@ H Copyright 2017 Jeremy Yallop IhhIh@ H Copyright 2018 Alban Reynaud JJ@ H Copyright 2018 INRIA KKN@ H LOOLO@ H All rights reserved. This file is distributed under the terms of MM@ H the GNU Lesser General Public License version 2.1, with the NN5@ H special exception on linking described in the file LICENSE. O66O6@ H PP@ H************************************************************************QQ@ * Static checking of recursive declarations, as described in A practical mode system for recursive definitions Alban Reynaud, Gabriel Scherer and Jeremy Yallop POPL 2021 Some recursive definitions are meaningful {[ let rec factorial = function 0 -> 1 | n -> n * factorial (n - 1) let rec infinite_list = 0 :: infinite_list ]} but some other are meaningless {[ let rec x = x let rec x = x+1 ]} Intuitively, a recursive definition makes sense when the body of the definition can be evaluated without fully knowing what the recursive name is yet. In the [factorial] example, the name [factorial] refers to a function, evaluating the function definition [function ...] can be done immediately and will not force a recursive call to [factorial] -- this will only happen later, when [factorial] is called with an argument. In the [infinite_list] example, we can evaluate [0 :: infinite_list] without knowing the full content of [infinite_list], but with just its address. This is a case of productive/guarded recursion. On the contrary, [let rec x = x] is unguarded recursion (the meaning is undetermined), and [let rec x = x+1] would need the value of [x] while evaluating its definition [x+1]. This file implements a static check to decide which definitions are known to be meaningful, and which may be meaningless. In the general case, we handle a set of mutually-recursive definitions {[ let rec x1 = e1 and x2 = e2 ... and xn = en ]} Our check (see function [is_valid_recursive_expression] is defined using two criteria: Usage of recursive variables: how does each of the [e1 .. en] use the recursive variables [x1 .. xn]? Static or dynamic size: for which of the [ei] can we compute the in-memory size of the value without evaluating [ei] (so that we can pre-allocate it, and thus know its final address before evaluation). The "static or dynamic size" is decided by the classify_* functions below. The "variable usage" question is decided by a static analysis looking very much like a type system. The idea is to assign "access modes" to variables, where an "access mode" [m] is defined as either m ::= Ignore (* the value is not used at all *) | Delay (* the value is not needed at definition time *) | Guard (* the value is stored under a data constructor *) | Return (* the value result is directly returned *) | Dereference (* full access and inspection of the value *) The access modes of an expression [e] are represented by a "context" [G], which is simply a mapping from variables (the variables used in [e]) to access modes. The core notion of the static check is a type-system-like judgment of the form [G |- e : m], which can be interpreted as meaning either of: - If we are allowed to use the variables of [e] at the modes in [G] (but not more), then it is safe to use [e] at the mode [m]. - If we want to use [e] at the mode [m], then its variables are used at the modes in [G]. In practice, for a given expression [e], our implementation takes the desired mode of use [m] as *input*, and returns a context [G] as *output*, which is (uniquely determined as) the most permissive choice of modes [G] for the variables of [e] such that [G |- e : m] holds. =* {1 Static or dynamic size}  X See the note on abstracted arguments in the documentation for Typedtree.Texp_apply x66yw@ p We need to keep track of the size of expressions bound by local declarations, to be able to predict the size of variables. Compare: let rec r = let y = fun () -> r () in y and let rec r = let y = if Random.bool () then ignore else fun () -> r () in y In both cases the final address of `r` must be known before `y` is compiled, and this is only possible if `r` has a statically-known size. The first definition can be allowed (`y` has a statically-known size) but the second one is unsound (`y` has no statically-known size). @B@< binding and variable cases  @3 non-binding cases   @< Unit-returning expressions @ 8 The code below was copied (in part) from translcore.ml ouo@ m A constant expr (of type <> float if [Config.flat_float_array] is true) gets compiled as itself.  X@0 Forward blocks !"@ 8 other cases compile to a lazy block holding a function 'z(z@  We use a non-recursive classification, classifying each binding with respect to the old environment (before all definitions), even if the bindings are recursive. Note: computing a fixpoint in some way would be more precise, as the following could be allowed: let rec topdef = let rec x = y and y = fun () -> topdef () in x - .!!@ = Note: we don't try to compute any size for complex patterns 3""4""@  an identifier will be missing from the map if either: - it is a non-local identifier (bound outside the letrec-binding we are analyzing) - or it is bound by a complex (let p = e in ...) local binding - or it is bound within a module (let module M = ... in ...) that we are not traversing for size computation For non-local identifiers it might be reasonable (although not completely clear) to consider them Static (they have already been evaluated), but for the others we must under-approximate with Not_recursive. This could be fixed by a more complete implementation. 9##:&&@ local modules could have such paths to local definitions; classify_expression could be extend to compute module shapes more precisely ?'8'@@''@ #* {1 Usage of recursive variables} Ƞ * For an expression in a program, its "usage mode" represents static information about how the value produced by the expression will be used by the context around it.  * [Ignore] is for subexpressions that are not used at all during the evaluation of the whole program. This is the mode of a variable in an expression in which it does not occur. ٌ * A [Delay] context can be fully evaluated without evaluating its argument , which will only be needed at a later point of program execution. For example, [fun x -> ?] or [lazy ?] are [Delay] contexts. x * A [Guard] context returns the value as a member of a data structure, for example a variant constructor or record. The value can safely be defined mutually-recursively with their context, for example in [let rec li = 1 :: li]. When these subexpressions participate in a cyclic definition, this definition is productive/guarded. The [Guard] mode is also used when a value is not dereferenced, it is returned by a sub-expression, but the result of this sub-expression is discarded instead of being returned. For example, the subterm [?] is in a [Guard] context in [let _ = ? in e] and in [?; e]. When these subexpressions participate in a cyclic definition, they cannot create a self-loop. d * A [Return] context returns its value without further inspection. This value cannot be defined mutually-recursively with its context, as there is a risk of self-loop: in [let rec x = y and y = x], the two definitions use a single variable in [Return] context. P * A [Dereference] context consumes, inspects and uses the value in arbitrary ways. Such a value must be fully defined at the point of usage, it cannot be defined mutually-recursively with its context. < Lower-ranked modes demand/use less of the variable/expression they qualify -- so they allow more recursive definitions. Ignore < Delay < Guard < Return < Dereference Zi33[m4J4N@ Returns the more conservative (highest-ranking) mode of the two arguments. In judgments we write (m + m') for (join m m'). `u44ay5N5R@ z If x is used with the mode m in e[x], and e[x] is used with mode m' in e'[e[x]], then x is used with mode m'[m] (our notation for "compose m' m") in e'[e[x]]. Return is neutral for composition: m[Return] = m = Return[m]. Composition is associative and [Ignore] is a zero/annihilator for it: (compose Ignore m) and (compose m Ignore) are both Ignore. f}55g67@ K* Create an environment with a single identifier used with a given mode. ֠ +* An environment with no used identifiers.  W* Find the mode of an identifier in an environment. The default mode is Ignore.  p* unguarded e l: the list of all identifiers in l that are dereferenced or returned in the environment e. \ Z* dependent e l: the list of all identifiers in l that are used in e (not ignored). & ?* Environments can be joined pointwise (variable per variable) 䠠 k* Environment composition m[G] extends mode composition m1[m2] by composing each mode in G pointwise  ,* Remove an identifier from an environment.  @* Remove an identifier from an environment, and return its mode Z <* Remove all the identifiers of a list from an environment. + 9* A "t" maps each rec-bound variable to an access status ٠ V Usage mode judgments. There are two main groups of judgment functions: - Judgments of the form "G |- ... : m" compute the environment G of a subterm ... from its mode m, so the corresponding function has type [... -> Mode.t -> Env.t]. We write [... -> term_judg] in this case. - Judgments of the form "G |- ... : m -| G'" correspond to binding constructs (for example "let x = e" in the term "let x = e in body") that have both an exterior environment G (the environment of the whole term "let x = e in body") and an interior environment G' (the environment at the "in", after the binding construct has introduced new names in scope). For example, let-binding could be given the following rule: G |- e : m + m' ----------------------------------- G+G' |- (let x = e) : m -| x:m', G' Checking the whole term composes this judgment with the "G |- e : m" form for the let body: G |- (let x = e) : m -| G' G' |- body : m ------------------------------- G |- let x = e in body : m To this judgment "G |- e : m -| G'" our implementation gives the type [... -> Mode.t -> Env.t -> Env.t]: it takes the mode and interior environment as inputs, and returns the exterior environment. We write [... -> bind_judg] in this case. AAG&G(@ A judgment [judg] takes a mode from the context as input, and returns an environment. The judgment [judg << m], given a mode [m'] from the context, evaluates [judg] in the composed mode [m'[m]]. 'JDJD)JK@ A binding judgment [binder] expects a mode and an inner environment, and returns an outer environment. [binder >> judg] computes the inner environment as the environment returned by [judg] in the ambient mode. -KK0LWLq@ Expression judgment: G |- e : m where (m) is an input of the code and (G) is an output; in the Prolog mode notation, this is (+G |- -e : -m). 4LL8MrMt@ G |- : m -| G' G' |- body : m ------------------------------- G |- let in body : m >N/N5CNN@ TODO: update comment below for eff_cases (Gi; mi |- pi -> ei : m)^i G |- e : sum(mi)^i ---------------------------------------------- G + sum(Gi)^i |- match e with (pi -> ei)^i : m FO6O<KPP!@ G1 |- low: m[Dereference] G2 |- high: m[Dereference] G3 |- body: m[Guard] --- G1 + G2 + G3 |- for _ = low to high do body done: m VR(R.\RR@ \ G |- c: m[Dereference] ----------------------- G |- new c: m eSSiT T@ Q G |- e: m[Guard] ------------------ G |- ref e: m oTTsUJUR@  [args] may contain omitted arguments, corresponding to labels in the function's type that were not passed in the actual application. The arguments before the first omitted argument are passed to the function immediately, so they are dereferenced. The arguments after the first omitted one are stored in a closure, so guarded. The function itself is called immediately (dereferenced) if there is at least one argument before the first omitted one. On the other hand, if the first argument is omitted then the function is stored in the closure without being called. vUU~WX)@ * (flat) float arrays unbox their elements \\\\M@ This is counted as a use, because constructing a generic array involves inspecting to decide whether to unbox (PR#6939). \\\]@ 3 non-generic, non-float arrays act as constructors ]h]t]h]@ r G |- e: m[Guard] ------------------ ----------- G |- `A e: m [] |- `A: m __`Q`Y@ Gc |- c: m[Dereference] G1 |- e1: m G2 |- e2: m --- Gc + G1 + G2 |- if c then e1 else e2: m Note: `if c then e1 else e2` is treated in the same way as `match c with true -> e1 | false -> e2` bbcc@ 5 G1 |- e1: m[Dereference] G2 |- e2: m[Dereference] --- G1 + G2 |- e1.x <- e2: m Note: e2 is dereferenced in the case of a field assignment to a record of unboxed floats in that case, e2 evaluates to a boxed float and it is unboxed on assignment. ddee@ G1 |- e1: m[Guard] G2 |- e2: m -------------------- G1 + G2 |- e1; e2: m Note: `e1; e2` is treated in the same way as `let _ = e1 in e2` fQfWg g@ G1 |- cond: m[Dereference] G2 |- body: m[Guard] --------------------------------- G1 + G2 |- while cond do body done: m ggh#h+@ r G |- e: m[Dereference] ---------------------- (plus weird 'eo' option) G |- e#x: m hhii"@ Z G |- e: m[Dereference] ----------------------- G |- e.x: m  i{iii@ \ G |- e: m[Dereference] ---------------------- G |- x <- e: m j'j-jj@ G |- e: m[Dereference] ----------------------- G |- assert e: m Note: `assert e` is treated just as if `assert` was a function.  kk  #kk@ K G |- M: m ---------------- G |- module M: m &kk*l?lG@ . G |- e: m (Gi; _ |- pi -> ei : m)^i -------------------------------------------- G + sum(Gi)^i |- try e with (pi -> ei)^i : m Contrarily to match, the patterns p do not inspect the value of e, so their mode does not influence the mode of e. /ll7mm@  G |- pth : m (Gi |- ei : m[Dereference])^i ---------------------------------------------------- G + sum(Gi)^i |- {< (xi = ei)^i >} (at path pth) : m Note: {< .. >} is desugared to a function application, but the function implementation might still use its arguments in a guarded way only -- intuitively it should behave as a constructor. We could possibly refine the arguments' Dereference into Guard here. ?nnHpp@ G |-{body} b : m[Delay] (Hj |-{def} Pj : m[Delay])^j H := sum(Hj)^j ps := sum(pat(Pj))^j ----------------------------------- G + H - ps |- fun (Pj)^j -> b : m #OqWq]$Vr@rH@ param P ::= | ?(pat = expr) | pat Define pat(P) as pat if P = ?(pat = expr) pat if P = pat )Xrerm*_s s@ > Optional argument defaults. G |-{def} P : m /dss0gss@ h G |- e : m ------------------ G |-{def} ?(p=e) : m 5ktOtY6ott@ J ------------------ . |-{def} p : m ;rtu <uuKuW@ } G |- e: m[Delay] ---------------- (modulo some subtle compiler optimizations) G |- lazy e: m AvvBww @ - ---------- [] |- .: m GyyHy7y?@ ( Function bodies. G |-{body} b : m MyyNzz@ G |- e : m ------------------ G |-{body} e : m (**) (**) The "e" here stands for [Tfunction_body] as opposed to [Tfunction_cases]. SzXz\T{ {@ * (Gi; _ |- pi -> ei : m)^i (**) ------------------ sum(Gi)^i |-{body} function (pi -> ei)^i : m (**) Contrarily to match, the values that are pattern-matched are bound locally, so the pattern modes do not influence the final environment. Y{M{QZ|y|@ These coercions perform a shallow copy of the input module, by creating a new module with fields obtained by accessing the same fields in the input module. _`K@ a This corresponds to 'external' declarations, and the coercion ignores its argument ef@ y Alias coercions ignore their arguments, but they evaluate their alias module 'pth' under another coercion. k2<ly@. G |- pth : m qSSrSe@ ------------ x: m |- x: m G |- A: m[Dereference] ----------------------- G |- A.x: m G1 |- A: m[Dereference] G2 |- B: m[Dereference] ------------------------ (as for term application) G1 + G2 |- A(B): m wx}@9 G |- struct ... end : m }~@ G1, {x: _, x in vars(G1)} |- item1: G2 + ... + Gn in m G2, {x: _, x in vars(G2)} |- item2: G3 + ... + Gn in m ... Gn, {x: _, x in vars(Gn)} |- itemn: [] in m --- (G1 + ... + Gn) - V |- struct item1 ... itemn end: m %@ N G |- : m -| G' where G is an output and m, G' are inputs *YY+|@ Ge |- e: m[Guard] G |- items: m -| G' --------------------------------- Ge + G |- (e;; items): m -| G' The expression `e` is treated in the same way as let _ = e /*06@ ? ------------------- G |- type t: m -| G CF@< G |- module M = E : m -| G d>>d>^@ GE |- E: m[mM + Guard] ------------------------------------- GE + G |- module M = E : m -| M:mM, G gkJR@ ' G |- let (rec?) (pi = ei)^i : m -| G' ggg@ (Gi, pi:_ |- ei : m[mbody_i])^i (pi : mbody_i -| D)^i ------------------------------------------------------------ Sum(Gi) + (D - (pi)^i) |- let (pi=ei)^i : m -| D @ b (Gi, (xj : mdef_ij)^j |- ei : m[mbody_i])^i (xi : mbody_i -| D)^i G'i = Gi + mdef_ij[G'j] ------------------------------------------------------------------- Sum(G'i) + (D - (pi)^i) |- let rec (xi=ei)^i : m -| D The (mdef_ij)^i,j are a family of modes over two indices: mdef_ij represents the mode of use, within e_i the definition of x_i, of the mutually-recursive variable x_j. The (G'i)^i are defined from the (Gi)^i as a family of equations, whose smallest solution is computed as a least fixpoint. The (Gi)^i are the "immediate" dependencies of each (ei)^i on the outer context (excluding the mutually-defined variables). The (G'i)^i contain the "transitive" dependencies as well: if ei depends on xj, then the dependencies of G'i of xi must contain the dependencies of G'j, composed by the mode mdef_ij of use of xj in ei. For example, consider: let rec z = let rec x = ref y and y = ref z in f x this definition should be rejected as the body [f x] dereferences [x], which can be used to access the yet-unitialized value [z]. This requires realizing that [x] depends on [z] through [y], which requires the transitive closure computation. An earlier version of our check would take only the (Gi)^i instead of the (G'i)^i, which is incorrect and would accept the example above.  @ X [binding_env] takes a binding (x_i = e_i) and computes (Gi, (mdef_ij)^j). Et@6 Gi, (x_j:mdef_ij)^j  @= (mdef_ij)^j (for a fixed i) VbV@$ Gi !)@3 (Gi, (mdef_ij)^j) mym@ + Gi, (mdef_ij)^j => Gi + Sum_j mdef_ij[Gj] drd@ G; m' |- (p -> e) : m with outputs G, m' and input m m' is the mode under which the scrutinee of p (the value matched against p) is placed. 66@ Ge |- e : m Gg |- g : m[Dereference] G := Ge+Gg p : mp -| G ---------------------------------------- G - p; m[mp] |- (p (when g)? -> e) : m  ?C@ e p : m -| G with output m and input G m is the mode under which the scrutinee of p is placed. =?@ mp := | Dereference if p is destructuring | Guard otherwise me := sum{G(x), x in vars(p)} -------------------------------------------- p : (mp + me) -| G  &JN@ B Fast path: functions can never have invalid recursive references F.3F.y@ . The expression has known size or is constant M M;@ ! The expression has unknown size QQ@  A class declaration may contain let-bindings. If they are recursive, their validity will already be checked by [is_valid_recursive_expression] during type-checking. This function here prevents a different kind of invalid recursion, which is the unsafe creations of objects of this class in the let-binding. For example, {|class a = let x = new a in object ... end|} is forbidden, but {|class a = let x () = new a in object ... end|} is allowed. Www`OQ@ 3 ---------- [] |- a: m  eh2<@ M ----------------------- [] |- struct ... end: m kjrn@ U --------------------------- [] |- fun x1 ... xn -> C: m q tZd@@*./ocamlopt)-nostdlib"-I(./stdlib"-I1otherlibs/dynlink"-g0-strict-sequence*-principal(-absname"-w8+a-4-9-40-41-42-44-45-48+-warn-error"+a*-bin-annot/-strict-formats"-I&typing"-I%utils"-I'parsing"-I&typing"-I(bytecomp"-I,file_formats"-I&lambda"-I*middle_end"-I2middle_end/closure"-I2middle_end/flambda"-I=middle_end/flambda/base_types"-I'asmcomp"-I&driver"-I(toplevel"-I%tools"-I'runtime"-I1otherlibs/dynlink"-I-otherlibs/str"-I4otherlibs/systhreads"-I.otherlibs/unix"-I8otherlibs/runtime_events2-function-sections"-cWX F/home/ci/builds/workspace/main/flambda/false/label/ocaml-ubuntu-latest ?>3210/.-,+*)('&%$#"! @@0׋f[){Um 3srrsssss@q@@ܐ0eT$BbRM dc5Build_path_prefix_map0DGl}%Y5Lhi8CamlinternalFormatBasics0|.e1R$|o0CamlinternalLazy0zY# #4#-*Cmi_format0`M{?w}@*Data_types0v\3,Svh)Debuginfo0_ |PooGq#Env0S B2*Format_doc0uy@GmWUࠠ%Ident0>ЃzV)j⠠,Identifiable0]/*N &Lambda0x_edT-uq)Load_path0,j " nn7ݠ(Location0nBɊOn?7~ؠ)Longident0wP q;ɡ$Misc0Bpg]?[q+Outcometree0BuG^)= 9c )Parsetree0v o[pY Y$Path0k.tbGmᠠ)Primitive0dU=\I/}%Shape0 M``ll&Stdlib0t0VoS%{<F:-Stdlib__Array0ѤT f:Pd.Stdlib__Buffer0,I[?z.Stdlib__Digest0#z25I*.Stdlib__Domain0'Ϳo\0m.K.Stdlib__Either0HD ?|>.Stdlib__Format00FClW/Stdlib__Hashtbl0(L%bԠ,Stdlib__Lazy0$1mlࠠ.Stdlib__Lexing0^m|e,Stdlib__List0C|Z`>s䠠+Stdlib__Map0*4ɇ2ɠ%Subst0=aqT/!p+.Type_immediacy00$ jbv\"k&0L+=%Eȧk]U젠0|ըm*n0V(|p%Types0"|Vȷ`X )Unit_info0'T Χ@aRm0J)Em_I*g4;>/Value_rec_types0`4xiVC(Warnings0Ef{&@@A@h)@{煰@!ӑ@ܐ@;';1@l^&@>>ְNGNQ@@$$ooŰ^hXb@0 0ґg!,6@@qFqP@@@<@@77 @ i s"y"@@@''Űȑ@@828<@QRr~r6DD@%5%?@@vv@@z̑@ΐ@!!A@Xb@@@@@%%@@Xf@͑`sܑ@@@99"@LL @@@,t@@@}@BB@@6pߑp,6@@@@.@s=y_W+@eް"q@t̑tְkuWےۜ@@$g$q@@#@qq@\f@I:J@yyFP@@_i@@@@@БT̰Q@[~[׌\:@GjGt@t@  p~|@Ƒа2'215?5@‘̰u׵@ϑٰɰz@R,>Б>ڰGjGt@@$đ$@@@@"@@@@))@|&ϐ^@:D@@EErr@#đ#@st@)&)0ݑ׽ה@@@@ \ f@@