Caml1999I0378. ; 'Diffing$Defs$left;@@@A@@@@@1utils/diffing.mli | ~ | @@@@@@A@%right;@@@A@@@@@ @   @  @@@@A@A@"eq;@@@A@@@@@A  A  @@@@'B@A@$diff;@@@A@@@@@D   D  @@@@1C@A@%state;@@@A@@@@@)G  *G  @@@@;D@A@@@-~ e e.I & )@?E@@+change_kind;@@(Deletion@@<N  =N  @@NG@)Insertion@@EO  FO  @@WH@,Modification@@NP  OP  @@`I@,Preservation@@WQ  XQ  @@iJ@@@A@@@@@[M  @@A@lF@A@&prefix*Format_doc'printer@#intA@@@@G@@@@@@@@@|R  }R  @@K@@%style@@@@$listK$Misc%Style%style@@@@@@@@@S  S  =@@L@@&change;$left@%right@"eq@$diff@@D&Delete@@W g iW g z@@N@&Insert@@X { }X { @@O@$Keep.*&@@Y  Y  @@P@&Change:6-@@Z  Z  @@Q@@@A@YYYY@@@@@@@@V @ @ @@@@M@A@(classify@Y@@@@@@@@@@@@@@\  \  @@R@@Ӡ&Define@!D"&change;@@@A($left@@@%right@@@ "eq@@@$diff@@@@@@@@@@;f<f4@@@@MT@@@%patch ;@@@A3@@@@@@@@@@Og57Pg5O@@@@aU@A@*Parameters -update_result;@@@A@@@@@`kak@@@@rV@A@&weight@!@@@@@@@@@rmsm@@W@@$test@[%state@@@@b$left@@@@i%right@@@&Stdlib&resultv"eq@@@۠|$diff@@@@@@@@@@@@@q>Bq>w@@X@@&update@e@@@@%state@@@`@@@@@@@@ww%@@Y@@@@j|@Z@@!S $diff@%state@@@@%arrayJ$left@@@@@@@%right@@@@@@@@@@@@@@@@%@@[@@@@~@ \@@Ӡ&Simple @@@@@@@@@@@@@@@@@@@@@@@@@@@ @@@@@@@@@@@@@@@@'@@@@@@@"@@@&%state@@@@@@@@;@@@@OP@a^@@@Ӡ-Left_variadic @@@@@@@@@@@@gh@@@@N@@@@T@@@@Z@@@b@@@g@@@@@@@@@@@@@'@@@J@@@@w@@@@%state@@@@Π$left@@@@@@@@@@@@@K@@@e@}@`@@@Ӡ.Right_variadic@@[@{@@@Z@@@@@@1@@Y@X@W@@@@V@@@@U@@@TQP@@@O@@@@@@@@@@@@@'@K@J@@@@@I@@@@%state@@@@2%right@@@@@@@@@@@@@K@V@@@7@)b@@@@@b9<@-c@@@@bZQ'Diffing0ɞyM۠-Stdlib__Uchar056uf4[_.Stdlib__String0Vê>*Format_doc0]mWϓ:Mݠ8CamlinternalFormatBasics0%FU(Q/Tu5Build_path_prefix_map0z HkGs@@@Caml1999T037[ a73#C'Diffing*ocaml.text&_none_@@A  Parametric diffing This module implements diffing over lists of arbitrary content. It is parameterized by - The content of the two lists - The equality witness when an element is kept - The diffing witness when an element is changed Diffing is extended to maintain state depending on the computed changes while walking through the two lists. The underlying algorithm is a modified Wagner-Fischer algorithm (see ). We provide the following guarantee: Given two lists [l] and [r], if different patches result in different states, we say that the state diverges. - We always return the optimal patch on prefixes of [l] and [r] on which state does not diverge. - Otherwise, we return a correct but non-optimal patch where subpatches with no divergent states are optimal for the given initial state. More precisely, the optimality of Wagner-Fischer depends on the property that the edit-distance between a k-prefix of the left input and a l-prefix of the right input d(k,l) satisfies d(k,l) = min ( del_cost + d(k-1,l), insert_cost + d(k,l-1), change_cost + d(k-1,l-1) ) Under this hypothesis, it is optimal to choose greedily the state of the minimal patch transforming the left k-prefix into the right l-prefix as a representative of the states of all possible patches transforming the left k-prefix into the right l-prefix. If this property is not satisfied, we can still choose greedily a representative state. However, the computed patch is no more guaranteed to be globally optimal. Nevertheless, it is still a correct patch, which is even optimal among all explored patches. 1utils/diffing.mliP77{ / 1@@@@@@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$DefsF~ e q~ e u@E@БA+$leftA |  | @@;@@@A@@@@@ | ~@@@@@@@@A@@@3@@A@A+%rightB@  @  @@;@@A@@@@@@  @@@@A@@@A@@@3@@A@A+"eqCA  A  @@;@@$A@@@@@A  @)ocaml.docɐ9 Detailed equality trace B  B  @@@@@@@@@B@@@A@ِ@@@@@@@3@.93@A #@A+$diffDD  D  @@;@@QA@@@@@D  @-; Detailed difference trace E  E  @@@@@@@@@ C@@@A@<@@@@@@@3@,RL@A!@A+%stateE G   G  @@;@@|A@@@@@G  @X environment of a partial patch H  H  %@@@@@@@@@5D@@@A@g/@@@@@@@3'&&'''''@,PJ@A!@@A@A@~A@YSA@0*A@@343344444@2,@A 376677777@5@A<~ e x=I & )@@N , The core types of a diffing implementation K} 3 3L} 3 d@@@@@@@N~ e e@L@A++change_kindGYM  ZM  @@;@@(Deletion@@cN  dN  @@|G@)Insertion@@lO  mO  @@H@,Modification@@uP  vP  @@I@,Preservation@@~Q  Q  @@J@@@A@@@@@M  @ː Z The kind of changes which is used to share printing and styling across implementationK + +L o @@@@@@@A@F@@#66N  4@3@@@7@#33O  1@0@@@4@#00P  .@-@@@1@#--Q  +@*@@@.@@A@*)(@((@@@(@(@@3@=2,A@"A@ A@A@A@@ @@@@@@N@ANQ@&prefixZR  R  @г*Format_doc'printer*Format_docR  R  @ R  R  @@В@г͠#intR  R  @@ @@@3@J@A@@@г+change_kind R   R  @@ @@@@@@@@ @@ @@@> @@@R  2@@@ R  5@@8K@@7@@$%style+S  ,S  @б@гݠ+change_kind6S  7S  $@@ @@@387788888@=i@A@@г$listES  9FS  =@г$Misc%Style%style$MiscYS  (ZS  ,@ ]S  -^S  2@@bS  3cS  8@ @@@@@ ;-@@@+@@@ =2(@@@8@@ >5;+@@@sS  .@@L@@0@@;A+&changeHV @ ^V @ d@А$left@ C3@Pe;@@ ?@@ @@@ A@@ B@D@A@GGGG@BBBB@@@V @ @Z  @@@@M@@AV @ FV @ K@@BAА%right@ D)V @ LV @ R@@ А"eq@ E4V @ SV @ V@@А$diff@ F?V @ WV @ \@@"@;G @D&DeleteSI@ G@@W g iW g z@@N@&Insert6I@ I@@X { }X { @@O@$KeepkI@ KEI@ M=I@ O@@Y  Y  @@P@&Change}I@ QWI@ SDI@ U@@ Z  g@@"Q@@@A@YYYY@@@@@@@@r@@@o@#DDW g kW g q@?@А$leftI!W g uG@@@@I@#EE&X { 'X { @@@А%rightJ.X { H@@@@J@#FF3Y  4Y  @;@А$leftK;Y  <Y  @@А%rightOBY  CY  @@А"eqSIY  Q@@@@S@#OONZ  OZ  @E@А$leftT̰VZ  WZ  @@А%rightXӰ]Z  ^Z  @@А$diff\ڰdZ  @@@@\@@A@@@3baabbbbb@@A@(classifyo\  p\  @б@г&changez\  {\  @@@@ e3}||}}}}}@@A\  \  @@@@@ f @@@@ g  @@@@ h@@ @@@ m@@гG+change_kind\  \  @@ @@@ n%@@@@@ o(&@@@\   @@R@@ @@.&DefineIbb@c@@Т!DJbb@РN$Defsbb@3@Qg)@A@@Бࠐ!Dcc@@A3@'@ @%S@*@Ac @@3@@A @@+&changeKff@@;@@gA&$left@@@ p,%right@@@ q2"eq@@@ r8$diff@@@ s@@@ x@@@@ff4@a * The type of potential changes on a list. %e&e@@@@@@@@@>T@@@Aг/&change/f.@г346f7f@@:V@@г67?f@f$@@=_@@г9:Hf%If'@@@h@@г<=Qf(Rf,@@Cq@@@ZrUf>@@@f>=@==@@@=@=@@KJ@A+%patchLkg5<lg5A@@;@@A@@@ @@@ @@@@yg57zg5O@Ð ( A patch is an ordered list of changes. hPRhP@@@@@@@@@U@@@Aг$listg5K@г &changeg5Dg5J@@(3@7;@@@A?@@@ @ @@@@/,@@@A@@@9 /@@1/.@..@@@.@.@@3@@A=<@*ParametersNjj@Z@БA+-update_resultMkk@@;@@?A@@@@@k@@@@V@@@A@@@3@9oi@A@&weight mm@б@г&changemm@@ @@@ 3@'!@A@@г̠#intmm@@ @@@ @@@@@ @@@m @M ] [weight ch] returns the weight of the change [ch]. Used to find the smallest patch. no<@@@@@@@*W@@@]%@@@@@@1$testà(q>F)q>J@б@гT%state3q>L4q>Q@@ @@@ 354455555@J_8@A@@б@гe$leftDq>UEq>Y@@ @@@ @@б@гt%rightSq>]Tq>b@@ @@@  @@г&result`q>qaq>w@г"eqjq>gkq>i@@ @@@ 7@@г$diffxq>kyq>o@@ @@@ E@@@%@@@ Kq>f$@@@2 @@ O5'@@@D@@ RG*@@@X@@ U[-@@@q>B0@ِ r [test st xl xr] tests if the elements [xl] and [xr] are co mpatible ([Ok]) or not ([Error]). rx|u@@@@@@@X@@@@@@@@@@t&updateĠww@б@гɠ&changeww @@ @@@ 3@8@A@@б@г%stateww@@ @@@ @@г-update_resultww%@@ @@@ @@@@@ !@@@'@@ $* @@@w@4 [update ch st] returns the new state after applying a change. The [update_result] type also contains expansions in the variadic case. x&*{@@@@@@@Y@@@D @@@@@@C@?9A@0 @@_&@@3        @La(@A 3@>@Aj|@@@j@3@D@A@!SO"~#~@;\@Б$diffƠ12@б@г]%state<=@@ @@@ 3>==>>>>>@n~xA@oH@(@e@@@8@A@@б@гޠ%arrayXY @г$leftbc@@ @@@ &@@@@@@ + @@б@г%arrayvw@г%right@@ @@@ D@@@@@@ I @@г'%patch %@@ @@@ V@@@@@ Y@@@5@@ \< @@@b@@ _e@@@@쐠 o [diff state l r] computes the optimal patch between [l] and [r], using the initial state [state]. &*@@@@@@@[@@!@Đ@@@@@@~@ @@3@"@A3@@A~@@@~@3@@A@&SimpleP@^@@Т@@УР(*Parameters@3@O@@@(@A  @@*-update_result@+2@;@@@A(%state@@@ @@@@@@@@]@@@Aг   @@' @@ @@9@5@@@ )@@@ @@ @9@ @@M@@@ @S@@@ @Y@@@ ܠa@@@ f@@@ @@@ @@ @@ @@ @%@@@@@ @v@@@ zR@@@ @@ @@ @8j\@@m8@Р;!S]^@w@@@Rzd@@@f @~ @-Left_variadicRr}s}@`@@Т@@УРĠ*Parameters@3@@@yx@nm@LK@@:@-@A@@̠-update_result@+Ԡ@;@@@A@%state@@@ @:$left@@@ @@@ @@ @@@@@@@@_@@@AВ@г@@!B@@@г%array@г!"@@(T@@@-U"@@@9V#@@%@@@@@@ =@@@ <@@ ;@h1@@@@@@ :@@@@ 9@$@@@ 8,@@@ 61@@@ 7@@@ 5@@ 4@@ 3@@ 2@%}o@`@\@@@ 1@AP@@@ 0@I{@@@ -@zRy@@@ /@@@ .@@ ,@@ +@@ *@FC5@@F@Р!S 6 7@@@@` =@@ N {1 Variadic diffing} Variadic diffing allows to expand the lists being diffed during diffing. in one specific direction.  K Lx|@@@@@@@ N}@ʰ@.Right_variadicT Z [@ sb@@Т@@ nУР*Parameters j k@3 j i i j j j j j@@@@@ih@@I;:@::@@@:@:@7@A@@-update_result   @+Ơ@;@@@A@%state@@@ >@ ,%right@@@ ?@@@ A@@ B@@@@  1@@@@ a@@@AВ@г  #@@!L@@@г%array ,@г!" & +@@(^@@@-_"@@@9`#@@%@@@@@@ @@@ @@ ~@r1@@@ @@@ }@@@@ |@@@@ {@@@ y#@@@ z@@@ x@@ w@@ v@@ u@%oa@R@N@@@ t@3B@@@ s@;{@@@ p@zDy@@@ r@@@ q@@ o@@ n@@ m@F5'@@F@Р!S (6 )7@@@@` /@@@ 1 @Ű @@C=@@A@*@%{@|@w@p@@j@@@ @@@@@@@3 E D D E E E E E@@@~@ts@RQ@@2@%@A#3 S R R S S S S S@s@A Xb Y9<@@3 Y X X Y Y Y Y Y@@A@@ n [Define(Defs)] creates the diffing types from the types defined in [Defs] and the functors that need to be instantatied with the diffing algorithm parameters  k^   la@@@@@@@ nb@@@;'@!A@Z@S @A@@@'ɐ"!@!!@@@!@!@@@@3        @@Ґɑ@@/)A@A@@}@@@@@} @@@@@@@@qp@@_@R@@L@@@@@@JwP@@q@@@@@@@u@@@Pd@A@ H************************************************************************ A@@ A@L@ H  BMM BM@ H OCaml  C C@ H  D D3@ H Gabriel Radanne, projet Cambium, Inria Paris  E44 E4@ H  F F@ H Copyright 2020 Institut National de Recherche en Informatique et  G G@ H en Automatique.  H Hg@ 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@ * Parametric diffing This module implements diffing over lists of arbitrary content. It is parameterized by - The content of the two lists - The equality witness when an element is kept - The diffing witness when an element is changed Diffing is extended to maintain state depending on the computed changes while walking through the two lists. The underlying algorithm is a modified Wagner-Fischer algorithm (see ). We provide the following guarantee: Given two lists [l] and [r], if different patches result in different states, we say that the state diverges. - We always return the optimal patch on prefixes of [l] and [r] on which state does not diverge. - Otherwise, we return a correct but non-optimal patch where subpatches with no divergent states are optimal for the given initial state. More precisely, the optimality of Wagner-Fischer depends on the property that the edit-distance between a k-prefix of the left input and a l-prefix of the right input d(k,l) satisfies d(k,l) = min ( del_cost + d(k-1,l), insert_cost + d(k,l-1), change_cost + d(k-1,l-1) ) Under this hypothesis, it is optimal to choose greedily the state of the minimal patch transforming the left k-prefix into the right l-prefix as a representative of the states of all possible patches transforming the left k-prefix into the right l-prefix. If this property is not satisfied, we can still choose greedily a representative state. However, the computed patch is no more guaranteed to be globally optimal. Nevertheless, it is still a correct patch, which is even optimal among all explored patches.  ) -* The core types of a diffing implementation ᠠ:* Detailed equality trace  i<* Detailed difference trace  A !* environment of a partial patch   [* The kind of changes which is used to share printing and styling across implementation * [Define(Defs)] creates the diffing types from the types defined in [Defs] and the functors that need to be instantatied with the diffing algorithm parameters Р +* The type of potential changes on a list.  )* A patch is an ordered list of changes.  ^* [weight ch] returns the weight of the change [ch]. Used to find the smallest patch. 3 s* [test st xl xr] tests if the elements [xl] and [xr] are co mpatible ([Ok]) or not ([Error]).  * [update ch st] returns the new state after applying a change. The [update_result] type also contains expansions in the variadic case. R p* [diff state l r] computes the optimal patch between [l] and [r], using the initial state [state].  * {1 Variadic diffing} Variadic diffing allows to expand the lists being diffed during diffing. in one specific direction. @-./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%utils"-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/.-,+*)('&%$#"! @@0nhCQP3        @ @@5Build_path_prefix_map0z HkGs8CamlinternalFormatBasics0%FU(Q/Tu ː0ɞyM۠Ԑ0]mWϓ:Mݠf0ob]6>Vê>&Stdlib0Lku]8_٠.Stdlib__Buffer08APF< t..Stdlib__Digest0l!LHgErζ .Stdlib__Domain0:M;׉<O$Ġ.Stdlib__Either0Vy`u~c à.Stdlib__Format0ܚ#G7m|/Stdlib__Hashtbl0ѱN][/!+Stdlib__Map0L5xE|O0~,J-.Stdlib__Result06 ]/J+Stdlib__Seq0nwzG&amg+Stdlib__Set0\$;7 .Stdlib__String0