Caml1999I037j ) 2Builtin_attributes-current_phase;@@&Parser@@>parsing/builtin_attributes.mliD < QD < W@@A@/Invariant_check@@ D < X D < i@@B@@@A@@@@@D < <@@A@@@A@-register_attr@$@@@v@(Location#loc&stringQ@@@w@@@x$unitF@@@y@@z@@{@3E j j4E j @@CC@@7mark_payload_attrs_used@)Parsetree'payload@@@|@@@}@@~@JL  KL  <@@ZF@@+warn_unused@(@@@,@@@@@@]Q^Q%@@mG@@/mark_alert_used@*)attribute@@@A@@@@@@rb--sb-^@@H@@0mark_alerts_used@?*attributes@@@V@@@@@@ee@@I@@ !mark_warn_on_literal_pattern_used@T*attributes@@@k@@@@@@jppjp@@J@@*%"e$Misc0ob]6>Vê>)Longident0s `7mɕc(Location0a7cK_H%9*Format_doc0]mWϓ:Mݠ0CamlinternalLazy0&͂7 Pˆ8CamlinternalFormatBasics0%FU(Q/Tu5Build_path_prefix_map0z HkGs(Asttypes0>n{T8cئ@@@Caml1999T037{ Cy<C2Builtin_attributes*ocaml.text&_none_@@A  Support for the builtin attributes: - ocaml.alert - ocaml.boxed - ocaml.deprecated - ocaml.deprecated_mutable - ocaml.explicit_arity - ocaml.immediate - ocaml.immediate64 - ocaml.inline - ocaml.inlined - ocaml.noalloc - ocaml.poll - ocaml.ppwarning - ocaml.remove_aliases - ocaml.specialise - ocaml.specialised - ocaml.tailcall - ocaml.tail_mod_cons - ocaml.unboxed - ocaml.untagged - ocaml.unrolled - ocaml.warnerror - ocaml.warning - ocaml.warn_on_literal_pattern {b Warning:} this module is unstable and part of {{!Compiler_libs}compiler-libs}. >parsing/builtin_attributes.mliP77m@@@@@@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@Ax ' {2 Attribute tracking for warning 53} oo@@@@@@A+-current_phaseAD < AD < N@@;@@&Parser@@D < QD < W@@A@/Invariant_check@@D < XD < i@@B@@@A@@@@@D < <@)ocaml.doc @ [register_attr] must be called on the locations of all attributes that should be tracked for the purpose of misplaced attribute warnings. In particular, it should be called on all attributes that are present in the source program except those that are contained in the payload of another attribute (because these may be left behind by a ppx and intentionally ignored by the compiler). The [current_phase] argument indicates when this function is being called - either when an attribute is created in the parser or when we see an attribute while running the check in the [Ast_invariants] module. This is used to ensure that we track only attributes from the final version of the parse tree: we skip adding attributes seen at parse time if we can see that a ppx will be run later, because the [Ast_invariants] check is always run on the result of a ppx. Note that the [Ast_invariants] check is also run on parse trees created from marshalled ast files if no ppx is being used, ensuring we don't miss attributes in that case. qC 9 ;@@@@@@@A@@@@#&&$#@"@@@&@#""D < Z @@@@#@@A@֐@@@@@@@ΰ*-@-register_attrZE j nE j {@б@гT-current_phaseE j ~E j @@ @@@3@_Y@A@@б@г(Location#loc(LocationE j E j @ E j E j @@гՠ&string E j  E j @@ @@@&@@@"@@@+ @@гʠ$unitE j E j @@ @@@8@@@@@;@@@A@@>D @@@+E j j@@CC@@@@D7mark_payload_attrs_used6L  7L  @б@г)Parsetree'payload)ParsetreeGL  #HL  ,@ KL  -LL  4@@@@@@\3NMMNNNNN@h}*@A @@г$unit[L  8\L  <@@ @@@]@@@@@^@@@fL   @ S Marks the attributes hiding in the payload of another attribute used, for the purposes of misplaced attribute warnings (see comment on [current_phase] above). In the parser, it's simplest to add these to the table and remove them later, rather than threading through state tracking whether we're in an attribute payload. sG  tK  @@@@@@@F@@@@@@@@@1+warn_unusedQ Q@б@гB$unitQQ@@ @@@_3@Jj8@A@@гQ$unitQ!Q%@@ @@@`@@@@@a@@@Q @ Issue misplaced attribute warnings for all attributes created with [mk_internal] but not yet marked used. Does nothing if compilation is stopped before lambda due to command-line flags. N > >P @@@@@@@G@@@А@@@@@@1ݐ > {3 Warning 53 helpers for environment attributes} Some attributes, like deprecation markers, do not affect the compilation of the definition on which they appear, but rather result in warnings on future uses of that definition. This is implemented by moving the raw attributes into the environment, where they will be noticed on future accesses. To make misplaced attribute warnings work appropriately for these attributes, we mark them "used" when they are moved into the environment. This is done with the helper functions in this section. S'']hj@@@@@@3@CX1@A/mark_alert_usedb-1b-@@б@г)attribute)Parsetreeb-Cb-L@ b-Mb-V@@@@@@b# @@г$unitb-Zb-^@@ @@@c0@@@@@d3@@@b-- @j Marks the attribute used for the purposes of misplaced attribute warnings if it is an alert. Call this when moving things allowed to have alert attributes into the environment. _ll a,@@@@@@@8H@@@z3@@@@@@R0mark_alerts_used6e7e@б@г*attributes)ParsetreeEeFe@ IeJe@@@@@@e3LKKLLLLL@toA@A @@г$unitYeZe@@ @@@f@@@@@g@@@de @ * The same as [List.iter mark_alert_used]. qd``rd`@@@@@@@I@@@@@@@@@1 !mark_warn_on_literal_pattern_usedjptjp@б@гR*attributes)Parsetreejpjp@ jpjp@@@@@@h3@SqA@A @@гX$unitjpjp@@ @@@i@@@@@j@@@jpp @ Marks "warn_on_literal_pattern" attributes used for the purposes of misplaced attribute warnings. Call this when moving constructors into the environment. gi\o@@@@@@@J@@@א@@@@@@1\!@A@@б@г)signature)Parsetreexx@ xx"@@@@@@| @@гU&alerts$Miscx&x*@ x+x1@@@@@@}0 @@@@@~3$ @@D9@@6x @@@x@@O@@@@=-alerts_of_stry26y2C@б$markгƠ$booly2J y2N@@ @@@3        @Xo!@A@@б@г)structure)Parsetreey2Ry2[@ !y2\"y2e@@@@@@ @@г&alerts$Misc3y2i4y2m@ 7y2n8y2t@@@@@@0 @@@@@3$ @@D9@@6Dy2E @@@Gy22@@_P@@@@=8check_deprecated_mutableR{vzS{v@б@гg!t(Locationa|b|@ e|f|@@@@@@3hgghhhhh@_v(@A @@б@г6*attributes)Parsetree{|||@ ||@@@@@@ @@б@гY&string||@@ @@@)@@гI$unit||@@ @@@6@@@@@9@@@%@@<- @@@B@@?J@@@{vv@@Q@@@@E "check_deprecated_mutable_inclusion}}@б#defг!t(Location~~@ ~~@@@@@@3@i*@A @@б#useг!t(Location~ ~@ ~~@@@@@@ @@б@г!t(Location~~#@ ~$~%@@@@@@4 @@б@г*attributes)Parsetree~)~2@ ~3~=@@@@@@L @@б@г*attributes)Parsetree-AC.AL@ 1AM2AW@@@@@@d @@б@г &stringAA[BAa@@ @@@s@@г$unitNAeOAi@@ @@@@@@@@@@@%@@- @@@@@@H@@@[@@c@@v@@c~ @@@@g~@@@j}@@R@@@@2error_of_extensionukovk@б@г?)extension)Parsetreekk@ kk@@@@@@3@(@A @@г%error(Locationkk@ kk@@@@@@ @@@@@& @@@kk @@S@@@@!1warning_attribute@б)ppwarningг$bool@@ @@@3@<Z!@A@@б@г)attribute)Parsetree@ @@@@@@ @@г$unit@@ @@@'@@@@@*@@;\4@@@ @@2@@ @@W & Apply warning settings from the specified attribute. "ocaml.warning"/"ocaml.warnerror" (and variants without the prefix) are processed and marked used for warning 53. Other attributes are ignored. Also implement ocaml.ppwarning (unless ~ppwarning:false is passed).   @@@@@@@%T@@$@g @@@@@@R-warning_scope##$0@б)ppwarningг$bool02?12C@@ @@@321122222@m:@A@@б@г*attributes)ParsetreeEGIFGR@ IGSJG]@@@@@@ @@б@б@г$unit[Gb\Gf@@ @@@+@@А!a@B@4jGjkGl@@@ @@9@@А!a=sGqtGs@@@ @@BxGa@@@/@@F7@@WO@@@ @@M24@@ @@ސ v Execute a function in a new scope for warning settings. This means that the effect of any call to [warning_attribute] during the execution of this function will be discarded after execution. The function also takes a list of attributes which are processed with [warning_attribute] in the fresh scope before the function is executed. tv@@@@@@@U@@#@@@@@@@m 5 {2 Helpers for searching for particular attributes} -@@@@@@3@1@A-has_attribute@б@г&string@@ @@@@@б@г*attributes)Parsetree%@ &0@@@@@@2 @@г$bool48@@ @@@?@@@@@B@@@.@@E1 @@@@S [has_attribute name attrs] is true if an attribute with name [name] or ["ocaml." ^ name] is present in [attrs]. It marks that attribute used for the purposes of misplaced attribute warnings.  // @@@@@@@ !V@@@c @@@@@@dA++attr_actionB  !@@;@@.Mark_used_only @@ * +@@ CX@&Return @@ 3 4@@ LY@@@A@@@@@ 7@  [select_attributes actions attrs] finds the elements of [attrs] that appear in [actions] and either returns them or just marks them used, according to the corresponding [attr_action]. Each element [(nm, action)] of the [actions] list is an attribute along with an [attr_action] specifying what to do with that attribute. The action is used to accommodate different compiler configurations. If an attribute is used only in some compiler configurations, it's important that we still look for it and mark it used when compiling with other configurations. Otherwise, we would issue spurious misplaced attribute warnings.  D:: E@@@@@@@A@ ]W@@#$$"!@ @@@$@#   Q@@@@!@@A@ c@@@@@@@3 [ Z Z [ [ [ [ [@g@A*-@1select_attributes  i j @б@г$list t) u-@В@г L&string  @@ @@@3        @*mg@A@@@гs+attr_action  '@@ @@@@@@@@ @@ @@@3 @@@ 1@@б@гn*attributes)Parsetree 1 :@  ; E@@@@@@6 @@г*attributes)Parsetree I R@  S ]@@@@@@L @@@@@O$ @@@9@@R5 @@@ @@ Z@@@@X3attr_equals_builtin   @б@г)attribute)Parsetree  @   @@@@@@3        @z(@A @@б@г ֠&string  @@ @@@@@г נ$bool  @@ @@@@@@@@!@@@'@@$/ @@@ '@ U [attr_equals_builtin attr s] is true if the name of the attribute is [s] or ["ocaml." ^ s]. This is useful for manually inspecting attribute names, but note that doing so will not result in marking the attribute used for the purpose of warning 53, so it is usually preferable to use [has_attribute] or [select_attributes].  4__ 5@@@@@@@ M[@@@ H@@@@@@C7warn_on_literal_pattern  K L @б@г*attributes)Parsetree Z  [ !@  ^ " _ ,@@@@@@3 a ` ` a a a a a@eA@A @@г ,$bool n 0 o 4@@ @@@@@@@@@@@ y @@ \@@ @@.explicit_arity  5 9  5 G@б@гN*attributes)Parsetree  5 I  5 R@   5 S  5 ]@@@@@@3        @:X(@A @@г e$bool  5 a  5 e@@ @@@@@@@@@@@  5 5 @@ ]@@ @@)immediate  g k  g t@б@г*attributes)Parsetree  g v  g @   g   g @@@@@@3        @:X(@A @@г $bool  g   g @@ @@@@@@@@@@@  g g @@ ^@@ @@+immediate64      @б@г*attributes)Parsetree      @       @@@@@@3        @:X(@A @@г נ$bool      @@ @@@@@@@@@@@ $   @@ <_@@ @@+has_unboxed /   0  @б@г*attributes)Parsetree >   ?  @  B   C  @@@@@@3 E D D E E E E E@:X(@A @@г $bool R   S  @@ @@@@@@@@@@@ ]   @@ u`@@ @@)has_boxed h   i  @б@г 2*attributes)Parsetree w   x !@  { !  | !@@@@@@3 ~ } } ~ ~ ~ ~ ~@:X(@A @@г I$bool  !  !@@ @@@@@@@@@@@    @@ a@@ @@2has_remove_aliases !!! !!3@б@г k*attributes)Parsetree !!5 !!>@  !!? !!I@@@@@@3        @:X(@A @@г $bool !!M !!Q@@ @@@@@@@@@@@ !! @@ b@@ @@*has_atomic !S!W !S!a@б@г *attributes)Parsetree !S!c !S!l@  !S!m !S!w@@@@@@3        @:X(@A @@г $bool !S!{ !S!@@ @@@@@@@@@@@ !S!S @@ c@@ @@@  zA@ 9 @  @  f@ 3 @@e@E@@@@5@.@|@u@@z0@@x8@A@[@T@@@T@M@@@x@qA@@3 D C C D D D D D@UsC@A@ H************************************************************************ MA@@ NA@L@ H  SBMM TBM@ H OCaml  YC ZC@ H  _D `D3@ H Alain Frisch, LexiFi  eE44 fE4@ H  kF lF@ H Copyright 2012 Institut National de Recherche en Informatique et  qG rG@ H en Automatique.  wH xHg@ H  }Ihh ~Ih@ H All rights reserved. This file is distributed under the terms of  J J@ H the GNU Lesser General Public License version 2.1, with the  K KN@ H special exception on linking described in the file LICENSE.  LOO LO@ H  M M@ H************************************************************************ N N5@ * Support for the builtin attributes: - ocaml.alert - ocaml.boxed - ocaml.deprecated - ocaml.deprecated_mutable - ocaml.explicit_arity - ocaml.immediate - ocaml.immediate64 - ocaml.inline - ocaml.inlined - ocaml.noalloc - ocaml.poll - ocaml.ppwarning - ocaml.remove_aliases - ocaml.specialise - ocaml.specialised - ocaml.tailcall - ocaml.tail_mod_cons - ocaml.unboxed - ocaml.untagged - ocaml.unrolled - ocaml.warnerror - ocaml.warning - ocaml.warn_on_literal_pattern {b Warning:} this module is unstable and part of {{!Compiler_libs}compiler-libs}.  (* {2 Attribute tracking for warning 53}   A* [register_attr] must be called on the locations of all attributes that should be tracked for the purpose of misplaced attribute warnings. In particular, it should be called on all attributes that are present in the source program except those that are contained in the payload of another attribute (because these may be left behind by a ppx and intentionally ignored by the compiler). The [current_phase] argument indicates when this function is being called - either when an attribute is created in the parser or when we see an attribute while running the check in the [Ast_invariants] module. This is used to ensure that we track only attributes from the final version of the parse tree: we skip adding attributes seen at parse time if we can see that a ppx will be run later, because the [Ast_invariants] check is always run on the result of a ppx. Note that the [Ast_invariants] check is also run on parse trees created from marshalled ast files if no ppx is being used, ensuring we don't miss attributes in that case.  T* Marks the attributes hiding in the payload of another attribute used, for the purposes of misplaced attribute warnings (see comment on [current_phase] above). In the parser, it's simplest to add these to the table and remove them later, rather than threading through state tracking whether we're in an attribute payload.  7 * Issue misplaced attribute warnings for all attributes created with [mk_internal] but not yet marked used. Does nothing if compilation is stopped before lambda due to command-line flags.  ?* {3 Warning 53 helpers for environment attributes} Some attributes, like deprecation markers, do not affect the compilation of the definition on which they appear, but rather result in warnings on future uses of that definition. This is implemented by moving the raw attributes into the environment, where they will be noticed on future accesses. To make misplaced attribute warnings work appropriately for these attributes, we mark them "used" when they are moved into the environment. This is done with the helper functions in this section.  ֠ * Marks the attribute used for the purposes of misplaced attribute warnings if it is an alert. Call this when moving things allowed to have alert attributes into the environment.  +* The same as [List.iter mark_alert_used].  E * Marks "warn_on_literal_pattern" attributes used for the purposes of misplaced attribute warnings. Call this when moving constructors into the environment.  * Marks "deprecated_mutable" attributes used for the purposes of misplaced attribute warnings. Call this when moving labels of mutable fields into the environment.  /* {2 Helpers for alert and warning attributes}  '* Apply warning settings from the specified attribute. "ocaml.warning"/"ocaml.warnerror" (and variants without the prefix) are processed and marked used for warning 53. Other attributes are ignored. Also implement ocaml.ppwarning (unless ~ppwarning:false is passed).  w* Execute a function in a new scope for warning settings. This means that the effect of any call to [warning_attribute] during the execution of this function will be discarded after execution. The function also takes a list of attributes which are processed with [warning_attribute] in the fresh scope before the function is executed. 2 6* {2 Helpers for searching for particular attributes}  * [has_attribute name attrs] is true if an attribute with name [name] or ["ocaml." ^ name] is present in [attrs]. It marks that attribute used for the purposes of misplaced attribute warnings. à * [select_attributes actions attrs] finds the elements of [attrs] that appear in [actions] and either returns them or just marks them used, according to the corresponding [attr_action]. Each element [(nm, action)] of the [actions] list is an attribute along with an [attr_action] specifying what to do with that attribute. The action is used to accommodate different compiler configurations. If an attribute is used only in some compiler configurations, it's important that we still look for it and mark it used when compiling with other configurations. Otherwise, we would issue spurious misplaced attribute warnings.  V* [attr_equals_builtin attr s] is true if the name of the attribute is [s] or ["ocaml." ^ s]. This is useful for manually inspecting attribute names, but note that doing so will not result in marking the attribute used for the purpose of warning 53, so it is usually preferable to use [has_attribute] or [select_attributes]. @-./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'parsing"-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  T/home/teraram/ci/builds/workspace/parallel-build/flambda/false/label/ocaml-manycores >10/.-,+*)('&%$#"! @@0Kރ'oy+X>3 & % % & & & & &@ $@@(Asttypes0>n{T8cئ5Build_path_prefix_map0z HkGs L04{}3Vê> 0Uҩ=p>*%"e&Stdlib0Lku]8_٠.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__Map0L5xE|O0~,J-.Stdlib__Result06 ]/J+Stdlib__Seq0nwzG&amg+Stdlib__Set0\$;7 .Stdlib__String0@(h  9@@@jg W @x 1@@  @ 5 @!V@;ʐ' A @@I@@@@h ͐ @@9w u @ D *@ ϐ @@@@[V@@P@@