Caml1999T037rC/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;@@@A@@@@@:@A@$charB;@@A@@@@@>@A@&stringQ;@@ A@@@@@B@@@%bytesC;@@ A@@@@@F@@@%floatD;@@A@@@@@J@@@$boolE;@@%falsec@@T@$trued@@Z@@@A@@@@@[@A@$unitF;@@"()e@@e@@@A@@@@@f@A@ #exnG;@@@A@@@@@j@@@#effH;@@O@A@A@@@@@@s@@@,continuationI;@@Q@@P@B@A@nY@@@@@@@@@%arrayJ;@@R@A@A@@@@@@@@@ $listK;@@S@A"[]f@@@"::g@@@T@@@ @@A@Y@@@@@@@@&optionL;@@V@A$Noneh@@@$Somei@@@@@A@Y@@@@@@@@)nativeintM;@@A@@@@@@@@%int32N;@@A@@@@@@@@%int64O;@@A@@@@@@@@&lazy_tP;@@X@AJA@Y@@@@@@@@5extension_constructorR;@@A@@@@@@@@*floatarrayS;@@A@@@@@@@@&iarrayT;@@Y@A[A@Y@@@@@@@@*atomic_locU;@@Z@AdA@@@@@@@@@.Assert_failure`#@@@@@J@@@@@@@@[@@A=ocaml.warn_on_literal_pattern @ @0Division_by_zero]#@@@A  @+End_of_file\#$@@@A@'FailureY#,@'@@A!$$@0Invalid_argumentX#5@0@@A*$-#-@-Match_failureV#>@@=@9@;@@a@@A;5>4>@)Not_foundZ#O@@@AC=F<F@-Out_of_memoryW#W@@@AKENDN@.Stack_overflow^#_@@@ASMVLV@.Sys_blocked_io_#g@@@A[U^T^@)Sys_error[#o@j@@Ad^g]g@:Undefined_recursive_modulea#x@@w@s@u@@h@@Auoxnx@:Continuation_already_takenb#@@@A}wv@&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@@q[_q[e@@@j1value_description@@@@@@@@3@fJD@@@&is_ref@:EA@@@@@@@@@б@г%Types9q[h:q[m@%=q[n>q[@@@-@@@& @@г+$boolJq[Kq[@@3@@@2@@@@@5@@EDA@@@C@@@@@@@@@?@@ঠ%Typeskrlr@(val_kindprqr@@3(val_kind%Types1value_description@@@*value_kind@@@@@A3(val_type)type_expr@@@@@@@A0typing/types.mli@M@Q@M@e@@@3'val_loc(Location!t@@@@@B@A@@@@@@#@3.val_attributes*)Parsetree*attributes@@@@@C%@A@@@@@@1@3'val_uid89#Uid!t@@@@@D2@A*@@+@@@@>@@A.@@/@@@@B@Ġ%Typesss@(Val_primss@@;(Val_primQ@@@@)Primitive+description@@@@A@AD@AQAPARRAPAu@@@e@ঠ)Primitivess@)prim_namess@@3)prim_name)Primitive+description@@@6&stringQ@@@/@@@3*prim_arity#intA@@@0@@A @@4typing/primitive.mli^^@@K@3*prim_alloc$boolE@@@1@@B@@ __@@#L@30prim_native_name*"@@@2@@C @@`?C`?\@@-M@35prim_native_repr_args4$listK:+native_repr@@@4@@@3@@D2@@)a*a@@?N@34prim_native_repr_resF @@@5@@E;@@2b3b@@HO@@@6]7]@@LJ@,%makemutableJsKs@@MsNs@@U@@@sE@r3QPPQQQQQ@86Xq[[Yv&4@@@@*prim_arity`tat @_Aftgt@@e@@@xE@w@@@nsot@@@@@zE@y!@@@@@@@@{%@@@zr{t@@i@@@~-@@@ภ$trueu!u%@;?O@@@M@@@AB@@A@@B@ @@U@@@@@@v&*v&+@@@@@I@@@ภ%falsev&/K@;`@@@@B@@A@@_@N@@S@@A%param q[R@@@S@б@г5|y@<@@@gx@г+wv@/@@@ns@@ @@pr@lA@@@@@@@@@@@B@{@A@x@xw@@@zz@@@@g)arg_label@@@@W)apply_arg@@@@@@@@@@3@@@@@@1is_abstracted_arg @FA@@@@@@@@@@@@@@@@2б@В@г23zz@@9@@@,@@@г89%z&z@@?@@@9@@@@@ @@@ @@гE$bool8z9z@@M@@@L@@@@@O)@@ihA@@@@g@@@@e@@@@@c@@@@@b@@@@^{_{@@@@@3a``aaaaa@tqhzi|@@@@@Ġ'Omittedr{s{@;'Omitted)Typedtree.arg_or_omitted!a@c!b@d@@@ @@AA@B@A4typing/typedtree.mli}6W6Y}6W6h@@@@Ġ"(){{@;CM@@@N@@@@A@@A@@F@@ @@$unitF@@@A@@@4@@@@@F@@{{@@@Q@@@砠@@@@@@U@@@ภ8{{@7@@@@@@a@@@||@@o@@@n@@Ġ#Arg||@;#Argh@a@A@@B@AV|6I6KW|6I6V@@@i@@||@@s*expression@@@@@@@@I@@@@@||@@@@@@@X@@@@@@@@ภd|@c@@@G@@Aa z@@@@б@В@г5@@@@@@гx7@|@@@@@@@ @@@гj@n@@@@@@@@+A@@@@\@@@!ՠ@Z@@@!@@!X@@@!@@!B@!@A@@@X@@R~  S~  @@@*expression@@@!@@@!@@!3]\\]]]]]@pn@@k@@@3classify_expression@~JA@@@@!@@@!@@!б@г)Typedtree}~ #~~ ,@&~ -~ 7@@@.@@@!' @@г,"sd~ ;~ =@@4@@@!3@@@@@!6@@FEA@@@D@@@!A@@@!@@!@@Aఠ3classify_expression@KA@@@%Ident#tbl@@@;C@;@@@;C@!@@@@"+C@! @@@"@@"@@"k@࣠@#envA@OA@@*3@~9@4@%.@@@!D@!@@!D@!@@!D@!@@@A7classify_value_bindings@(Asttypes(rec_flag@@@$C@!@VC@;C@;C@!@$listK-value_binding@@@;F@;@@@;C@!C@!@@"D@!@@!D@!@@!D@!@@@6LA-classify_path@wC@"@$Path!t@@@$C@"X6recursive_binding_kind@@@"@@"D@"@@"D@!@=#,#2>#,#?@@VMA:classify_module_expression@C@"@+module_expr@@@<5C@" @@@" D@" @@" D@"@@" D@!@Z''['(@@sNA@@@@@@!eAgh@PA@@3hgghhhhh@@@@@@@@@ఐ!e{|@@@@@3|{{|||||@!@@@(exp_desc@3(exp_desc@@@ "/expression_desc@@@ @@@ 3'exp_loc (Location!t@@@ @@A @A   !@@%x@3)exp_extra$listK@6)exp_extra@@@ @!t@@@ @E*attributes@@@ @@ @@@ @@B0@A7"&8"\@@Jy@3(exp_type>%Types)type_expr@@@ @@C>@AE]aF]{@@Xz@3'exp_envL#Env!t@@@ @@DL@AS|T|@@f{@3.exp_attributesZ(@@@ !@@EU@A\]@@o|@@A`a@@sw@ti@@c@@@"*s@Ġ(Texp_let!'!/@;(Texp_lett@@@ @@@@ 0f@@@ 2@@@ 1(@@@ 3@CBA_@A6@@@@ఠ(rec_flag !1!!9@9QA@@.@@@"33$##$$$$$@@@@ఠ"vb/!;0!=@HRA@@+!@@@"5@@@"4@ఠ!eA!?B!@@ZSA@@\@@@"6!@@@MI!A@@@@@"7&@@@@@"8)@@@@ఠ#env)ZEQ[ET@s]A@@^C@$3]\\]]]]]@HA@B@C:3@4@5)"@#@$@@@ఐ7classify_value_bindingspEWqEn@@@@@u@n^@@$@@$@@$@@ఐc(rec_flagEoEw@!@@&@@ఐ#envExE{@%@@3@@ఐn"vbE|E~@:@@C@;C@$C@@4@@D@A@EM@@ఐ3classify_expression@Ұ@@@@@@@$@@$@@$3@Ze^@_@`@@@@ఐl#env@ @@k@@ఐ!e@o@@H@$@@*@@ @@@$H@$&@; @@@@@$@Ġ*Texp_ident@;*Texp_ident@@@@ +#loc)Longident!t@@@ -@@@ ,>1value_description@@@ .@C@A_@A@D@@@@@ఠ$path@0TA@@@@@"@3@@@@@"#@@.,@@@"B@@@"A @@./@@+@@@"C@@@G4@@@@@"D@@@@@"E@@@ఐ -classify_pathDE@$@@@"@@@@$@@$@@$3KJJKKKKK@=6@7@8@@@@ఐ#env[\@@@@@ఐQ$pathhi@@@=@@(@@@Ġ-Texp_sequencexy@;-Texp_sequence|@@@@ s@@@ t@BPA_@A))))@@@@@@@@@@"K3@@@@ఠ!e@UA@@@@@"SI@"L@@@+@@@@@"M@@@Ġ0Texp_struct_item"2@;0Texp_struct_item@>.structure_item@@@ @@@ @B^A_@A4,,,5,,-@@@G@@45@@@@@"R9@8!e78@VA@@5C@@@&9@@J@@@"TH@@H@@b@@N@@@"WL@@@ఐ<3classify_expression=E=X@ @@@;@*1@@@$@@$@@$3@r]V@W@X@@@@ఐ*#env=Y=\@@@P@@ఐq!e =] =^@@@JH@$@@*@@0 @Ġ.Texp_construct `f `t@;.Texp_construct@)#loc)!t@@@ Q@@@ P*Data_types7constructor_description@@@ RP@@@ T@@@ S@CHA_@A$c$e$y$@@@@@ E`v F`w@@(&@@@"a@@@"`3 K J J K K K K K@@@@ঠ(cstr_tag X`z Y`@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 &` '`@;,Cstr_unboxed@@@"@@@@AC@Ajj@@@V@@@  @@@@@"@@@ 7`y 8`@@@@@"H@"@Ġ":: E` F`A;   Ȑ@@U@ B@AA@A Z@@ ఠ!e# T`@ lWA@@n@@@" @Ġ"[] A; @@@@AA@A p@@ @@A@ Р~@@@"@@@"@@@ l`'@@8@@@"@@@"&@@@[ u`@@@@@"+@@@@@".@@@ఐ۠3classify_expression  @@@@@@@@$@@$@@$3        @A;@<@=@@@@ఐɠ#env  @1@@@@ఐU!e  @@@H@$@@*@@ @Ġ.Texp_construct  @@  @@@@@"@@@"y@@ @@@@"~@@@@@@"@@@"@@@@@J@@@"@@M@@@"@@@ภ&Static  @;&Static/Value_rec_types6recursive_binding_kind@@@@@@@B@@A:typing/value_rec_types.mliUU@@@ A@@@@@Ġ+Texp_record  @;+Texp_record@y@@@ @AJA_@A%j%l&3&8@@;@@&fields@@%arrayJ@1label_description@@@ Z@7record_label_definition@@@ [@@ Y@@@ X%%%%@@@.representation@@m5record_representation@@@ \%%%&@@@3extended_expression@@&optionL_@@@ ^@@@ ]&& &&2@@@@JA@@@@@ ^@@@ hAA@ঠ&fields \3 ]9@3L[@@@"N@@@310@@AA*@'3$#@@BA@A9@6A@@ n? o@@@R@@@# 3 p o o p p p p p@@@@@Ġ*Overridden |B }L@;*OverriddenZ@@@ @#loc!t@@@ @@@ Ӡ@@@ @BA@B@A m44 m44@@@@@ N O@@@@@#@@@#2@ఠ!e$ P Q@ XA@@@@@#@@@@8 R@@@@@#E@@K@@@M@ @@#L@@ < U@@@@@@#@@@@#@@#@@@#_@.representation   @3@@@"@@A3@@@A@3@@BA@A@Ġ.Record_unboxed   @;.Record_unboxed v5record_representation@@@@$boolE@@@@A@BC@A nDSS oDSS@@@ @@  @@@@@#"@@@@@@@@##@@@  W@@ @@@#%H@#$@@@@@@@@#&@@@@@#'@@@ఐv3classify_expression [c ![v@C@@@u@dk@@@$@@$@@$3 ' & & ' ' ' ' '@}@~@@@@@ఐd#env 7[w 8[z@̰@@@@ఐ!e D[{ E[|@@@H@%@@*@@j @Ġ+Texp_record T} U}@U@ Y} Z}@@W@@@#,@@@ @@@@@#-@@@@@#.@@@ภ&Static k l@@@@@Ġ,Texp_variant  @;,Texp_variant@%label@@@ UI@@@ W@@@ V@BIA_@A %<%> %<%i@@@@@  @@@@@#5-@@@@@@#7@@@#66@@@*@@@@@#8:@@:@Ġ*Texp_tuple  @;*Texp_tuple@@&stringQ@@@ N@@@ M@@@@ O@@ L@@@ K@AGA_@AJ""K"# @@@]@@  @@#@"!@@@#C@@@#B@@@@#D@@#A@@@#@~@@@=@@f@@@#E@@@@v@@j@@@#F@Ġ/Texp_atomic_loc  @;/Texp_atomic_loc@@@@ _#loc!t@@@ a@@@ `1label_description@@@ b@CKA_@A ''((R@@@@@ % &@@>@@@#M@@@" @@@#O@@@#N@@@@@@#P@@@8@@@@@#Q@@@@@@@@@#R@Ġ:Texp_extension_constructor H I@;:Texp_extension_constructorL@W#locW!t@@@ @@@ ,!t@@@ @B]A_@A+,,+,,@@@@@ h i@@@@@#Y@@@#X@@ @@@@#Z@@@/@@@@@#[@@@@@@@@@#\ @Ġ-Texp_constant   @;-Texp_constant@(constant@@@ /@AAA_@A  @@@ @@  @@@@@#`*@@@@@@@@#a.@@.@@" @@@@@#c2@@@ภ&Static  (  .@@@@;@Ġ(Texp_for 06 0>@;(Texp_for@%Ident!t@@@ w)Parsetree'pattern@@@ x@@@ y@@@ z.direction_flag@@@ {@@@ |@FRA_@A ])) ^*5*G@@@ p@@ 0? 0@@@-@@@#m@@@)@@@#n@@ @ @@@#o@@@ @@@#p@@@'@@@#q@@@ @@@#r@@@O@@@@@#s@@@Ġ-Texp_setfieldAGAT@;-Texp_setfield@ 4@@@ g+#loc+!t@@@ i@@@ h1label_description@@@ j L@@@ k@DMA_@A (( () @@@ @@@AUAAV@@ Y@@@#{@@@&$@@@#}@@@#|@@@"@@@#~@@@ l@@@#@@@A@@@@@#@@@@@@@@@#@Ġ*Texp_whilehW]iWg@;*Texp_whilel@ @@@ u @@@ v@BQA_@A )) ))@@@ @@|Wh}Wi@@ @@@#@@@ @@@#@@@ @@@@@#@@@@@@@@@#@Ġ/Texp_setinstvarjpj@;/Texp_setinstvar@m!t@@@ t!t@@@ #loc@@@ @@@  @@@ @DVA_@A .** /*+@@@ A@@jj@@&@@@#Q@@@$@@@#V@@ @" @@@#@@@#_@@@ @@@#d@@@B@@L@@@#h@@h@@@@P@@@#l@@@ภ&Static@@@@u@Ġ0Texp_unreachable@;0Texp_unreachable@@@@A_@A m*,, n*,,@@@ @@@  @@p@@@#@@s@@@#@@@ภ&Static @&@@@+@Ġ*Texp_apply@;*Texp_apply@ 1@@@ 7|@ 0)arg_label@@@ :@ )apply_arg@@@ ;@@ 9@@@ 8@BDA_@A ?A ?z@@@ @ঠ(exp_descAB@Ġ*Texp_identIJ@\@NO@@ "@@@#3POOPPPPP@@@@@WX@@ca@@@#@@@# @ఠ"vd%gh@YA@@f@@@#@@@&o@@@@@# @@@tu@@ @@@#H@#(@@~@@b@a@@@#@_@@@#@@#@@@#=@@@| @@ @@@#B@@ @@@#E@@ఐ &is_ref!,!2@ @@@ @@@%! @@@% @@%3@ /LE@F@G@@@@ఐS"vd!3!5@ @@ @@@%(H@%*H@%)@@# @@@@@%+H@%'@ภ&Static9A9G@@@@'@Ġ*Texp_applyHNHX@ɠ@HZH[@@ @@@#3@ i@@@ఠ$args&H\H`@ ZA@@֠@@@@#Ƞ@@@@#@@#@@@#@@@'Ha@@ z@@@#!@@ }@@@#$@@డ$List&existsbmbq@ brbx@@@@!a@&=$boolE@@@(@@(@ %@@@( @@@(@@(@@'@(list.mli$$$$@@,Stdlib__Liste@(#@@@@@ k@@@(@ i@@@(@@(G@(*@@@(@@(@'@@@(&@@@(@@(@@(3]\\]]]]]@ vo@p@q@@@@ఐ u1is_abstracted_argmbynb@ @@@@ @@@(@ @@@(@@( @@@(@@(!@@ఐ$argsbb@+@@`O@@@(H@)H@(6@@} @@@@@)H@(<@ภ&Static@@@@E@Ġ*Texp_apply@@@@ @@@#@@@@@@@#נ@@@@#@@#@@@#@@@@@ @@@@#@@ C@@@#@@@ภ'Dynamic@;'Dynamic@@@AB@@AYY@@@B@@  @@ @Ġ*Texp_array@;*Texp_array @ ,mutable_flag@@@ l U @@@ n@@@ m@BNA_@A v) )  w) );@@@ @@@@@@@#$@@@ (@@@#@@@#-@@@*@@ @@@#1@@ @@@#4@@@ภ&Static"#@@@@@ E=@Ġ)Texp_pack/0@;)Texp_pack 3@ @@@ @A[A_@A "++ "++@@@ @ఠ$mexp'CD@\[A@@ @@@#3GFFGGGGG@ @@@@@@@ @@@#@@ @@@#@@@ఐ :classify_module_expression[\(@ @@@ @  @@@)@@)@@)3baabbbbb@ (!@"@#@@@@ఐ #envr)s,@ @@ @@ఐ<$mexp-1@@@ 6C@)%@@)@@ @Ġ-Texp_function282E@;-Texp_function @  !.function_param@@@ 5@@@ 4 (-function_body@@@ 6@BCA_@A  @@@ -@@2F2G@@@@@#@@@#j@@ @@@@#o@@@,@@ .@@@#s@@ 1@@@#v@@@ภ&StaticKSKY@@@@ @Ġ)Texp_lazyZ`Zi@;)Texp_lazy @ @@@ @AYA_@A R ++ S ++@@@ e@ఠ!e(ZjZk@\A@@ @@@# o@@@@@ c@@@# s@@ f@@@# v@@@డ'Typeopt6classify_lazy_argument'Typeopt@   @@@)Typedtree*expression@@@)Р%Other@4Constant_or_function@=Float_that_cannot_be_shortcut@*IdentifierР%Other@-Forward_value@@@@)A@@@)@@@)A@@@)@@)@2typing/typeopt.mlia++eA@@'TypeoptR@:5@@@2@@@)Р-@,@+@*Р)@(@@@@)A@@@)@@@)A@@@)@@)3]\\]]]]]@ x@y@z@@@@ఐ!emn@ @@d@@@)I@)I@)@@r @@Р`@_@^@]Р\@[@@@@)A@@@)@@@)A@@@)3@4Constant_or_function@Р@@@~Р}@|@@@@)A@@@)@@@)A@@@@@)Y@@Р@@@Р@@@@@)A@@@)@@@)A@@@)t@@@ఐ 33classify_expression@ @@@ 2@ ! (@@@*Z@@*Y@@*X@@ఐ #env@ @@ D@@ఐ!e@@@ >I@*g@@'@@ )@@@*V@=Float_that_cannot_be_shortcut@Р@@@Р@@@@@)A@@@)@@@)A@@+,@@@)@@@*Identifier-Forward_value@Р @ @@@@)A@@BC@@ @)@Р-@,@+@*Р)@(@@@@)A@@@)@@@)A@@a@@@)@@@@:"@@РM@L@K@JРI@H@@@@*A@@@*@@@*A@@@) @@@ภ&Static%@@@@)@*Identifier%Other@Рg@f@@@@* A@@&:&@@@ @*B@Р@@@Р@@@@@*A@@@*@@@*A@@&.@@@*`@@Р@@@Р@@@@@*%A@@@*$@@@*#A@@@*"{@@@ఐ:3classify_expressionDNDa@@@@9@(/@@@*r@@*q@@*p@@ఐ%#envDbDe@ @@K@@ఐ!eDfDg@@@EI@*@@'@@@%Other@Р@@@Р@@@@@*7A@@@*6@@@*5A@@-hp.hv@@@*4@@Р@@@Р@@@@@*?'@;*Texp_matchB@Z@@@ <$case+computation@@@ ?@@@ >@@@ =%value@@@ B@@@ A@@@ @'partial@@@ C@DEA_@A    @@@@@t(u)@@@@@$+@@@431@@@$.@@@$-@@@$,@@@0@/@@@$1@@@$0@@@$/@@"@.@@@$2@@@[$@@ @@@$3@@@@'(@@@@@$4!@Ġ/Texp_ifthenelse*0*?@;/Texp_ifthenelse@@@@ o@@@ p s@@@ r@@@ q@COA_@A4)<)>5)<)~@@@G@@*@*A@@@@@$;K@@@@@@$<P@@ @@@@$>@@@$=Y@@@1@@M@@@$?]@@]@@g@@Q@@@$@a@Ġ)Texp_sendBHBQ@;)Texp_send@@@@ }{$meth@@@ ~@BSA_@Am*H*Jn*H*j@@@@@BRBS@@@@@$E@@@@@@$F@@@! @@}@@@$G@@@@@@@@@$H@Ġ*Texp_fieldTZTd@;*Texp_field@4@@@ c+#loc+!t@@@ e@@@ d 1label_description@@@ f@CLA_@A(S(U(e(@@@@@<Te=Tf@@U@@@$O@@@" @@@$Q@@@$P@@@@@@$R@@@8@@@@@$S@@@@@@@@@$T@Ġ+Texp_assert_gm`gx@;+Texp_assertc@{@@@ !t@@@ @BXA_@A+g+i+g+@@@@@vgywgz@@@@@$Y@@@@@@$Z@@@" @@@@@$[@@@@@@@@@$\ @Ġ(Texp_try{{@;(Texp_try@@@@ DRA@@@ G@@@ F@@@ E_N@@@ J@@@ I@@@ H@CFA_@A)" " *" "G@@@<@@{{@@@@@$f@@@@(yh@@@$i@@@$h@@@$gM@@@(u@@@$l@@@$k@@@$jZ@@@J@@N@@@$m^@@^@@h#@@R@@@$nb@Ġ-Texp_override@;-Texp_override@!t@@@ S@ :!t@@@ @#loc D@@@ @@@ @(@@@ @@ @@@ @BWA_@A+ +"+ +f@@@@@@@1@@@$x@@@/@.@@@${@+)@@@$}@@@$|@P@@@$~@@$z@@@$y@@@U @@@@@$@@@@$@@@@@$@Ġ*Texp_letopMN@;*Texp_letopQ@ǐ@@@ @A\A_@A#++),,@@;@@$let_@@*binding_op@@@ $,,$,,(@@@$ands@@͠@@@ @@@ %,),/%,),F@@@%param@@ !t@@@ &,G,M&,G,]@@@$body@@B1@@@ @@@  ',^,d ',^,v@@@'partial@@5@@@ (,w,}(,w,@@(@@\A@@@@@@@@@A+@@@@Y@@@$/@@@b@@#@@@$3@@3@@= @@'@@@$7@@@ภ'Dynamic@@@@@@@@A@г預"sd@@@@@:@"&3@R@@ @@@@@A@@(@@@@:@@:@@:C@:@@@"@@@@@@@@"@@"@@"3@@@@࣠@(rec_flag3A@aA@@3@!@@@@@@#env4A@bA@@3@1@@@@@@@@(bindings5A@0cA@@3@@@@@@@@@ డ&ignore+!!,!!@@!a@$unitF@@@\@@['%ignoreAA @@@*stdlib.mli````@@&Stdlibt@@@@TG@;@@@; @@; 3JIIJJJJJ@3?E@6@7@@@@ఐf(rec_flagZ!![!!@P@@i@@3@@@@@;G@;@@ఠ'old_env6n!!o!!@dA@@pC@;3pooppppp@&@@@ఐx#env{!!|!!@`@@| @A@!!@@@ఠ1add_value_binding7!!!!@eA@@@@@@;~K@;j@@@;yG@;@@@@;dG@;G@;@@; G@;@@;G@;3@\@9@:@;@@@࣠@#env9A!!!!@fA@@(3@5!!""@@@@@  @@"vb:A!!!!@gA@@-3@!?@@@@@@@@ఐ"vb!!!!@B@@@@C3@#@@@&vb_pat!!!!@3&vb_pat@@@ {'pattern@@@ @@@ 3'vb_expr @@@ @@A@ArEFsEF@@@3+vb_rec_kind/Value_rec_types6recursive_binding_kind@@@ @@B@AFFFFP@@@3-vb_attributes"U@@@ @@C@AFQFUFQFo@@@3&vb_loc+!t@@@ @@D)@AFpFtFpF@@@@AEEEE@@@H=@@7@@@;&G@(pat_desc/!!0!"@3(pat_desc,pattern_data!a@ {@@@ @@@ 3'pat_loc !t@@@ @@A @Arr @@\@3)pat_extra@)pat_extra@@@ @!t@@@ @@@@ @@ @@@ @@B*@As s G@@]@3(pat_type:)type_expr@@@ @@C6@AtHLtHf@@_@3'pat_envF!t@@@ @@DB@Augkugz@@c@3.pat_attributesR@@@ @@EK@Av{v{@@d@@Aqq@@[@a@@,pattern_desc;@t@;*@;,@@@;.J@;/@Ġ(Tpat_var""""@;(Tpat_varS@@@ @@@ @ !t@@@ #loc @@@ @@@ T#Uid!t@@@ @C@ALAAGQ & (HQ & g@@@Zk@ఠ"id;""""@hA@@)@@@;?@ఠ$_loc<"""""@iA@@0.@@@;A@@@;@@ఠ$_uid=""$""(@jA@@7@@@;B@@@Y"")@@r@@@;D@@@;C(@ @y@@@;F@@@;E/@@@@ఠ$size>"-";"-"?@6kA@@g@@@;aL@;Q3#""#####@ERK@L@ME>@?@@4-@.@/@@@ఐ3classify_expression6"-"B7"-"U@Y@@@@z@@@;U@@;T@@;S@@ఐܠ'old_envJ"-"VK"-"]@@@'@@ఐ"vbY"-"^Z"-"`@y@@6@'vb_expr`"-"aa"-"h@k @@M@;c?@@0@@C@@A@g"-"7@@డ%Ident#add%Identw"l"vx"l"{@ {"l"||"l"@@@!t@@@6@!a@5@ܠ @@@6 @@@6@@6@@6@@6@0typing/ident.mligg@@X@% @@@@@@;l@ @@@@;k@@@;i@@;h@@;g@@;f3@@@@@@@ఐޠ"id"l""l"@@@@@@@;{L@;}L@;|@@ఐ$size"l""l"@!@@8$@@ఐ(#env"l""l"@ @@L1@@h@@K2@y@@:@@""""@@U@@@;J@@@;I @ @\@@@;L@@@;K@@@ఐJ#env""?@.@@@Y@@@A!!B@@[3@@@@MDA@uG@;K@A@H@డ$List)fold_left"""#@ "#"# @@@@#acc@&@!a@& @@'@@'@ @ @@@'@@'@@'@@'@ 33 3r@@ ]@#@@@@7F@;@*@@;@@;@@41@@@; @@;@@;@@;3BAABBBBB@@@@@@@ఐȠ1add_value_bindingR"# S"#@ @@@@@@;@@@;@K@@@; @@;@@;@@ఐj#envm"#n"#"@R@@n+@@ఐf(bindingsz"##{"#+@-@@r8@@l@@E9@@@F@@@G @V@@H@A@@@@o@@;@@;@@;C@;@@@@ppUT@SV@@m@j`@@@"@@"@@"3@9@@@࣠@#env?A#,#@#,#C@lA@@3@@@@@@@Ġ$Path#}##}#@&Pident#}##}#@@;&Pident$Path!t@@@*@%Ident!t@@@*@A@@D@A/typing/path.mliSTVSTi@@@B@ఠ!x@#}##}#@mA@@@@@;3@ I@@@A@@@@@3 @@D@;D@;@@@డ)find_same%Ident####@ ####@@@@@@6@Y!a@5@@@6@@6@@6@}h~h@@`Y@@@@@@@;@mh@@@;i@@;@@;3      @?KD@E@F@@@@ఐR!x0##1##@ @@@@@;G@;G@;@@ఐ#envD##E##@_@@ $@@L@@%@Ġ)Not_foundP##Q##@;)Not_found#exnG@@@@@@ A@A&_none_@@A@@I@@@@@@@@<C@@@ภ'Dynamicl&&m&&@ @@@9@@@<Q@@@u##v&&@@@@@;W@Ġ$Path'''' @$Pdot'' ''@@;$Pdot@@@@*ޠ&stringQ@@@*@BA@D@AUU@@@C@@''''@@@@@;@@@@@@;@@@( @@@Ġ$Path''''@&Papply''''@@;&Papply@@@@*@@@*@BB@D@AWW@@@ D@@'' ''!@@@@@;@@@@@@;@@@% @@@@V @@@Ġ$Path''$''(@)Pextra_ty'')''2@@;)Pextra_ty0@1@@@*5(extra_ty@@@*@BC@D@A)Y*Y5@@@:E@@''3''4@@D@@@;"@@@@@@;'@@@' @@$(@@ @@%)@@@ภ'Dynamic''''@ <@@@2@@ApA#,#t@б@@6: #,#F!#,#G@@г/Value_rec_types*#,#K+#,#Z@.#,#[/#,#q@@@@@@<D@;Q @@@@@<D@;V @@@(A@@@ @@@<#@@<"@@0module_expr_desc@@@ 9@@@ 3'mod_loc  !t@@@ :@@A @A====@@,@3(mod_type+module_type@@@ ;@@B@A%==&==@@8@3'mod_env#!t@@@ <@@C!@A1==2==@@D@3.mod_attributes/@@@ =@@D*@A:==;==@@M@@A>=`=d?=`=@@Q@I>@@8@@@<4H@Ġ*Tmod_ident(B(H(B(R@;*Tmod_identI@@@ X@!t@@@ H#loc!t@@@ J@@@ I@B@@G@Al?m?qm?m?@@@@ఠ$pathD(B(T(B(X@pA@@#@@@<<3@@@@@ (B(Z (B([@@%#@@@<>@@@<= @@@<(B(\@@@@@(`(y@ɰ@@@@ఐI$pathJ(`(zK(`(~@@@!H@<@@*@@~@@@<~$@Ġ.Tmod_structure^ ((_ ((@;.Tmod_structure@)structure@@@ K@AA@G@A????@@@@@p ((q ((@@@@@@@)@@@@?@@' @@@Ġ,Tcoerce_none*)h)r*)h)~@;,Tcoerce_none@@@ @@@@AD@A* FF+ FF@@@=@@@  @@@@@<@@@@@<!@@@ఐ:classify_module_expression+))+))@@@@@z@@@<@@<@@<4@@ఐ~#env+))+))@h@@A@@ఐ$mexp+))+))@J@@J@<P@@'@@@@@<T@Ġ1Tcoerce_structure,)),))@;1Tcoerce_structureP@_@#intA@@@ @;@@@ @@ @@@ t@[!t@@@ @@@@ @V@@@ @@ @@@ @B@AD@A FFFG+@@@@@ 8,)) 9,))@@9@8@@@<@p@@@<@@<@@@<@@@6@5@@@< @2@@@<à@@@@<@@<@@@<@@@f)@@@@@<@@@@@<@@@ภ&Static n-)) o-))@@@@@Ġ/Tcoerce_functor {.)) |.))@;/Tcoerce_functor@@@@ @@@ @BAAD@AG,G.G,Gd@@@@@ .)* .)*@@@@@<@@@@@@<@@@ @@@@@<@@@@@<@@@ภ&Static /** /**@@@@ @Ġ1Tcoerce_primitive 0**" 0**3@;1Tcoerce_primitive@B2primitive_coercion@@@ @ABAD@A4GeGg5GeG@@@G@@ 0**4 0**5@@@@@<,@@@@@@@@<0@@@@@<3@@@డ$Misc+fatal_error$Misc 1*9*E 1*9*I@  1*9*J 1*9*U@@@&stringQ@@@>!a@>@@>@.utils/misc.mliYY@@$Misc@@@@@@@@?@@@@J@?@@?g@@ &letrec: primitive coercion on a module! 1*9*W!1*9*}@@!1*9*V!1*9*~@@,@@@@J@@J@@{@@: @@+|@Ġ-Tcoerce_alias!$2**!%2**@;-Tcoerce_aliasx@T!t@@@ !t@@@ a@@@ @CCAD@AHHHH@@@@@!B2**!C2**@@@@@<@@@@@@<@@ @x@@@<@@@.@@|@@@<@@@@@<@@@డ+fatal_error$Misc!e3**!f3**@ !i3**!j3**@@@@@@@@@$@@@@J@@@@@@@ "letrec: alias coercion on a module!3**!3**@@!3**!3**@@@@@@ J@@J@@ @@' @@@@@A!))K)S!4**@@?@Ġ+Tmod_unpack!5**!5**@;+Tmod_unpack@@@@ V+module_type@@@ W@BF@G@AA*A, A*A[@@@2@ఠ!eG!5**!5**@!sA@@@@@@A@"~  Q@@R@A"" " {1 Usage of recursive variables} ":+O+O":+O+v@@@@@@3""""""""@SQa@d@N@@$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@@@@@@@#FxA+Dereference@@#6b2y2}#7b2y2@^ 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. #Dc22#Ee33l@@@@@@@#]yA@@A@@@@@#H@,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. #U=++#V?,,F@@@@@@@A@#ntA@##]A,R,X@t@@@#o@@@@@@##nF-)-/}@n@@@#~}@}}@@@}@}@#yy#K..w@h@@@z#xw@ww@@@w@w@#ss#\1E1Kq@b@@@t#rq@qq@@@q@q@#mm#b2y2k@\@@@n#lk@kk@@@k@k@@A@g#fe@ee@@@e@e@@r@3########@@@@@#g3n3t#g3n3y@@@@@@B@@@@B#@@@B@@B@@B3########@%@@@%equal@#zA@@@@B@@@@B@@@B@@B@@B'б@г'!t#g3n3#g3n3@@/@@@B$@@б@г/!t$g3n3$g3n3@@7@@@B2@@г7$bool$g3n3$g3n3@@?@@@B>@@@@@BA@@@#@@BD& @@XWA@@@V@@@B@U@@@BT@@@B@@B@@BS@డ"!=$0g3n3}$1g3n3@@!a@@$boolE@@@'@@&@@%&%equalBA @@@@ y y@@ Q@@б@гba@@@@B^@б@г^]@@@@BZ@г$'ZY@@@@BV@@ @@BU@@@@BT@$og3n3|$pg3n3@@@@@@@C@@@@C@@@C@@C @@C D@C@A@$g3n3p@@@@ఠ$rank$n4O4U$n4O4Y@${A@@@@@@CD@C#@@@CD@C@@CD@C3$$$$$$$$@@@@@@@Ġ&Ignore$o4e4k$o4e4q@;@@@B@@@@E@@A@@@@@!3$$$$$$$$@.$n4O4Q$s44@@@@@@@$o4e4u$o4e4v@@' @Ġ%Delay$p4w4}$p4w4@;@@@AE@@A@@@@@:@@@A$p4w4$p4w4@@:@Ġ%Guard$q44$q44@;/@@@BE@@A@@@@@M,@@@B$q44$q44@@M2@Ġ&Return$r44$r44@;B@@@CE@@A@@@@@`?@@@C$r44$r44@@`E@Ġ+Dereference%s44%s44@;U@@@DE@@A@@@@@sR@@@D% s44R@@rW@@A!g%n4O4\U@@@V@@D@C.]@A@Z@ZY@t@ఠ$join% z5S5Y%!z5S5]@%9|A@@@@@@CQD@C0@ D@C5 D@C6@@C7D@C1@@C2D@C/3%2%1%1%2%2%2%2%2@@@@@@࣠@!mA%Cz5S5^%Dz5S5_@%\}A@@3%D%C%C%D%D%D%D%D@,%Kz5S5U%L{5e5@@@@@  @@"m'A%Wz5S5`%Xz5S5b@%p~A@@*3%X%W%W%X%X%X%X%X@!6@@@@@@@@డ#">=%k{5e5s%l{5e5u@@!a@@;@@@6@@5@@4-%greaterequalBA @@@@@ @ A@@ ?V@@@@$@@@CPF@C>@@@@C=@@C<@@C;3%%%%%%%%@6Bb@9@:@@@@ఐ$rank%{5e5l%{5e5p@j@@@ @@@CJ$@@@CI@@CH@@ఐt!m%{5e5q%{5e5r@Y@@'@@@@0(@@ఐ6$rank%{5e5v%{5e5z@@@@1@@@CV$@@@CU@@CT?@@ఐ"m'%{5e5{%{5e5}@I@@L@@@@WH@C\O@@A@@@@@C_G@CFU@ఐ!m%{5e5%{5e5@@@_@ఐ"m'%{5e5@f@@i@%{5e5i@@k@A@D@Cc@A@@@ʠ@ఠ'compose& 77& 77@&#A@@@|@@@CyD@Ce@@@@CD@Cj@@@CD@Ck@@ClD@Cf@@CgD@Cd3&"&!&!&"&"&"&"&"@ @@@@@࣠@"m'A&377&477@&L@A@@%3&4&3&3&4&4&4&4&4@2&;77&<8 8A@@@@@  @@!mA&G77 &H77!@&`AA@@03&H&G&G&H&H&H&H&H@!<@@@@@@@@@ఐ-"m'&]77*&^77,@@@N3&]&\&\&]&]&]&]&]@"H@@@@@@ఐ(!m&l77.&m77/@ @@T@@@@@b@[@@Cs@@Ġ&Ignore&757;&757A@@@@@w@Cu3&&&&&&&&@*@@@@@&757C&757D@@xD@Cq@Cv @@@@@@ @@Cz@@@@@&757G&757H@@@C{@@Ġ&Ignore&757J&757P@@@@@@C|)@@@@@@@@C0@@0@@5 @@@@@@C7@@@ภ&Ignore&757T&757Z@@@@@@@Ġ+Dereference&7[7a&7[7l@@@@@@CS@@@&7[7n&7[7o@@@C[@@@@@@ @@Cb@@@@@@Ch@@@ภ+Dereference&7[7s&7[7~@@@@q@@Ġ%Delay' 77' 77@>@@@@@C@@@'77'77@@@C@@@@@@ @@C@@@@@@C@@@ภ%Delay')77'*77@^@@@ @@Ġ%Guard':77';77@\@@@@+@C@@Ġ&Return'G77'H77@V@@@@/@C@@@@@@ @@C@@@@@@C@@@ภ%Guard'_77'`77@@@@B@@Ġ%Guard'p77'q77@@@@@a@C3'r'q'q'r'r'r'r'r@@@@@Ġ+Dereference'77'77@@@@@l@C@Ġ%Guard'77'77@@@@@ @@@@ @Ġ%Delay'77'77@@@@@'@@'77'77@@*@!m'77'77@'BA@@@C'77'77@@%7@@=@@@>@,@@C>@@@D@2@@CD@@@ఐ!m'77'77@@!@@@3''''''''@e'@@@@Ġ&Return'77'77@@@@@@Cd@@Ġ&Return'77'77@@@@@@Cq@@@@@@ @@Cx@@@@@@C~@@@ภ&Return'78'78 @@@@@@Ġ&Return( 8 8( 8 8@@@@@@C@@Ġ+Dereference(8 8(8 8%@@@@@@C@Ġ%Guard((8 8(()8 8-@J@@@@ @@@@ @Ġ%Delay(28 80(38 85@g@@@@@@(68 8(78 86@@@!m(<8 8:(=8 8;@(UCA@@@C(C8 8(D8 8<@@%@@<@@@=@,@@C@@@C@2@@C@@@ఐ!m(Y8 8@@@ @ @@<3(Y(X(X(Y(Y(Y(Y(Y@&@@@@@A(_77$$@@@@.%A@SD@D',@A@)@)(@?@A@@3@PE@ha@b@c@@3(l(k(k(l(l(l(l(l@Kk@@(r<+x+(s8B8E@@@(v<+x+x@@ƠA+$modeD(8G8L(8G8P@@;@@&Ignore@@(8G8\(8G8b@@(FA%Delay@@(8G8c(8G8j@@(GA%Guard@@(8G8k(8G8r@@(HA&Return@@(8G8s(8G8{@@(IA+Dereference@@(8G8|(8G8@@(JA@@A!t@@@D:@@@@(8G8G @@A@(EA@#8865@4@@@8@#44(8G8e2@1@@@5@#11(8G8m/@.@@@2@#..(8G8u,@+@@@/@#++(8G8~)@(@@@,@@Aг($Mode(8G8S(8G8W@/(8G8X(8G8Y@@@73((((((((@:3@'!A@P@k@@@@@8|;@@@A@@@D@@D(@@@@I@@@G@@ @@J@@JT@3))))))))@@@#EnvE)88)88@)(A@Б!M?F)!==)"==@):KA@гР'#Map$Make)3==)4==@ )7==)8==@@@3)9)8)8)9)9)9)9)9@R@@@#Ord␡+Stdlib__Map+OrderedType#key@;@@@A!t@@@F3@@@@'map.mlin::n::@@@@r@A@!t@;!a@F2@A@A+Stdlib__Map$Make1@@F4I@B@@@I V ZI V e@@@@2D@A@%empty#!a@F1@@@F0@0L  1L  @@DE@@#add@I@@@F/@!a@F-@  @@@F.$ @@@F,@@F+@@F*@@F)@OO  PO  @@cF@@+add_to_list@@@@F(@!a@F%@>$listK@@@F'@@@F&I @@@F$@@@F#@@F"@@F!@@F @yX  zX  @@G@@&update@I@@@F@@&optionL!a@F@@@F  @@@F@@F@v@@@Fz@@@F@@F@@F@@F@^^@@H@@)singleton@u@@@F@!a@F@@@F@@F@@F@jW[jW{@@I@@&remove@@@@F@!a@F@@@F@@@F @@F @@F @oo@@J@@%merge@@@@@F @`!a@F@@@F @k!b@F@@@Ft!c@E@@@F@@F@@F@@F@@@@F@@@@F@@@E@@E@@E@@E@vY]x@@,K@@%union@@@@@E@!a@E@ @@@E@@E@@E@@E@@@@E@@@@E@@@E@@E@@E@@E@EfjFf@@YL@@(cardinal@)!a@E@@@E#intA@@@E@@E@^_@@rM@@(bindings@B!a@E@@@E @>@@@E蠠@@@E@@@E@@E@8<8a@@N@@+min_binding@c!a@E@@@E@[@@@E⠠@@@E@@E@bfb@@O@@/min_binding_opt@!a@E@@@E#@{@@@Eݠ@@@E@@@E@@E@JNJ|@@P@@+max_binding@!a@E@@@E@@@@Eנ@@@E@@E@484[@@Q@@/max_binding_opt@!a@E@@@E`@@@@EҠ@@@E@@@E@@E@ @@ R@@&choose@ݠ!a@E@@@E@@@@E̠@@@E@@E@@@)S@@*choose_opt@!a@E@@@E@@@@EǠ@@@E@@@E@@E@67@@JT@@$find@@@@E@!a@E@@@E@@E@@E@NO@@bU@@(find_opt@@@@E@7!a@E@@@E۠ @@@E@@E@@E@kIMlIs@@V@@*find_first@@=@@@E$boolE@@@E@@E@\!a@E@@@E@T@@@E@@@E@@E@@E@    D@@W@@.find_first_opt@@f@@@E)@@@E@@E@!a@E@@@E'@@@@E@@@E@@@E@@E@@E@"*"."*"l@@X@@)find_last@@@@@EU@@@E@@E@!a@E@@@E@@@@E@@@E@@E@@E@#_#c#_#@@Y@@-find_last_opt@@@@@E|@@@E@@E@֠!a@E@@@Ez@@@@E@@@E@@@E@@E@@E@$y$}$y$@@'Z@@$iter@@@@@E@!a@E$unitF@@@E@@E@@E@ @@@E @@@E@@E@@E@9%%:%& @@M[@@$fold@@ @@@E@!a@E@#acc@E@@E@@E@@E@0@@@E@  @@E@@E@@E@]'%')^'3'l@@q\@@#map@@!a@E~!b@E|@@E@M @@@E}Q @@@E{@@Ez@@Ey@|(e(i}(e(@@]@@$mapi@@N@@@Ex@!a@Eu!b@Es@@Ew@@Ev@q @@@Etu @@@Er@@Eq@@Ep@))))@@^@@&filter@@r@@@Eo@!a@Ej;@@@En@@Em@@El@ @@@Ek@@@Ei@@Eh@@Eg@****@@_@@*filter_map@@@@@Ef@!a@EbO!b@E`@@@Ee@@Ed@@Ec@@@@Ea @@@E_@@E^@@E]@ ,, ,,?@@`@@)partition@@@@@E\@!a@EV@@@E[@@EZ@@EY@ @@@EX@@@@EU@@@@EW@@ET@@ES@@ER@.../%@@/a@@%split@@@@EQ@!a@EM@@@EP@ @@@EL@@@@EN@@@@EO@@EK@@EJ@@EI@H$0'0+I$0'0\@@\b@@(is_empty@,!a@EH@@@EG@@@EF@@EE@_022!`022;@@sc@@#mem@/@@@ED@H!a@EC@@@EB@@@EA@@E@@@E?@{32l2p|32l2@@d@@%equal@@!a@E:@@@@E>@@E=@@E<@m@@@E;@s@@@E9#@@@E8@@E7@@E6@@E5@722723-@@e@@'compare@@!a@E0@]@@@E4@@E3@@E2@@@@E1@@@@E/m@@@E.@@E-@@E,@@E+@=4(4,=4(4a@@f@@'for_all@@@@@E*@!a@E&d@@@E)@@E(@@E'@ @@@E%n@@@E$@@E#@@E"@A45A450@@g@@&exists@@@@@E!@!a@E@@@E @@E@@E@ @@@E@@@E@@E@@E@F55F55@@%h@@'to_list @!a@E@@@E@@@@E@@@E@@@E@@E@2M6~63M6~6@@Fi@@'of_list @ՠ@ @@@E@!a@E@@E@@@E(@@@E@@E @SQ66TQ67@@gj@@&to_seq @7!a@E @@@E &Stdlib#Seq!t@9@@@E @@@E @@@E@@E@zW77{W77@@k@@*to_rev_seq @^!a@E@@@E'#Seq!t@]@@@E@@@E@@@E@@E@[8A8E[8A8n@@l@@+to_seq_from @n@@@E@!a@D@@@DP#Seq!t@@@@D@@@D@@@D@@D@@D@_88_88@@m@@'add_seq@l#Seq!t@@@@D@!a@D@@D@@@D@  @@@DƠ@@@D@@D@@D@d99d99@@n@@&of_seq@#Seq!t@@@@D@!a@D@@D@@@D@@@D@@D@h::h::>@@)o@@@@5G@735@Р%Ident/x==/y==@@;@@@A@@@D@@@@RYYRY_@@@@)@@A@Ӡ!T@@TaiTa@,Identifiables@@@%equal@!t@@@D@@@@D$boolE@@@D@@D@@D@@/Stdlib__Hashtbl`@@$hash@@@@D#intA@@@D@@D@1@a@@&output@&Stdlib+out_channel@@@D@76@@@D$unitF@@@D@@D@@D@M@JC@@%print@&Format)formatter@@@D@RQ@@@D@@@D@@D@@D@f@cD@@Ӡ#Set@@nku@@@Ӡ#Map@@vsv@@@Ӡ#Tbl@@~{w@@@)doc_print*Format_doc'printer@@@D@@@D@[(([(K@@*oB@@0print_with_scope'printer@@@D@@@D@\LL\Lw@@*C@@-create_scoped%scope#intA@@@D@&stringQ@@@D3@@@D@@D@@D@aa"@@*D@@,create_local@@@@DE@@@D@@D@b##b#@@@*E@@1create_persistent@&@@@DW@@@D@@D@cAAcAc@@*F@@-create_predef@8@@@Di@@@D@@D@ddddd@@*G@@&rename@w@@@Dz@@@D@@D@ff@@*H@@$name@@@@D^@@@D@@D@kRRkRg@@*I@@+unique_name@@@@Dp@@@D@@D@(lhh)lh@@+ J@@4unique_toplevel_name@@@@D@@@D@@D@:m;m@@+K@@*persistent@@@@D$boolE@@@D@@D@NnOn@@+1L@@$same@@@@D@@@@D@@@D@@D@@D@eofo@@+HM@@-compare_stamp@@@@D@@@@D@@@D@@D@@D@|v}v @@+_N@@'compare@@@@D@@@@D@@@D@@D@@D@y W Wy W q@@+vO@@&global@@@@DY@@@D@@D@|  |  @@+P@@)is_predef@)@@@Dk@@@D@@D@}  }  @@+Q@@%scope@;@@@D@@@D@@D@    @@+R@@,lowest_scope&@@@D@A  A  @@+S@@-highest_scope3@@@D@B  B  )@@+T@@&reinit@$unitF@@@D@@@D@@D@D + +D + C@@+U@@+;!a@D@A@A-+ @@DG@B@@@ F E EF E P@@@@+V@A@%empty[@D@@@D@X@U@#add@@@@D@6@D@@@@D @@@D@@D@@D@@D@3@/@)find_same@@@@D@)@D@@@D@@D@@D@@@)find_name@@@@D@;!a@D@@@D@@@@D@@@D@@D@@D@bici@@,EZ@@(find_all@@@@D@]!a@D@@@D$listK@@@@D@@@D~@@@D}@@D|@@D{@jj"@@,n[@@,find_all_seq@@@@Dz@!a@Dx@@@Dy&Stdlib#Seq!t@+@@@Dw@@@Dv@@@Du@@Dt@@Ds@k##k#W@@,\@@)fold_name@@>@@@Dr@!a@Dn@!b@Dl@@Dq@@Dp@@Do@@@@Dm@  @@Dk@@Dj@@Di@lXXlX@@,]@@(fold_all@@b@@@Dh@!a@Dd@!b@Db@@Dg@@Df@@De@@@@Dc@  @@Da@@D`@@D_@mm@@,^@@$iter@@@@@D^@!a@DZ(@@@D]@@D\@@D[@ @@@DY2@@@DX@@DW@@DV@$n%n@@-_@@&remove@@@@DU@!a@DS@@@DT&@@@DR@@DQ@@DP@@oAo@@-#`@@2make_key_generator@]@@@DO@@@@DN@@@DM@@DL@@DK@Ws==Xs=f@@-:a@@@ @U@@G@F@E@p@@@ 2==@ G;@@@A @@@Ge@@@@ @@@ A@ G; @A@A    @@@Gd  @@ @@@ A@  @@@Gc@ @ @ @(@@@Gb@ @ @@@Ga @@@G`@@G_@@G^@@G]@ @ @ @@@@G\@ @(  @@@G[@@@GZ0  @@@GY@@@GX@@GW@@GV@@GU@ @ @ @3@@@GT@@ ~ {@@@GS w @@@GR@@GQ@O @@@GPS @@@GO@@GN@@GM@@GL@ v@ s@ r@R@@@GK@ qb t@@@GJ@@GI@@GH@ m@ j@ i@a@@@GG@q h@@@GFu l@@@GE@@GD@@GC@ d@ a@ `@@v@@@GB@ _ ^@@@GA@ Z Y@@@G@ U T@@@G?@@G>@@G=@@G<@ n@@@G;@ i@@@G: d@@@G9@@G8@@G7@@G6@ P@ M@ L@@@@@G5@ K@ M G P@@@G4@@G3@@G2@@G1@ V@@@G0@ \@@@G/à `@@@G.@@G-@@G,@@G+@ F@ C@ B@͠ A@@@G* =@@@G)@@G(@ :@ 7@ 6@ڠ 5@@@G' 1@@@@G&@ B@@G%@@@G$@@G#@ 0@ -@ ,@ +@@@G"@@@@G!@ 5@@G @@G@ '@ $@ #@ "@@@G @@@@G@ /@@G@@@G@@G@ @ @  @ @@@G@@@@G@ "@@G@@G@ @ @ !@. @@@G @.@@@G@ @@G@@@G@@G@ @ @ "@E @@@G@B@@@G@ @@G@@G @ @@#@X@@@G @X@@@G @ @@G @@@G @@G@@@$@d@@@G@t@@@G@@G@@G@@@%@s@@@G@@@@G@@@G@@G@@F@@@&@@@@@F@@@F@@F@@@@F@@@@F@@@F@@F@@F@@@'@@@@@F@@@F@@F@@@@FΠ@@@@F@@@F@@@F@@F@@F@@@(@@@@@F@@@F@@F@٠@@@F@@@@F頠@@@F@@F@@F@@@)@@@@@F@@@F@@F@@@@F@@@@Fᠠ@@@F@@@F@@F@@F@@@*@@@@@F@@@@F@@F@@F@@@@F@@@F@@F@@F@@@+@@@@@F@@@@F@@F@@F@1@@@F@@@F@@F@@F@@@,@@@@F@A@@@FE@@@F@@F@@F@@@-@@F@@@F@@@F@@F@X@@@F\@@@F@@F@@F@@@.@@]@@@F@{@@@F@@F@@F@r@@@Fv@@@F@@F@@F@z@w@v/@@w@@@F@uqp@@@F@@F@@F@~@@@Fz@@@F@@F@@F@l@i@h0@@@@@F@gc@@@F@@F@@F@o@@@F@w@@@F@}@@@F@@F@@F@@F@b@_@^1@@@@F@Ġ]@@@F@̠e@@@F@Yk@@@F@ؠq@@@F@@F@@F@@F@X@U@T2@S@@@FO@@@F@@F@N@K@J3@@@@F@I@@@FE@@@F@@F@@F@D@A@@4@@?@A;@@@F@@F@@F@ I@@@F@O@@@F:@@@F@@F@@F@@F@9@6@55@@4@60@@@F@@F@@F@&>@@@F@,D@@@F/@@@F@@F@@F@@F@.@+@*6@@0@@@F@)%@@@F@@F@@F@E1@@@F$@@@F@@F~@@F}@#@ @7@@I@@@F|@@@@F{@@Fz@@Fy@^&@@@Fx@@@Fw@@Fv@@Fu@@@8@k@@@Ft@k@@@Fs@ @@Fr@@@Fq@@Fp@@ @ 9@ @~@@@Fo@@@Fn@@@Fm @@@Fl@@Fk@@@:@@@@Fj@@@@Fi@@@Fh@@@Fg@@Ff@@@;@@@@Fe@@@@Fd@@@Fc@@@Fb@@Fa@@@<@@@@F`@Р@@@F_2@@@@F^@@@F]@@@F\@@F[@@FZ@@@=@Gڠ@@@@FY@@@FX@@@FW@@@@FV@@@FU@@FT@@FS@@@>@fϠ@@@@FR@@@FQ@@@FP@@@FO@@FN@@@@ @@77==;@<@ A+!t@H7B==7C==@@;@@5iA.!t!t@@@H@@@H@@@@7T==7U=> @| 8 A "t" maps each rec-bound variable to an access status 7b==7c==@@@@@@@@@7{LA@@Aг !M7n=>7o=>@'7r=>@@г)$Mode7}==7~=>@07=>7=>@@@8377777777@Jk@A@A@vu@on@[Z@@?@#"@@@@@@@@ut@dc@ON@>=@)(@@  @@@@@@kj@[Z@FE@.-@@@@@@@@lk@UT@@?@+*@@@@@@@;@@@A@@@L@Gf@@@@@@@@pk@@@iq@@7@@@@@@@@377777777@u@@@ఠ%equal8> >8> >@8MA@@@_N@@@L?I@L@@@L,@ @@@L+ ,@@@L*@@L)@@L(I@L38!8 8 8!8!8!8!8!@@@@డ%equal!M83> >84> >@ 87> >88> > @@@@ `@ b \@@@H>@@H=@@H<@8 j@@@H;@> p@@@H: [@@@H9@@H8@@H7@@H6@ Z@ W!@@@@E@G u@@@L@@L@@L@QO@@@L@WU@@@L t@@@L@@L@@L@@LH@@డ%equal$Mode8z> >!8{> >%@ 8~> >&8> >+@@@o@@@D.@t@@@D-@@@D,@@D+@@D*@@@@@}@@@L:@@@@L9@@@L8@@L7@@L6y@@k@@z@A@8> > !@@"@}@ఠ$find8>->38>->7@8NA@@@L!t@@@LLI@LG@@@@LUI@LPN@@@LI@LQ@@LRI@LH@@LII@LF388888888@@@@@@࣠@"idA@8>->98>->;@@&@@@LM388888888@88>->/8>Q>@@@@  @8OA2г5%Ident8>->=8>->B@<8>->C8>->D@@@D@@@LJ @@8>->89>->E@@@K"@@@@#tblA@9 >->G9 >->J@@K@@@LV39 9 9 9 9 9 9 9 @2?7@:@,@@@  @9,PAT гW!t9>->L9 >->M@@_@@@LS@@9&>->F9'>->N@@@f@@@@డ$find!M99>Q>Y9:>Q>Z@ 9=>Q>[9>>Q>_@@@5@@@G@; @@@G @@G@@G@ @ @@@ @@@L^@GI@LxK@L\@@@L]@@L[@@LZ39Y9X9X9Y9Y9Y9Y9Y@MZR@U@J@@@@ఐ"id9i>Q>`9j>Q>b@Y@@+@@@LlL@Lk@@ఐs#tbl9{>Q>c9|>Q>f@@@@@@Lt%@@I@@*&@Ġ)Not_found9>Q>l9>Q>u@:@@@@8@@@L4@@@ภ&Ignore9>Q>y@;@@@DF@@@@E@@A@@@@@A@@@9>Q>U@@GC@A@I@L@A@@@נ@ఠ%empty9>>9>>@9QA@@@@L@@@LI@L399999999@ @@@@@డ%empty!M9>>9>>@ 9>>9>>@@ Q@@@Gi@M@J @@!@A@9>> @@ @@ఠ$join9>>9>>@9RA@@@@@@LI@L@@@@LI@L@@@LI@L@@LI@L@@LI@L399999999@HYR@S@T@@@࣠@!xA@:>>:>>@@$@@@L3::::::::@6:>>:?8?A@@@@  @:3SA0г3!t:&>>:'>>@@;@@@L@@:->>:.>>@@@B@@@@!yA@:9>>::>>@@D@@@L3:;:::::;:;:;:;:;@+80@3@%@@@  @:ZTAM гP!t:M>>:N>>@@X@@@L@@:T>>:U>>@@@_@@@@డB$fold!M:e>>:f>>@ :i>>:j>>@@@@.@@@G@ @  @@G@@G@@G@l @@@G@  @@G@@G@@G@ @ ɰ@@@@B@@@L@!t@@@LK@L@K@L@@L@@L@@L@@@@L@  @@L@@L@@L3::::::::@anf@i@^@@@@࣠@"idA@:>>:>>@@ G!t@@@L3::::::::@@@@  @:UAz@@@LN@Lг%Ident:>>:>>@:>>:>>@@@!@@@L @@:>>:>>@@@@@@L%@@@@!vA@:>>:>>@@\@@@L3::::::::@NE=@@@4@@@  @;VAe гh$Mode:>>:>>@o;>>;>>@@@w@@@L @@;>>; >>@@@~@@@@#tblA@;>>;>>@@@@@L3;;;;;;;;@/<4@7@,@@@  @;5WA" г%!t;(>>;)>>@@-@@@L@@;/>>;0>>@@@4@@@@@ఠ"v';=>>;>>>@;VXA@@{@@@LP@L3;C;B;B;C;C;C;C;C@.;3@6@+@@@ఐ$find;R>?;S>?@@@@@@@L@@@@L@@@L@@L@@L@@ఐ"id;l>?;m>?@@@@@@LQ@LQ@L0@@ఐo#tbl;>? ;>? @:@@@@@LQ@MQ@MD@@9 @@HE@A@;>> @@డw#add!M;??;??@ ;??;??@@@a@@@Go@@@@@Gn@@@Gm@@Gl@@Gk@@Gj@ @ @@@s@@@M@@@@M;O@M @ @@@M@@@M @@M @@M @@M 3;;;;;;;;@@@@@@@ఐ+"id;??;??!@@@@@@M(P@M'@@డ.$join$Mode;??#;??'@ ;??(;??,@@@@@@D4@@@D3@@D2@@ܰ @@@@@@M0@@@M/@@M.<@@ఐ-!v<??-<??.@@@\Q@M8Q@M:Q@M9O@@ఐ栐"v'<#??/<$??1@Y@@i\@@<'??"<(??2@@_@@ఐ"#tbl<3??3<4??6@@@9@@@MBo@@@@,@@@M"t@ @@@<@>>[A@@@@@@MI@M@*(@@@NK@M@@@N I@M53@@@NK@M@@@MI@M@@MI@M@@MI@M3=I=H=H=I=I=I=I=I@@@@@@࣠@!mA=Z?v?=[?v?@=s\A@@13=[=Z=Z=[=[=[=[=[@>=b?v?x=c??@@@@@  @@#envA=n?v?=o?v?@=]A@@<3=o=n=n=o=o=o=o=o@!H@@@@@@@@డa#map!M=??=??@ =??=??@@@@@@H@@@@H@@@H@@H@@H@@İ@@@@dY@@M@i@@@Mb@@@M@@M@@M3========@8Dv@;@<@@@@డ'compose$Mode=??=??@ =??=??@@@@@@D9@@@@D8@@@D7@@D6@@D5@@Ű@@@@@@M@@@@M@@@M@@M@@M6@@ఐ!m=??=??@w@@C@@=??=??@@@@@@N@@@N@@NN@@ఐ#env>??@W@@Z@@@@[@A@I@N@A@@@@ఠ&single>??>??@>,^A@@@@@@N*>)>)>*>*>*>*>*@@@ @@@࣠@"idA>;??><??@>T_A@@$3><>;>;><><><><><@1>C??>D??@@@@@  @@$modeA>O??>P??@>h`A@@/3>P>O>O>P>P>P>P>P@!;@@@@@@@@డB#add!M>e??>f??@ >i??>j??@@˰@@@,@@@N'@N@hS@@@N&lW@@@N$@@N#@@N"@@N!3>{>z>z>{>{>{>{>{@,8]@/@0@@@@ఐS"id>??>??@8@@s@@ఐL$mode>??>??@@@w@@ఐ%empty>??b@c@@L@ND@@@NC/@@Ij@@0@tkA@I@NRr@A@o@on@@ఠ)unguarded>??>??@>aA@@@@@@NI@NT@8à @@@NK@Nb@@@NqI@NY8Ϡ @@@NpI@NZ@@N[I@NU@@NVI@NS3>>>>>>>>@@@@@@࣠@#envA>??>??@?bA@@.3>>>>>>>>@;>??>?@9@@@@@  @@"liA??????@?cA@@93????????@!E@@@@@@@@డ=$List&filter??????@ ?????@@@@@!a@%.@@@(D@@(C@_ @@@(BW@@@(A@@(@@@(?@.^-)-).^-)-X@@.o@#@@@@l@@@Ne@@Nd@ut@@@Ncmx@@@Na@@N`@@N_3?J?I?I?J?J?J?J?J@GS@J@K@@@@࣠@"idA?^?@?_?@@?wdA@@3?_?^?^?_?_?_?_?_@@@@@@@డ=!>?n?@$?o?@%@@!a@@>@@@0@@/@@.,%greaterthanBA'C@@@@'C'D@@'BT@@@@>@@@NM@N}@@@@N|@@N{@@Nz3????????@G>@5@6@@@@డ$rank$Mode??@ ??@@ ??@??@@@@@@@D1>@@@D0@@D/@%@& @@@@@@N>@@@N@@N,@@ఐ$find??@??@@@@@@@@N@@@@N@@@N@@N@@NH@@ఐ"id??@??@@R@@U@@ఐ#env??@??@"@@@0b@@??@??@#@@0@@@Nh@@V@@qi@@డK$rank$Mode@ ?@&@ ?@*@ @?@+@?@/@@f@@@@@@N?&@@@N@@N@@ภ%Guard@%?@0@&?@5@;@@@BE@@A@@@@@b@@@N@@"@@O@N@@ @@ @@@NN@N@@7?@@8?@6@@@k@@@Ns@@NrL@NL@N@@ఐL"li@L?@7U@V@@@@6W@@s@aXA@I@N_@A@\@\[@r@ఠ)dependent@^@;@A@_@;@J@@weA@@@@@@O"I@N@@@@O#K@N@@@NI@N @@@NI@N@@NI@N@@NI@N3@}@|@|@}@}@}@}@}@@@@@@࣠@#envA@@;@K@@;@N@@fA@@,3@@@@@@@@@9@@;@=@@T@@@@@@  @@"liA@@;@O@@;@Q@@gA@@73@@@@@@@@@!C@@@@@@@@డ?=$List&filter@@T@X@@T@\@ @@T@]@@T@c@@@@@@P@@@N@@N@X@@@N\@@@N@@N@@N3@@@@@@@@@,8e@/@0@@@@࣠@"idA@@T@i@@T@k@@hA@@r3@@@@@@@@@@@@@@@డ?z@@T@@@T@@@@@@@@@O M@N@@@@N@@N@@N3@@@@@@@@@0'@@@@@@డR$rank$ModeA@T@oA@T@s@ A@T@tA@T@x@@m@@@ @@@O@-@@@O@@O#@@ఐ$findA/@T@zA0@T@~@u@@@~@@@O@w@@@Ot@@@O@@O@@O?@@ఐj"idAI@T@AJ@T@@I@@L@@ఐˠ#envAV@T@AW@T@@@@Y@@AZ@T@yA[@T@@@@@@O!_@@M@@h`@@డ$rank$ModeAp@T@Aq@T@@ At@T@Au@T@@@ʰ@@@ e@@@O2@@@@O1@@O0@@ภ&IgnoreA@T@A@T@@@@@@@@O?@@ @@O@O8@@ @@l@@@OBN@O@A@T@dA@T@@@@-x@@@N@@NL@OFL@OD@@ఐ"liA@T@@ܰ@@A@@@@5@$A@PI@OL"@A@@@5@ఠ&removeA@@A@@@AiA@@@@@@OS@ @OQ@@@OR Ġ@@@OP@@OO@@ONI@OM3AAAAAAAA@W~w@x@y@@@డ&remove!MA@@A@@@ A@@A@@@@@@@@G@ @@@G @@@G@@G@@G@@Ȱ@@6&@A@A@@@@@)@ఠ$takeB @@B @@@B#jA@@@@@@OI@OU@ [@@@OvI@OZ@ `@@@OuI@O_@ ! @@OI@O@@@OI@O`@@OaI@O[@@O\I@OV@@OWI@OT3B6B5B5B6B6B6B6B6@dx@y@z@@@࣠@"idABG@@BH@@@B`kA@@93BHBGBGBHBHBHBHBH@FBO@@BP@@@@@@@  @@#envAB[@@B\@@@BtlA@@D3B\B[B[B\B\B\B\B\@!P@@@@@@@@@ఐ Š$findBq@@Br@@@@@@ @@@Og@ @@@Of @@@Oe@@Od@@Oc3B~B}B}B~B~B~B~B~@#/i@&@'@@@@ఐJ"idB@@B@@@/@@@@ఐC#envB@@B@@@@@@@.@@w@@ఐꠐ&removeB@@B@@@q@@@ l@@@O@ @@@O @@@O@@O@@O;@@ఐ"idB@@B@@@g@@H@@ఐ{#envB@@B@@@R@@U@@-@@V@@B@@@@@@@@O^@A@I@O@A@@@@ఠ+remove_listàB@@B@@@CmA@@@< @@@OK@O@@@OI@O@  S@O@@@OI@OI@O@@OI@O@@OI@O3C C C C C C C C @ @@@@@࣠@!lAC@@C@@@C5nA@@*3CCCCCCCC@7C$@@C%AA<@@@@@  @@#envAC0@@C1@A@CIoA@@/3C1C0C0C1C1C1C1C1@!A@@@@@@@@డA$List)fold_leftCFAACGAA @ CJAA CKAA@@(4@@@@MK@O@[@@O@@O@@=Mb@@@O @@O@@O@@O3C[CZCZC[C[C[C[C[@+7\@.@/@@@@࣠@#envACoAACpAA@CpA@@!3CpCoCoCpCpCpCpCp@@@@@@@"idAC~AA CAA"@CqA@@3CC~C~CCCCC@%3@@@@@@@@డq&remove!MCAA&CAA'@ CAA(CAA.@@@@@ [@@@O@ @@@O @@@O@@O@@O3CCCCCCCC@*6@-@.@@@@ఐ="idCAA/CAA1@ @@@@ఐY#envCAA2CAA5@C@@v@@5@@ @@@O"@CAACAA6@@@@@@O@@OL@PL@P e@@ఐ#envCAA7CAA:@@@@@ఐ֠!lCAA;@@@@@@@@A@I@P@A@@@@@@ @@  A@  /@ W C@ W @ $k@@@&@R@5@S@ @)"@#@$@@3DDDDDDDD@,@@D==DA=A@@$3DDDDDDDD@@@@!tI;@@BEA@@@@@D"88D#88@@@@D;rAA@&single@)!t@@@P@!~!t@@@P@@@P@@P@@P@D?88D@88@!g J Create an environment with a single identifier used with a given mode. DM88DN99@@@@@@@DfsA@%empty:@@@P@DZ99!D[99.@! * An environment with no used identifiers. Dh9/91Di9/9`@@@@@@@DtA@$find@*!t@@@P@_@@@P!!t@@@P@@P@@P @D9b9dD9b9@! V Find the mode of an identifier in an environment. The default mode is Ignore. D99D99@@@@@@@DuA@)unguarded@@@@P!@D&*=!t@@@P"@@@P$D1*H!t@@@P%@@@P'@@P(@@P)@D99D9:@!␠ o unguarded e l: the list of all identifiers in l that are dereferenced or returned in the environment e. D::D:h:@@@@@@@DvA@)dependent@@@@P*@D[*r!t@@@P+@@@P-Df*}!t@@@P.@@@P0@@P1@@P2@D::D::@" Y dependent e l: the list of all identifiers in l that are used in e (not ignored). D::D;;%@@@@@@@EwA@$join@@@@P3@@@@P4@@@P5@@P6@@P7@E;';)E;';?@@E/xA@)join_list@D @@@P8@@@P:@@@P;@@P<@E.;@;BE/;@;]@"V > Environments can be joined pointwise (variable per variable) E<;^;`E=;^;@@@@@@@EUyA@'compose@"!t@@@P=@3@@@P>7@@@P?@@P@@@PA@EW;;EX;;@" j Environment composition m[G] extends mode composition m1[m2] by composing each mode in G pointwise Ee;;Ef< <7@@@@@@@E~zA@&remove@+!t@@@PB@\@@@PC`@@@PD@@PE@@PF@E<9<;E<9@@@@ @@@@@@@G;@;FG;@;O@б@г$listG;@;TG;@;X@г!tG;@;RG;@;S@@3GGGGGGGG@5@A@@@@@г!tG;@;\@@ @@ @@@@$GՐ@@@@@@G;;G;;@б@г$ModeG;;G;;@G;;G;;@@@3GGGGGGGG@3@A @@б@г!tG;;G;;@@ @@г!tG;;@@@@ @@@@@@%(H@@@@@@$H<9@A @@б@г!tH1<9@A @@б@гȠ!tHn<<Ho<<@@ @@В@г͠$ModeH}<<H~<<@԰H<<H<<@@@!@@@гנ!tH<<@@+@@@,@@-#@@.6@@@@%H@@@@@@;꠰ڠڰH<=H<=@б@г۠$listH<=H<=@гࠡ%IdentH<=H<=@H<=H<=@@@3HHHHHHHH@^/-@A @@@ @@б@г점!tH<=!H<="@@@@г!tH<=&@@@@ @@  @@@@&Hꐠ@@@@@@%H=l=rH=l=w@б@г!tH=l=zH=l={@@3HHHHHHHH@81/@A@@б@г!tI=l=I=l=@@ @@г$boolI =l=@@@@ @@@@@@@@3I I I I I I I I @@A3IIIIIIII@@@I88I==@@G@C@B@H@I@D@E@F@J@K@L@A@@ @@@I288@!@@I488@@$@ఠ*remove_patנIAABAFIBABAP@IZA@@@D/general_pattern@S=@@@SKJ@R@ R=@@@S5J@R@@@S4J@R@@RJ@R@@RJ@R3I_I^I^I_I_I_I_I_@ ' Z@JHA@CA@@@@@rp@[Y@75@@@@@@@M o@@@࣠@#patAIABAQIABAT@IA@@F3IIIIIIII@.SIABABIA[A@@@@@  @@#envAIABAUIABAX@IA@@M3IIIIIIII@!]@@@@@@@@డ +remove_list#EnvIA[A]IA[A`@ IA[AaIA[Al@@@@@@S@@@S@q@@@St@@@S@@S@@S@ܰ@@@@@@S)@@@S(@@@@S'@@@S&@@S%@@S$3IIIIIIII@?K@B@C@@@@డHX0pat_bound_identsIA[AnIA[A~@@!k@@@@ C[<>!t@@@ ~@@@ }@@ |@E~ssEst!@@E@@@@Ġ@@@S<@@@S;@@@S:@@S99@@ఐ#patJ$A[AJ%A[A@@@F@@J(A[AmJ)A[A@@ao@@@S7@@@S6M@STN@SDT@@ఐ#envJ?A[A@]@@`@@@@a@A@J@SZ@A@@@䠰@ఠ.remove_patlist۠JQAAJRAA@JjA@@@DN@S@@@SL@Sl@@@S{J@S\@@@@SJ@SaJ@Sb@@ScJ@S]@@S^J@S[3JoJnJnJoJoJoJoJo@70@1@2@@@࣠@$patsAJAAJAA@JA@@+3JJJJJJJJ@8JAAJAA@@@@@  @@#envAJAAJAA@JA@@-3JJJJJJJJ@!B@@@@@@@@డI/$List*fold_rightJAAJAA@ JAAJAA@@@@!a@&@#acc@&@@'@@'@g@@@'@  @@'@@'@@'@::@@:^@#@@@@r@hL@Sj@@Sn@@Sm@|{@@@Sk@  @@Si@@Sh@@Sg3JJJJJJJJ@FRu@I@J@@@@ఐ*remove_patJAAJAA@x@@@@@@S@@@@S@@@S@@S@@S@@ఐ$patsKAAKAA@m@@+@@ఐ#envKAA@4@@7@@k@@B8@A@J@S@A@@@A+)term_judgJK"G)G.K#G)G7@@;@@IIA@(r!t@@@S"(!t@@@S@@S@@@@K5G)G)K6G)GI@@@@KNA@@Aб@г$ModeKCG)G:KDG)G>@KGG)G?KHG)G@@@@"3KGKFKFKGKGKGKGKG@@@0;@@@A8@@@S@S@@@@#@@@ @@@@г*#EnvK`G)GDKaG)GG@1KdG)GH/@0@@81@@A%2@@4@@43@3KfKeKeKfKfKfKfKf@@@A+)bind_judgKKsGJGOKtGJGX@@;@@IA@(!t@@@S@"{!t@@@S"!t@@@S@@S@@S@@@@KGJGJKGJGs@@@@KA@@Aб@г$ModeKGJG[KGJG_@"KGJG`KGJGa@@@*3KKKKKKKK@Z7;@@@A?@@@S@S@@@@"@@@@@@@б@г1#EnvKGJGeKGJGh@8KGJGiKGJGj@@@@@@г;#EnvKGJGnKGJGq@BKGJGr@@A@@I-B@@R.C@@[/7D@@F@@FE@3KKKKKKKK@0@@@ఠ&optionKGuGyKGuG@KA@Ш!a@б@б@А!a @S3KKKKKKKK@R@@KGuGKGuG@@гߠ)term_judgLGuGLGuG@@ @@@S@@@@@S@@б@гKr&optionLGuGLGuG@А!a'$LGuGLGuG@@@-@@@S+ @@г)term_judgL(GuGL)GuG@@ @@@S8@@@@@S;@@@,@@S>L4GuG @@F@@SCL9GuGA@[ZA@@@@O@SH@@@S@@S@; @@@S*@@@S@@S@@SӠ@@SZ@࣠@!fALZGGL[GG@LsA@@@n@Sh@@@S@@S3LbLaLaLbLbLbLbLb@qLiGuGuLjGG@@@@@@@!oALuGGLvGG@LA@@m@@@S3LzLyLyLzLzLzLzLz@,@"@@@S@@S@(@)@@@@@@!mALGGLGG@LA@@k@@@T3LLLLLLLL@*<@@@S@%@&@@@@@@ఐ6!oLGGLGG@@@N@@@T3LLLLLLLL@)@@@T@#@$@@@Ġ$NoneLGGLGG@;LL(L%@@W@@@@AA@AL@@L@@ @@k@@@T 3LLLLLLLL@@@@@p@@@T@@@డ#%empty#EnvLGGLGG@ LGGLGG@@@@@R@} @@@@@T@Ġ$SomeLGGLGG@;LK6@LIA@AA@AM@@LIఠ!vMGGMGG@MA@@S@TW@@@@@@@@T\@@@@@T`@@@ఐ!fMGGMGG@@@@#@@@T@@T3MMMMMMMM@r&@ @!@@@@ఐ-!vM-GGM.GG@ @@,@@ఐ!mM:GG@@@@@@T.R@T0R@T/%@@.@@^&@@@AMGGG@@@@@T9@MLGG@@@@Y@@@TV@@TU@L@@@TT;@@@TS@@TR@@TQL@TK@A@@@k@ఠ$listMkGHMlGH@MA@Ш!a@б@б@А!a @Tr3M}M|M|M}M}M}M}M}@@@@S@@@S@@S@ @@@Sq@@@S@@S@@S@@@@MGHMGH@@г})term_judgMGHMGH@@ @@@Ts$@@@*@@Tt'@@б@гM-$listMGH%MGH)@А!a:7MGH"MGH$@@@@@@@Tv> @@г)term_judgMGH-MGH6@@ @@@TwK@@@@@TxN@@@,@@TyQMGH  @@Y@@TzVMGH A@nmA@@@@b@TH@@@T@@T@; @@@T*@@@T@@T@@T@@Tm@࣠@!fAMH9H?MH9H@@NA@@@@Th@@@T@@T3NMMNNNNN@NGGNHIH@@@@@@@"liANH9HANH9HC@N,A@@m@@@T3NNNNNNNN@,@"@@@T@@T@(@)@@@@@@!mAN-H9HDN.H9HE@NFA@@ @@@T3N1N0N0N1N1N1N1N1@*<@@@T@%@&@@@@@@డL$List)fold_leftNJHIHMNKHIHQ@ NNHIHRNOHIH[@@38@@@@,@@@UO@TO@T@cO@T @@T@@T@ @HX @@@T@@T@@T@@T3NfNeNeNfNfNfNfNf@6ED@@@T@?@@@@@@࣠@#envAN}HIHaN~HIHd@NA@@+3N~N}N}N~N~N~N~N~@@@@@@@$itemANHIHeNHIHi@NA@@13NNNNNNNN@(=@@@@@@@@డ%$join#EnvNHIHmNHIHp@ NHIHqNHIHu@@@T@@@S@Y@@@S\@@@S@@S@@R@ @ @@@b@@@T@g@@@Tj@@@T@@T@@T3NNNNNNNN@6Bi@9@:@@@@ఐX#envNHIHvNHIHy@B@@@@ఐ점!fNHIH{NHIH|@ư@@@N@@@T@@T$@@ఐj$itemNHIH}NHIH@.@@1@@ఐ֠!mOHIHOHIH@@@@@@UT@UT@UG@@O HIHzOHIH@@@@@T@U T@UQ@@u @@S@TT@OHIH\OHIH@@@@@@T@@TP@UP@U@@డ&!%empty#EnvO2HIHO3HIH@ O6HIHO7HIH@@V@@P@U@@ఐ6"liOFHIH?@@@@I?@@@TP@UP@U@@I@@@ORH9H;K@@@@[@@@U2@@U1@c@@@U0@@@U/@@U.@@U-L@U'b@A@_@_^@栰@ఠ%arrayOqHHOrHH@OA@Ш!a@б@б@А!a @UN3OOOOOOOO@!@@@T@@@T@@T@ @@@T@@@T@@T@@T@-@.@@OHHOHH@@г)term_judgOHHOHH@@ @@@UO$@@@*@@UP'@@б@гO=%arrayOHHOHH@А!a:7OHHOHH@@@@@@@UR> @@г)term_judgOHHOHH@@ @@@USK@@@@@UTN@@@,@@UUQOHH @@Y@@UVVOHHA@nmA@@@@b@UfH@@@Ul@@Uk@; @@@Uj*@@@Ui@@Uh@@Ug@@Uem@࣠@!fAOHHOHH@PA@@@@Umh@@@U@@U3PPPPPPPP@P HHPHI*@@@@@@@"arAPHHPHH@P2A@@m@@@U3PPPPPPPP@,@"@@@U@@U~@(@)@@@@@@!mAP3HHP4HH@PLA@@@@@U3P7P6P6P7P7P7P7P7@*<@@@U@%@&@@@@@@డN%Array)fold_leftPPHHPQHH@ PTHHPUHH@@@@#acc@Vb@!a@Vd @@W@@W@ @%arrayJ@@@W@@W@@W@@W@)array.mli    @@-Stdlib__ArrayY@(#@@@@R@@@XO@XyO@XL@O@XN @@XP@@XO@ @! @@@XM@@XK@@XJ@@XI3PPPPPPPP@Vej@@@U@_@`@@@@࣠@#env'APHHPHH@PA@@+3PPPPPPPP@@@@@@@$item(APHHPHI@PA@@13PPPPPPPP@(=@@@@@@@@డ'$join#EnvPHIPHI@ PHI PHI @@&@@@z@@@Xm@@@@Xl@@@Xk@@Xj@@Xi3PPPPPPPP@(4[@+@,@@@@ఐJ#envPHIPHI@4@@q@@ఐ!fPHIPHI@ذ@@@`@@@X}@@X|$@@ఐ\$itemQ HIQ HI@.@@1@@ఐ蠐!mQHIQHI@@@@@@XT@XT@XG@@Q%HIQ&HI@@@@@Xx@XT@XQ@@g @@S@XwT@Q2HHQ3HI@@@@@@X_@@X^P@XP@X@@డ(9%empty#EnvQJHIQKHI!@ QNHI"QOHI'@@n@@P@X@@ఐH"arQ^HI(Q@#R@@@@@X]P@XP@X@@[@@@QjHH]@@@@m@@@X@@X@Ơu@@@X@@@X@@X@@XL@Xt@A@q@qp@@@QI,I0QI,I6@@@7!!t@@@Xv@@@X@@X3QQQQQQQQ@*@@@U`@@@U_@@Ud@ @@@Uc@@@U\@@Ub@@Ua@6@7@@@&single)'&@QA@&@@@X#@@@X@@X1б@г1%IdentQI,I9QI,I>@8QI,I?QI,I@@@@@@@@X9 @@г>)term_judgQI,IDQI,IM@@F@@@XE@@@@@XH@@XWA@@@V@@@XS@@@X@@XR@డ(&single#EnvQI,IPQI,IS@ QI,ITQI,IZ@@@  @@@R@  @@@R@@@R@@R@@R@   @б@г7UTQN@ @@@XM@гML@@@@XI@@ @@XH@4/A@@@@@@Y @@@Y@@YL@Y@A@R1I,I,;@@<@@@R<I[I_R=I[Ii@@@Qà7!t@@@Y#@@@Y"@2@@@Y!6@@@Y @@Y@@Y3RRRQRQRRRRRRRRRR@@@@@@*remove_ids* @RsA@@@@Y@@@Y@@@@Y@@@Y@@Y@@Y3б@г3$listRyI[ItRzI[Ix@г8%IdentRI[IlRI[Iq@?RI[IrRI[Is@@@G@@@Y 9 @@@O@@@Y >@@б@гI)term_judgRI[I|RI[I@@Q@@@YL@@гQ)term_judgRI[IRI[I@@Y@@@YX@@@@@Y[@@@$@@Y^0 @@yxA@@@wv@@@Y)@@@Y(@s@@@Y'r@@@Y&@@Y%@@Y$q@࣠@#ids,AR IIR II@RA@@RX8o@@@YB@@@YA3RRRRRRRR@RI[I[R II@@@@@@@!f-AR IIR II@SA@@@@@YM3RRRRRRRR@/%$@@@Y@@@@Y?@-@.@@@@@@!m.AS  IIS  II@S$A@@@@@YX3SSSSSSSS@,"@@@YL@&@'@@@@ @@డ*+remove_list#EnvS' IIS( II@ S+ IIS, II@@ r@@@ d r@@@Yb@@@Ya@ @@@Y` @@@Y_@@Y^@@Y]3S=S<S<S=S=S=S=S=@/>@@@YW@8@9@@@@ఐ#idsSP IISQ II@Y@@  @@@Yp@@@YoP@YsP@Yq@@ఐ~!fSj IISk II@X@@z@@@Yv0@@ఐr!mSz IIS{ II@:@@Y@@@YQ@YQ@YF@@S II@@ 4@@@Yn@YQ@YO@@i@@d@@@YP@YmU@S II@б@гǠ)(гȠ%$`!@@@@Y*@@֠@@@Y,@б@г@@@@Y-@г@@@@Y.@@ @@Y/@@@@Y0@/A@@@@@@Y@@@Y@@@@Y@@@Y@@Y@@YL@Y@A@@@@@S"IIS"II@@@Si@@@Y@@@Y@@@Y@@Y3SSSSSSSS@@@@@@$join/@TA@@@@Y@@@Y@@@Y@@Y&б@г&$listT"IIT"II@г+)term_judgT"IIT"II@@3@@@Y-@@@;@@@Y2 @@г7)term_judgT,"IIT-"II@@?@@@Y>@@@@@YA@@TSA@@@RQ@@@Y@@@YP@@@Y@@YO@࣠@"li1ATM#IITN#II@TfA@@SԠ :@@@Y@@@Y3TWTVTVTWTWTWTWTW@heT^"IIT_#IJ"@@@@@@@!m2ATj#IITk#II@TA@@ F@@@Y3TnTmTmTnTnTnTnTn@-#"@@@Y@@@Y@+@,@@@@@@డ+y)join_list#EnvT#IIT#II@ T#IIT#IJ@@@t ?@@@S@@@S C@@@S@@S@qn`@@@ L@@@Y@@@Y P@@@Y@@Y3TTTTTTTT@;J @@@Y@D@E@@@@డSF$List#mapT#IJT#IJ @ T#IJ T#IJ@@@@!a@&!b@&@@'@Nʠ@@@'NϠ@@@'@@'@@'@DD@@DW@% @@@@@@@ZO@Y @@@YO@ZO@ZO@Y@@Y@#@@@Y"@@@Y@@Y@@YW@@࣠@!f3AU#IJU#IJ@U)A@@*3UUUUUUUU@i@@@@@@ఐ!fU #IJU!#IJ@9@@@@:3U!U U U!U!U!U!U!@z@@@@ఐɠ!mU0#IJU1#IJ@@@ @K@ZO@Z@@ @@MO@Z@U=#IJU>#IJ@@@[V@@Z P@ZP@Z1@@ఐ"liUO#IJUP#IJ!@ް@@o@@@Z P@ZP@Z@@U[#IJ@@@n@@@YO@ZP@Z P@@@@ 9@@@Z O@YV@Uk#II @б@г edг!a`@%@@@Y#]@@,@@@Y'\@г f\[@@@@Y/X@@@@Y1W@!-A@@@@@@Z:@@@Z9@@@Z8@@Z7L@Z3@@A@=@=<@@ఠ%empty4U%J$J(U%J$J-@UA@@@@@Z?L@Z< \@@@Z@L@Z=@@Z>L@Z;3UUUUUUUU@@@@@@࣠@%param6A@U%J$J4U%J$J5@@3UUUUUUUU@$U%J$J$U%J$JB@@@@@ @@డ,%empty#EnvU%J$J9U%J$J<@ U%J$J=@@@@+@U%J$J0@@7L@ZB@A@@@-@@U*KKU*KK@@@ @@@ZW@3A!t@@@ZV @@@ZU@@ZT@@ZS3UUUUUUUU@KaZ@[@\@@@"<<7@VA@@@@ZR@@@@ZQ@@@ZP@@ZO@@ZN*б@г*)term_judgV!*KKV"*KK'@@2@@@ZD%@@б@г2$ModeV1*KK+V2*KK/@9V5*KK0V6*KK1@@@A@@@ZE: @@г?)term_judgVB*KK5VC*KK>@@G@@@ZFF@@@@@ZGI@@@*@@ZHL- @@baA@@@`@@@Z\@_@@@Z[\@@@ZZ@@ZY@@ZX[@࣠@!f9AVg+KAKGVh+KAKH@VA@@ P@@@Zn3VlVkVkVlVlVlVlVl@olVs*KKVt+KAK@@@@@@@*inner_mode:AV+KAKIV+KAKS@VA@@3@@@Zy3VVVVVVVV@* @@@Zm@$@%@@@@@@࣠@*outer_mode;AV+KAK[V+KAKe@VA@@ w@@@Z3VVVVVVVV@,"@@@Zx@&@'@@@@ @@ఐO!fV+KAKiV+KAKj@+@@K@@@Z3VVVVVVVV@' @@@Z@!@"@@@@డ4'compose$ModeV+KAKlV+KAKp@ V+KAKqV+KAKx@@@@@@@@Z@@@@Z@@@Z@@Z@@Z+@@ఐV*outer_modeV+KAKyV+KAK@5@@@@@ZQ@ZQ@Z?@@ఐ*inner_modeW+KAKW+KAK@`@@@@@ZQ@ZQ@ZS@@W +KAKk@@ @@@Z@ZQ@Z^@@e@@ @@@ZP@Zd@W+KAKW@@ @@@ZN@Z@W&+KAKC@б@г@@@@Z] @б@г  A@@@@Z^@г@"@@@Z_@@ @@Z`@@@@Za@%A@@@^@@@Z@]@@@ZZ@@@Z@@Z@@ZL@Z@A@@@Z@@Wd1LrLvWe1LrLz@@@ @@@Z@ S@@@Z W@@@Z@@Z@@Z3WsWrWrWsWsWsWsWs@vt@@q@@@">><@WA@@@@Z@@@@Z@@@Z@@Z@@Z(б@г()bind_judgW1LrL}W1LrL@@0@@@Z%@@б@г0)term_judgW1LrLW1LrL@@8@@@Z3@@г8)term_judgW1LrLW1LrL@@@@@@Z?@@@@@ZB@@@#@@ZE& @@YXA@@@W@@@Z@V@@@ZU@@@Z@@Z@@ZT@࣠@&binder>AW2LLW2LL@WA@@ m@@@[3WWWWWWWW@heW1LrLrW2LL@@@@@@@$term?AW2LLW2LL@XA@@ @@@[ 3WWWWWWWW@)@@@[@#@$@@@@@@$mode@AX2LLX2LL@XA@@ @@@[3X XXX X X X X @(@@@[ @"@#@@@@ @@ఐK&binderX2LLX2LL@(@@G@@@[3X XXX X X X X @' @@@[@!@"@@@@ఐ1$modeX32LLX42LL@@@ @@@[2P@[4P@[3@@ఐa$termXK2LLXL2LL@?@@]@@@[6.@@ఐY$modeX[2LLX\2LL@8@@ :@@@[EQ@[GQ@[FD@@Xh2LL@@ @3@[1@[HQ@[DN@@U@@ F@@@[IP@[0T@Xx2LL@б@г@@@@Z@б@г@@@@Z@г s@@@@Z@@ @@Z@@@@Z@#A@@@7@@@[n@6@@@[m5@@@[l@@[k@@[jL@[e@A@@@5A@X9MuM}X9MuM@@@W'*expression@@@[ @@@[@@[3XXXXXXXX@MK_@b@H@@@*expressionA@XA@@@@[@@@[@@[б@г)TypedtreeX9MuMX9MuM@&X9MuMX9MuM@@@.@@@[' @@г,)term_judgX9MuMX9MuM@@4@@@[3@@@@@[6@@FEA@@@D@@@\A@@@\@@\@@࣠@#expTAY :MMY:MM@Y&A@@WY@@@]S3YYYYYYYY@geu@x@b-function_bodyB@G@@@|#L@\O@@@|cL@\@@\M@[p@Y=zzY>zz#@@YVA*binding_opC@W*binding_op@@@[0@@@[@@[@YP||YQ||@@YiA/class_structureD@W/class_structure@@@[C@@@[@@[@Yc}A}EYd}A}T@@Y|A+class_fieldE@W+class_field@@@[V@@@[@@[@Yv}}Yw}}@@YA0class_field_kindF@W0class_field_kind@@@[i@@@[@@[@YmqYm@@YA&modexpG@X+module_expr@@@[|@@@[@@[@Y/3Y/9@@YA$pathH@$Path!t@@@[@@@[@@[@YfjYfn@@YA)structureI@X()structure@@@[@@@[@@[@YY@@YA.structure_itemJ@X;.structure_item@@@[f@@@[@@[@Y,Y,@@YA.module_bindingK@@YI?}!t@@@\@@@\@X_+module_expr@@@\@@\@@@\@@\@Ye_cYe_q@@ZA0open_declarationL@Xr0open_declaration@@@\@@@\@@\@ZvimZvi}@@Z'A9recursive_module_bindingsM@Y@Y?!t@@@\/@@@\.@X+module_expr@@@\0@@\-@@@\,@@@\+@@\*@Z7|Z8|@@ZPA*class_exprN@X*class_expr@@@\<*@@@\;@@\:@ZJZK@@ZcA5extension_constructorO@X5extension_constructor@@@\H=@@@\G@@\F@Z]Z^@@ZvA.value_bindingsP@X(rec_flag@@@\a@YX-value_binding@@@\`@@@\_ @@@\^@@\]@@\\@Z|Z}@@ZA$caseQ@X$case!k@\v@@@\x@2@@@\t@1!t@@@\r@2'@@@\s@@\q@@\p@@\w@Z Z @@ZA'patternR@Y/general_pattern!k@\@@@\@1!t@@@\2F@@@\@@\@@\@Z@DZ@K@@ZA8is_destructuring_patternS@Y7@8@9@@@@ఐE#pth[\<MM[]<MN@ @@@@@_P@_P@_@@# @@L@@@_@Ġ(Texp_let[u=NN[v=NN@Tyఠ(rec_flagV[~=NN[=NN@[A@@U@@@]p3[[[[[[[[@@@@ఠ(bindingsW[=NN[=NN$@[A@@TU@@@]r@@@]q@ఠ$bodyX[=NN&[=NN*@[A@@V@@@]s!@@@2[=NN+@@U@@@]t&@@U@@@]u)@@@ఐ:">>[DNN[DNN@@@@T@@@_@S@@@_R@@@_@@_@@_3[[[[[[[[@QJ@K@LC<@=@>2+@,@-@@@@ఐv.value_bindings[DNN[DNN@z@@@z@@@_@xw@@@_@@@_t@@@_@@_@@_'@@ఐz(rec_flag[DNN[DNN@/@@@@@_R@_R@_;@@ఐ(bindings\ DNN\ DNN@B@@@@@_@@@_R@_R@_S@@A@@@@@_W@@ఐa*expression\*DNN\+DNO@@@@w@@@`t@@@`@@`n@@ఐ$body\?DNO\@DNO@t@@@@@` R@`"R@`!@@  @@@@@`'@@t@@@Ġ*Texp_match\XEO O\YEO O@Gఠ!eY\aEO O\bEO O@\zA@@W|@@@]3\e\d\d\e\e\e\e\e@p@@@ఠ%casesZ\pEO O\qEO O#@\A@@G-G,G*@@@]@@@]@@@]@ఠ)eff_cases[\EO O%\EO O.@\A@@G2GBG1@@@]@@@]@@@]-@@\EO O0\EO O1@@G3@@@]5@@@F\EO O2@@V@@@]:@@V@@@]=@@@࣠@$modeA\LP"P-\LP"P1@\A@@@@@`93\\\\\\\\@^W@X@YPI@J@K;4@5@6@@@@@@@@ఠ(pat_envs\MP5PA\MP5PI@\A@@VǠA@@@`Q@`G@@@`UQ@`>3\\\\\\\\@(7@@@`8@1@2@@@@ఠ)pat_modes\MP5PK\MP5PT@]A@@VW@@@`Q@`I@@@`VQ@`?@@/@@@/@@@`B%@డ[$List%split]NPWPa]NPWPe@ ]NPWPf]NPWPk@@@W @!a@%p@!b@%r@@(@@@(@]@@@(@E@@@(@@(@@(@M=*=*M=*=Y@@L@@0+@@@(@q@U@@`K@@@`J@|{@@@`F@dc@@@`H@@`E@@`D3]W]V]V]W]W]W]W]W@|@@@@డ[$List#map]kNPWPm]lNPWPq@ ]oNPWPr]pNPWPu@@@@@@H.@@@`R@`x@@@`R@`_@@@@`XR@`R@`R@`]@@``@@@@`^@@@`\@@`[@@`Z>@@࣠@!cA]NPWP{]NPWP|@]A@@3@@@@ఐ2$case]NPWP]NPWP@6@@@6A@@@`w@/@@@`v@.@@@`t@+@@@`u@@`s@@`r@@`q3]]]]]]]]@2[@)@*@@@@ఐ9!c]NPWP]NPWP@ @@h@@ఐ<$mode]NPWP]NPWP@ @@]@@@`U@`"@@=@@n#@]NPWPv]NPWP@@@y@@`lS@`S@`@@ఐ%cases^NPWP^NPWP@K@@ 5@@@`kS@`S@`@@^NPWPl^NPWP@@@@@`WR@`S@`j=@@  @@@P@4@@`R@`TF@A@^%MP5P=@@@ఠ%env_e^0OPP^1OPP@^IA@@@@@`Q@`3^8^7^7^8^8^8^8^8@_tm@n@oWP@Q@R@@@ఐ*expression^IOPP^JOPP@!@@@@@@`@@@`@@`@@ఐ!e^^OPP^_OPP@@@@@@`R@`R@`-@@డ\$List)fold_left^xOPP^yOPP@ ^|OPP^}OPP@@Cf@@@@%@@@`R@`@R@`@@`@@`@ @X@@@`@@`@@`@@`Y@@డ;$join$Mode^OPP^OPP@ ^OPP^OPP@@"@@@&@@@`@@@`@@`v@@ภ&Ignore^OPP^OPP@%%@@@%@@@`@@ఐޠ)pat_modes^OPP^OPP@@@XĠI@@@`S@`S@`@@^OPP^OPP@@T@@@@@A@^OPP@@@@ఠ(eff_envs^PPP^PPP@_A@@[@@@a.Q@`@@@`Q@`3^^^^^^^^@@@@@@@ఠ)eff_modes_PPP_PPQ@_A@@m@@@a/Q@`@@@`Q@`@@*@@@*@@@`!@డ]$List%split_&QQ Q_'QQ Q@ _*QQ Q_+QQ Q@@@@@@E@-@@`@@@`@jO@@@`@R;@@@`@@`@@`3_E_D_D_E_E_E_E_E@P@@@@డ]$List#map_YQQ Q_ZQQ Q#@ _]QQ Q$_^QQ Q'@@ @@@@J @@@a@R@a!@@@a1R@a@@p@@aR@aCR@a-R@a@@a @ @@@a @@@a@@a@@a>@@࣠@!cA_QQ Q-_QQ Q.@_A@@3@@@@ఐ $case_QQ Q2_QQ Q6@$@@@$A@@@a @@@@a@@@@a@@@@a@@a@@a@@a3________@2[@)@*@@@@ఐ9!c_QQ Q7_QQ Q8@ @@h@@ఐ*$mode_QQ Q9_QQ Q=@@@K@@@a6U@a5"@@=@@n#@_QQ Q(_QQ Q>@@@y@@aS@a=S@a<@@ఐm)eff_cases_QQ Q?_QQ QH@8@@ #@@@aS@aAS@a>@@_QQ Q`QQ QI@@@@@aR@aBS@a@@ @@@#@ @@aDR@`@A@`PPP@@@ఠ%eff_e`RQMQY`RQMQ^@`7A@@@@@a\Q@aE3`&`%`%`&`&`&`&`&@3G@@A@B.'@(@)@@@ఐn*expression`7RQMQa`8RQMQk@@@@@@@aI@@@aH@@aG@@ఐ렐!e`LRQMQl`MRQMQm@@@@@@aYR@a_R@a^-@@డ^$List)fold_left`fRQMQo`gRQMQs@ `jRQMQt`kRQMQ}@@ET@@@@'@@@aR@ad@R@af@@ah@@ag@ @Zq@@@ae@@ac@@ab@@aaY@@డ=$join$Mode`RQMQ~`RQMQ@ `RQMQ`RQMQ@@$@@@(@@@a~@@@a}@@a|v@@ภ&Ignore`RQMQ`RQMQ@'@@@'@@@a@@ఐ)eff_modes`RQMQ`RQMQ@@@ZI@@@auS@aS@a@@`RQMQn`RQMQ@@T@@@@@A@`RQMQU@@డ7)join_list#Env`SQQ`SQQ@ `SQQ`SQQ@@ L@@@@@@a@@@a@@@a@@a3````````@@@@@@@ภ"::`TQQ`TQQ@Vడ7)join_list#EnvaTQQaTQQ@ a TQQa TQQ@@ |@@@@@@a@@@a@@@a@@a0@@ภ-a"TQQa#TQQ@Vݠఐ%env_ea,TQQa-TQQ@4@@@@@aR@aR@aR@aN@ఐr(pat_envsa@TQQaATQQ@@@`@@@aR@aR@aa@@aLTQQaMTQQ@@0@@@aR@aj@@aUTQQaVTQQ@@@@@aQ@a@aR@av@ภqafTQQagTQQ@W!ఐR%eff_eapTQQaqTQQ@@@Q@aQ@aQ@a@ఐ(eff_envsaTQQaTQQ@W@@`@@@aQ@aQ@a@@aTQQaTQQ@@`9@@@aQ@a@@aTQQaTQQ@@z@@@@aQ@a@@@@s@@@aQ@a@@@|@@@@@@l@@@ @aLP"P(aTQQ@@D@Ġ(Texp_foraUQRaUQR @S@aUQR aUQR @@S@@@]3aaaaaaaa@@@@@aUQRaUQR@@S@@@] @ఠ#low\aUQRaUQR@aA@@\@@@]@ఠ$high]aUQRaUQR@aA@@\@@@]%@@aUQRaUQR@@T @@@]-@ఠ$body^aUQRaUQR#@b A@@]@@@];@@@FaUQR$@@[p@@@]@@@[s@@@]C@@@ఐ$joinb ]RRb ]RR@ T@@@*)@@@a@@@a(@@@a@@a3bbbbbbbb@%SL@M@NF?@@@A1*@+@,@@@@ภ"::b*^RRb+aSbSiAWఐ ."<<b6^RSb7^RS @ @@@ J@@@b@ I@@@b F@@@b@@b@@b,@@ఐ *expression(bR^RS@ )*@@@ @@@b% @@@b$@@b#B@@ఐ#lowbf^RSbg^RS@J@@ @@@b5T@b7T@b6V@@G @@ @@@b<Z@@ภ+Dereferenceb}^RS b~^RS@;9(@@@DE@@A9@@9@@@)@@@bKk@@\@@ @@@bRo@ภfb_SS eAXIఐ "<<b_SS0b_SS2@ $@@@ @@@bo@ @@@bn @@@bm@@bl@@bk@@ఐ *expression'b_SS*@ )@@@ @@@b @@@b@@b@@ఐ$highb_SS+b_SS/@@@ @@@bT@bT@b@@F @@ @@@b@@ภ+Dereferenceb_SS3b_SS>@d@@@*@@@b@@Y@@ @@@b@ภȰb`S@SHAXఐ "<<b`S@SXb`S@SZ@ @@@ @@@b@ @@@b @@@b@@b@@b@@ఐ O*expression'c`S@SR@ )@@@ d@@@b a@@@b@@b@@ఐ9$bodyc,`S@SSc-`S@SW@@@ {@@@cT@cT@c@@F @@ y@@@c  @@ภ%GuardcC`S@S[cD`S@S`@#@@@*~@@@c/@@Y@@ M@@@c"3@ภ"[]cTaSbSh*AX@+A@bĠq@@@b@@@bP@c1E@@o5A@bΠ{@@@bc@@@bdP@bO@@?A@bؠ@@@a@@@aP@bbY@@ct]RRJ@@@@@a@@@aP@ad@@tT@@e@Ġ-Texp_constantcbSjSpcbSjS}@V@cbSjS~cbSjS@@V@@@]@@@ @@]@@@]@@] @@@]@@@ఐ %emptyccSSccSS@ @@=@Ġ(Texp_newcdSScdSS@O8ఠ#pth_cdSScdSS@cA@@O@@@@]3cccccccc@@@@@cdSScdSS@@OBO@@@@]@@@] @@cdSScdSS@@OA@@@]@@@&cdSS@@]I@@@]@@]L@@@]@@@ఐ ܠ"<<cjTT#cjTT%@ n@@@ @@@cI@ @@@cH @@@cG@@cF@@cE3cccccccc@C<@=@>@@@@ఐ `$pathdjTTdjTT@ d@@@ d@@@cg _@@@cf@@ce@@ఐa#pthdjTTdjTT"@$@@ {@@@cwR@cyR@cx.@@  @@ w@@@c~2@@ภ+Dereferenced/jTT&d0jTT1@@@@+j@@@cA@@3@@B@Ġ,Texp_instvard@kT2T8dAkT2TD@Oఠ)self_path`dIkT2TFdJkT2TO@dbA@@O@@@]3dMdLdLdMdMdMdMdM@ X@@@ఠ#pthadXkT2TQdYkT2TT@dqA@@O@@@]@ఠ)_inst_varbdfkT2TVdgkT2T_@dA@@OO@@@]@@@]!@@@2drkT2T`@@]@@@]&@@]@@@])@@@ఐ$joindlTdTldlTdTp@˰@@@@@@c@@@c@@@c@@c3dddddddd@ PI@J@KB;@<@=5.@/@0@@@@ภwdlTdTrdlTdTAZ[ఐ"<<dlTdTdlTdT@ 6@@@@@@c@@@@c@@@c@@c@@c+@@ఐ %$path(dlTdTv@ (*@@@ (@@@c #@@@c@@cA@@ఐ)self_pathdlTdTwdlTdT@I@@ ?@@@cT@cT@cU@@G @@ ;@@@cY@@ภ+DereferencedlTdTdlTdT@v@@@,.@@@ch@@Z@@@@@dl@ภڰelTdTcAZఐ k$path elTdT@ n @@@ n@@@d! i@@@d @@d@@ఐʠ#pthe"lTdTe#lTdT@@@ @@@d1R@d3R@d2@@* @@ @@@d8@ภAZ@A@dR@@@d@@@dP@dG@@>A@d\@@@c@@@cP@d@@eKlTdTq@@hg@@@c@@@cP@c@@@@ @Ġ*Texp_applye`mTTeamTT@VKঠ(exp_descekmTTelmTT@^Ġ*Texp_identesmTTetmTT@]@exmTTeymTT@@_L@@@]3ezeyeyezezezezez@ @@@@emTTemTT@@]]@@@]@@@] @ఠ"vdcemTTemTT@eA@@]@@@]@@@&emTT@@_@@@] @@@emTTemTT@@`@@@]P@](@Ġ[gemTTemTTA[f@@ emTT@@V@@@];@@Ġ#ArgemTTemTT@`ఠ#argdemTTemTT@eA@@`@@@]S@@@@@V@@@]W@@* @@@$@ @@]^@Ġ[5A[@@6A@eN@V@@@]@V@@@]@@]@@@]u@@@emTTH@@V֠@V@@@]@V@@@^@@]@@@]@@@fmTT@@_z@@@^@@_}@@@^@@ఐc&is_reffnTTfnTT@b%@@@d@@@dUd@@@dT@@dS3ffffffff@ +@@`Y@Z@[@@@@ఐ"vdf0nTTf1nTT@@@d$@@@d\P@d^P@d]@@% @@Vv@@@d_P@d[@ఐA"<<fItUSUhfJtUSUj@Ӱ@@@]@@@de@\@@@ddY@@@dc@@db@@da8@@ఐ *expressionfetUSUYfftUSUc@ =@@@ @@@d @@@d@@dO@@ఐ#argfztUSUdf{tUSUg@W@@ @@@dR@dR@dc@@  @@ @@@dg@@ภ%GuardftUSUkftUSUp@&l@@@-@@@dv@@3@@ 1w@Ġ*Texp_applyfuUqUwfuUqU@Wఠ!eefuUqUfuUqU@fA@@a@@@^ 3ffffffff@ @@@ఠ$argsffuUqUfuUqU@fA@@W@W@@@^@W@@@^@@^ @@@^ @@@-fuUqU@@`D@@@^!@@`G@@@^$@@@Aఠ*split_argsfX*X:fX*XD@fA@@/has_omitted_argW#@@@eP@d@\@@@dȠ@b-N@dP@d̠bp@@@dP@d@@@dP@d@@dP@d@@@dP@d@fP@e%@@@e)P@d@\֠P@e@@@eP@d@@d@@d@@d3g ggg g g g g @ -x@y@zqj@k@l@@@࣠FFAJg2X*XFg3X*XU@gKA@@N3g3g2g2g3g3g3g3g3@\WU@R@5@-@@dQ@d@@dQ@d@@dQ@d@f@g@@@@gJX*XE@@Ġ"[]gTXaXmgUXaXo@\@@@@h3gTgSgSgTgTgTgTgT@"-r@%@&@@@@@@ภgcXaXsgdXaXu@]@@@]d@@@d@@ภgqXaXwgrXaXy@]@@@],tP@d@@@d"@@@@@l@d@@d)@Ġ"::gXzXgXzX@]C@@gXzXgXzX@@3gggggggg@<@@@@Ġ'OmittedgXzXgXzX@c*ĠcgXzXgXzX@c@@@@@@@ @@@@gXzXgXzX@@@@@@d@ఠ$restgXzXgXzX@gA@@g(P@d@@@d.@@@ @@/@@@ఐ렐*split_argsgXzXgXzX@@@@@Ġ@@@d@@d@@d3gggggggg@&@ @!@@@ภd]gXzXgXzX@d\@@@P@dT@d@@ఐ;$restgXzXgXzX@@@P@d @@.@@!@ĠyhXXhXX@]@@h XXh XX@@P@d3h h h h h h h h @@@@@Ġ#ArghXXhXX@c<ఠ#arghXXh XX@h8A@@ P@d@@@@@'P@d@@h(XXh)XX@@@#@ @@d#@ఠ$resth7XXh8XX@hPA@@gJP@d@@@d4@@@ @@S5@@@@@ఠ'appliedhPXXhQXY@hiA@@BT@e3hRhQhQhRhRhRhRhR@=6@7@8&@ @!@@@@ఠ'delayedhbXYhcXY @h{A@@LP@eT@e@@@@@@ @@e@ఐ*split_argshyXYhzXY@C@@@@r@j@@e@@e@@e1@ఐ`/has_omitted_arghXYhXY)@9@@>@@ఐf$resthXY*hXY.@F@@P@eM@@*@@@U@E@@eU@eV@A@hXX@@ఐ/has_omitted_arghY2YAhY2YP@_@@3hhhhhhhh@fpi@j@k_X@Y@Z@@@@ఐy'appliedhYQYbhYQYi@@@x@@ภްhYQYohYQYq@^ఐ#arghYQYkhYQYn@@@'@ఐ'delayedhYQYrhYQYy@-@@2@@@@3@@$@@@@@@e:@@ภhYzYhYzY@^ఐ蠐#argiYzYiYzY@@@Q@ఐ 'appliediYzYiYzY@X@@\@@@@P@e(_@@ఐ'delayedi!YzYi"YzY@f@@k@@@@:S@e+n@i(Y2Y>@@<p@~@@@@Aei,X*XX @@@ A@LJ@E@&@@@e}@@e|@@e{P@ex@@@i;X*X2@@@@ఠ'appliediJYYiKYY@ic A@@hdl@@@eP@e@@@eP@e3iXiWiWiXiXiXiXiX@%@@@@ఠ'delayedidYYieYY@i} A@@_"@@@eP@e@@% @@@%@ @@e@ఐ*split_argsi~YYiYY@H@@Y@@@e@_@@Zk@@@eP@e@e Fe@@@e@@@e@@e@@@e@iS@@@e@_aY@@@e@@e@@e@@eR@ɐภfiYYiYY@f@@@Y@@@eQ@eb@@ఐ $argsiYYiYY@@@_@F@eaeB@@@e@@@e@@e@@@eQ@eQ@e@@c@@@@@@eQ@e@A@iYY#@@@ఠ-function_modeiYZiYZ@j A@@13@@@eP@e3iiiiiiii@@@@@@@@ఐ 'appliedj ZZ#j ZZ*@ @@i{e)@@@e@@@e@Ġ̰jZ0Z<j Z0Z>@_@@@@ie<@@@e@@@e+@@ieC@@@e@@@e2@@@ภ%Guardj6Z0ZBj7Z0ZG@*@@@@;@ĠjBZHZVjCZHZX@_@jGZHZTjHZHZU@@e`@@@eN@@jOZHZYjPZHZZ@@iek@@@e@@@eZ@@@ @@iŠes@@@e@@@eb@@i̠ez@@@e@@@ei@@@ภ+DereferencejmZHZ^jnZHZi@@@@wr@@@AjqZZ@@yt@A@jsYY@@ఐ$joinj}ZuZ}j~ZuZ@ư@@@@@@f=@@@f<@@@f;@@f:3jjjjjjjj@@@@@@@ภnjZuZjZ[A`Rఐ"<<jZuZjZuZ@-@@@@@@fc@@@@fb@@@fa@@f`@@f_'@@ఐ*expression(jZuZ@*@@@ @@@f@@@f@@f=@@ఐ(!ejZuZjZuZ@@@"@@@fT@fT@fQ@@G @@ @@@fU@@ఐ-function_modejZuZjZuZ@_@@2&@@@fe@@[@@@@@fi@ภҰjZZdA`ఐ"<<kZZkZZ@@@@@@@f@@@@f@@@f@@f@@f@@ఐ$list'k"ZZ@)@@@@r@@@gS@f@@@f@@f@ @@@fw@@@f@@f@@f@@ఐz*expressionkCZZkDZZ@@@@@@@g@@@g@@g @@ఐ'appliedkXZZkYZZ@Y@@:@@@fT@gT@g@@i @@@@@g@@ภ+DereferencekpZZkqZZ@@@@2@@@g)@@|@@z@@@g0@ภ WkZZAa:ఐ"<<kZZkZ[@@@@@@@gM@@@@gL@@@gK@@gJ@@gI@@ఐ<$list'kZZ@ )@@@@@@@gS@gm@@@go@@gn@  @@@gl@@@gk@@gj@@gi2@@ఐ*expressionkZZkZZ@@@@@@@g@@@g@@gG@@ఐy'delayedkZZkZZ@ݰ@@::@@@gT@gT@g\@@i @@*@@@g`@@ภ%GuardkZ[kZ[@+@@@30@@@go@@|@@@@@gs@ภmAa@nA@kt!@@@gA@@@gBP@g@@xA@k~+@@@f@@@fP@g@@@A@k5@@@fW@@@fXP@f@@l$ZuZ@@A@@@@fO@@@fNP@fV@@@@@@@gP@fM@@@7@L@@@@@@Ġ*Texp_tuplelA[[lB[[@_ఠ%exprsglJ[[lK[[@lcA@@_@__@@@^@@@^@gu@@@^@@^@@@^3l_l^l^l_l_l_l_l_@j@@@@@#@@e@@@^@@e@@@^ @@@ఐk"<<ls["[Mlt["[O@@@@@@@g@@@@g@@@g@@g@@g3llllllll@?8@9@:@@@@ఐ'$listl["[(l["[,@ @@@@@@@h Q@g@@@g@@g@ @@@g@@@g@@g@@g'@@ఐ렐*expressionl["[-l["[7@@@@@@@h@@@h@@h<@@డkT$List#mapl["[9l["[=@ l["[>l["[A@@@@@@@`!` @@@h?@@@h>R@h9@UR@h@R@h7@@h;R@h'R@h%@@h(@@@@h& @@@h$@@h#@@h"x@@డk#sndm["[Bm["[E@@@!a@y@!b@w@@~@@}'%field1AATޠ@@@T n n T n n5@@T@@@@J5@@h4S@h:@@ఐ堐%exprsm/["[Fm0["[K@@@_^@@@h3S@hAS@h<@@m;["[8m<["[L@@@@@h R@hBS@h2@@ @@@@@hG@@ภ%GuardmR["[PmS["[U@--@@@4@@@hV@@@@@Ġ/Texp_atomic_locmc[V[\md[V[k@`bఠ$exprhml[V[mmm[V[q@mA@@h@@@^(3mpmomompmpmpmpmp@{@@@@mw[V[smx[V[t@@`o`m@@@^*@@@^) @@m[V[vm[V[w@@`n@@@^+@@@&m[V[x@@f@@@^,@@g@@@^-@@@ఐ"<<m[|[m[|[@#@@@@@@h_@@@@h^@@@h]@@h\@@h[3mmmmmmmm@C<@=@>@@@@ఐ*expressionm[|[m[|[@@@@@@@h}@@@h|@@h{@@ఐa$exprm[|[m[|[@$@@@@@hR@hR@h.@@  @@@@@h2@@ภ%Guardm[|[m[|[@-@@@5@@@hA@@3@@B@Ġ*Texp_arraym[[m[[@] @m[[m[[@@] @@@^43mmmmmmmm@@@@ఠ%exprsin[[n[[@n A@@]i%@@@^6@@@^5@@@n[[@@g@@@^7@@g@@@^8@@@@ఠ*array_moden$[[n%[[@n= A@@5b@@@lP@h3n*n)n)n*n*n*n*n*@6,%@&@'@@@డ\;*array_kind'Typeoptn?[[n@[[@ nC[[nD[[@@@\9*expression@@@)&Lambda*array_kind@@@)@@)@\[\[6@@\N@@@@@@@h@@@h@@h7@@ఐd#expnn[[no[[@@@,@@@lR@lR@lK@@: @@*@@@lO@Ġ&Lambdan[[n[\@+Pfloatarrayn[\n[\@@;+Pfloatarray&Lambda*array_kind@@@k@@@CD@@A1lambda/lambda.mli@@@ @@@@@R@@@lw@@U@@@lz@@@ภ+Dereferencen\N\Zn\N\e@ 0@@@@Ġ&Lambdan\f\pn\f\v@)Pgenarrayn\f\wn\f\@@;)Pgenarray4@@@@D@@A,-@@@4@@@ @@}@@@l@@@@@l@@@ภ+Dereferencen]]*n]]5@ [@@@@Ġ&Lambdan]6]@n]6]F@*Paddrarrayn]6]Gn]6]Q@@;*Paddrarraya@@@AD@@AYZ@@@a@@@ @@@@@l@@@Ġ&Lambdao]6]To]6]Z@)Pintarrayo ]6][o ]6]d@@;)Pintarray~@@@BD@@Avw@@@~@@@ @@@@@l@@@@1@@@@@l@@@ภ%Guardo#]]o$]]@.@@@@@@Ao'[[@@@A@o)[[@@ఐ+"<<o3]]o4]]@@@@G@@@l@F@@@lC@@@l@@l@@l3o@o?o?o@o@o@o@o@@%@@ @@@@ఐ!砐$listoR]]oS]]@̰@@@@@@@m3Q@m!@@@m @@m @! @@@m!@@@m@@m@@m'@@ఐ*expressionot]]ou]]@L@@@@@@m0@@@m/@@m.<@@ఐ%exprso]]o]]@\@@!:@@@mR@m6R@m4Q@@C @@!@@@m;U@@ఐ~*array_modeo]]o]]@_@@6@@@mEe@@W@@D@@@mIP@lk@ @@H@Ġ.Texp_constructo]]o]^@f@o]^o]^@@ff@@@^B@@@^A3oooooooo@@@@ఠ$descjo]^ o]^@oA@@f@@@^C@ఠ%exprsko]^o]^@oA@@fj@@@^E@@@^D!@@@0o]^@@i^@@@^F&@@ia@@@^G)@@@@ఠ2access_constructoro^^$o^^6@pA@@@@@mvP@mJ3pooppppp@ ;4@5@6.'@(@)@@@ఐD$descp^9^Gp^9^K@@@f@@@mO@mM3pppppppp@@@@(cstr_tagp ^9^Lp!^9^T@fȰ@@f@@@mN @Ġ.Cstr_extensionp0^Z^dp1^Z^r@;.Cstr_extensionf @$Path!t@@@"fu@@@"@BBAC@Afk  fk  &@@@fW@ఠ#pthpN^Z^tpO^Z^w@pgA@@@@@mU:@@pX^Z^ypY^Z^z@@@@@mVB@@@.p^^Z^{@@f@@@mWG@@f@@@mXJ@@@ఐf"<<pn^^po^^@@@@@@@mc@@@@mb~@@@ma@@m`@@m_3p{pzpzp{p{p{p{p{@|6/@0@1@@@@ఐꠐ$pathp^^p^^@@@@@@@m@@@m@@m@@ఐT#pthp^^p^^@$@@@@@mU@mU@m.@@  @@@@@m2@@ภ+Dereferencep^^p^^@<@@@7@@@mA@@3@@B@@p^^p^^@@gd@@@mZ@@gg@@@m[@@@ఐ/%emptyp^^p^^@԰@@@@@Ap^9^A@@@A@p^^ @@@ఠ"m'p^^p^^@pA@@8$@@@mP@m3pppppppp@@@@@@ఐ.$descp^^p^^@@@g@@@m@m@(cstr_tagq ^^q ^^@g@@g@@@m @Ġ,Cstr_unboxedq^^q^^@f@@@@g@@@m0@@g@@@m3@@@ภ&Returnq(__ q)__@;H7@@@CE@@AH@@H@@@C>@Ġ-Cstr_constantq;__q<__)@;-Cstr_constantg@g@@@"@A@AC@Agh"gh6@@@gT@@qL__*qM__+@@@@@mb@@@@@g@@@mf@@f@Ġ*Cstr_blockq]__.q^__8@;*Cstr_blockg7@g@@@"@AAAC@Agijlgij@@@h U@@qn__9qo__:@@@@@m@@@@@h@@@m@@@@= @@h@@@m@Ġ.Cstr_extensionq__=q__K@S@q__Lq__M@@U@@@m@@@Q@@@m@@@ @@h/@@@m@@@@\@@h3@@@m@@@ภ%Guardq_Q_[q_Q_`@1{@@@@@@Aq^^@@@A@q^^@@ఐ$joinq_j_pq_j_t@@@@Ϡ@@@m@@@m@@@m@@m3qqqqqqqq@@@@@@@ภq_w_q__Agఐڠ2access_constructor q_w_@ @@@@@n @ภq__Agఐ⠐"<<q__q__@t@@@@@@n)@@@@n(@@@n'@@n&@@n%;@@ఐ$$list'r__@")@@@@V@@@ntS@nI$y@@@nK@@nJ@$l @@@nH$[@@@nG@@nF@@nE^@@ఐ^*expressionr'__r(__@@@@t@@@nqq@@@np@@nos@@ఐ_%exprsr<__r=__@7@@$:@@@n`T@nwT@nu@@i @@$@@@n|@@ఐo"m'rU__rV__@@@9@@@n@@}@@_@@@n@ภre__Ah@A@qՠ@@@n@@@nP@n@@A@qߠ@@@n@@@nP@n@@r{_j_u@@@@@m@@@mP@m@@@@!@@@nP@m@@@@@@&@Ġ,Texp_variantr__r__@f@r__r__@@f@@@^N3rrrrrrrr@@@@ఠ"eolr__r__@rA@@f"m@@@^P@@@^O@@@r__@@l*@@@^Q@@l-@@@^R@@@ఐ"<<r`Z`ur`Z`w@O@@@@@@n@@@@n@@@n@@n@@n3rrrrrrrr@2+@,@-@@@@ఐ'&optionr`Z``r`Z`f@%d@@@@5@@@nQ@n&@@@n@@n@& @@@n&@@@n@@n@@n'@@ఐ=*expressions`Z`gs`Z`q@ް@@@S@@@nP@@@n@@n<@@ఐr"eos`Z`rs`Z`t@F@@':@@@nR@nR@nQ@@C @@'@@@oU@@ภ%Guards3`Z`xs4`Z`}@3@@@:n@@@od@@V@@e@Ġ+Texp_recordsD`~`sE`~`@hEঠ&fieldssO`~`sP`~`@3h?hN@@@^YhA@@@3h$h#@@AhAh@h3hh@@BhAh @h hAh,@h)ఠ"esms^`~`s_`~`@swA@@hN@hK@@@^g@hH@@@^h@@^f@@@^e3sosnsnsososososo@z@@@.representationsy``sz``@3hIhx@@@^]hK@@A3hnhm@@@h1AhU@hR3hAh@@@Bh2Ah6@h3h2AhH@hEఠ#repns``s``@sA@@hX@@@^l@3extended_expressions`~`s`~`@3hWh@@@^[hY@@B3hh@@@hMAhq@hn3hkhj@@AhNAhd@hahNAhR@hOఠ"eoos`~`s`~`@sA@@hfn@@@^r@@@^q=@@@s`~`s``@@h@@@^tP@^sE@@@t@@m,@@@^uI@@m/@@@^vL@@@@ఠ*field_modes``s``@sA@@;@@@o5P@o3ssssssss@{t@u@vRK@L@M70@1@2@@@ఐY#reps`as`a @ @@h@@@o@Ġ,Record_floatsaasaa'@;,Record_floath @@@ABC@AqlCSkSmqmCSkS{@@@q@@@  @@h@@@o-@@h@@@o0@@@ภ+Dereferencetaa+taa6@@@@>9@Ġ.Record_unboxedta7aCta7aQ@h-@ta7aRta7aS@@h*@@@oM@@@ @@h@@@o Q@@h@@@o!T@@@ภ&Returnt+a7aWt,a7a]@@@@b]@Ġ.Record_regulart<a^ajt=a^ax@;.Record_regularhU@@@@BC@AqBSS#qBSS1@@@q@@@  @@i@@@o%x@@x@Ġ.Record_inlinedtQa^a{tRa^a@;.Record_inlinedhj@#intA@@@@AABC@AqESTqEST@@@q@@tda^atea^a@@@@@o)@@@@@i6@@@o*@@@@2 @@i:@@@o+@Ġ0Record_extensiontyaatzaa@;0Record_extensionh@$Path!t@@@@ABBC@AqFT<T>qFT<TZ@@@r@@taataa@@@@@o/@@@@@i`@@@o0@@@@\ @@id@@@o2@@@ภ%Guardtaataa@4|@@@@@@At`a@@@A@t``@@@ఠ%fieldtaataa@tA@@@@@@oJ@i@@@oSP@oK@@oLP@oG @@@ovP@oH@@oIP@oF3tttttttt@ @@@@@࣠@A@ఠ&_labeltaataa@tA@@%3tttttttt@8taatbbE@@@@@ఠ)field_deftaataa@u A@@3@@taataa@@@>@<@@oN@@ @@ఐ)field_defu aau aa@J@@@@K3u u u u u u u u @,5S@/@0$@@@Ġ$Keptuabuab @;$Kepti@n[)type_expr@@@ Ѡo3,mutable_flag@@@ @B@@B@Apl44pl44@@@p@@u6ab u7ab@@@@@oV3u8u7u7u8u8u8u8u8@,@@@@ @@@@oW@@@% @@~@@~@@@ఐ%emptyuIabuJab@H@@@Ġ*OverriddenuVbb$uWbb.@iڠ@u[bb0u\bb1@@i٠i@@@o]@@@o\U@ఠ!eukbb3ulbb4@uA@@p@@@o^c@@@usbb5@@e@@e@@@ఐ*expressionu}bb9u~bbC@U@@@@@@og@@@of@@oe3uuuuuuuu@z#@@@@@@ఐ*!eubbD@ @@@@@owT@oyT@ox@@"@@@@@Auaa@@f@A@P@p$@A@@ఐ!$joinubQbYubQb]@@@@!̠!@@@p)@@@p(!@@@p'@@p&3uuuuuuuu@ @ @ @@@@ภub`bjubbAkఐˠ"<<ub`byub`b{@]@@@@@@pO@@@@pN@@@pM@@pL@@pK'@@ఐ&~%array(ub`bo@$Y*@@@@@j@@@pS@p@j@@@p@@pS@po&g@@@pq@@pp@&Z@@@pn&I@@@pm@@pl@@pkU@@ఐi%fieldvb`bpvb`bu@_@@@@)@k@@@p@@pk@@@p@@pp@@ఐؠ"esv6b`bvv7b`bx@c@@&K@@@pT@pT@p@@{ @@&}@@@p@@ఐ*field_modevOb`b|vPb`b@@@=@@@p@@@@ Y@@@p@ภ6v_bbAlఐ b"<<vjbbvkbb@@@@ ~@@@p@ }@@@p z@@@p@@p@@p@@ఐ*&option'vbb@))@@@@@@@q"S@p*@@@p@@p@* @@@p*y@@@p@@p@@p@@ఐޠ*expressionvbbvbb@@@@@@@q@@@q@@q@@ఐ"eovbbvbb@@@*:@@@qT@q%T@q# @@i @@*@@@q*@@ภ+Dereferencevbbvbb@W@@@>@@@q9@@|@@ @@@q@"@ภvbbAl@A@vT#@@@p@@@pP@qO3@@(A@v^# @@@pC@@@pDP@p=@@vbQb^3@@##@@@p;@@@p:P@pBH@@X=@@@@@qYP@p9N@"C@@=@eD@@;@Ġ/Texp_ifthenelsewbbwbb@anఠ$condpwbbw bb@w8A@@r:@@@^~3w#w"w"w#w#w#w#w#@.@@@ఠ$ifsoqw.bbw/bb@wGA@@rI@@@^@ఠ%ifnotrw<bbw=bb@wUA@@arZ@@@^@@@^!@@@2wHbb@@p@@@^&@@p@@@^)@@@ఐ#^$joinwXccwYcc@!@@@#w#v@@@q^@@@q]#u@@@q\@@q[3wdwcwcwdwdwdwdwd@rPI@J@KB;@<@=5.@/@0@@@@ภMwvddwwdbdiAm1ఐ!z"<<wddwdd@ @@@!@@@q@!@@@q!@@@q@@q@@q+@@ఐՠ*expression(wdd@u*@@@@@@q@@@q@@qA@@ఐ$condwddwdd@I@@@@@qT@qT@qU@@G @@@@@qY@@ภ+Dereferencewddwdd&@L@@@?@@@qh@@Z@@!@@@ql@ภwd(d0cAmఐ*expression wd(d:@ @@@0@@@q-@@@q@@q@@ఐʠ$ifsowd(d;wd(d?@@@G@@@qR@qR@q@@* @@E@@@r@ภx dAdIAmƠఐ,7&option xdAdO@* @@@@g@@@rIQ@r,(@@@r @@r@, @@@r, @@@r@@r@@r@@ఐo*expressionx8dAdPx9dAdZ@@@@@@@rF@@@rE@@rD@@ఐ%ifnotxMdAd[xNdAd`@@@,H:@@@r5R@rLR@rJ@@M @@,8@@@rQ@ภxbdbdhAn@A@wҠ$@@@r@@@rP@r`@@bA@wܠ$@@@q@@@qP@r@@A@w$@@@qx@@@qyP@q@@xcc @@$$@@@qp@@@qoP@qw%@@5@@&&@Ġ-Texp_setfieldxdjdpxdjd}@jఠ"e1sxdjdxdjd@xA@@s@@@^3xxxxxxxx@@@@@xdjdxdjd@@jj@@@^@@@^ @@xdjdxdjd@@j@@@^@ఠ"e2txdjdxdjd@xA@@s@@@^#@@@4xdjd@@r@@@@^(@@rC@@@^+@@@ఐ$᠐$joinxeexee@#$@@@$$@@@ro@@@rn$@@@rm@@rl3xxxxxxxx@QJ@K@L/(@)@*@@@@ภΰxeexf)f0Anఐ""<<yeeyee@!@@@#@@@r@#@@@r#@@@r@@r@@r)@@ఐ V*expression(yee@*@@@ k@@@r h@@@r@@r?@@ఐ"e1y3eey4ee@H@@ @@@rT@rT@rS@@G @@ @@@rW@@ภ+DereferenceyJeeyKef@@@@@@@@rf@@Z@@#T@@@rj@ภ1yZff cAoఐ#]"<<yeffyfff@!@@@#y@@@r@#x@@@r#u@@@r@@r@@r@@ఐ *expression'yff@ X)@@@ @@@s @@@s@@s@@ఐҠ"e2yffyff@@@ @@@s+T@s-T@s,@@F @@ @@@s2@@ภ+Dereferenceyffyff'@/@@@@@@@sA@@Y@@#@@@sH@ภiyf)f/Ao\@A@y,%@@@r@@@rP@sW@@nA@y6%@@@r@@@rP@r@@yee@@%%@@@r@@@rP@r@@@@v@Ġ-Texp_sequenceyf1f7yf1fD@qoఠ"e1uyf1fFyf1fH@z A@@u @@@^3yyyyyyyy@@@@ఠ"e2vyf1fJzf1fL@zA@@u@@@^@@@ zf1fM@@s|@@@^@@s@@@^@@@ఐ&$joinzggzgg@$`@@@&6&5@@@sf@@@se&4@@@sd@@sc3z#z"z"z#z#z#z#z#@0=6@7@8/(@)@*@@@@ภ z3g"g*z4gYg`Aoఐ$7"<<z?g"g8z@g"g:@"ɰ@@@$S@@@s@$R@@@s$O@@@s@@s@@s)@@ఐ!*expression(z[g"g4@!2*@@@!@@@s!@@@s@@s?@@ఐ"e1zog"g5zpg"g7@H@@!@@@sT@sT@sS@@G @@!@@@sW@@ภ%Guardzg"g;zg"g@@:a@@@A@@@sf@@Z@@$@@@sj@ภmzgBgJcApPఐ!ؠ*expression zgBgT@!x @@@!@@@s!@@@s@@s@@ఐ"e2zgBgUzgBgW@@@"@@@tR@tR@t@@* @@"@@@t @ภvzgYg_Api@A@z9&@@@s@@@sP@t@@?A@zC&@@@s@@@sP@s@@zgg @@&&@@@sx@@@swP@s@@@@@Ġ*Texp_whilezgaggzgagq@lఠ$condwzgagszgagw@{A@@v@@@^3{{{{{{{{@ @@@ఠ$bodyx{ gagy{ gag}@{%A@@v'@@@^@@@ {gag~@@t@@@^@@t@@@^@@@ఐ'*$join{$h,h2{%h,h6@%m@@@'C'B@@@t'@@@t&'A@@@t%@@t$3{0{/{/{0{0{0{0{0@ ==6@7@8/(@)@*@@@@ภ{@h9hA{AhhApఐ%D"<<{Lh9hQ{Mh9hS@#ְ@@@%`@@@tM@%_@@@tL%\@@@tK@@tJ@@tI)@@ఐ"*expression({hh9hK@"?*@@@"@@@tk"@@@tj@@ti?@@ఐ$cond{|h9hL{}h9hP@H@@"@@@t{T@t}T@t|S@@G @@"@@@tW@@ภ+Dereference{h9hT{h9h_@@@@B@@@tf@@Z@@%@@@tj@ภz{hahicAq]ఐ%"<<{hahy{hah{@$8@@@%@@@t@%@@@t%@@@t@@t@@t@@ఐ#*expression'{hahs@")@@@#@@@t#@@@t@@t@@ఐҠ$body{haht{hahx@@@#-@@@tT@tT@t@@F @@#+@@@t@@ภ%Guard{hah|{hah@;@@@C0@@@t@@Y@@%@@@u@ภ|hhAq@A@{u("@@@t@@@tP@u@@nA@{(,@@@tA@@@tBP@t@@|h,h7@@(8(7@@@t9@@@t8P@t@@@@@ @Ġ)Texp_send|0hh|1hh@fHఠ"e1y|9hh|:hh@|RA@@wT@@@^3|=|<|<|=|=|=|=|=@!H@@@@|Dhh|Ehh@@fU@@@^ @@@|Jhh@@u@@@^@@u@@@^@@@ఐ(`$join|Zi#i)|[i#i-@&@@@(y(x@@@u@@@u(w@@@u@@u3|f|e|e|f|f|f|f|f@!r6/@0@1@@@@ภK|t i0i8|u iUi\Ar/ఐ&x"<<| i0iF| i0iH@% @@@&@@@uD@&@@@uC&@@@uB@@uA@@u@'@@ఐ#Ӡ*expression(| i0iB@#s*@@@#@@@ub#@@@ua@@u`=@@ఐw"e1| i0iC| i0iE@G@@#@@@urT@utT@usQ@@G @@#@@@uyU@@ภ+Dereference| i0iI| i0iT@J@@@D@@@ud@@Z@@&@@@uh@ภ| iUi[cArw@dA@|G(@@@u8@@@u9P@uy@@|i#i.o@@)(@@@u0@@@u/P@u7@@y@@!@Ġ*Texp_field| i]ic| i]im@fఠ!ez} i]io} i]ip@}A@@x@@@^3}}}}}}}}@"@@@@}  i]ir}  i]is@@ff@@@^@@@^ @@} i]iu} i]iv@@f@@@^@@@&} i]iw@@v@@@^@@v@@@^@@@ఐ'&"<<}.ii}/ii@%@@@'B@@@u@'A@@@u'>@@@u@@u@@u3};}:}:};};};};};@"GC<@=@>@@@@ఐ$*expression}Mii}Nii@$%@@@$@@@u$@@@u@@u@@ఐa!e}bii}cii@$@@$@@@uR@uR@u.@@  @@$@@@u2@@ภ+Dereference}yii}zij@@@@D@@@uA@@3@@"B@Ġ/Texp_setinstvar}jj}jj@nఠ#pth{}jj}jj@}A@@n@@@^3}}}}}}}}@"@@@@}jj}jj@@n@@@^ @@}jj}jj @@nn@@@^@@@^@ఠ!e|}jj!}jj"@}A@@x@@@^#@@@4}jj#@@w3@@@^(@@w6@@@^+@@@ఐ)Ԡ$join}jj}jj@(@@@))@@@u@@@u)@@@u@@u3}}}}}}}}@"QJ@K@L/(@)@*@@@@ภ}jj}jjAsఐ'"<<}jj}jj@&@@@( @@@v @( @@@v(@@@v@@v@@v)@@ఐ$o$path(~jj@$r*@@@$r@@@v>$m@@@v=@@v<?@@ఐ#pth~&jj~'jj@H@@$@@@vNT@vPT@vOS@@G @@$@@@vUW@@ภ+Dereference~=jj~>jj@@@@Ex@@@vdf@@Z@@(G@@@vkj@ภ$~MjjcAtఐ(P"<<~Xjj~Yjj@&@@@(l@@@v@(k@@@v(h@@@v@@v@@v@@ఐ%*expression'~tjj@%K)@@@%@@@v%@@@v@@v@@ఐҠ!e~jj~jj@@@%@@@vT@vT@v@@F @@%@@@v@@ภ+Dereference~jj~jj@"@@@E@@@v@@Y@@(@@@v@ภ\~jjAtO@A@~*@@@v|@@@v}P@v@@nA@~)*@@@v@@@vP@v{@@~jj@@**@@@v @@@v P@v@@@@#i@Ġ+Texp_assert~jj~jj@h{ఠ!e}~jj~jj@~A@@y@@@^3~~~~~~~~@#@@@@~jj~jk@@h@@@^ @@@~jk@@xi@@@^@@xl@@@^@@@ఐ("<<$kk$kk@'@@@)@@@v@)@@@v)@@@v@@v@@v3@$70@1@2@@@@ఐ&Z*expression#$kk$$kk@%@@@&p@@@w&m@@@w@@w@@ఐU!e8$kk9$kk@$@@&@@@w R@w"R@w!.@@  @@&@@@w'2@@ภ+DereferenceO$kkP$kk@@@@F@@@w6A@@3@@#B@Ġ)Texp_pack`%kka%kk@n1ఠ$mexp~i%kkj%kk@A@@y@@@^3mllmmmmm@$x@@@@@@@x@@@^@@x@@@^@@@ఐ%&modexp+lHlN+lHlT@%@@@%@@@w=%@@@w<@@w;3@$)"@#@$@@@@ఐ0$mexp+lHlU+lHlY@ @@&@@@wMP@wOP@wN@@# @@$=@Ġ+Texp_object,lZl`,lZlk@jఠ(clsstrct,lZlm,lZlu@A@@j@@@^3@$@@@@,lZlw,lZlx@@jj@@@^@@@^ @@@,lZly@@yA@@@^@@yD@@@^@@@ఐ&/class_structure-l}l-l}l@&@@@&@@@wT&@@@wS@@wR3@$6/@0@1@@@@ఐ=(clsstrct-l}l-l}l@ @@&@@@wdP@wfP@we@@# @@$@Ġ(Texp_try .ll .ll@iyఠ!e.ll.ll@+A@@{-@@@^3@%!@@@ఠ%cases!.ll".ll@:A@@ijݠj@@@^@@@^@@@^@ఠ)eff_cases7.ll8.ll@PA@@ijj@@@^@@@^@@@^-@@@>G.ll@@y@@@^2@@y@@@^5@@@@ఠ(case_envX8mnY8mn@qA@@@%ޠF@w@@@wP@wi@%@@@wP@wn%@@@wP@wo@@wpP@wj@@wkP@wh3rqqrrrrr@%kd@e@f]V@W@XHA@B@C@@@࣠@!cA8mn8mn@A@@+3@88mn8mn$@@@@@  @@!mA8mn8mn@A@@43@!B@@@@@@@@డ5#fst8mn8mn@@@!a@{@!b@}@@| @@{'%field0AAh@@@hmmhmm@@h~@@@@@_R@wu@&4@@@wR@ww@@wv @@wt3@:Fp@=@>@@@@ఐ&d$case8mn8mn@&h@@@&h@@@w@&a@@@w@&`@@@w@&]@@@w@@w@@w@@w~)@@ఐ!c 8mn  8mn!@l@@6@@ఐ!m8mn"8mn#@@@@C@@8mn@@@V@T@@w|S@wT@wO@@{@@YP@A@P@w@A@@ఐ-:$join49n(n.59n(n2@+}@@@-S-R@@@w@@@w-Q@@@w@@w3@??@@@@@@@@@@@@ภ%N:n5n=O=nnAw ఐ(*expression Z:n5nG@(1@@@(@@@w(@@@w@@w!@@ఐ\!en:n5nHo:n5nI@@@(@@@wR@wR@w5@@+ @@(@@@w9@ภY;nKnS4Aw<ఐ4"$list ;nKnW@2 @@@@'l;@@@x2Q@x@@@x)Q@w4@@@w@@w@3@@@w3@@@w@@w@@wg@@ఐ\(case_env;nKnX;nKn`@q@@@'5$@@@x$@'.@@@x#')@@@x"@@x!@@x @@ఐ%cases;nKna;nKnf@W@@4,F@@@xR@x3R@x0@@Y @@4@@@x8@ภ<nhnpAwఐ4$list <nhnt@2h @@@@'sl@@@xQ@xy@@@xQ@xU4h@@@xW@@xV@4[@@@xT4J@@@xS@@xR@@xQ@@ఐ(case_env<nhnu<nhn}@Ӱ@@@'$@@@x~@'@@@x}'@@@x|@@x{@@xz@@ఐ)eff_cases1<nhn~2<nhn@@@4F@@@xlR@xR@x@@Y @@4~@@@x@ภF=nnAw@A@.c@@@xI@@@xJP@x@@nA@.m@@@w@@@wP@xH@@ A@ʠ.w@@@w@@@wP@w"@@f9n(n3@@..@@@w@@@wP@w-@@="@@' @@@xP@w3@(@@'@Ġ-Texp_override>nn>nn@kఠ#pth>nn>nn@A@@k@@@_3@'@@@ఠ&fields>nn>nn@A@@k@k@@@_@kk@@@_@@@_@}@@@_@@_@@@_%@@@6>nn@@|,@@@_ *@@|/@@@_ -@@@@ఠ%fieldIppIpp@A@@@@@@x@@@x@*(@@@xP@x@@xP@x*'@@@xP@x@@xP@x3@'e^@_@`WP@Q@R@@@࣠@-3 A@@IppIpp@@%3@8IppIpp@@@@@@IppIpp@@- @@ఠ#arg IppIpp@(A@@5@@IppIpp@@@D@B@@@@x#@@  @@ఐ*`*expression)Ipp*Ipp@*@@@*v@@@x*s@@@x@@x310011111@:+Y@%@&@@@@ఐ2#argAIppB@ C@@e@@D@@_@1EA@yP@xL@A@I@ఐ/V$joinPJppQJpp@-@@@/o/n@@@x@@@x/m@@@x@@x3\[[\\\\\@x@@@@@@ภ!AjKppkMq)q0Ay%ఐ-n"<<vKppwKpp@,@@@-@@@x@-@@@x-@@@x@@x@@x'@@ఐ)$path(Kpp@)*@@@)@@@y)@@@y@@y=@@ఐ#pthKppKpp@@@* @@@y'T@y)T@y(Q@@G @@*@@@y.U@@ภ+DereferenceKppKpp@!@@@@J@@@y=d@@Z@@-@@@yDh@ภ!LpqcAyఐ-Р"<<LpqLpq@,b@@@-@@@ya@-@@@y`-@@@y_@@y^@@y]@@ఐ6$list'Lpq @4m)@@@@@m@@@yS@y@mm@@@y@@@yS@y@+Z@@@y@@yS@y6}@@@y@@y@6p#@@@y6_@@@y@@y~@@y}@@ఐc%field+Lpq ,Lpq@̰@@@@4@/@+@@@y@@y+}@@@y@@y@@ఐ&fieldsHLpqILpq@^@@6X@@@yT@yT@y@@ @@6@@@y@@ภ+Dereference`LpqaLpq'@!@@@K@@@y@@@@.j@@@y @ภ!pMq)q/Az@A@0@@@yU@@@yVP@y@@A@0@@@x@@@xP@yT&@@Jpp@@00@@@x@@@xP@x1@@A&@@),@@@yP@x7@,@@)0@Ġ-Texp_functionNq1q7Nq1qD@sఠ¶msNq1qFNq1qL@A@@ss@@@_@@@_3@)@@@ఠ$bodyNq1qNNq1qR@A@@s#@@@_@@@$Nq1qS@@~:@@@_@@~=@@@_@@@@ఠ)param_pat WrIrSWrIr\@A@@@sI@@@yP@yk@@@z P@y@@yP@y3@)E>@?@@3,@-@.@@@࣠@%param AWrIr]WrIrb@A@@3@+WrIrObsXs@@@@@  @@ఐ%param`ss%`ss*@4@@@@53@$@@@'fp_kind`ss+`ss2@3'fp_kinds@@@ 3function_param_kind@@@ @@C3,fp_arg_label 2)arg_label@@@ @@@@A=.*..=.*.F@@@3(fp_paramwp!t@@@ @@A@A>.G.K>.G.]@@@3*fp_partial"o@@@ @@B@AB..B..@@@+3+fp_newtypes+~V#locx@@@ @@@ @@@ @@D2@AI/w/{I/w/@@@3&fp_loc@~!t@@@ @@E>@AN00N00@@@@AH/U/YH/U/v@@@]R@@L@@@y\@Ġ*Tparam_patyas8sBzas8sL@;*Tparam_pat]@@@ @l@@@ @A@@B@AU1H1JU1H1a@@@@ఠ#patas8sMas8sP@A@@l@@@y3@@@@@@ @@y@@@y@@|@@@y@@@ఐ#patas8sTas8sW@@@@@3@ @@@Ġ7Tparam_optional_defaultbsXsbbsXsy@;7Tparam_optional_default=@l@@@ @@@ @BA@B@A9W11:W11@@@L@ఠ#patbsXs{bsXs~@A@@l@@@z@@bsXsbsXs@@@@@z@@@(bsXs@@@@@z@@@@@z@@@ఐ#patbsXs@@@@@ 3@'@@@@@A`ss@@3@@@@A@P@z@A@@@ఠ-param_defaulthsshss@ A@@@tt@@@{P@z-R@@@{)P@z@@zP@z3@,C<@=@>@@@࣠@%paramA!hss"hss@:!A@@3"!!"""""@))hss*vuXui@@@@@  @@ఐ%param8ist 9ist@2@@@@3398899999@$@@@'fp_kindBistCist@) @@%@@@{ @Ġ7Tparam_optional_defaultRjtt'Sjtt>@@Wjtt@XjttA@@mh@@@{  @ఠ'defaultcjttCdjttJ@|"A@@~@@@{ .@@@kjttK@@L@@@{ 3@@O@@@{ 6@@@ఐ-*expression{ptt|ptt@-S@@@-@@@{-@@@{@@{3@K)"@#@$@@@@ఐ0'defaultpttptt@ @@-@@@{*T@{,T@{+@@# @@@Ġ*Tparam_patqttqtt@/@qttqtt@@m@@@{v@@@ @@@@@{z@@@@@{}@@@ఐ1%emptyvuXud@0@@@@@Aist@@3@@@@A@P@{@A@@@ఠ(patternsxusu}xusu@#A@@1m@@@{P@{@@@{P@{3@@@@@@డv$List#mapxusuxusu@ xusuxusu@@20@@@@uh@@@{P@{'@@{@2- @@@{2,0@@@{@@{@@{+@@ఐ@)param_patxusuxusu@@@@u@@@{n-@@@{@@{@@@ఐ¶ms+xusu,xusu@B@@2[8@@@{Q@{Q@{U@@F @@_V@A@8xusuy @@@ఠ(defaultsCyuuDyuu@\$A@@2m.@@@|P@{@@@| P@{3ONNOOOOO@r@@@@@డ$List#mapbyuucyuu@ fyuugyuu@@2@@@@u@@@|P@{'@@{@2 @@@{20@@@{@@{@@{+@@ఐ-param_defaultyuuyuu@@@@u@@@|.@@@|@@|@@@ఐ¶msyuuyuu@@@2̠8@@@| Q@|Q@|U@@F @@_V@A@yuu @@@ఠ$bodyzuuzuu@%A@@.L@|iL@|3@j~w@x@y@@@ఐ.-function_bodyzuuzuu@.@@@..@@|@@ఐ$bodyzuuzuu@@@.@@@@.@A@zuu@@@ఠ!f{vv {vv @&A@@1@@@|=P@|$3@5A:@;@<@@@ఐ1"<<{vv({vv*@0@@@2@@@|*@2@@@|)2 @@@|(@@|'@@|&@@ఐ4$join{vv{vv@2`@@@4645@@@|I@@@|H44@@@|G@@|F7@@ภ'9.{vv/{vv@}ఐ$body8{vv9{vv@I@@L@ఐ(defaultsC{vvD{vv&@@@/@@@|dS@|pS@|n_@@O{vvP{vv'@@4m4l@@@|[@@@|ZS@|bk@@D @@4l@@@|~o@@ภ%Delayg{vv+h{vv0@;_N@@@AE@@A_@@_@@@O@@@|@@Y@@@A@q{vv @@࣠@!mA}|v4v?~|v4v@@'A@@=Y@@@|3@@@@@@@  @@@ఠ#env}vDvQ}vDvT@(A@@=k@@@|Q@|3@*=y@@@|@$@%@@@ఐǠ!f}vDvW}vDvX@)@@2@@@|@@ఐC!m}vDvY}vDvZ@@@=@+@|R@|R@|*@@ @@0+@A@}vDvM @@ఐ>.remove_patlist~v^vg~v^vu@=@@@>~?s@@@|P@|@@@|@@@|@?@@@|@@|@@|3@P`Y@Z@[@@@@ఐ((patterns~v^vv~v^v~@@@>?(@@@|@@@|Q@|Q@|@@ఐ#env~v^v~v^v@&@@=@@@|Q@|Q@|Q@|2@@L @@3@W @@@"|v4v:#~v^v@@-@@@|O@|@@@;@P@@p@ @@@ @@ L@ @@ @/ @@-G@Ġ)Texp_lazy9vv:vv@wfఠ!eBvvCvv@[A@@]@@@_3FEEFFFFF@.Q@@@@@@@@@@_@@@@@_@@@@ఠ)lazy_mode[w!w+\w!w4@t)A@@P@@@}ZP@|3a``aaaaa@.m(!@"@#@@@డwr6classify_lazy_argument'Typeoptvw!w=ww!wD@ zw!wE{w!w[@@wp@@@wp@@@|Рwk@wj@wi@whРwg@wf@@@@|A@@@|@@@|A@@@|@@|:@@ఐf!ew!w\w!w]@D@@w@@@|R@|R@|N@@= @@Рw@w@w@wРw@w@@@@|A@@@|@@@|A@@@|j@4Constant_or_function@Рw@w@w@wРw@w@@@@} A@@@} @@@}A@@wcwmwcw@@@}@@@*Identifier@wwww@@Рw֐@wՐ@@@@}A@@@}@Рw@w@w@wРw@w@@@@}A@@@}@@@}A@@'ww'@@@}@@@@7*@@Рx@x@x@xРx@x@@@@}!A@@@} @@@}A@@@}@=Float_that_cannot_be_shortcut@Рx2@x1@x0@x/Рx.@x-@@@@}/A@@@}.@@@}-A@@fwwgww@@@},@@@@w@@РxS@xR@xQ@xPРxO@xN@@@@}8A@@@}7@@@}6A@@@}5"@@@ภ&Returnwwww@d@@@0+@%Other@Рx}@x|@x{@xzРxy@xx@@@@}JA@@@}I@@@}HA@@wwww@@@}GQ@@Рx@x@x@xРx@x@@@@}OA@@@}N@@@}MA@@@}Ll@@@ภ%Delaywwww@o@@@zu@@@Aw!w7@@|w@A@w!w'@@ఐ4ޠ"<<xxxx@3p@@@4@@@}d@4@@@}c4@@@}b@@}a@@}`3@@@@@@@ఐ2<*expressionxx xx@1ݰ@@@2R@@@}2O@@@}@@}@@ఐؠ!exxxx@@@2i@@@}R@}R@}.@@  @@2g@@@}2@@ఐנ)lazy_mode2xx3xx$@<@@Rm@@@}B@@4@@/@@@}P@}wH@c @@/@Ġ*Texp_letopIx%x+Jx%x5@sঠ$let_Tx%x6Ux%x:A3st@@@_#s@@@3ss@@AsAs@s3ss@@BsAs@s3ss@@CsAs@s3ss@@DsAs@ssAs@sఠ@{A@t@@@_,3eddeeeee@0p@@@$andsox%x<px%x@A3tt @@@_%t@@A3tt@@@sAt@t 3ss@@BsAs@s3ss@@CsAs@s3ss@@DsAs@ssAt@tఠ@A@tt!@@@_2@@@_1@$bodyx%xBx%xFA3tt>@@@_'t@@C3t4t3@@@sAt.@t+3t(t'@@AsAt@t3tt@@BsAt@t3ss@@DsAs@ssAt@tఠ@A@vSvB@@@_8@@@_7=@@A\x%xJ@@tW@@@_:P@_9D@@@d@@!@@@_;H@@$@@@_<K@@@@ఠ(case_envxNxZxNxb@*A@@@1CR@}@@@}P@}@1A@@@}P@}1>@@@}P@}@@}P@}@@}P@}3@0}z@|@{c`@b@aFC@E@D@@@࣠@!cAxNxcxNxd@+A@@+3@8xNxVxNxw@@@@@  @@!mAxNxexNxf@,A@@43@!B@@@@@@@@డ#fstxNxixNxl@ e@@@@FR@}@1@@@}R@}@@} @@}3!  !!!!!@!-W@$@%@@@@ఐ1$case3xNxn4xNxr@1@@@1q@@@}@1@@@}@1@@@}@1@@@}@@}@@}@@})@@ఐn!cWxNxsXxNxt@S@@6@@ఐg!mdxNxuexNxv@@@@C@@hxNxmt@@@V@T@@}S@}T@}O@@b@@YP@A@P@}@A@@ఐ8$joinx{xx{x@6ɰ@@@88@@@}@@@}8@@@}@@}3@@@@@@@ภ*qxxxxAUఐ6"<<xxxx@50@@@6@@@~ @6@@@~6@@@~@@~@@~'@@ఐ?W$list(xx@=;*@@@@3@@@~TS@~)?5@@@~+@@~*@?( @@@~(?@@@~'@@~&@@~%J@@ఐ3*binding_opxxxx@3@@@3@@@~Q3@@@~P@@~O_@@ภ,xxxx@ఐ$let_xxxx@$@@;T@~\v@ఐ$ands xxxx@0@@OU@~V@@@~[T@~_T@~]@@xxxx@@?uZ@@@~@T@~Z@@@@?e@@@~d@@ภ+Dereference0xx1xx@*@@@Tk@@@~s@@@@7:@@@~z@ภ+@xxAఐ7C"<<KxxLxx@5հ@@@7_@@@~@7^@@@~7[@@@~@@~@@~@@ఐ(case_env'gxx@װ)@@@2x@@@~S@~@@@~@2@@@~2@@@~@@~@@~@@ఐ蠐$bodyxxxx@@@3 "@@@~T@~T@~@@R @@@3@@@~2@@@~@@~ @@ภ%Delayxxxx@<@@@T@@@~@@j@@7@@@~@ภ*`xxAS@A@#9@@@~@@@~P@~/@@$A@-9@@@}@@@}P@~9@@x{x/@@99@@@}@@@}P@}D@@T9@@2o@@@~P@}J@?@@2s@Ġ0Texp_unreachablexxxy@~@@@@[@@@_@@@^@@@_A@@@ఐ8N%emptyy@yFy@yK@7@@2@Ġ:Texp_extension_constructoryLyRyLyl@ఠ$_lid yLyn yLyr@#A@@@@@_I@@@_H3@3@@@ఠ#pthyLytyLyw@6A@@@@@_J@@@$%yLyx@@@@@_K@@@@@_L@@@ఐ8-"<<5y|y6y|y@6@@@8I@@@@8H@@@8E@@@@@@@3BAABBBBB@3OB;@<@=0)@*@+@@@@ఐ4$pathVy|yWy|y@4@@@4@@@%4@@@$@@#@@ఐN#pthky|yly|y@$@@4@@@5R@7R@60@@  @@4@@@<4@@ภ+Dereferencey|yy|y@,@@@U@@@KC@@3@@3"D@Ġ0Texp_struct_itemyyyy@ఠ"siyyyy@A@@@@@_R3@ఠ!eyyyy@A@@@@@_S3@@@yy@@'@@@_T3@@*@@@_U3@@@ఐ7E">>yyyy@6@@@7_@@@T@7^@@@S7]@@@R@@Q@@P3@3=6@7@80)@*@+@@@@ఐ5.structure_itemyyyy@5@@@5@@@t5@@@s@@r@@ఐ\"siyyyy@%@@53@@@R@R@0@@  @@51@@@4@@ఐ6I*expressionyyyy@5@@@6_@@@6\@@@@@K@@ఐ}!e'yy(yy@S@@6v@@@R@R@_@@  @@6t@@@c@@S@@3d@@@A7:MM@@3@@@D387788888@4C@@@=:MM@б@г626l6k66h6e@69@@@]H676d@г3栐6c6b@3@@@]I6>6_@@ @@]J6@6^@/A@@@6@@@Q6@@@P@@OL@L6K@@@b9MuMu;@6<6<6,6+@6*6-@@6964@@\3hgghhhhh@6@@@࣠@$bodyyAwzz$xzz(@-A@@6I3xwwxxxxx@6e@@@@@@ఐ$bodyz+z3z+z7@6X@@@@6Y3@6v@@@Ġ.Tfunction_bodyz=zAz=zO@;.Tfunction_body}@@@ @@@@ @A@@B@A]22]22@@@,@ఠ$bodyzz=zPz=zT@.A@@@@@X3@*@@@@@ @@6@@6@@@ఐ6*expression{{{{#@6@@@7 @@@o7 @@@n@@m3@A#@@@@@@ఐ*$body{{${{(@ @@7'@@@P@P@@@# @@6@Ġ/Tfunction_cases{){-{){<@;/Tfunction_casesV@~U@@@ @AA@B@An^22of33@@;@@%cases@@`zz@@@ @@@ @@@ Ű_23_23@@@'partial@@z@@@ Ȱ`33!`332@@@%param@@^!t@@@ ɰa333;a333J@@@#loc@@!t@@@ ʰb3K3Sb3K3c@@@)exp_extra@@@@@ @@@ ˰c3d3lc3d3@@@*attributes@@@@@ Ͱd33d33@@@@AA@@@@@b@@@lBA@ঠ%cases`{){?a{){DA3bq@@@]d@@@3SR@@AAO@L3IH@@BAB@?3<;@@CA5@23/.@@DA&@#3  @@EA@A^@[ఠ{@/A@p{*{@@@f@@@e@@@d@@A~{){={){I@@@@@hP@g@@@@@7T@@7T@@@ఐ<$join||||@:ذ@@@<<@@@@@@<@@@@@3@2/@1@0@@@@డ6$List#map||||@ ||||@@;@@@@6;{e@@@P@@@@P@<@@@P@P@@@@;@@@;@@@@@@@;@@࣠@!c|A||||@0A@@.3@M@@@@@@$mode}A||||@1A@@6k@@@P@3@b!E@@@@@@  @@డ#fst ||||@`@@@@E@@@P@P@S@ @6@@@S@@@@@3%$$%%%%%@*;1@2@3@@@@ఐ6$case7||8||@6@@@6}@@@@6@@@@6@@@Π@6@@@@@@@@@)@@ఐw!c[||\||@\@@6@@ఐu$modeh||i||@@@@qC@@l||m||@@@`@U@@T@U@P@@l @@cQ@z||{||@@@@@Q@Q@@@ఐ%cases||||@@@<@@@Q@Q@@@ @@==@@@@@P@Q@@@@@8l@@@Az+z-@@8n3@@@@0A@@8y8t@@L@ 0@@@zz@@8c@8o3@8@@@8s8s8e8d@8c@8r@@@[8o@@@[@@[8nб@г8})Typedtree||||@8||||@@@8@@@[" @@г8)term_judg||||@@8@@@[.@@@@@[1@@88A@@@8@@@]8@@@]@@\;@࣠@#bop~A|}|}@2A@@k8@@@3@8@@@@  @@ఐ>$join }} }}@,>+@@@"@@@!>*@@@ @@3@9-#@@@@'@(@@@@ภ0*}}+}}?Aఐ8$path 6}}@8@@@8@@@F8@@@E@@D$@@ఐW#bopL}}M}}@0@@z@@@Z@X8@+bop_op_pathX}}Y}}&@3+bop_op_pathz@@@ 1!t@@@ @@@ 3+bop_op_name r#loc@@@ @@@ @@A @Ar55r550@@@3*bop_op_val1value_description@@@ @@B@As5155s515Z@@@3+bop_op_type()type_expr@@@ @@C%@At5[5_t5[5}@@@3'bop_exp4@@@ @@D.@A w55 w56 @@@3'bop_loc=!t@@@ @@E:@Ax6 6x6 6%@@(@@Aq44q45@@,@\O@@9@@@VP@[P@Y@@W@@9@@@`@ภ0}}(Asఐ9*expression }}2@9 @@@:@@@{: @@@z@@y@@ఐ堐#bop}}3}}6@@@{}@@@@@'bop_exp}}7}}>@Z@@:5@@@P@P@@@8 @@:3@@@@ภ/A@A@i?@@@q@@@rN@@@LA@s? @@@<@@@=N@p@@}}@@?,?+@@@4@@@3N@;@@ @@H@@@N@2@!||@б@г+ed9a^@2@@@0]@г\[@@@@7X@@ @@9W@A@@@9@@@9@@@@@L@D@@@F||@@9@93IHHIIIII@:@@@9999@9@9@@@[9@@@[@@[9б@г:)Typedtreed}A}We}A}`@: h}A}ai}A}p@@@:@@@[" @@г:)term_judgu}A}tv}A}}@@:@@@[.@@@@@[1@@::A@@@:)@@@]:&@@@]@@];@࣠@"csA}}}}@3A@@:>@@@3@:@@@@  @@ఐF<$list}}}}@D!@@@@:E@@@M@F@@@@@@F @@@E@@@@@@@3@:6,@@@@0@1@@@@ఐ:e+class_field}}}}@:i@@@:i@@@:f@@@@@@@ఐW"cs}}}}@'@@~@@@@/@+cstr_fields}}}}@3+cstr_fields~@@@ W+class_field@@@ @@@ @@A3)cstr_self{@@@ @@@@A999:@@@3)cstr_typeH/class_signature@@@ @@B@A:(:+:(:L@@@3*cstr_meths%U%Meths!t`!t@@@ @@@ @@C'@A:M:P:M:r@@@@A:: ::'@@@M@@@F@@@N@N@|@@I@@I#@@@N@@C}}Q@б@г:@@@@@г@@@@@@ @@@jA@@@; @@@;@@@@@ L@ @@@h}A}Av@@:@;3kjjkkkkk@;@@@; ; ::@:@;@@@[;@@@[@@[;б@г;)Typedtree}}}}@;}}}}@@@;"@@@[" @@г; )term_judg}}}}@@;(@@@[.@@@@@[1@@;+;*A@@@;8@@@];5@@@]@@];@࣠@"cfA}}}}@4A@@';M@@@3@;@@@@  @@ఐ"cf}}}}@@@@@@@@@@@#@!3@;, @@@'cf_desc}}}~@3'cf_desc@@@ n0class_field_desc@@@ @@@ 3&cf_loc X!t@@@ @@A @Ah::i::@@{@3-cf_attributes=@@@ @@B@Aq::r::@@@@Au::v::@@@9&@@ @@@"0@Ġ+Tcf_inherit~~ ~~@;+Tcf_inherit1@@@ 8@#-override_flag@@@ *class_expr@@@ c@@@ !@@@ @q@@@ $@z!t@@@ %@@ #@@@ "@@@@ (@!t@@@ )@@ '@@@ &@E@@F@A;g;k;;@@@@@b~~c~~@@K@@@33dccddddd@@@@ఠ"ceo~~p~~@5A@@T@@@4@ఠ&_super}~~ ~~~&@6A@@\[@@@6@@@5!@ఠ)_inh_vars~~(~~1@7A@@d@c@@@9@b@@@:@@8@@@7<@ఠ*_inh_meths~~3~~=@8A@@i@h@@@=@g@@@>@@<@@@;W@@@~~>@@@@@?\@@@@@@_@@@ఐ?Ǡ"<<~B~V~B~X@>Y@@@?@@@@?@@@?@@@@@@@3@ yr@s@tle@f@g[T@U@VA:@;@<@@@@ఐ;*class_expr~B~H~B~R@;@@@;@@@;@@@@@ @@ఐ"ce ~B~S ~B~U@'@@;@@@R@R@4@@  @@;@@@8@@ภ+Dereference ~B~Y!~B~d@3@@@][@@@G@@3@@K @@@L@Ġ'Tcf_val5~e~k6~e~r@;'Tcf_val$@D#locy@@@ +@@@ *O,mutable_flag@@@ ,!t@@@ -0class_field_kind@@@ .$boolE@@@ /@EA@F@A<#<%<#@@@M@ఠ#cfk~e~~e~@;A@@E@@@N%@@~e~~e~@@G@@@O-@@@n~e~@@@@@P2@@@@@Q5@@@ఐ=60class_field_kind~~~~@=:@@@=:@@@=7@@@@@3@\U@V@WJC@D@E5.@/@0@@@@ఐ<#cfk~~~~@ @@=X@@@P@P@@@' @@@Ġ*Tcf_method~~~~@;*Tcf_method@#loc(@@@ 1@@@ 0,private_flag@@@ 2@@@ 3@CB@F@At==>>>>>@k)"@#@$@@@@ఐ0#cfkN~~O~~@ @@=@@@P@P@@@# @@2@Ġ.Tcf_constraintc~~d~~@;.Tcf_constraintR@)core_type@@@ 4@@@ 5@BC@F@A<<<<@@@@@y~~z~~@@@@@dp@@@@@@eu@@@! @@@@@fy@@@@@g|@@@ఐA렐%empty~~ @A@@m@Ġ/Tcf_initializer  @;/Tcf_initializer@@@@ 6@AD@F@A<<<<@@@0@ఠ!e   !@=A@@@@@l@@@@@@@@m@@@@@n@@@ఐA"<<%8%:@@S@@@A@@@ @A@@@A@@@@@@@3@-&@'@(@@@@ఐ?*expression%+%5@>@@@?5@@@'?2@@@&@@%@@ఐK!e%6%7@$@@?L@@@7R@9R@8.@@  @@?J@@@>2@@ภ+Dereference%;%F@5@@@_O@@@MA@@3@@B@Ġ-Tcf_attribute%GM&GZ@;-Tcf_attribute@)attribute@@@ 7@AE@F@A<<<=@@@@@7G[8G\@@@@@se@@@@@Y@@@ti@@\@@@ul@@@ఐB%emptyJ`fK`k@BI@@&v@@@AN}}@@(@@@3ONNOOOOO@{@@@T}} @б@г۠>@@@@@г=@A@@@@@ @@@#A@@@?@@@?@@@@@L@@@@y}}/@@>@?3|{{|||||@?@@@??>>@>@?@@@[?@@@[@@[?б@г?)Typedtreemm@?mm@@@? @@@[" @@г?)term_judgmm@@?&@@@[.@@@@@[1@@?)?(A@@@?6@@@] ?3@@@] @@];@࣠@#cfkA@>A@@8?K@@@3@?@@@@  @@ఐ#cfk@@@@@@@@@@@3@?( @@@Ġ,Tcfk_virtual@;,Tcfk_virtual@@@ @@@@ @A@@B@Ar;;s;;@@@@@@@@@@3@$@@@@@@@A@@@@@D@@@@@@ఐCq%empty@C@@M@@@@Ġ-Tcfk_concrete()@;-Tcfk_concrete8@7-override_flag@@@ J@@@ @BA@B@A;;!;;N@@@@@>?@@@@@_@ఠ!eJK@c?A@@e@@@m@@@*R@@@@@r@@@@@u@@@ఐCZ"<<b c !@A@@@Cv@@@@Cu@@@Cr@@@@@@@3onnooooo@.'@(@)@@@@ఐ@*expression  @@Y@@@@@@@@@@@@@@@ఐL!e  @$@@@@@@R@R@.@@  @@@@@@2@@ภ+Dereference " -@70@@@`@@@A@@3@@B@@@A@@@@@f@ @б@г10@E-*@@@@)@г('@@@@$@@ @@#@&A@@@@Z@@@s@W@@@r@@qL@n@@@mm2@@@J@@V3@A#@@@@Z@Z@L@K@@J@@Y@@@[@V@@@[@@[@Uб@г@d)Typedtree/</E@@k/F/Q@@@@s@@@[" @@г@q)term_judg/U/^@@@y@@@[.@@@@@[1@@@|@{A@@@@@@@] @@@@] @@] ;@࣠@$mexpA+ag,ak@D@A@@@@@@310011111@A@@@@  @@ఐ$mexpBauCay@@@@~@@@@@@@@3KJJKKKKK@A9, @@@(mod_descTazUa@|ư@@|@@@ @Ġ*Tmod_identde@|ఠ#pthmn@AA@@|@@@3qppqqqqq@&@@@@xy@@||@@@@@@ @@@@@|@@@@@|@@@@@@ఐ@$path@@@@@@@@@@@@@@@3@P6/@0@1@@@@ఐ=#pth@ @@A @@@P@P@@@# @@O@@@@Ġ.Tmod_structure@|eఠ!s@BA@@|m@@@3@@@@@@@@}@@@@@@}C@@@@@@ఐA,)structure@A0@@@A0@@@A-@@@@@3@)"@#@$@@@@ఐ0!s@ @@AJ@@@P@P@@@# @@R@Ġ,Tmod_functor@|@@@|@@@3@@@@ఠ!e#$@<CA@@@@@@@@+@@}@@@@@}@@@@@@ఐE3"<<; <@CŰ@@@EO@@@ @EN@@@EK@@@@@@@3HGGHHHHH@.'@(@)@@@@ఐAʠ&modexpZ[ @Aΰ@@@A@@@'A@@@&@@%@@ఐL!eo p @$@@A@@@7R@9R@8.@@  @@A@@@>2@@ภ%Delay@@@@b@@@MA@@3@@B@Ġ*Tmod_apply%@|Πఠ!f'(@DA@@V@@@3@Y@@@ఠ!p*+@EA@@e@@@@@-.@@|@@@@@@(/@@~+@@@@@~.@@@@@@ఐGՠ$join393=@F@@@GG@@@U@@@TG@@@S@@R3@E>@?@@70@1@2@@@@ภ9°@HAఐE"<<@Q@S@D@@@F @@@{@F @@@zF@@@y@@x@@w)@@ఐB&modexp(@N@B*@@@B@@@B@@@@@?@@ఐ!f'@O(@P@H@@B@@@T@T@S@@G @@B@@@W@@ภ+Dereference>@T?@_@9@@@cy@@@f@@Z@@FH@@@j@ภ:%NaicAఐFQ"<<YarZat@D@@@Fm@@@@Fl@@@Fi@@@@@@@@@ఐB堐&modexp'uao@B)@@@B@@@B@@@@@@@ఐڠ!papaq@@@B@@@T@T@@@F @@B@@@@@ภ+Dereferenceaua@:#@@@c@@@'@@Y@@F@@@.@ภ9]AP@A@ H@@@@@@P@=@@nA@*H@@@o@@@pP@@@3>@@HH@@@g@@@fP@n@@@@@Ġ/Tmod_apply_unit@}Ϡఠ!f@FA@@@@@3@@@@@@@@X@@@@@[@@@@@@ఐF"<<@E@@@G@@@M@G@@@LG @@@K@@J@@I3      @.'@(@)@@@@ఐC&modexp@C@@@C@@@kC@@@j@@i@@ఐL!f01@$@@C@@@{R@}R@|.@@  @@C@@@2@@ภ+DereferenceGH@:@@@d@@@A@@3@@B@Ġ/Tmod_constraintXY@~ఠ$mexpab@zGA@@@@@3eddeeeee@@@@@lm@@~*@@@ @@tu@@~+@@@@ఠ#coe@HA@@~@@@@@@0@@@@@$@@@@@'@@@Aఠ(coercion@JA@@@~@@@P@@@d@@@P@G@@@P@ϐ@@P@P@@@@@3@j\U@V@W>7@8@9@@@࣠@#coeA@KA@@+3@7@2@/ @@Q@@@Q@@9@:@@@@@@!kA  @LA@@=3@&G@@@@@@@@ఐ.#coe@@@U3@Q@@@@@Ġ,Tcoerce_none&2@~U@@@@e3@@@@@f@@@ఐ2!k6@6A@@@k @@ภ&Return6B6H@,@@@eU@@@@@@@l@Ġ1Tcoerce_structure-IS.Id@~1@2Ie3If@@~3@~2@@@@j@@@@@@@@@@@@~0@~/@@@@~,@@@@@@@@@@@@W@@@/)@@X@@X@Ġ/Tcoerce_functordgqeg@}@igjg@@@@@j@@@@@@o@@@ @@p@@p@@H @@q@@@ఐ!k~LWLX@@@}@@ภ+DereferenceLYLd@< @@@e@@@@@@@@Ġ1Tcoerce_primitiveeoe@}@ee@@}@@@@@@ @@@@@@@ఐӠ!k@@@ @@ภ&Ignore@e&@@@e@@@@@@@ @Ġ-Tcoerce_alias   @}@ " #@@}@@@@ఠ#pth % (@MA@@}@@@@ఠ#coe * -@NA@@@@@@@@' .@@U@@U@@@ఐd(coercion@3@@@c@^O@@@@3@.'@(@)!@@@@@@ఐ(#coe@ @@wU@3@@@@@࣠@!mA'(@@OA@@@@@@ఐI."<<67@G@@@IJ@@@@II@@@IF@@@@@@@3CBBCCCCC@C(@@ @@@@ఐE$pathUV@E@@@E@@@ E@@@ @@ @@ఐ#pthjk@e@@E@@@Y@Y@.@@  @@E@@@$2@@ఐ^!m@<@@?@@1@@@@@@P@2s@@@@t@@@A @@@A@@@@@@@P@@@@@@ఐ(coercion@ְ@@@@@@@@f@@@I@@@@@@@@@3@@@@@ఐ=#coe@@@@@@P@P@3@@@@@࣠@!mA  @PA@@g@@@@@@@ఐIࠐ"<<@Hr@@@I@@@@I@@@I@@@@@@@3@/+g3@@@@%@&@@@@ఐFz&modexp  @F~@@@F~@@@F{@@@@@@@ఐ$mexp @h@@F@@@T@T@1@@  @@F@@@5@@ఐd!m78 @?@@gr@@@'E@@4@@JC@@@+R@K@DE!@@@g@@@@@@3P@@@P@0P@-@@@@@@@@Ġ+Tmod_unpack`"(a"3@~Ǡఠ!ei"5j"6@IA@@@@@"@@s"8t"9@@~@@@*@@@y":@@@@@/@@@@@2@@@ఐG*expression>D>N@Ga@@@G@@@7G@@@6@@53@G1*@+@,@@@@ఐ8!e>O>P@ @@G@@@GP@IP@H@@# @@@@@Aao @@@@@@3@c@@@ac@б@гàG+@@@@t@г@@@@u@@ @@v@+A@@@G@@@@MG=@@@L@@KL@H@@@//7@@G.@G<3@H@@@G@G@G0G/@G.@G?@@@[G:@@@[@@[G9б@гGJ$Pathfqfu@GOfvfw@@@GY@@@[" @@гGU)term_judgf{f@@G]@@@[.@@@@@[1@@G`G_A@@@Go@@@]Gj@@@]@@];@࣠@#pthA$%@=QA@@GG@@@Y3*))*****@H@@@@  @@ఐ#pth9:@@@@X@@@@@@@^3@??@@@@@@H.( @@@Ġ$PathQR@&PidentVW@@ఠ!x`a@yRA@@@@@c3dccddddd@$@@@@@@@A@@@d@@D@@@e@@@ఐOʠ&singlexy@O#@@@O@@@O@@@@@3@A)"@#@$@@@@ఐ0!x@ @@P @@@P@P@@@# @@V@@@@Ġ$Path@$Pdot@@#ఠ!t@SA@@@@@k3@~@@@@@@0@@@l @@@ @@@@@m@@@@@n@@@ఐKӠ"<<@Je@@@K@@@@K@@@K@@@@@@@3@70@1@2@@@@ఐHW$path@H[@@@H[@@@HV@@@@@@@ఐU!t@$@@Hr@@@R@R@.@@  @@Hn@@@2@@ภ+Dereference&'@?@@@ia@@@A@@3@@B@Ġ$Path9:@&Papply> ?@@ఠ!fHI@aTA@@@@@t3LKKLLLLL@ @@@ఠ!pWX@pUA@@@@@u@@@&_@@8@@@v@@;@@@w@@@ఐNu$joino"p&@L@@@NN@@@@@@N@@@@@3{zz{{{{{@==6@7@8/(@)@*@@@@ภ@b)3ktAFఐL"<<):)<@K!@@@L@@@@L@@@L@@@@@@@)@@ఐI$path()7@I*@@@I@@@5I@@@4@@3?@@ఐ!f)8)9@H@@I*@@@ET@GT@FS@@G @@I&@@@LW@@ภ+Dereference)=)H@@a@@@j@@@[f@@Z@@L@@@bj@ภ@ŰJTcAఐL"<<J[J]@K@@@M @@@@M @@@~M @@@}@@|@@{@@ఐIr$path'JX@Iu)@@@Iu@@@Ip@@@@@@@ఐҠ!p)JY*JZ@@@I@@@T@T@@@F @@I@@@@@ภ+Dereference@J^AJi@@@@@j{@@@@@Y@@MJ@@@@ภ?PksA@A@Om@@@s@@@tP@@@nA@ʠOw@@@ @@@ P@r@@f'@@OO@@@@@@P@ @@@@@Ġ$Path}u{~u@)Pextra_tyuu@@ఠ!puu@VA@@@@@}P@ఠ&_extrauu@WA@@@@@~^@@@%u@@{@@@c@@~@@@f@@@ఐJ$path@J@@@J@@@J@@@@@3@|81@2@3+$@%@&@@@@ఐ@!p@@@J/@@@P@P@@@% @@<@@@A @@>@@@3@@@@@б@гJA@@@@N@гS@W@@@O@@ @@P@+A@@@JX@@@JS@@@@@L@@@@ff7@@JF@JR3@KG@@@JVJVJHJG@JF@JU@@@[JR@@@[@@[JQб@гJ`)Typedtree!"@Jg%&@@@Jo@@@[" @@гJm)term_judg23@@Ju@@@[.@@@@@[1@@JxJwA@@@J@@@]J@@@]@@];@࣠@!sAO&P&@hXA@@J@@@*3UTTUUUUU@KB@@@@  @@!mAc&d&@|YA@@Y?@@@53gffggggg@KU$@@@)@@@@@@ @@డ$List*fold_right''@ ' '@@Yհ@@@@J@@@qN@?@Yh@@@N@vN@=@@A@@@@Z@@@@>@@@<@@;@@:3@8GY|@@@4@A@B@@@@࣠@"itA''@ZA@@.3@@@@@@@#envA''@[A@@63@(@@@@@@@@@ఐK .structure_item'#'1@K@@@K@@@\K @@@[@@Z3@&R@@@@@@ఐ<"it'2'4@&@@f@@ఐ!m'5'6@Z@@Y@@@wR@zR@y&@@ఐP#env'7':@0@@3@@?@@R@u6@'';@@@@@@P@@OO@O@i@@ఐ⠐!s.(<B/(<C@İ@@@@@@@)str_items:(<D;(<M@3)str_items@@@ ]@@@ Z@@@ Y@@@3(str_type)signature@@@ [@@A @AAAAA@@@3-str_final_env!t@@@ \@@B@AAAAA@@@@AAoAqAoA@@@9,@@[@@@NO@O@@@డ|l%empty#Env}(<N~(<Q@ (<R(<W@@X@@O@@@ @@@&@б@г<vuKro@C@@@An@гZ~nm@@@@ Ij@@ @@!Ki@"A@@@K@@@K@@@@@L@V@@@.@@K@K3@L@@@KKKK@K@K@@@[K@@@[@@[K꠰б@гK)Typedtree,,@L,,@@@L@@@[" @@гL)bind_judg,,@@L@@@[.@@@@@[1@@LLA@@@L@@@]L@@@]@@];@࣠@!sA--@\A@@nL3@@@3@L@@@@  @@!mA--@(]A@@Z@@@3@M$@@@@@@@@@ @@#envA&-'-@?^A@@Z@@@3*))*****@'Z@@@@!@"@@@@ @@ఐH!s@-A-@*@@@@@@3EDDEEEEE@+Z@@@@%@&@@@(str_descR-S- @3(str_desc@@@ a3structure_item_desc@@@ ^@@@ 3'str_loc !t@@@ _@@A @ABB BB@@@3'str_env!t@@@ `@@B@ABB#BB2@@@@AAAAB@@@<)@@#@@@7@Ġ)Tstr_eval..@;)Tstr_eval4@@@ @@@@ b@@@ c@B@@N@ABRBVBRBz@@@"@ఠ!e.!."@_A@@@@@3@c@@@@.$.%@@@@@ @@@,.&@@]@@@@@`@@@@@@@ఠ&judg_e77@kA@@P@@@R@3@1*@+@,@@@ఐPӠ"<<7'7)@Oe@@@P@@@@P@@@P@@@@@@@@@ఐN.*expression77$@Mϰ@@@ND@@@NA@@@@@3@@ఐh!e 7% 7&@=@@N[@@@U@U@G@@  @@NY@@@K@@ภ%Guard#7*$7/@f@@@n^@@@Z@@3@@^[@A@+7 @@డ~($join#Env9839:83<@ =83=>83A@@X@@@]@@@@]@@@]@@@@@@@3KJJKKKKK@@@@@@@ఐ&judg_e]83C^83I@@@Qc@@@@@ఐa!mm83Jn83K@@@@\L@@@S@S@+@@z83B{83L@@^(@@@@S@5@@ఐj#env83M83P@E@@^<@@@R@R@I@@_ @@\@@@R@O@s@@\@@@@Ġ*Tstr_value9QW9Qa@;*Tstr_value"@(rec_flag@@@ d@@@ f@@@ e@BA@N@A5B{B}6B{B@@@H@ఠ(rec_flag9Qc9Qk@`A@@@@@3@@@@ఠ(bindings9Qm9Qu@aA@@'@@@@@@@@@:9Qv@@@@@@@@@@@@@ఐM.value_bindings:z:z@M@@@M@@@@MM@@@@@@M@@@@@@@3@F?@@@A81@2@3@@@@ఐN(rec_flag:z:z@@@M@@@ R@(R@'@@ఐS(bindings,:z-:z@!@@MǠM@@@@@@R@+R@)1@@ఐ8!mD:zE:z@@@\@@@&R@.R@-G@@ఐ7#envZ:z[:z@@@\@@%R@0R@/\@@q @@]@Ġ+Tstr_modulep;q;@;+Tstr_module@.module_binding@@@ m@AF@N@ACLCNCLCm@@@@ঠ%mb_id;;A3%mb_id@@@ M!t@@@ @@@ @@@3'mb_name#loc`@@@ @@@ @@@ @@A@A"EE#EE9@@5 @3&mb_uid&!t@@@ @@B@A-E:E?.E:EM@@@ @3+mb_presence1/module_presence@@@ @@C)@A9ENES:ENEv@@L @3'mb_expr={@@@ @@D2@ABEwE|CEwE@@U @3-mb_attributesF@@@ @@E;@AKEELEE@@^@3&mb_locOG!t@@@ @@FG@AWEEXEE@@j@@A[DD\DD@@n @ఠfgfe@bA@`_@@@@@@3@@@@'mb_expr;;A8ఠ@cA@@@@@@@ ; ;@@@@@R@@@@@@@@@@@@@@!@@@ఐOB.module_binding <!<@OF@@@@OFOE@@@7@@@6@OB@@@8@@5O?@@@4@@3354455555@PM@O@N;8@:@9@@@@@ఐ\%mb_idK<L<@@@OoOn@@@R@@@QR@cR@a!@@ఐ]'mb_exprb<c<@(@@Oy@@@SR@fR@e4@@m<n<@@@#@@@PR@g?@@ఐu!m<<@T@@^@@@YR@iR@hU@@ఐt#env<<@O@@^@@XR@kR@jj@@ @@k@Ġ.Tstr_recmodule== @;.Tstr_recmodule$@A@@@ o@@@ n@AG@N@A1CnCp2CnC@@@D@ఠ#mbs==@dA@@X@@@@@@3@@@@@@& @@z@@@@@}@@@@@@@ఠ(bindings>>'@lA@@U @ed@@@@@@R@@@@@R@@@R@r@@@R@m3@C<@=@>@@@డ$List#map>*>.@ >/>2@@UR@@@@@@@R@t8@@u@UO @@@sUNA@@@q@@p@@o3+**+++++@+@@@@࣠@TxAঠ%mb_id@>9A>>Aఠ@^mA@@@@@@@L@'mb_exprU>@V>GAఠ@snA@@@@]@@@a>8b>H@@DU@b@@@@@ఐ*%mb_idr>Ms>R@-@/@.@@3srrsssss@u5 @@@@@@ఐ&'mb_expr>T>[@ @@@@>L>\@@@@@@@>3>]@@@y@@S@S@@@ఐܠ#mbs>^>a@@@UҠ@@@S@S@@@ @@@A@> @@ఐP9recursive_module_bindings?ek?e@P@@@P@PP@@@@@@@P@@@@@@@@P@@@@@3@@@@@@@ఐ(bindings?e?e@ @@PӠ@PҠP@@@@@@@P@@@@@@@@R@R@(@@ఐ!m?e?e@ڰ@@_@@@R@R@>@@ఐ#env?e?e@հ@@_@@R@R@S@@p @@_@@@R@Y@@@,@Ġ.Tstr_primitive9@:@@;.Tstr_primitive@1value_description@@@ g@AB@N@ABBBB@@@@@K@L@@@@@@@@@@@@@@@@@@@@@@ఐ;#env^A_A@@@@Ġ)Tstr_typekBlB@;)Tstr_type@z(rec_flag@@@ hԠ0type_declaration@@@ j@@@ i@BC@N@ABBBC@@@ @@BB@@@@@ @@@@@@ @@@ @@@,@@>@@@@@A@@@@@@ఐ#envGG @\@@ @Ġ+Tstr_typextH!'H!2@;+Tstr_typext(@@.type_extension@@@ k@AD@N@A2CC3CC&@@@E@ঠ2tyext_constructorsH!4H!F@32tyext_constructors@@@ .^5extension_constructor@@@ @@@ @@C3*tyext_path!t@@@ @@@ @AY`h`lZ`h`@@l@3)tyext_txt#loc!t@@@ @@@ @@A@Ak``l``@@~@3,tyext_params.Y@@@@ @@(variance@@@ @+injectivity@@@ @@ @@ @@@ @@B?@A````@@@R3-tyext_privateR),private_flag@@@ @@DJ@A aa aa3@@@3)tyext_loc]!t@@@ @@EV@A a4a8 a4aN@@@30tyext_attributesi{@@@ @@F_@A aOaS aOap@@@@A```a@@@ఠ$extsGH!IHH!M@`eA@@{z@@@@@@3ONNOOOOO@ @@@@ATH!3UH!Q@@@@@R@ @@@@@@@@ @@@@@@@@@ఠ'ext_idslIU_mIUf@oA@@W!t@@@R@@@@R@3{zz{{{{{@7=6@7@8@@@డ$List#mapIUiIUm@ IUnIUq@@WͰ@@@@@@@R@*@@@Wʠ @@@Wɠ3@@@@@@@3@+@@@@࣠@VAঠ&ext_idIUxIU~@3&ext_id@@@ K@@@ @@@ 3(ext_name #loc@@@ @@@ @@A @AHb8b<Ib8bQ@@[@3(ext_type5extension_constructor@@@ @@B@ATbRbVUbRb}@@g@3(ext_kind%n:extension_constructor_kind@@@ @@C$@A_b~b`b~b@@r@3'ext_loc0[!t@@@ @@D0@Akbblbb@@~@3.ext_attributes<@@@@ @@E9@Atbbubb@@@@Axb#b'yb#b7@@@ఠ"id IU IU@%pA@@@@@@@AIUwIU@@|U@@@@@ఐ"id!IU"IU@@@@@3"!!"""""@@@@(IUr)IU@@@@@S@S@@@ఐ$exts:IU;IU@@@Xj@@@S@S@@@ @@@A@GIU[ @@డD$join#EnvUJVJ@ YJZJ@@^@@@d@@@@d @@@d@@@@@@@3gffggggg@@@@@@@ఐ`$listyKzK@]@@@@S0@@@CR@_@@@@@@_ @@@_@@@@@@@'@@ఐSJ5extension_constructorKK@SN@@@SN@@@@SK@@@?@@><@@ఐi$extsKK@2@@` :@@@+S@FS@DQ@@ఐ!mKK@@@b@@@1S@HS@Gg@@KK@@d@@@@IS@0q@@డ+remove_list#EnvLL@ LL@@d6@@@h(d6@@@P@@@O@d@@@Nd@@@M@@L@@K@@ఐ'ext_idsLL@@@hHdV@@@^@@@]S@aS@_@@ఐ#env&L'L@ް@@d@@@\S@dS@c@@1L2L@@d@@@ @eS@[@@ @@b@@@fR@ @@@@Ġ.Tstr_exceptionKMLM @;.Tstr_exception@.type_exception@@@ l@AE@N@AC'C)C'CK@@@@ঠ1tyexn_constructorcMdM@31tyexn_constructor@@@ @@@ @@@ 3)tyexn_loc !t@@@ @@A @Aaaaa@@@30tyexn_attributesڠV@@@ @@@ @@B@Aaaaa@@ @@Aaaaa@@@ఠ#extM"M%@fA@@@@@'3@Q@@@@AM M)@@O@@@)R@( @@@X@@J@@@* @@M@@@+@@@డ$join#EnvN-3N-6@ N-7N-;@@`@@@eh@@@l@em@@@kep@@@j@@i@@h3@?8@9@:@@@@ఐT5extension_constructorO<EO<Z@T@@@T@@@|T@@@{@@z@@ఐ]#extO<[O<^@$@@T@@@S@S@.@@ఐ!mO<_O<`@ְ@@c@@@S@S@D@@O<DO<a@@e@@@x@S@N@@డ&remove#Env)Pbk*Pbn@ -Pbo.Pbu@@@ii@@@S@e@@@Se@@@S@@S@@S @iii@@@@@@@e@@@e@@@@@@@@@ఐǠ#extYPbvZPby@@@@@@@@&ext_idePbzfPb@@@9@@@S@S@@@ఐ V#envyPbzPb@ 1@@f(@@@S@S@@@PbjPb@@f2@@@w@S@@@ @@@Ġ,Tstr_modtypeQQ@;,Tstr_modtype @+7module_type_declaration@@@ p@AH@N@ACCCC@@@0@@QQ@@@@@0@@@@@ [@@@1@@@Ġ/Tstr_class_typeRR@;/Tstr_class_type 6@"@ !t@@@ y@#loc@@@ {@@@ z@j6class_type_declaration@@@ |@@ x@@@ w@AK@N@A]DD!^DDj@@@p@@RR@@,@+@@@<@(&@@@>@@@=@%@@@?@@;@@@:p@@@K@@ @@@@t@@t@@r@@ @@@Ax@Ġ.Tstr_attributeSS@;.Tstr_attribute @@@@ ~@AM@N@ADDDD@@@@@)S*S@@@@@E@@@@@ @@@F@@@@ @@ @@@H@@@ఐ #env=T>T@ @@@Ġ)Tstr_openJUKU@;)Tstr_open @0open_declaration@@@ q@AI@N@ACCCC@@@@ఠ"od`UaU@ygA@@@@@M3dccddddd@ @@@@@@@ @@@N@@ @@@O@@@ఐVv0open_declarationxVyV@Vz@@@Vz@@@Vw@@@@@3@ <)"@#@$@@@@ఐ0"odVV@ @@V@@@R@R@@@ఐ !mVV@ w@@e2@@@R@R@-@@ఐ #envV V @ r@@e@@@R@R@B@@N @@ (C@Ġ*Tstr_classW W @;*Tstr_class G@3@g1class_declaration@@@ t@B"@@@ v@@@ u@@ s@@@ r@AJ@N@AeCCfCD@@@x@ఠ'classesW W %@hA@@)@(@@@Z@&%@@@\@@@[@@Y@@@X3@ @@@@@D@@ @@@]@@ @@@^@@@@ఠ)class_ids$X)5%X)>@=qA@@\Nl!t@@@R@@@@R@332233333@ B;@<@=@@@@ఠ(class_idCYAODYAW@\rA@@@@+class_infosw@@@@S@ᠠ@@@@@S@1@@@S@@@S@-@࣠@[A@ঠ+ci_id_classuYAZvYAe@3+ci_id_class&!a@m@@@ R@@@ @@C/3'ci_virt,virtual_flag@@@ @@@@AOggOgg@@@3)ci_params@2@@@ @@(variance@@@ @+injectivity@@@ @@ @@ @@@ @@A,@A&Pgh'Pgh7@@9@3*ci_id_name=#loc@@@ @@@ @@B<@A6Qh8h<7Qh8hT@@I@M30ci_id_class_typeM!t@@@ @@DH@ABShohsCShoh@@U@3,ci_id_objectY!t@@@ @@ET@ANThhOThh@@a@3'ci_expreb@@FZ@ATUhhUUhh@@g@3'ci_declk1class_declaration@@@ @@Gf@A`VhhaVhh@@s@3,ci_type_declw)6class_type_declaration@@@ @@Hr@AlWhhmWhi@@@3&ci_loch!t@@@ @@I~@AxXiiyXii*@@@3-ci_attributesM@@@ @@J@AYi+i/Yi+iI@@@@ARhUhYRhUhn@@@ఠ"id YAhYAj@2sA@@@@@3@␰$YAK%YAw@@@@@A'YAY(YAn@@U@ @@@/YAp0YAq@@@@2YAX3YAr@@@@@@@@ @@ఐ*"idCYAu@(@)@*!@@3CBBCCCCC@'3@@@$A@S@+@A@(@డ$List#mapXZ{YZ{@ \Z{]Z{@@]@@@@@@@@R@@@@@@@@R@ @@R@M@@@]@@@]V@@@@@@@3@OG@@A@B@@@@ఐN(class_idZ{Z{@ @@@@G@5@R@ @@@@5@@ w@@@ @@ %@@ఐ'classesZ{Z{@}@@]Y@@@S@S@:@@g @@;@ @@@A@X)1@@@ఠ1class_declarationĠ[[@tA@@@@X@@@[R@$@@@%R@ @@@!@@"R@@g@@@_R@*i@@@@R@+@@,R@@@R@3@@@@@@࣠@]BA@ঠ'ci_expr[[A4ఠƠ@,uA@73@O[\@@@@@A[[@@ET@# @@@%[&[@@@@@([)[@@@@I@@'@@ @@!mA:[;[@SvA@@Q3;::;;;;;@).b@-@,@@@@@@డ?+remove_list#EnvP\Q\@ T\U\@@i@@@mi@@@5@@@4@j @@@3j@@@2@@1@@03feefffff@,8@/@0@@@@ఐR)class_idsv\w\@}@@mi@@@C@@@BU@FU@D@@ఐYR*class_expr\\@YV@@@YV@@@KYS@@@J@@I2@@ఐ'ci_expr\\ @g@@?@@ఐ{!m\\@I@@L@@\@@jc@@@A@bV@^U@@o@@V@A@R@f@A@@డ$join#Env]]@ ] ]$@@e-@@@j@@@l@j@@@kj@@@j@@i@@h3@@@@@@@ఐf$list^%0^%4@dm@@@@@%@@@R@@%$@@@@@@R@@@R@~fx@@@@@@fk@@@}fZ@@@|@@{@@z8@@ఐZ1class_declaration&^%5'^%F@B@@@@ܠY@@@@@@@1@@@i@@@j@@@@@@@\@@ఐP'classesJ^%GK^%N@@@fZ@@@S@S@q@@ఐS!m_^%O`^%P@2@@i>@@@S@S@@@l^%/m^%Q@@k@@@x@S@@@డt+remove_list#Env_R]_R`@ _Ra_Rl@@jа@@@n j@@@@@@@k@@@@kC@@@@@@@@@ఐ)class_ids_Rm_Rv@@@nj@@@@@@S@S@@@ఐ#env_Rw_Rz@x@@ko@@@S@S@@@_R\_R{@@ky@@@w@S@@@ @@iP@@@R@v@@@@@@ >@Ġ,Tstr_include`|`|@;,Tstr_include]@u3include_declaration@@@ }@AL@N@AgDkDmhDkD@@@z@ঠ(incl_mod`|`|@3(incl_mod-include_infos!a@N@@@ @@@ 3)incl_type H)signature@@@ @@A @ASxS}SxS@@Y@3(incl_loc!t@@@ @@B@ASSSS@@Z@3/incl_attributes%@@@ @@@ @@C#@ASSSS@@[@@ASeSjSeSw@@X@ఠ$mexp=`|>`|@ViA@@@@@m@)incl_typeJ`|K`|@?ఠ#mtyR`|S`|@kjA@@G@@@u@@AZ`|[`|@@s@@@wR@v@@@|@@ @@@x@@ @@@y @@@@ఠ,included_idsɠrasa@wA@@`%Ident!t@@@R@@@@R@3@@PI@J@K<5@6@7@@@డ$List#mapaa@ aa@@`װ@@@@1.signature_item@@@R@0@@@`֠ @@@`ՠ9@@@@@@@/@@డ1signature_item_id%Typesaa@ aa@@@'@@@yS@@@x@@w@IddJdd@@]A@@@@4@@@`@@@@@Z@@ఐ#mtyaa@b@@@@@j@@Y@@yk@A@a@@డ$join#Envbb@ bb @@g^@@@l@@@ @l@@@ l@@@ @@ @@ 3@@@@@@@ఐ\&modexp$b %b@\@@@\@@@\@@@@@@@ఐ$mexp9b:b@@@\@@@-S@3S@2.@@ఐA!mMbNb@ @@k,@@@1S@5S@4D@@Zb [b@@m@@@@6S@0N@@డb+remove_list#Envsbtb@ wbxb*@@l@@@pl@@@=@@@<@m.@@@;m1@@@:@@9@@8w@@ఐ$,included_idsb+b7@@@pРl@@@K@@@JS@NS@L@@ఐ#envb8b;@f@@m]@@@IS@QS@P@@bb<@@mg@@@@RS@H@@ @@k>@@@SR@@@@+C@@@A-@@kD@@@3@@@@-@б@гנ]   @@@@ @гkt @@@@@@ @@@1A@@@]#@@@] @@@@@L@@@@,=@@]@]3@^:@@@]#]#]]@]@@]"]!@@@[@@@[@]@@@\@@[]@@@[@@[]б@В@г]:&option#e_}$e_@г]?%Ident.e_u/e_z@]F2e_{3e_|@@@]N@@@[< @@@]V@@@[A@@@г]P)TypedtreeHe_Ie_@]WLe_Me_@@@]_@@@[V @@@@@ @@[], @@г]d)bind_judg`e_ae_@@]l@@@[i@@@@@[lie_t @@]p]oA@@@@]]@@@]@@@]@]@@@]@@]]@@@]@@]@࣠@aA@ఠ"idʠff@yA@@.]@@@#@@@"3@^@@@@ఠ$mexpˠff@zA@@]@@@$@@ff@@@#"@@@(@@@'@@@@)@@&%@@@@!mAff@{A@@lX@@@73@^KD@E@F5.@/@0@@@@  @@#envAff@|A@@lf@@@B3@&lt@@@6@ @!@@@@ @@@@ఠ&judg_EΠlS]lSc@}A@@b @@@P@G3@ /l@@@A@)@*@@@@ఠ#envϠlSelSh@0~A@@l@@@P@H@@! @@@!@ @@K@ఐ"id0mky1mk{@[@@@@@N@@@M376677777@1@@@Ġ$NoneEnFn@k@@@@@@@V@@@UF@@@@@X@@@WM@@@@ఐb["<<cndn@`@@@bw@@@p@bv@@@obs@@@n@@m@@lj@@ఐ^&modexpnn@^@@@^@@@^@@@@@@@ఐ$mexpnn@@@_ @@@U@U@@@  @@_@@@@@ภ%Guardnn@x@@@@@@@@3@@@@ఐ۠#envnn@@@@@@@@@@@@f@Ġ$Someoo@kڠఠ"idРoo@A@@D@@@_@@@@@LK@@@a@@@`@@SR@@@c@@@b@@@@@ఠ"mMѠpp@A@@sZsY@@@S@3@4-@.@/@@@@ఠ#envҠpp@*A@@o@@@S@@@ @@@@ @@@డ$take#Env.p/p@ 2p3p@@@ss@@@S@o@@@S@C@@@S@o@@@S@@S@@S@@S@sss @@@@@@@o@@@@Z@@@à@p @@@@@@@@@^@@ఐ"idnpop@h@@=@@@T@T@r@@ఐ#envpp@y@@p1@@@T@T@@@_ @@@@@@T@@A@p@@@ఠ&judg_EӠqq@A@@c@@@S@3@@@@@@@@ఐc"<<qq@bB@@@c@@@@c@@@c@@@@@@@@@ఐ`D&modexpqq @`H@@@`H@@@`E@@@@@5@@ఐB$mexpq q@@@`_@@@V@V@I@@  @@`]@@@M@@డF$join$Modeqq@  q q@@~@@@@@@$@@@#@@"l@@ఐ$"mM q!q @u@@a@@@4U@,U@.U@-@@ภ%Guard5q!6q&@z@@@@@9q:q'@@@@h@@@A@=q@@@ఐ&judg_EIr+5Jr+;@@@@@IR@<3LKKLLLLL@@@@@ఐI#envZr+=[r+@@@@BR@=@@@@@@ @@>@* @@@ @@b@@@Aimks@@@j@U@@Gg@A@qlSY@@డn$join#EnvtJPtJS@ tJTtJX@@kݰ@@@q1@@@M@q6@@@Lq9@@@K@@J@@I3@@@~@@@@@@ఐ&judg_EtJZtJ`@@@d@@@[@@ఐ렐!mtJatJb@˰@@o@@@jQ@lQ@k-@@tJYtJc@@qp@@@Y@mQ@i7@@ఐ#envtJdtJg@?@@q@@@XP@oP@nK@@a @@o[@@@pP@WQ@u@@@f@б@В@г]Ӡг^Ϡa@e@@@b@@l@@@f@@г[Ša@b@@@r@@@@ @@x@гo@@@@ @@@@ @:KA@@@@aFaE@@@@@@@aB@@@@@a?@@@@@L@@@@9e__d@@a2@a>3<;;<<<<<@b}@@@aBaBa4a3@a2@aA@@@\a>@@@\@@\ a=б@гaL)TypedtreeWviXvi@aS[vi\vi@@@a[@@@\" @@гaY)bind_judghviivi@@aa@@@\.@@@@@\ 1@@adacA@@@aq@@@]an@@@]@@];@࣠@eAঠ)open_exprww@3)open_expr*open_infos!a@Z@@@ @@@ 30open_bound_items )signature@@@ @@A @AvR1R6vR1RX@@(S@3-open_override-override_flag@@@ @@B@A wRYR^!wRYR{@@3T@3(open_env$!t@@@ @@C @A,xR|R-xR|R@@?U@3(open_loc0(!t@@@ @@D,@A8yRR9yRR@@KV@3/open_attributes<&#@@@ @@@ @@E:@AFzRRGzRR@@YW@@AJuRR"KuRR0@@]R@ఠ$mexpՠww@A@@@@@3@b@@@0open_bound_itemsww@Wఠ"sg֠ww@ A@@_@@@@@Aww@@ma@@@@@@@!mA ww@&A@@p@@@3@c=6@7@8(!@"@#@@@@  @@#envA#w$w@<A@@p@@@3'&&'''''@&p@@@@ @!@@@@ @@@ఠ&judg_E٠<x=x@UA@@b@@@P@3BAABBBBB@+p@@@@%@&@@@ఐbĠ&modexpTxUx@bȰ@@@b@@@b@@@@@@@ఐ$mexpixjx@T@@b@@@Q@Q@.@@  @@2/@A@ux @@@ఠ)bound_idsڠy y @A@@g@@@P@@@@P@3@KYR@S@T@@@డ$$List#mapy  y $@ y %y (@@gް@@@@@@@P@'@@@g۠ @@@gڠ0@@@@@@@+@@డ1signature_item_id%Typesy )y .@ y /y @@@@@@,@@@ X@@@ @@ I@@ఐ"sgy Ay C@̰@@L@@@Y@@J@@cZ@A@y @@డ$join#EnvzGMzGP@ zGQzGU@@nV@@@s@@@@s@@@s@@@@@@@3        @@@@@@@ఐࠐ&judg_EzGWzG]@@@c@@@(@@ఐ"!m,zG^-zG_@@@r @@@7Q@9Q@8+@@9zGV:zG`@@s@@@&@:Q@65@@డA+remove_list#EnvRzGbSzGe@ VzGfWzGq@@s@@@ws@@@A@@@@@t @@@?t@@@>@@=@@<^@@ఐ)bound_idsuzGrvzG{@h@@ws@@@O@@@NQ@RQ@Pv@@ఐm#envzG|zG@H@@t<@@@MQ@UQ@T@@zGazG@@tF@@@%@VQ@L@@ @@r@@@WP@$@@@@4@@d@w@б@гa`c]Z@@@@Y@гrNYX@@@@U@@ @@T@,A@@@c@@@xc@@@w@@vL@s@@@vii8@@c@c3@e@@@cƠcưcc@c@cŠ@cĠc@@@\(@@@\'@c@@@\)@@\&@@@\%c@@@\$@@\#cб@гc᠐$list}}@В@гc栐&option } }@гc렡%Ident}}@c}}@@@c@@@\I @@@d@@@\N@@@гc)Typedtree/}0}@d3}4}@@@d @@@\c @@@@@ @@\j, @@@d+ @@@\oF}I@@гd)bind_judgM}N}@@d@@@\|@@@@@\@@d dA@@@dC@dBdA@@@]%@@@]$@d>@@@]&@@]#@@@]"d;@@@]!@@] @࣠@*m_bindingsA{~|~@A@@@!di@@@@@@@dh@@@@@@@@3@e@@@@ @@!mA~~@A@@s/@@@3@e9/@.-@@@@@@@+@@@@@@@@@D@E@@@@@@#envA~~@A@@sO@@@3@)8s]@@@@2@3@@@@ @@@ఠ$midsߠ@A@@ޠf@@@P@@@@P@3@#2sw@@@@,@-@@@డ$List*filter_map  @   @@@@!a@&&optionL!b@&@@@'@@'@@@@'?@@@'@@'@@'@@@Z@+&@@@@@'S@@@P@Ԡ@@@@P@@@P@2^@@@@@@+@@@ih@@@@@@@c@@డ#fstbc@>@@@@.@(@@0@@x@@ఐ*m_bindingswx(@̰@@YJ@@@Q@Q@@@{ @@@A@ @@@ఠ'binding,4,;@A@@@@rݠ{2{1@@@WP@@@@P@堠@f@@@P@@@P@@t@@@P@ve@@@P@@@P@@@P@3@@@@@@࣠@j A@ఠ#mid,=,@@A@@:3@M,06@@@@@ఠ$mexp,B,F@A@@>@@,<,G@@@S@G@@@@ @@!mA,H,I@A@@L3@+4g@.@/#Z@@@@@@  @@@ఠ&judg_ELVL\@*A@@j@@@S@3@'i@@@@@ఐS#mid&_m'_p@%@@3&%%&&&&&@@@@Ġ$None4v5v@su@@@@@@@@@ఐj8"<<@vAv@hʰ@@@jT@@@@jS@@@jP@@@@@@@6@@ఐf̠&modexp\v]v@fа@@@f@@@f@@@@@M@@ఐ$mexpqvrv@o@@Z@@@@f@@@3^@@ภ%Guardvv@\@@@@@@Bm@@,@@sn@Ġ$Some@sఠ#mid@A@@P@XP@y@@@@@z@@z@@@@ఠ"mM@A@@|5|4@@@UV@E3@"@@@@@డ$find#Env@ @@@-@@@R@w~@@@R&@@@R@@R@@R@|X|U|G@@@;@@@K@w@@@J4@@@I@@H@@G3@@ఐY#mid@=@@X@@@ఐ8#env@ @@w@@@VW@ZW@YT@@E @@YU@A@  @@ఐk"<<@i@@@k+@@@`@k*@@@_k'@@@^@@]@@\3$##$$$$$@qy@z@{@@@@ఐg&modexp67@g@@@g@@@~g@@@}@@|@@ఐf$mexpKL@I@@'@@@@g@@@+@@డ$join$Modebc@ fg@@s@@@W@@@@@@@@J@@ఐΠ"mM{|@T@@@@@W@W@W@`@@ภ%Guard@k@@@l@@@@o@@a@@V@sr@@@@@@A_g@@@A@LR @@డ+remove_list#Env@ &@@w@@@{w@@@@@@@xf@@@xi@@@@@@@3@@@@@@@ఐ점$mids'+@@@| x@@@@@@S@S@@@ఐڠ&judg_E-3@'@@k@@@-@@ఐ!m45@@@J:@@,$@@x@@@@T@C@@],@@KD@l-@@L@ .A@wP@5@A@2@డ$join#Env>B>E@ >F>J@@sw@@@x@@@@x@@@x@@@@@@@3+**+++++@o@@@@@@ఐtҠ$list=>L>>P@r@@@@@u@@@=@@@<@h@@@>@@;P@t@@@@@@t@@@t@@@@@@@4@@ఐݠ'bindingl>Qm>X@>@@@@u@@@5@@@4@h@@@6@@3@w[@@@2y.@@@1@@0@@/[@@ఐ*m_bindings“>Y”>c@@@tY@@@Q@HQ@Cp@@ఐ!m¨>d©>e@հ@@w@@@!Q@JQ@I@@µ>K¶>f@@yc@@@@KQ@ @@డ+remove_list#Env>h>k@ >l>w@@y@@@} y@@@R@@@Q@y@@@Py@@@O@@N@@M@@ఐ $mids>x>|@1@@}+y9@@@`@@@_Q@cQ@a@@ఐ@#env >} >@@@y@@@^Q@fQ@e@@>g>@@y@@@@gQ@]@@ @@w@@@hP@@I@@d@@@0@&~@б@г54В@г10г-,i)&@@@@y%@@@@@{$@@г#"i"@@@@|@@@@ @@}@@۠ @@@@гw@@@@@@@@@CTA@@@iW@iViU@@@@@@@iR@@@@@@@@iO@@@@@L@@@@Å|q@@iB@iN3ÈÇÇÈÈÈÈÈ@j@@@iRiRiDiC@iB@iQ@@@\9iN@@@\8@@\7iMб@гi\)Typedtreeãä@icçè@@@ik@@@\1" @@гii)term_judgôõ@@iq@@@\2.@@@@@\31@@itisA@@@i@@@])i~@@@](@@]';@࣠@"ceA@A@@Di@@@3@j@@@@  @@ఐ"ce@@@@@@@@.@@@@3@j, @@@'cl_desc@3'cl_desc.@@@ /class_expr_desc@@@ @@@ 3&cl_loc u!t@@@ @@A @A7777@@@3'cl_typeN*class_type@@@ @@B@A77!77;@@@3&cl_env#L!t@@@ @@C!@A7<7A7<7O@@@3-cl_attributes/r@@@ @@D*@A7P7U7P7o@@@@A6667@@@Q>@@8@@@H@Ġ)Tcl_identFG@;)Tcl_identI@@@ @ !t@@@ _#loc_!t@@@ @@@ ,@@@ @@@ @C@@G@A7777@@@@ఠ#pthvw@ďA@@,@@@3zyyzzzzz@@@@@āĂ@@.,@@@@@@ @@čĎ@@--*@@@@@@@@@Qė@@@@@@@@@@!@@@ఐn"<<ħ Ĩ @m1@@@n@@@-@n@@@,n@@@+@@*@@)3ĴijijĴĴĴĴĴ@G@@A@B@@@@ఐk#$path@k'@@@k'@@@Kk"@@@J@@I@@ఐe#pth @$@@k>@@@[R@]R@\.@@  @@k:@@@b2@@ภ+Dereference @bu@@@-@@@qA@@3@@y@@@'F@Ġ-Tcl_structure,@;-Tcl_structure@@@@ @AA@G@A7777@@@@ఠ"cs-/@4A@@@@@3@.@@@@@@@#@@@@@&@@@@@@ఐkܠ/class_structure33;43J@k@@@k@@@xk@@@w@@v3;::;;;;;@K)"@#@$@@@@ఐ0"csK3KL3M@ @@k@@@P@P@@@# @@]@Ġ'Tcl_fun`NTaN[@;'Tcl_fun@o)arg_label@@@ z@@@ ͠@!t@@@ @@@@ @@ @@@ 0e@@@ !@@@ @EB@G@A77848P@@@@@œN]ŔN^@@0@@@3ŕŔŔŕŕŕŕŕ@@@@@ŜN`ŝNa@@@@@ @ఠ$argsŨNcũNg@A@@=@<@@@Ӡ@@@@@@@@@$@ఠ"ceNiNk@A@@0@@@2@@NmNn@@h@@@:@@@sNo@@@@@?@@@@@B@@@@ఠ#idsss@A@@qx@@@P@@@@P@3@RK@L@M81@2@3@@@డĊ$List#mapss@  s s@@qD@@@@@*P@@3@@@P@@@P@2@@@qJ@@@qI;@@@@@@@6@@డĻ#fst3s4s@E@@@)M@@Q@G@@ఐ$argsDsEs@P@@qt=@@@Q@Q@\@@K @@f]@A@Qs{ @@ఐs*remove_ids[\@rh@@@t t@@@@@@@t@@@t@@@@@@@3lkklllll@}@@@@@@ఐ#ids|}@ @@tCtB@@@@@@P@P@@@ఐp"<<ƖƗ@o @@@p@@@@p@@@p@@@@@@@7@@ఐlt*class_exprƲƳ@lx@@@lx@@@lu@@@@@N@@ఐ"ce@Ұ@@l@@@T@ T@b@@  @@l@@@f@@ภ%Delay@>w@@@@@@u@@@@p@@@${@@@@@@@.P@@ @@@Ġ)Tcl_apply@;)Tcl_apply@1@@@ b@)arg_label@@@ @@@@ @@ @@@ @BC@G@AŽ8Q8S8Q8@@@¡@ఠ"ce#$@<A@@2@@@3'&&'''''@6@@@ఠ$args23@KA@@2@1@@@䠠@@@@@@@@@@@@LG@@G@@@!@@J@@@$@@@@ఠ#argXY@qA@@@@@@3@n@@@ZP@<@@@>P@=@@@;P@4@@5P@0n@@@YP@1@@2P@/3}||}}}}}@d]@^@_VO@P@Q@@@࣠@qA@@Ǒǒ@@-3ǐǏǏǐǐǐǐǐ@@Ǘǘ<]@@@@@ఠ#argǡǢ@ǺA@@;@@Ǧǧ@@@F@D@@7@@ @@ఐ#argǹǺ@R@@@@S3ǺǹǹǺǺǺǺǺ@+"@@@Ġ'Omitted(/@WĠ<02@;@@@@_3@@@@@@ @@l@@l@@@ఐr7%empty6;@qܰ@@e @Ġ#Arg<H<K@ఠ!e<L<M@ A@@P@[P@@=@@@@@>@@>@@@ఐo;*expression<Q<[@nܰ@@@oQ@@@JoN@@@I@@H3        @S"@@@@@@ఐ)!e<\@ @@'@@@@@@@A  @@M@|A@P@@A@@ఐt3$join-iq.iu@rv@@@tLtK@@@@@@tJ@@@@@398899999@@@@@@@ภfGxHAఐrK"<<SxTx@pݰ@@@rg@@@@rf@@@rc@@@@@@@'@@ఐn1*class_expr(ox@n4*@@@n4@@@n1@@@@@=@@ఐ`"ceȃxȄx@@@nK@@@T@T@Q@@G @@nI@@@U@@ภ+DereferenceȚxțx@f@@@@@@.d@@Z@@r@@@5h@ภfȪcAdఐr"<<ȵȶ@q?@@@r@@@R@r@@@Qr@@@P@@O@@N@@ఐ{f$list'@yJ)@@@@@@@@S@@@@@S@@@S@r{Q@@@t@@s@{D@@@q{3@@@p@@o@@n@@ఐ#arg@ð@@@@+@ĔpU@@@x@@@@@@@@pW@@@@@@@ఐ$args"#@@@{U@@@T@T@@@ @@{o@@@@@ภ+Dereference:;@f@@@u@@@@@@@sD@@@@ภeJA@A@Ⱥug@@@F@@@GP@@@A@Ġuq@@@@@@P@E#@@`iv@@u}u|@@@@@@P@.@@>#@@t@@@P@4@)@@x@Ġ'Tcl_let{|@;'Tcl_let5@Ê(rec_flag@@@ u@@@ @@@ @!t@@@ @Ķ@@@ @@ @@@ 4@@@ @DD@G@A8888@@@1@ఠ(rec_flagɳɴ@A@@7@@@3ɷɶɶɷɷɷɷɷ@@@@ఠ(bindings@A@@@ô@@@@@@@@@@C@B@@@@@@@@@@@@(@ఠ"ce@A@@4@@@6@@@v@@@@@;@@@@@>@@@ఐr">>&(@q?@@@r@@@@r@@@r@@@@@@@3  @ f_@`@aXQ@R@S2+@,@-@@@@ఐo.value_bindings$%@oİ@@@o@@@ @o o@@@ @@@ o@@@ @@ @@'@@ఐ(rec_flagBC@/@@o@@@)R@+R@*;@@ఐ(bindingsVW%@B@@oo@@@(@@@'R@.R@,S@@A@@o@@@6W@@ఐp6*class_exprt)u3@p:@@@p:@@@Lp7@@@K@@Jn@@ఐ"ceʉ4ʊ6@t@@pQ@@@\R@^R@]@@  @@pO@@@c@@t@@@Ġ.Tcl_constraintʢ7=ʣ7K@;.Tcl_constraint\@5@@@ i9*class_type@@@ @@@ @@@ @@@ @@@ @@@ 'MethSet!t@@@ @EE@G@AI88J9M9d@@@\@ఠ"ce7M7O@A@@5@@@3@@@@@7Q7R@@@?@@@ @@@  @@7T7U@@A@@@@ @@@ @@7W7X@@CB@@@@@@ %@@ 7Z7[@@E@@@-@@@q7\@@@@@2@@@@@5@@@ఐp堐*class_expr#`h$`r@p@@@p@@@qp@@@p@@o3+**+++++@;VO@P@Q@@@@ఐ]"ce;`s<`u@ @@q@@@P@P@@@# @@M@Ġ(Tcl_openPv|Qv@;(Tcl_open @0open_description@@@ 6<@@@ @BF@G@A9999@@@@@fvgv@@@@@w@ఠ"cervsv@ˋA@@6W@@@@@@*zv@@z@@@@@}@@@@@@ఐqL*class_exprˊˋ@qP@@@qP@@@qM@@@@@3˒ˑˑ˒˒˒˒˒@)"@#@$@@@@ఐ0"ceˢˣ@ @@qj@@@P@P@@@# @@@@@Aˮ @@@@@?3˯ˮˮ˯˯˯˯˯@@@@˴@б@г堡q~@@@@@гˠ@@@@@@ @@@+A@@@q@@@Lq@@@K@@JL@G@@@7@@q@q3@s@@@qqqq@q@q@@@\Eq@@@\D@@\Cqб@гq)Typedtree@q@@@q@@@\=" @@гq)term_judg @@q@@@\>.@@@@@\?1@@qqA@@@q@@@],q@@@]+@@]*;@࣠@"ec(A%&@>A@@ʘq@@@X3+**+++++@s@@@@  @@ఐ"ec<=@@@@W@@@@ q@@@`@^3EDDEEEEE@s3, @@@(ext_kindNO@n@@m@@@_ @Ġ)Text_decl^_$@;)Text_decl~@@@ @Ġt#loc@@@ @@@ @@@ Ơ5constructor_arguments@@@ ɠ:5@@@ @@@ @C@@B@A c c  c cT@@@@@̌%̍&@@('%@@@l@@@k@@@j3̖̖̖̖̖̖̕̕@Q@@@@@&@@@m@@@%5<@@@o@@@n@@@K@@@@@p@@@@@q@@@ఐw%empty̶*0̷*5@v@@@@@$@Ġ+Text_rebind6<6G@;+Text_rebindi@ƞ!t@@@ ̠#loc!t@@@ @@@ @BA@B@AV!cUcWW!cUc@@@i@ఠ#pth)6I6L@A@@#@@@x@ఠ$_lid*6N6R@A@@*(@@@z@@@y@@@>6S@@ "@@@{@@ %@@@|@@@ఐsr$pathW]Wa@sv@@@sv@@@sq@@@@@3@<5@6@7/(@)@*@@@@ఐD#pth/Wb0We@@@s@@@P@P@@@% @@@@@A; @@@@@@@@б@гWVrSP@$@@@M"O@гNM@@@@N)J@@ @@O+I@*A@@@s @@@s @@@@@L@6@@@e6@@r@s3hgghhhhh@t@@@s s rr@r@s @@@\[@s s@@@\Z@@@\Ys@@@\X@@\W@@\Vsб@гss ͉͊@@s&@@@\I#@@б@гs%$list͗͘@гs*)Typedtreeͣ͢@s1ͦͧ@@@s9@@@\JA @@@sA@@@\LF@@гs;)bind_judg͸͹@@sC@@@\MR@@@@@\NU@@@8@@\OX; @@sIsHA@@@sb@@@]2@s`s_@@@]1@@@]0s\@@@]/@@].@@]-k@࣠@(rec_flag+A@A@@ks@@@3@t@@@@  @@(bindings,A@ A@@{ks@@@%@@@$3@t* @@@@$@%@@@@@@$mode-A@+A@@@@@23@.$#@@@#@@@"@,@-@@@@@@)bound_env.A-.@FA@@@@@=310011111@+@@@1@%@&@@@@ @@@ఠ.all_bound_pats/F G  @_A@@yp`@@@ZQ@F@@@SQ@A3RQQRRRRR@"1@@@<@+@,@@@డ$List#maph #i '@ l (m +@@y@@@@a@@@[Q@H*@@I@y @@@Gy3@@@E@@D@@C3΀΀΀΀΀΀@.@@@@࣠@"vb0AΒ 1Γ 3@ΫA@@"A@@@@ఐ"vbΡ 7΢ 9@0@@@@13΢ΡΡ΢΢΢΢΢@Q@@@&vb_patΫ :ά @@ @@] @ί ,ΰ A@@@Ch@@UR@^R@]b@@ఐР(bindings B J@@@yW@@@TR@aR@_I@@e @@x@A@  @@@ఠ)outer_env1NVN_@A@@@@@sQ@b3@@@@@@ఐ.remove_patlistNbNp@@@@@@@|Q@i@@@h@@@g@@@@f@@e@@d%@@ఐˠ.all_bound_patsNqN@/@@Р%@@@u@@@tR@xR@v>@@ఐ)bound_env*N+N@հ@@RR@R@O@@D@@SP@A@3NR @@@ఠ,bindings_env2>?@WA@@@@@[Q@3FEEFFFFF@hvo@p@q@@@ఐw(rec_flagUV@S@@s@@@3XWWXXXXX@@@@Ġ,Nonrecursivefg@;,Nonrecursive(Asttypes(rec_flag@@@@@@@B@@A4parsing/asttypes.mli``@@@ I@@@@@@@@3yxxyyyyy@3@@@@@@@@@@@ఠ+binding_env3ϊϋ@ϣA@@@@@@T@@@@@T@J@@@T@@@T@@@T@\@࣠@y9Aঠ&vb_patϳϴAఠ5@A@@@@3ϻϺϺϻϻϻϻϻ@v9(]@@@@'vb_exprAఠ6@A@@@@@@A@@FV@@@@@!m7A@A@@M3@,41@3@2@@@@@@  @@@ఠ"m'8@A@@@@@W@3@'j@@@@@డQ'compose$Mode@ @@V@@@@@@@ @@@@@@@@@@%@@ఐP!m12 @/@@2@@ఐu'pattern@ A@u@@@u@@@X@@@@@u@@@u@@@@@@@V@@ఐ&vb_patbc@y@@t@@e@@ఐG)bound_envqr#@@@u@@@Y@Y@y@@| }$@@u@@@@@p@@@A@Ѓ@@ఐL*remove_patЍ(4Ў(>@@@@G8@@@ V@@@@@G@@@J@@@@@@@3ТССТТТТТ@@@@@@@ఐ&vb_patв(?г(E@ɰ@@@@@@ఐw*expression(G(Q@w@@@x@@@x @@@@@)@@ఐ'vb_expr(R(Y@@@x'@@@,X@2X@1=@@ఐ"m'(Z(\@G@@@@@0X@4X@3S@@(F7@@@@@@5X@/\@@u?@@`]@@@@a@.AA@vT@9H@A@E@ఐ$listakao@@@@@@@@pS@?@@@A@@@@v @@@>e@@@=@@<@@;3$##$$$$$@@@@@@@ఐ+binding_env4ap5a{@ @@@$@@@k@)@@@j@@@i@@h@@g@@ఐ](bindingsNa|Oa@5@@B@@@VT@wT@u2@@ఐT$modecada@/@@B@&@\T@yT@xG@@` @@+H@ @@.'@Ġ)Recursivez{@;)Recursive@@@AB@@A ` `@@@J@@@  @@@@@,@@@@@/@@@@ఠ+binding_env:єuѕu@ѭA@@@ˉ@@@T@{@Q@@@uT@r@|Ԡv@@@w@@@vT@s@@tT@|@@}T@z;@࣠@{FAঠ&vb_patuu@ఠ#x_i<uu@A@@@@@3@Eu@@@@'vb_expruu@ఠ#e_i=uu@A@@@@@@@Auu@@VV@~ @@@@@ఠ'mbody_i>@A@@wF@@@V@3@7C<@=@>)"@#@$@@@ఐwj'pattern@wn@@@wn@@@V@@@@@wo@@@wl@@@@@@@&@@ఐl#x_i9:@/@@K@@5@@ఐ)bound_envHI@@@w@@@W@W@I@@< @@MJ@A@T @@@ఠ)rhs_env_i?_ ` %@xA@@7@@@V@3gffggggg@bpi@j@k@@@ఐy*expressionv (w 2@yN@@@y@@@y@@@@@@@ఐ#e_iҋ 3Ҍ 6@@@y@@@W@W@+@@డ'compose$Modeҥ 8Ҧ <@ ҩ =Ҫ D@@@@@@@@@@@@@@@@@@@P@@ఐ$mode E I@@@@@@X@X@d@@ఐؠ'mbody_i J Q@n@@x@@@t@@ 7 R@@@@@X@@@t @@@A@  @@@ఠ,mutual_modes@@A@@~ xA@@@DV@*@@@7V@3@@@@@@@ఠ'mdef_ijA@+A@@@@@@W@xa@@@ W@@@W@@࣠@}jDAঠ&vb_pat23@Hఠ#x_jC:;@SA@@M@@@3>==>>>>>@=4EF@@@@@AHI@@0Y@ @@@@ఐx'patternWX@x@@@x@@@X@@@@@x@@@x@@@@@@@3lkklllll@/;4@5@6@@@@ఐB#x_j|}@ @@@@@@ఐ,)rhs_env_iӋF@G@@x@@@ Y@#Y@"%@@>O@@t&@NPA@W@%W@A@T@డ*$List#mapӥӦ@ өӪ@@~@@@@͞@@@EV@,@@-@~ @@@+~@@@)@@(@@'3ӽӼӼӽӽӽӽӽ@@@@@@@ఐ'mdef_ij@ @@@ͽ@@@By@@@A@@@@@ఐ(bindings @ɰ@@;@@@8W@HW@F-@@I @@.@ @@@A@@@@ఠ%env_iE*:*?@A@@@@@ZV@I3@ @@@@@ఐ.remove_patlist*B*P@Ű@@@͠@@@cV@P@@@O@@@N@@@@M@@L@@K%@@ఐ.all_bound_pats3*Q4*_@Q@@ߠ%@@@\@@@[W@_W@]>@@ఐ)rhs_env_iL*`M*i@G@@RW@qW@pO@@D@@SP@A@U*6 @@@ఐf%env_iab@e@f@g@@3baabbbbb@bp@@@@ఐz,mutual_modespq@l@@@@t@@@Р@@@x@'@@x@@@x@@@ @+@@ v@A@T@z@A@@@@ఠ#envGԐԑ@ԩA@@w C@@@T@@@@T@|3ԜԛԛԜԜԜԜԜ@W @ @ @@@@ఠ$mdefHԪԫ@A@@w٠y@@@@@@T@@@@T@}@@.@@@.@@@%@డV$List%split@ @@w@@@w@I@1@@@@@@xS@@@@w?@@@@@@@T@@డӈ$List#map@ @@B@@@@@@@U@@@m@@U@U@U@@@@K@@@J@@@@@@@@@ఐ+binding_env45@@@@$@@@@@@@@iz@@@@@@@@@@@@ఐe(bindingsVW@=@@Q@@@V@V@@@bc@@xNQ@@@U@V@@@ @@@ߠ@@@U@@A@v@@Aఠ2transitive_closureIՁ Ղ .@՚A@@@|7@@@U@r@@@T@ψA@@@@@@T@@@3՚ՙՙ՚՚՚՚՚@ @@@@@@@࣠@#envJAխ /ծ 2@A@@*3ծխխծծծծծ@6@1%@@U@@4@5@@@@  @@@ఠ/transitive_depsK5E5T@A@@@v@@@V@@ʠ@@@&Z@@@@V@@@@V@@@V@@@V@3@7Cc@:@;@@@࣠@%env_iMA5U5Z@A@@-3@:5A@@@@@  @@&mdef_iNA 5[ 5a@"A@@83        @!D@@@@@@@@డ$join#Env @ #$@@}@@@@@@@@@@@@@@@@@310011111@(4b@+@,@@@@ఐO%env_iAB@4@@x@@డC)join_list#EnvTU@ XY@@ʰ@@@> @@@@@@ @@@@@4@@డ$List$map2xy@ |}@@@@!a@&r@!b@&p!c@&n@@'@@'@@@@'@Ѝ@@@' @@@'@@'@@'@@'@hi@@g`@0+@@@@@%T@bT@%Z@b@@@Z@*Z@$Z@@@@@@@@@@+@@@4@@@@@@@@@@@డ'compose#Env@ @@@@@@S @@@@S @@@S @@S @@S@@@@@@@!@@@@ @@@@@@@@@ఐ&mdef_i @԰@@6@@ఐk#env@.@@@@@@h@@@Z@)[@@@$'@@@@@@+Z@@@/@@I@90A@fV@/7@A@4@@ఠ$env'O:;@SA@@@@@_V@6@@@KV@03FEEFFFFF@c@@@@@డ$List$map2YZ @ ]!^%@@@@@@V@:@|@@@fV@a@@@`V@81@@<@@;@@@@9@@@@7@@@@5@@4@@3@@2;@@ఐʠ/transitive_deps׎&׏5@E@@@;@@@\@@@@[@@@ZG@@@Y@@X@@WY@@ఐ#env׬6׭9@Ű@@(f@@ఐ$mdef׹:׺>@@@&Z@@@LW@gW@d{@@l @@|@A@ @@డ[$List(for_all2BQBU@ BVB^@@@@!a@&5@!b@&3@@@( @@( @@( @i@@@( @@@@( @@@(@@(@@(@@(@%%%%@@f@0+@@@@}@@@@U@p%@@@u@@t@@s@@@@q@$@@@o#@@@n@@m@@l@@k3      @@@@@@@డ#%equal#Env4B_5Bb@ 8Bc9Bh@@@@@@S#@@@@S"A@@@S!@@S @@S@@@=@@@@@@@@@@O@@@@@@@4@@ఐ#envaBibBl@z@@A@@ఐ4$env'nBmoBq@K@@}l@@@V@V@V@@ @@ȵ@@@V@\@ఐL$env'؆r؇r@c@@f@ఐ2transitive_closureؓؔ@@@@@@u@@ఐh$env'آأ@@@T@@@@@@ةBN@@@@@b@ @@@ A@@*@@T@@@@ز @@@ఠ&env'_iPؽؾ@A@@.n@@@@@@T@3@@@@ఐS2transitive_closure@#@@@P@@@@@@K@@@@@@@@@@ఐa#env@S@@o@@@@@@U@U@5@@,@@=6@A@@@డ)join_list#Env@ @@@@@@@@@@@@@@@@3      @sle@f@g@@@@ఐs&env'_i01 @ @@@@@@@@T@T@@@0@@ T@@A@@x@@@@@@@m@@  @@@AF@@  @A@H@@డE$join#EnvVW@ Z[@@@@@@@@@ @@@@@@@@@@3hgghhhhh@ # 3 ,@ -@ .@@@@ఐ :,bindings_envxy*@ @@'@@@Q@Q@@@ఐ )outer_envٌ+ٍ4@ C@@;@@@Q@Q@+@@A @@@@@Q@1@U@@ T@ k@@ @ @@ J@٠@б@г B "@ @@@  @б@г   г   G  @ @@@  @@ Ơ@@@  @гV  @@@@  @@@@  @@$@@  @/BA@@@n@@@$@lk@@@#@@@"h@@@!@@ @@L@ @@@W@iiDC@BEШc@б@гn)Typedtree  @u  @@А!k{@\b3@E@@    @@@ @@@\d@@б@г$mode  @@@@@\e@@В@г#Env* + @. / @@@@@@\f- @@@г$mode=  > @@@@@\g;@@@@@ @@\hB  @@@2 @@\iE5@@@D@@\jHG@@N@@\kLT A@A@@@֠X@]4@@@];@@@@]:@@@@]8@@@@]9@@]7@@]6@@]5@@]3j@࣠@WAঠ)Typedtreeځ ڂ #@%c_lhsچ $ڇ )@A3%c_lhs@!k@@@@ H@@@ @@@3&c_contX!t@@@ @@@ @@A@A6--6--@@.@3'c_guard i@@@ @@@ @@B@A)7--*7--@@<@3%c_rhs.@@@ @@C%@A28--38-. @@E@@A65--75--@@I@ఠCQDHB@A@G@ L@bO@8@@@;3@@@@'c_guard + 2A4ఠR@A@8@@@B@@@A@%c_rhs 4 9A;ఠS@A@@@@G'@@@  ;@@z2L@%@@@J/@@@@@ఠ$judgT@(A@@&@@@iN@T3@VS@U@T>;@=@<*'@)@(@@@ఐ.$join( )@q@@@GF@@@Y@@@XE@@@W@@V@@ภy?@^eAఐC"<<K4L6@հ@@@_@@@@^@@@~[@@@}@@|@@{C@@ఐ&option(g @*@@@@@@@R@x@@@@@@k @@@Z@@@@@@@f@@ఐ*expressionۈ!ۉ+@`@@@@@@@@@@@{@@ఐ'c_guard۝,۞3@@@:@@@S@S@@@j @@@@@@@ภ+Dereference۵7۶B@y8@@@@@@@@}@@@@@@ภyDLAఐ*expression DV@ @@@@@@@@@@@@@ఐ점%c_rhsDWD\@Ȱ@@3@@@Q@Q@@@* @@1@@@@ภx^dAј@A@h@@@@@@O@)@@?A@r@@@s@@@tO@@@@@+*@@@k@@@jO@r@@@@@A@@@࣠@!mUA&ir'is@?A@@@@@:3*))*****@$@@@@@@  @@@ఠ#envV<w=w@UA@@@@@PO@@3DCCDDDDD@*@@@9@$@%@@@ఐG$judgVwWw@)@@j@@@B@@ఐC!mfwgw@@@@@@R%@@@@+&@A@nw~@@@ఐ;*remove_pat|}@ @@@6@@@a@/@@@`2@@@_@@^@@]3܊܉܉܊܊܊܊܊@GWP@Q@R@@@@ఐР%c_lhsܚܛ@@@R@@@s@@ఐo#envܫܬ@@@Z@@@mO@‚O@(@@ܷܶ@@!@@@ƒO@l0@@డ 'compose$Mode@ @@@@@@@@‰@@@@ˆ@@@‡@@†@@…T@@ఐȠ!m@@@]@@@–d@@ఐP'pattern@T@@@T4@@@Ÿ@N@@@žK@@@@@œ@@›@@ఐN%c_lhs@@@РQ@@@µ@@ఐ#env)*@@@v@@@¯P@P@@@45@@v@@@®@@n@@@@@O@“@@ @@@@ @@@@@@HimI@@@@@@@@@@Ԡ@@@@@@@@M@0@D@@F@_ @@@f@@@@@@@@@@@⠠@@@@@@@@@@L@@@@z 2@ְ֠@Ш@б@г۠ܰݎ@Yݏ@h@А!k@\y3ݓݒݒݓݓݓݓݓ@@@ݘ@Wݙ@X@@@ @@@\{@@б@г砡#Envݩ@lݪ@o@ݭ@pݮ@q@@@@@@\| @@г$modeݺ@uݻ@y@@@@@\})@@@@@\~,@@@+@@\/. @@5@@\3@A@@@ =@]=@@@]B@@@@]A@@@]@@@]?@@]> @@]<F@࣠@#patYA@@@A@@Z==XN@@@@@@3@;@@@A@@@A@@S@T@@@@A@@@@@@#envZA@@@ A@@Q@@@3        @2('@@@@@@@0@1@@@@@@@ఠ%m_pat[&'OU''OZ@?A@@d@@@8Q@3,++,,,,,@ 1'@@@@+@,@@@ఐt8is_destructuring_pattern@'O`A'Ox@x@@@x[@@@(Q@@@@w@@@@@"@@ఐw#pat['Oy\'O|@K@@s@@@'3@@#@@Ξ@@@6R@!9@ภ+Dereferencen(}o(}@{@@@@@@9E@ภ%Guard{)|)@V@@@Q@<Q@ށ'O]@@S@A@ރ'OQ@@@ఠ%m_env\ގ+ޏ+@ާA@@@@@|Q@=3ޔޓޓޔޔޔޔޔ@iwp@q@r@@@డ.$List)fold_leftީ. ު. @ ޭ. ޮ. "@@×@@@@@@@mS@N@S@P@@R@@Q@ @ش@@@O@@M@@L@@K3@.@@@@డ$join$Mode. #. '@ . (. ,@@@@@@@@h@@@g@@f@@ภ&Ignore. -. 3@W@@@'@@@p-@@J@@@<@@@_D@@^4@@డݐ$List#map - -@ --@@J@@@@u@@@òT@Ðk@@@ðT@Î@@Ñ@L@@@ÏK@@@Í@@Ì@@Ëf@@࣠@"id]A9-:-@RA@@&@@@@డ;$find#EnvL-M-@ P-Q-@@@@@@@@æ@@@@å@@@ä@@ã@@â3^]]^^^^^@1M@(@)@@@@ఐ8"idn-o-@ @@Z@@ఐw#env{-|- @L@@*@@@ñW@õW@ô$@@: @@h%@߇-߈- @@@xs@@ÝU@øU@÷@@@@@~@@@Ü}@@@Û@@Ú@@డ0pat_bound_identsߦ,ߧ,@@@@`@@@S@@@@@@@@@@@@$@@ఐ᠐#pat,,@@@ݠ@@@5@@'@@ 0@@@@@@S@T@A@@3Q@@РL@@@}R@S@J@@<@@NK@A@+@@డ0$join$Mode09;09?@ 09@09D@@@@@@@@@@@@@3@jxq@r@s@@@@ఐ砐%m_pat 09E09J@v@@H@@@@@ఐ%m_env09K09P@@@X@@@#@@3@@Q@&@D @@@ @@@d Av@б@гFгG@@L@@@I@@S@@@M@б@г9@@@@@Y@гԠ@@@@a@@ @@c@@@@e@2@@@@@@@6@@@@5@@@4@@3@@2L@+w@@@m@@P@@Ш@б@г2R|2R@А!k@\3@@@2Rz2R{@@@ @@@\@@г$bool2R2R@@@@@\@@@@@\@@@@\@ A@@@ܠ%@]D@@@]G@@@]F@@]E@@]C)@࣠@#pat_A33@A@@0^N@@@X@@@W3@;@@@A@@@A@2Rv2Rw@@@@A@@@@@@ఐ&#pat33@"!@@@V@@@U@*@+  @@*)@@@_@@@^3@(>@@@(pat_desc33@ɰ@@j@a@@cP@d@Ġ(Tpat_any44@;(Tpat_any˶@@@ @@@ @@@@ALAAܐO  ܑO  @@@ܣi@@@@@nj]@@@r@@@q3#""#####@4@a;@@@Aܵ@@@p@@AP<@@@FA@A@@@ǝn@@@t@@@s@@@ภݚ<4=4@ݚ@@@@@@š@Ġ(Tpat_varM5N5@Ǣ@R5S5@@ǝ@@@Ą3TSSTTTTT@e@;@@@A@@@ă@@APm@@@wA@A@@@d5e5@@ǨǦ@@@Ć@@@ą@@p5q5@@ǩ@@@ć@@@)v5@@@@@ĉ@@@Ĉ'@ @@@@ċ@@@Ċ.@@@ภ55@@@@N6@Ġ*Tpat_alias66@;*Tpat_alias?@@@ @@@ @XG@@@ @@@ !t@@@  ۼ#loc@@@ @@@ à!t@@@ Š)type_expr@@@ @EAALAA@S y {AU  @@@Sl@ఠ#pat`66 @A@@}@@@ğ@@@Ğ3@@;@@@Aŏ@@@ĝ@@AP@@@A@A@@@6 6 @@D@@@Ġ@@66@@EC@@@Ģ@@@ġ@@66@@F@@@ģ&@@ 6 6@@H@@@Ĥ.@@@x6@@}N@@@Ħ@@@ĥ7@ @ȄU@@@Ĩ@@@ħ>@@@ఐ[8is_destructuring_pattern'6(63@_@@@_@@@ŽQ@Ű@@@ů^@@@Ů@@ŭ354455555@Gib@c@dZ@@@ఐp#patE64F67@ @@@@@ż@@&@@@Ġ-Tpat_constantW78>X78K@;-Tpat_constantȠ@@@ @@@ @m(constant@@@ @ABALAAW  W  ;@@@m@@p78Lq78M@@@@@ĵ3rqqrrrrr@@;@@@A@@@Ĵ@@AP@@@A@A@@@@)@@@@@ķ@@@Ķ@@@@@Ĺ@@@ĸ@@@ภ 78Q78U@ @@@W!@Ġ*Tpat_tuple8V\8Vf@;*Tpat_tupleH@@@ @@@ @ @r@@@ @@@ Π@tc@@@ @@@ @@ @@@ @ACALAA>Y k m?Z | @@@Qn@@8Vg8Vh@@%@$#@@@@@@͠@ͅ@@@@@@@@@@@3@@$;@@@Ax͏@@@@@AP@@@ A@A@@@@T$@@a2@@@@@@@@h9@@@@@@@@@ภ߁8Vl8Vp@߀@@@!@Ġ.Tpat_construct9qw9q@;.Tpat_constructɅͼ@@@ @@@ @*#loc*!t@@@ @@@ Ԡ7constructor_description@@@ ֠ܒ@@@ @@@ @@@ נ@ܧW#locՏ!t@@@ @@@ @@@ ܠ@K@@@ @@ @@@ @DDALAAa  dq@@@o@@h9qi9q@@JH@@@@@@3nmmnnnnn@@;@@@A@@@@@AP@@@A@A@@@@P@@@@@@N:)@@@@@@@@@@@(@N@MLJ@@@@@@@@@@L;@@@@@@@@6@@@?@@@@@@@@>@@@@@@@@E@@@ภ59q9q@4@@@M@Ġ,Tpat_variant::@;,Tpat_variant9p@@@ @@@ @%label@@@ ؘ΂@@@ @@@ @@@ &Stdlib#ref((row_desc@@@ @@@ @CEALAAmmPRno@@@߀p@@::@@,@@@ 3@@>;@@@AߒΩ@@@ @@AP@@@#A@A@@@@5Ǡζ@@@@@@@@@@@@50@@@@@@ @@@\%@@ʑb@@@@@@(@@ʘi@@@@@@/@@@ภ౰7:8:@@@@7@Ġ+Tpat_recordD;E;@;+Tpat_recordʵ@@@ @@@ @ݮ@b#locb!t@@@ @@@ 젠@:1label_description@@@ @#@@@ @@@ @@ @@@ ށ+closed_flag@@@ @BFALAAu^`{@@@q@@;;@@6@53@@@-@@@,@0@@@.@P?@@@0@@@/@@+@@@*3@@;@@@A2I@@@)@@AP@@@A@A@@@;;@@;@@@1@@@r;@@$@@@3@@@2@ @+@@@5@@@4"@@@ภD;;@C@@@*@Ġ*Tpat_array<<@;*Tpat_arrayH@@@ @@@ @,mutable_flag@@@ Gϑ@@@ @@@ @@@ @BGALAAlm@@@r@@<<@@@@@E3@@=;@@@AϨ@@@D@@AP@@@"A@A@@@@%Ơϵ@@@H@@@G@@@F@@@C@@ˇX@@@J@@@I@@ˎ_@@@L@@@K&@@@ภ᧰-<.<@@@@.@Ġ)Tpat_lazy:=;=@;)Tpat_lazy˫@@@ @@@ @@@@ @@@ @AHALAAJ@@@s@@U=V=@@ @@@[@@@Z3[ZZ[[[[[@l@;@@@A@@@Y@@APt@@@~A@A@@@@/@@֠@@@]@@@\@@ݠ@@@_@@@^@@@ภ|=}=@@@@@!@Ġ*Tpat_value> >@;*Tpat_value@@@@ @@@ @3tpat_value_argument@@@ @AIALAA~~@@@$t@ఠ#pata>>@A@@@@@l3@@;@@@A<b@@@k@@AP@@@A@A@@@@/@@%@@@n@@@m@@,@@@p@@@o@@@ఐ8is_destructuring_pattern>>3@@@@z@@@*Q@@@@@@@@@3@B;@<@=7@@@ఐI#pat>5>8@ @@гd'pattern><>C@@ @@@@@>4>D@@@@*@%@@9@@&@Ġ.Tpat_exception?EK?EY@;.Tpat_exceptioñ@@@ @@@ @Ӡ@@@ @@@ @AJALAA$&$j@@@u@@-?EZ.?E[@@@@@@@@~332233333@D@q;@@@A@@@}@@APL@@@VA@A@@@@/@@̮@@@Ł@@@ŀ@@̵@@@Ń@@@ł@@@ภⲰT?E_U?Ed@@@@!@Ġ'Tpat_ora@ekb@er@;'Tpat_orҠ!k@ m@@@ @# @@@ (@@@ 6ߵ(row_desc@@@ @@@ @CKALAA@@@ v@ఠ!lb@et@eu@A@@H@@@œ@@@Œ@ఠ!rc@ev@ew@A@@Z@@@ŕ@@@Ŕ@@@ex@ey@@98@@@ŗ@@@Ŗ@@@X@ez@@'@@@ř@@@Ř@ @.@@@ś@@@Ś@@@డY"||A~A~@@›@@@P@¡@@@O¥@@@N@@M@@L'%sequorBAΪ@@@@ΪΫ@@Ω^@@@@@@@I@@@@H@@@G@@F@@E3@ sl@m@nb[@\@]@@@@ఐ@8is_destructuring_pattern A~ A~@D@@@DQ@@@gR@Z@@@YC@@@X@@W"@@ఐ!l'A~(A~@+@@ߠ@@@f3@@#@@]@@@U@uS@`;@@ఐv8is_destructuring_patternBA~CA~@z@@@z@@@ƇR@z@@@yy@@@x@@wX@@ఐ!r]A~^A~@`@@@@@Ɔi@@#@@@@@T@ƕS@ƀq@@a@@.r@@@An3@@0@@@x3onnooooo@@@@A@б@гг@@@@@F@@Ƞ@@@H@гN@R@@@I@@ @@J@#@@@͠@?@@@˙@@@˘@@˗L@˒@@@2RRG@@XDH@䠰@ఠ=is_valid_recursive_expressiondCC@A@@@@@@@@@L@@@@@̮L@4@@@@@@L@@@L@@@L@3@@@@࣠@&idlistfACC@A@@.3@;CUKu@@@@@  @@$exprgACC@A@@43@!E@@@@@@@@ఐ$expr D D@G@@@@H3        @!@@@(exp_descD D@ᐰ @@@@@ @Ġ-Texp_function%E&E(@֗@*E)+E*@@֙֘@@@ @@@30//00000@$@@@@ @֘@@@ @@@@@@@@  @@@@@  @@@ภ$SomeFGzGGz@Qภ&StaticOGzPGz@m@@@@@@P@!$@@@@@@@@@@,@@eHfH@@@@@[@@@@@^@@@@ఠ%rkindhwIxI@A@@!@@@2Q@$M@ఐ"3classify_expressionII@װ@@@8@@@(5@@@'@@&a@@ఐ$exprII@@@n@@@@%o@A@I@@@ఠ(is_validiJJ@A@@y@@@yQ@53@F?@@@A@@@ఐL%rkindKK@ @@j@@@73@@@@Ġ&StaticLL@@@@@{@@@?3@#@@@@@@@@@@@@ఠ"tyjN<IN<K@A@@@@@bT@K<@ఐ3*expressionN<NN<X@԰@@@I@@@OF@@@N@@MP@@ఐ$exprN<YN<]@@@M]@@ภ&ReturnN<^N<d@w@@@X@@@jl@@(@@6m@A@%N<E@@డ!=/Oh0Oh@@@@@@@̎@@@̍S@q@ @@@p@@o@@n3@??@@@@@@aZ@[@\@@@@డE)unguarded#EnvVOhqWOht@ ZOhu[Oh~@@@@@@R@ @@@R@@@R7@@@R@@@R@@R@@R@@@@@@@́@٠@@@̀@@@ՠM@@@~@@@}@@|@@{G@@ఐ"tyOhOh@Q@@C@@@̑U@̓U@̒[@@ఐȠ&idlistOhOh@@@h@@V@@vi@@ภaOhOh@U@@@S@̙v@@d@@w@@@ @Ġ'DynamicPP@@@@@l@@@H@@o@@@I@@@@ఠ"tykRR@A@@@@@̱T@̚ @ఐ#*expressionRR@İ@@@9@@@̞6@@@̝@@̜@@ఐ $exprRR@@@=*@@ภ&Return RR@x@@@H@@@̹9@@(@@6:@A@R@@డ"&&S# S%@@@@@K@@@@J@@@I@@H@@G(%sequandBA@@@@@@]@@@@@@@@@@@@@@̿@@̾@@̽3FEEFFFFF@wp@q@r@@@@డ)+WSXS@'@@@(@@@@@@T@@ ,@@@@@@@!@@డi)unguarded#EnvzS{S @ ~S S@@$@@@,@@@@$@@@@@@Z@@@@@@@@@@N@@ఐɠ"tySS@X@@P@@@V@V@b@@ఐՠ&idlistSS@@@o@@?@@[p@@ภnS S"@b@@@hT@}@@M@@@@@@U@@@డbS>S?@Ʃ@@@@@@@@@T@@ Ư@@@@@@@@@డ)dependent#EnvS&S)@ S*S3@@@@@@R@4Q@@@R@@@R03@@@R@@@R@@R@@R@,)@@@@@@@Jg@@@@@@FI@@@ @@@ @@ @@ @@ఐb"ty:S4;S6@@@@@@ V@"V@!@@ఐn&idlistNS7OS=@S@@@@U@@r @@ภZS@[SB@@@@T@(@@c@@:@@@@)U@@@ @@T@!@V@@@@@AlK@@@A@nJ@@ఐʠ(is_validxUKSyUK[@@@˰@@۷@@@1P@03~}}~~~~~@ @@@ภ$SomeUKaUKe@ఐ%rkindUKfUKk@ܰ@@@@@8P@@@@ఐ.value_bindingsrwsw@@@@@@@@@@@@@@ @@@@@@@3@jc@d@e\U@V@W6/@0@1@@@@ఐs(rec_flagww@@@9@@@;T@CT@B@@ఐx(bindingsww@"@@FE@@@:@@@9T@FT@D3@@ఐ$modeww@@@@@@HC@@ఐ*class_exprww@ @@@@@@Q@@@@P@@@O@@N@@M_@@ఐE$modeww@$@@@@@]U@aU@`s@@ఐ"ceww@y@@@@@\U@cU@b@@ww@@@@@@@dU@[@@ @@@Ġ.Tcl_constraint$x%x@$ఠ"cev-x.x@FA@@Z@@@310011111@J@@@@8x9x@@$$@@@@@@ @@DxEx@@$$@@@@@@@@PxQx @@$$@@@@@@%@@\x"]x#@@$@@@-@@@>bx$@@+b@@@2@@+e@@@5@@@ఐ+*class_exprry(0sy(:@@@@F@@@k@@@@jE@@@i@@h@@g3~~@[T@U@V@@@@ఐ堐$modey(;y(?@İ@@e@@@wT@{T@z@@ఐv"cey(@y(B@!@@@@@vT@}T@|+@@< @@p,@Ġ(Tcl_openzCKzCS@$h@zCUzCV@@$j@@@@ఠ"cewzCXzCZ@A@@Z@@@@@@zC[@@+@@@@@+@@@ @@@ఐ*class_expr{_g{_q@,@@@@@@΄@@@@΃@@@΂@@΁@@΀3@.'@(@)@@@@ఐT$mode{_r{_v@3@@@@@ΐT@ΔT@Γ@@ఐI"ce{_w{_y@!@@*@@@ΏT@ΖT@Ε+@@< @@,@@@Ac @@@@@v@#c@б@гx@|@@@x{@б@гlɠF@s@@@y@г@@@@z@@@@{@@@@|@(8A@@@@@@Ғ@e@@@ґ@@@Ґ@@ҏ@@ҎO@҉@@@[bvxI@@డZ)unguarded#Envk}l}@ o}p}@@@@@@@@қ@נ@@@Қ@@@ҙӠK@@@Ҙ@@@җ@@Җ@@ҕ3@@@@@ఐN*class_expr}}@@@@i@@@ұ@@@@Ұh@@@ү@@Ү@@ҭ@@ภ&Return}}@@@@@@@ҽQ@.@@ఐ"ce}}@@@;@@}}@@r@@@ҫ@Q@һE@@ఐҠ&idlist}}@@@R@@p@@-@@@Ҩ@@@ҧZ@Ġ~~@@@@@@@@@@@@m@@G@@@@@@t@@@ภ{~~@z@@@|@Ġ @Ƞ@@@@@@@@@@@@@@@@@@@ @@v@@@@@@@@}@@@@@@@@@ภ핰7'@@(@@D@@@A:}*@@F@+@@G@5,A@aL@3@A@0@0/@F@mgA@%Q@R@Δ@ΐ@@Ί@@A@E@5@?@@@@82A@A@~@@@ @ m@n@c@d@@B@CA@0.@@ @@@@@@@@sq@LJ@;9@*(@  @@@ @@@@@3@@@@/Value_rec_checkD@@ C@@@@ߠ@@A@*l@@N@栰@@J@g@TAtA@A4w@@@ 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  M M@ 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************************************************************************"Q#Q@ * 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 .x66/yw@ 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). 4@B5@< binding and variable cases :; @3 non-binding cases @A@< Unit-returning expressions FG@ 8 The code below was copied (in part) from translcore.ml LouMo@ m A constant expr (of type <> float if [Config.flat_float_array] is true) gets compiled as itself. R SX@0 Forward blocks XY@ 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 d e!!@ = Note: we don't try to compute any size for complex patterns j""k""@  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. p##q&&@ local modules could have such paths to local definitions; classify_expression could be extend to compute module shapes more precisely v'8'@w''@ #* {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. φ * 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. r * 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. ^ * 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. J Lower-ranked modes demand/use less of the variable/expression they qualify -- so they allow more recursive definitions. Ignore < Delay < Guard < Return < Dereference i33m4J4N@ Returns the more conservative (highest-ranking) mode of the two arguments. In judgments we write (m + m') for (join m m'). u44y5N5R@ 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. }5567@ K* Create an environment with a single identifier used with a given mode. V +* 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) v k* Environment composition m[G] extends mode composition m1[m2] by composing each mode in G pointwise P ,* Remove an identifier from an environment. * @* Remove an identifier from an environment, and return its mode  <* 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` $fQfW%g g@ G1 |- cond: m[Dereference] G2 |- body: m[Guard] --------------------------------- G1 + G2 |- while cond do body done: m *gg+h#h+@ r G |- e: m[Dereference] ---------------------- (plus weird 'eo' option) G |- e#x: m 0hh1ii"@ Z G |- e: m[Dereference] ----------------------- G |- e.x: m 6 i{i7ii@ \ 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. Bkk C#kk@ K G |- M: m ---------------- G |- module M: m H&kkI*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. N/llO7mm@  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. T?nnUHpp@ 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 ZOqWq][Vr@rH@ param P ::= | ?(pat = expr) | pat Define pat(P) as pat if P = ?(pat = expr) pat if P = pat `Xrerma_s s@ > Optional argument defaults. G |-{def} P : m fdssggss@ h G |- e : m ------------------ G |-{def} ?(p=e) : m lktOtYmott@ J ------------------ . |-{def} p : m rrtu suuKuW@ } G |- e: m[Delay] ---------------- (modulo some subtle compiler optimizations) G |- lazy e: m xvvyww @ - ---------- [] |- .: m ~yyy7y?@ ( Function bodies. G |-{body} b : m yyzz@ G |- e : m ------------------ G |-{body} e : m (**) (**) The "e" here stands for [Tfunction_body] as opposed to [Tfunction_cases]. zXz\{ {@ * (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. {M{Q|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 @ y Alias coercions ignore their arguments, but they evaluate their alias module 'pth' under another coercion. 2<y@. G |- pth : m SSSe@ ------------ 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 }@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) my m@ + 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.3-F.y@ . The expression has known size or is constant 2M 3M;@ ! The expression has unknown size 8Q9Q@  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 DeEh2<@ M ----------------------- [] |- struct ... end: m JkjrKn@ U --------------------------- [] |- fun x1 ... xn -> C: m Pq QtZd@@-./boot/ocamlc)-nostdlib"-I&./boot*-use-prims2runtime/primitives"-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_events"-c =/builds/workspace/precheck/flambda/false/label/ocaml-linux-32 >10/.-,+*)('&%$#"! @@0׋f[){Um 3@@@,0>n{T8cئ5Build_path_prefix_map0z HkGs8CamlinternalFormatBasics0%FU(Q/Tu0CamlinternalLazy0&͂7 Pˆ*Cmi_format0c˯7͗ԩmݠ*Data_types0I'Ue`wq]Ѡ)Debuginfo0PtJ=^w/#Env0zV L{YWI*Format_doc0]mWϓ:Mݠ%Ident0">WA+9*X,Identifiable0 {d\FX'`&Lambda0z1x]&ZT)Load_path0I@18 ~(Location0a7cK_H%9)Longident0s `7mɕc$Misc0ob]6>Vê>+Outcometree0kX%d5Q/+)Parsetree0T鿁ۘ7Qu$Path0Y2kf֯J._Ϡ)Primitive0²~$xzT෠%Shape0oNՄBH&Stdlib0Lku]8_٠-Stdlib__Array0?3$( Q&.Stdlib__Buffer08APF< t..Stdlib__Digest0l!LHgErζ .Stdlib__Domain0:M;׉<O$Ġ.Stdlib__Either0Vy`u~c à.Stdlib__Format0ܚ#G7m|/Stdlib__Hashtbl0ѱN][/!,Stdlib__Lazy0* -S$.)"0D.Stdlib__Lexing0e<.V ,Stdlib__List0MYm 7R+Stdlib__Map0L5xE|O0~,J-.Stdlib__Result06 ]/J+Stdlib__Seq0nwzG&amg+Stdlib__Set0\$;7 .Stdlib__String0s.Type_immediacy0A^abOhՠ0ekG |tz06]xs<%Types0^Y~# )Unit_info0ڀh%(0mUwK! aڱSm=/Value_rec_types0`4xiVC(Warnings0mJɒkgr @@E@@@$Y$ctԑ@,G@@n]@IS@@77"@II '@=>g@@@@@@@@Fmzm *Б@@@>@F=̓W@b԰KÑ@qIqSAKїѡ@@##@@is@nwn@pz@8`@uّu@@f԰-7ߑ@@@@@wR9HR|@XX͸͈F@E#E-@t@ r |cqӈ@*40n0x6@o@͡@dn@*<Ñ<ͰE#E-@@#r#|@@@@|@@@@(*(4@o&]@fp@@CCo6o@@""@p|p@CM''!*P@ )@@@PZ@@:P:Z=߰yt~%/@@66@ yу@ 0@!@@ ڑ >f@͍̓@v@UѰ@ i ԑDh3.@@@bO @&&@x!4@ ؑ OPܓm@@@@@S]&@  ak@HɰӫN@''@͑װk!k+@@P@ @ @@@A>@;@@@B@@