From ae4735db5e7e9386036cf7b496ebdc994514dc53 Mon Sep 17 00:00:00 2001 From: Coccinelle Date: Sun, 3 Oct 2010 14:03:24 +0200 Subject: [PATCH] Release coccinelle-0.2.1-rc1 Relese Candidate 1 for coccinelle-0.2.1 --- Makefile | 27 +- changes.txt | 16 + cocci.ml | 517 +- cocci.mli | 14 +- commitmsg | 26 +- commons/backtrace.ml | 10 +- commons/common.ml | 2336 +++--- commons/common.mli | 249 +- commons/common_extra.ml | 20 +- commons/copyright.txt | 1 + commons/glimpse.ml | 86 +- commons/interfaces.ml | 54 +- commons/oarray.ml | 20 +- commons/oassoc.ml | 38 +- commons/objet.ml | 16 +- commons/ocamlextra/dumper.ml | 2 +- commons/ocamlextra/dumper.mli | 2 +- commons/ocamlextra/mapb.ml | 2 +- commons/ocamlextra/setPt.ml | 40 +- commons/ocamlextra/setb.mli | 6 +- commons/ocamlextra/suffix_tree.ml | 6 +- commons/ocamlextra/suffix_tree.mli | 2 +- commons/ocamlextra/suffix_tree_ext.ml | 10 +- commons/ocamlextra/suffix_tree_ext.mli | 4 +- commons/ocollection.ml | 66 +- commons/ocollection.mli | 4 +- commons/ocollection/oassoc_buffer.ml | 72 +- commons/ocollection/oassoc_buffer.mli | 2 +- commons/ocollection/oassoc_cache.ml | 134 +- commons/ocollection/oassoc_cache.mli | 2 +- commons/ocollection/oassocb.ml | 6 +- commons/ocollection/oassocbdb.ml | 136 +- commons/ocollection/oassocbdb.mli | 16 +- commons/ocollection/oassocbdb_string.ml | 128 +- commons/ocollection/oassocbdb_string.mli | 16 +- commons/ocollection/oassocdbm.ml | 50 +- commons/ocollection/oassocdbm.mli | 2 +- commons/ocollection/oassoch.ml | 14 +- commons/ocollection/oassocid.ml | 6 +- commons/ocollection/ograph2way.ml | 38 +- commons/ocollection/osetb.ml | 12 +- commons/ocollection/oseth.ml | 48 +- commons/ocollection/oseti.ml | 10 +- commons/ocollection/osetpt.ml | 12 +- commons/ofullcommon.ml | 4 +- commons/ograph.ml | 6 +- commons/ograph_extended.ml | 136 +- commons/ograph_extended.mli | 40 +- commons/ograph_simple.ml | 50 +- commons/ograph_simple.mli | 10 +- commons/oset.ml | 22 +- commons/oset.mli | 6 +- commons/parser_combinators.ml | 74 +- commons/parser_combinators.mli | 8 +- commons/seti.ml | 148 +- commons/sexp_common.ml | 70 +- configure | 19 +- copyright.txt | 3 +- ctl/Makefile | 2 +- ctl/ast_ctl.ml | 26 +- ctl/ctl_engine.ml | 150 +- ctl/ctl_engine.mli | 10 +- ctl/flag_ctl.ml | 2 +- ctl/pretty_print_ctl.ml | 98 +- ctl/pretty_print_ctl.mli | 4 +- ctl/test_ctl.ml | 36 +- ctl/wrapper_ctl.ml | 42 +- ctl/wrapper_ctl.mli | 8 +- demos/orgmode.cocci | 17 +- demos/orgmode2.cocci | 34 + demos/vm.c | 5 + demos/vm.cocci | 19 + docs/manual/cocci_syntax.tex | 14 +- docs/manual/copyright.txt | 5 +- docs/manual/license.txt | 20 +- docs/manual/main.tex | 5 +- docs/manual/main_grammar.pdf | Bin 287683 -> 288765 bytes docs/manual/main_options.tex | 2 +- docs/manual/manual.pdf | Bin 365065 -> 367338 bytes docs/manual/options.pdf | Bin 94559 -> 95726 bytes docs/manual/spatch_options.tex | 16 + docs/spatch.1 | 3 +- editors/vim/ftdetect/cocci.vim | 2 +- editors/vim/syntax/cocci.vim | 2 +- engine/Makefile | 2 +- engine/asttoctl.ml | 20 +- engine/asttoctl.mli | 2 +- engine/asttoctl2.ml | 28 +- engine/asttoctl2.mli | 2 +- engine/asttomember.ml | 4 +- engine/asttomember.mli | 2 +- engine/c_vs_c.ml | 170 +- engine/c_vs_c.mli | 2 +- engine/check_exhaustive_pattern.ml | 30 +- engine/check_reachability.ml | 14 +- engine/check_reachability.mli | 2 +- engine/cocci_vs_c.ml | 1949 ++--- engine/cocci_vs_c.mli | 52 +- engine/ctlcocci_integration.ml | 156 +- engine/ctlcocci_integration.mli | 16 +- engine/ctltotex.ml | 4 +- engine/ctltotex.mli | 2 +- engine/flag_engine.ml | 2 +- engine/flag_matcher.ml | 2 +- engine/isomorphisms_c_c.ml | 24 +- engine/lib_engine.ml | 20 +- engine/lib_matcher_c.ml | 2 +- engine/lib_matcher_c.mli | 2 +- engine/main.ml | 2 +- engine/pattern_c.ml | 194 +- engine/pattern_c.mli | 4 +- engine/postprocess_transinfo.ml | 4 +- engine/postprocess_transinfo.mli | 2 +- engine/pretty_print_engine.ml | 40 +- engine/pretty_print_engine.mli | 10 +- engine/sgrep.ml | 2 +- engine/transformation_c.ml | 249 +- engine/transformation_c.mli | 6 +- extra/classic_patch.ml | 16 +- extra/classic_patch.mli | 2 +- extra/kbuild.ml | 118 +- extra/kbuild.mli | 4 +- extra/maintainers.ml | 50 +- extra/maintainers.mli | 4 +- flag_cocci.ml | 4 +- globals/Makefile | 2 +- globals/config.ml.in | 2 +- globals/flag.ml | 10 +- main.ml | 60 +- menhirlib/engine.ml | 2 +- menhirlib/infiniteArray.ml | 6 +- menhirlib/packedIntArray.ml | 2 +- menhirlib/rowDisplacement.ml | 6 +- menhirlib/tableFormat.ml | 4 +- menhirlib/tableInterpreter.ml | 40 +- ocamlsexp/pre_sexp.ml | 2 +- parsing_c/ast_c.ml | 419 +- parsing_c/comment_annotater_c.ml | 63 +- parsing_c/comment_annotater_c.mli | 2 +- parsing_c/compare_c.ml | 181 +- parsing_c/compare_c.mli | 8 +- parsing_c/control_flow_c.ml | 161 +- parsing_c/control_flow_c.mli | 12 +- parsing_c/control_flow_c_build.ml | 633 +- parsing_c/control_flow_c_build.mli | 2 +- parsing_c/cpp_analysis_c.ml | 205 +- parsing_c/cpp_analysis_c.mli | 4 +- parsing_c/cpp_ast_c.ml | 205 +- parsing_c/cpp_ast_c.mli | 28 +- parsing_c/cpp_token_c.ml | 301 +- parsing_c/cpp_token_c.mli | 18 +- parsing_c/flag_parsing_c.ml | 40 +- parsing_c/lexer_c.mll | 486 +- parsing_c/lexer_parser.ml | 51 +- parsing_c/lexer_parser.mli | 4 +- parsing_c/lib_parsing_c.ml | 103 +- parsing_c/orig.mly | 34 +- parsing_c/parse_c.ml | 479 +- parsing_c/parse_c.mli | 12 +- parsing_c/parser_c.mly | 794 +- parsing_c/parsing_consistency_c.ml | 81 +- parsing_c/parsing_consistency_c.mli | 2 +- parsing_c/parsing_hacks.ml | 953 +-- parsing_c/parsing_hacks.mli | 34 +- parsing_c/parsing_recovery_c.ml | 75 +- parsing_c/parsing_recovery_c.mli | 6 +- parsing_c/parsing_stat.ml | 115 +- parsing_c/pretty_print_c.ml | 957 +-- parsing_c/pretty_print_c.mli | 32 +- parsing_c/sexp_ast_c.ml | 44 +- parsing_c/test_parsing_c.ml | 246 +- parsing_c/token_c.ml | 51 +- parsing_c/token_helpers.ml | 295 +- parsing_c/token_helpers.mli | 2 +- parsing_c/token_views_c.ml | 293 +- parsing_c/type_annoter_c.ml | 689 +- parsing_c/type_annoter_c.mli | 16 +- parsing_c/type_c.ml | 215 +- parsing_c/type_c.mli | 14 +- parsing_c/unparse_c.ml | 221 +- parsing_c/unparse_c.mli | 6 +- parsing_c/unparse_cocci.ml | 40 +- parsing_c/unparse_cocci.mli | 2 +- parsing_c/unparse_hrule.ml | 27 +- parsing_c/unparse_hrule.mli | 4 +- parsing_c/visitor_c.ml | 923 +-- parsing_c/visitor_c.mli | 38 +- parsing_cocci/.depend | 4 +- parsing_cocci/Makefile | 2 +- parsing_cocci/adjacency.ml | 2 +- parsing_cocci/adjacency.mli | 2 +- parsing_cocci/adjust_pragmas.ml | 2 +- parsing_cocci/adjust_pragmas.mli | 2 +- parsing_cocci/arity.ml | 2 +- parsing_cocci/arity.mli | 2 +- parsing_cocci/ast0_cocci.ml | 10 +- parsing_cocci/ast0_cocci.mli | 2 +- parsing_cocci/ast0toast.ml | 2 +- parsing_cocci/ast0toast.mli | 2 +- parsing_cocci/ast_cocci.ml | 8 +- parsing_cocci/ast_cocci.mli | 2 +- parsing_cocci/check_meta.ml | 9 +- parsing_cocci/check_meta.mli | 2 +- parsing_cocci/comm_assoc.ml | 2 +- parsing_cocci/comm_assoc.mli | 2 +- parsing_cocci/compute_lines.ml | 4 +- parsing_cocci/compute_lines.mli | 2 +- parsing_cocci/context_neg.ml | 2 +- parsing_cocci/context_neg.mli | 2 +- parsing_cocci/data.ml | 9 +- parsing_cocci/data.mli | 7 +- parsing_cocci/disjdistr.ml | 14 +- parsing_cocci/disjdistr.mli | 2 +- parsing_cocci/flag_parsing_cocci.ml | 7 +- parsing_cocci/free_vars.ml | 25 +- parsing_cocci/free_vars.mli | 2 +- parsing_cocci/function_prototypes.ml | 7 +- parsing_cocci/function_prototypes.mli | 2 +- parsing_cocci/get_constants.ml | 5 +- parsing_cocci/get_constants.mli | 2 +- parsing_cocci/get_constants2.ml | 26 +- parsing_cocci/get_constants2.mli | 2 +- parsing_cocci/index.ml | 2 +- parsing_cocci/index.mli | 2 +- parsing_cocci/insert_plus.ml | 2 +- parsing_cocci/insert_plus.mli | 2 +- parsing_cocci/iso_compile.ml | 2 +- parsing_cocci/iso_compile.mli | 2 +- parsing_cocci/iso_pattern.ml | 21 +- parsing_cocci/iso_pattern.mli | 2 +- parsing_cocci/lexer_cocci.mll | 14 +- parsing_cocci/lexer_script.mll | 2 +- parsing_cocci/main.ml | 2 +- parsing_cocci/merge.ml | 2 +- parsing_cocci/merge.mli | 2 +- parsing_cocci/parse_aux.ml | 12 +- parsing_cocci/parse_cocci.ml | 22 +- parsing_cocci/parse_cocci.mli | 2 +- parsing_cocci/parser_cocci.mly | 2 +- parsing_cocci/parser_cocci_menhir.ml | 6357 +++++++++-------- parsing_cocci/parser_cocci_menhir.mli | 2 +- parsing_cocci/parser_cocci_menhir.mly | 102 +- parsing_cocci/plus.ml | 2 +- parsing_cocci/plus.mli | 2 +- parsing_cocci/pretty_print_cocci.ml | 2 +- parsing_cocci/pretty_print_cocci.mli | 2 +- parsing_cocci/semantic_cocci.ml | 2 +- parsing_cocci/simple_assignments.ml | 2 +- parsing_cocci/simple_assignments.mli | 2 +- parsing_cocci/single_statement.ml | 2 +- parsing_cocci/single_statement.mli | 2 +- parsing_cocci/test.cocci | 2 +- parsing_cocci/test2.cocci | 2 +- parsing_cocci/test_exps.ml | 2 +- parsing_cocci/test_exps.mli | 2 +- parsing_cocci/top_level.ml | 2 +- parsing_cocci/top_level.mli | 2 +- parsing_cocci/type_cocci.ml | 2 +- parsing_cocci/type_cocci.mli | 2 +- parsing_cocci/type_infer.ml | 4 +- parsing_cocci/type_infer.mli | 2 +- parsing_cocci/unify_ast.ml | 2 +- parsing_cocci/unify_ast.mli | 2 +- parsing_cocci/unitary_ast0.ml | 4 +- parsing_cocci/unitary_ast0.mli | 2 +- parsing_cocci/unparse_ast0.ml | 6 +- parsing_cocci/unparse_ast0.mli | 2 +- parsing_cocci/visitor_ast.ml | 4 +- parsing_cocci/visitor_ast.mli | 6 +- parsing_cocci/visitor_ast0.ml | 36 +- parsing_cocci/visitor_ast0.mli | 6 +- parsing_cocci/visitor_ast0_types.ml | 8 +- popl/Makefile | 2 +- popl/ast_popl.ml | 4 +- popl/asttopopl.ml | 2 +- popl/asttopopl.mli | 2 +- popl/insert_befaft.ml | 2 +- popl/insert_befaft.mli | 2 +- popl/insert_quantifiers.ml | 2 +- popl/insert_quantifiers.mli | 2 +- popl/popl.ml | 2 +- popl/popl.mli | 2 +- popl/popltoctl.ml | 2 +- popl/popltoctl.mli | 2 +- popl/pretty_print_popl.ml | 2 +- popl/pretty_print_popl.mli | 2 +- popl09/Makefile | 2 +- popl09/ast_popl.ml | 4 +- popl09/asttopopl.ml | 2 +- popl09/asttopopl.mli | 2 +- popl09/flag_popl.ml | 2 +- popl09/insert_quantifiers.ml | 2 +- popl09/insert_quantifiers.mli | 2 +- popl09/popl.ml | 2 +- popl09/popl.mli | 2 +- popl09/popltoctl.ml | 4 +- popl09/popltoctl.mli | 2 +- popl09/pretty_print_popl.ml | 4 +- popl09/pretty_print_popl.mli | 2 +- pycaml/pycaml.ml | 42 +- pycaml/pycamltest.ml | 8 +- python/Makefile | 2 +- python/coccilib/org.py | 8 + python/coccilib/{output_base.py => output.py} | 0 python/coccilib/report.py | 5 + python/coccilib/{output_trac.py => trac.py} | 0 python/no_pycocci.ml | 10 +- python/no_pycocci_aux.ml | 8 +- python/yes_pycocci.ml | 23 +- python/yes_pycocci_aux.ml | 4 +- scripts/extract_c_and_res.pl | 2 +- scripts/extract_examples.pl | 2 +- scripts/extractor_README.pl | 2 +- scripts/gather_failed.pl | 2 +- scripts/readme.pl | 2 +- scripts/stat_directories.pl | 2 +- scripts/stat_directories_complete.pl | 2 +- scripts/stat_directory_complete.pl | 2 +- standard.iso | 2 +- test.ml | 22 + testing.ml | 210 +- testing.mli | 6 +- tools/Makefile | 2 +- tools/alloc_free.ml | 2 +- tools/bridge.ml | 10 +- tools/dir_stats.ml | 2 +- tools/extract_c_and_res.ml | 14 +- tools/generate_dependencies.ml | 42 +- tools/gitgrep.ml | 2 +- tools/gitsort.ml | 8 +- tools/licensify.ml | 4 +- tools/process_isoprofile.ml | 2 +- tools/split_patch.ml | 102 +- tools/spp.ml | 2 +- 334 files changed, 13230 insertions(+), 12621 deletions(-) rewrite commitmsg (99%) create mode 100644 demos/orgmode2.cocci create mode 100644 demos/vm.c create mode 100644 demos/vm.cocci rename python/coccilib/{output_base.py => output.py} (100%) create mode 100644 python/coccilib/report.py rename python/coccilib/{output_trac.py => trac.py} (100%) diff --git a/Makefile b/Makefile index 6a44945..66e9fa3 100644 --- a/Makefile +++ b/Makefile @@ -1,4 +1,4 @@ -# Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen +# Copyright 2005-2010, Ecole des Mines de Nantes, University of Copenhagen # Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix # This file is part of Coccinelle. # @@ -82,7 +82,7 @@ EXEC=$(TARGET) # Generic ocaml variables ############################################################################## -OCAMLCFLAGS=# -g -dtypes # -w A +OCAMLCFLAGS= # for profiling add -p -inline 0 # but 'make forprofiling' below does that for you. @@ -346,9 +346,10 @@ BINSRC=spatch env.sh env.csh standard.h standard.iso \ *.txt \ docs/manual/manual.pdf docs/manual/options.pdf docs/manual/main_grammar.pdf docs/spatch.1 \ docs/manual/cocci-python.txt \ - demos/foo.* demos/simple.* -# $(PYLIB) python/coccilib/ demos/printloc.* + demos/* +BINSRC-PY=$(BINSRC) $(PYLIB) python/coccilib/ BINSRC2=$(BINSRC:%=$(PACKAGE)/%) +BINSRC2-PY=$(BINSRC-PY:%=$(PACKAGE)/%) TMP=/tmp OCAMLVERSION=$(shell ocaml -version |perl -p -e 's/.*version (.*)/$$1/;') @@ -391,25 +392,36 @@ OCAMLVERSION=$(shell ocaml -version |perl -p -e 's/.*version (.*)/$$1/;') prepackage: cvs up -CdP $(MAKE) distclean + sed -i "s|^OCAMLCFLAGS=.*$$|OCAMLCFLAGS=|" Makefile release: cvs ci -m "Release $(VERSION)" globals/config.ml.in $(MAKE) licensify package: + $(MAKE) package-src + $(MAKE) package-nopython + $(MAKE) package-python + +package-src: $(MAKE) distclean # Clean project $(MAKE) srctar + $(MAKE) coccicheck + +package-nopython: + $(MAKE) distclean # Clean project ./configure --without-python $(MAKE) docs $(MAKE) bintar $(MAKE) bytecodetar $(MAKE) staticbintar + +package-python: $(MAKE) distclean # Clean project ./configure # Reconfigure project with Python support $(MAKE) docs $(MAKE) bintar-python $(MAKE) bytecodetar-python - $(MAKE) coccicheck # I currently pre-generate the parser so the user does not have to @@ -453,7 +465,7 @@ bytecodetar: all bintar-python: all rm -f $(TMP)/$(PACKAGE) ln -s `pwd` $(TMP)/$(PACKAGE) - cd $(TMP); tar cvfz $(PACKAGE)-bin-x86-python.tgz --exclude-vcs $(BINSRC2) + cd $(TMP); tar cvfz $(PACKAGE)-bin-x86-python.tgz --exclude-vcs $(BINSRC2-PY) rm -f $(TMP)/$(PACKAGE) # add ocaml version in name ? @@ -461,7 +473,7 @@ bytecodetar-python: all rm -f $(TMP)/$(PACKAGE) ln -s `pwd` $(TMP)/$(PACKAGE) make purebytecode - cd $(TMP); tar cvfz $(PACKAGE)-bin-bytecode-$(OCAMLVERSION)-python.tgz --exclude-vcs $(BINSRC2) + cd $(TMP); tar cvfz $(PACKAGE)-bin-bytecode-$(OCAMLVERSION)-python.tgz --exclude-vcs $(BINSRC2-PY) rm -f $(TMP)/$(PACKAGE) coccicheck: @@ -577,7 +589,6 @@ distclean:: clean set -e; for i in $(MAKESUBDIRS); do $(MAKE) -C $$i $@; done rm -f .depend rm -f Makefile.config - rm -f python/coccilib/output.py rm -f python/pycocci.ml rm -f python/pycocci_aux.ml rm -f globals/config.ml diff --git a/changes.txt b/changes.txt index abbad46..8db554f 100644 --- a/changes.txt +++ b/changes.txt @@ -1,5 +1,21 @@ -*- org -*- +* 0.2.1 +** Language: +- Add virtual identifiers +- Add coccilib.report and coccilib.trac Python modules +- coccilib.org and coccilib.report are imported by default but not loaded + in the current scope. + +** Features: +- Parse_error_msg now more helpful. New option -verbose_parsing for even + more information. +- Improve Python import handling. They are imported once during script + initialization. + +** Bugfix: +- correct treatment of depends on with || for virtual rules + * 0.2.0 ** Language: diff --git a/cocci.ml b/cocci.ml index 97cabba..089297f 100644 --- a/cocci.ml +++ b/cocci.ml @@ -1,5 +1,5 @@ (* - * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen + * Copyright 2005-2010, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * @@ -28,7 +28,7 @@ module TAC = Type_annoter_c module Ast_to_flow = Control_flow_c_build (*****************************************************************************) -(* This file is a kind of driver. It gathers all the important functions +(* This file is a kind of driver. It gathers all the important functions * from coccinelle in one place. The different entities in coccinelle are: * - files * - astc @@ -42,20 +42,20 @@ module Ast_to_flow = Control_flow_c_build (* --------------------------------------------------------------------- *) (* C related *) (* --------------------------------------------------------------------- *) -let cprogram_of_file file = +let cprogram_of_file file = let (program2, _stat) = Parse_c.parse_c_and_cpp file in - program2 + program2 -let cprogram_of_file_cached file = +let cprogram_of_file_cached file = let (program2, _stat) = Parse_c.parse_cache file in if !Flag_cocci.ifdef_to_if - then - program2 +> Parse_c.with_program2 (fun asts -> + then + program2 +> Parse_c.with_program2 (fun asts -> Cpp_ast_c.cpp_ifdef_statementize asts ) else program2 -let cfile_of_program program2_with_ppmethod outf = +let cfile_of_program program2_with_ppmethod outf = Unparse_c.pp_program program2_with_ppmethod outf (* for memoization, contains only one entry, the one for the SP *) @@ -68,35 +68,35 @@ let _hctl = Hashtbl.create 101 let sp_of_file2 file iso = Common.memoized _hparse (file, iso) (fun () -> Parse_cocci.process file iso false) -let sp_of_file file iso = +let sp_of_file file iso = Common.profile_code "parse cocci" (fun () -> sp_of_file2 file iso) (* --------------------------------------------------------------------- *) (* Flow related *) (* --------------------------------------------------------------------- *) -let print_flow flow = +let print_flow flow = Ograph_extended.print_ograph_mutable flow "/tmp/test.dot" true let ast_to_flow_with_error_messages2 x = - let flowopt = + let flowopt = try Ast_to_flow.ast_to_control_flow x - with Ast_to_flow.Error x -> + with Ast_to_flow.Error x -> Ast_to_flow.report_error x; None in - flowopt +> do_option (fun flow -> + flowopt +> do_option (fun flow -> (* This time even if there is a deadcode, we still have a * flow graph, so I can try the transformation and hope the - * deadcode will not bother us. + * deadcode will not bother us. *) try Ast_to_flow.deadcode_detection flow - with Ast_to_flow.Error (Ast_to_flow.DeadCode x) -> + with Ast_to_flow.Error (Ast_to_flow.DeadCode x) -> Ast_to_flow.report_error (Ast_to_flow.DeadCode x); ); flowopt -let ast_to_flow_with_error_messages a = +let ast_to_flow_with_error_messages a = Common.profile_code "flow" (fun () -> ast_to_flow_with_error_messages2 a) @@ -130,13 +130,13 @@ let show_or_not_cfile2 cfile = Common.pr2_xxxxxxxxxxxxxxxxx (); Common.command2 ("cat " ^ cfile); end -let show_or_not_cfile a = +let show_or_not_cfile a = Common.profile_code "show_xxx" (fun () -> show_or_not_cfile2 a) let show_or_not_cfiles cfiles = List.iter show_or_not_cfile cfiles -let show_or_not_cocci2 coccifile isofile = +let show_or_not_cocci2 coccifile isofile = if !Flag_cocci.show_cocci then begin Common.pr2_xxxxxxxxxxxxxxxxx (); pr2 ("processing semantic patch file: " ^ coccifile); @@ -145,12 +145,12 @@ let show_or_not_cocci2 coccifile isofile = Common.command2 ("cat " ^ coccifile); pr2 ""; end -let show_or_not_cocci a b = +let show_or_not_cocci a b = Common.profile_code "show_xxx" (fun () -> show_or_not_cocci2 a b) (* the output *) -let show_or_not_diff2 cfile outfile show_only_minus = +let show_or_not_diff2 cfile outfile show_only_minus = if !Flag_cocci.show_diff then begin match Common.fst(Compare_c.compare_to_original cfile outfile) with Compare_c.Correct -> () (* diff only in spacing, etc *) @@ -204,17 +204,17 @@ let show_or_not_diff2 cfile outfile show_only_minus = (String.concat ":" l1) (String.concat ":" l2)) in diff_line::minus_line::plus_line::rest | _ -> res in - xs +> List.iter (fun s -> + xs +> List.iter (fun s -> if s =~ "^\\+" && show_only_minus then () else pr s) end -let show_or_not_diff a b c = +let show_or_not_diff a b c = Common.profile_code "show_xxx" (fun () -> show_or_not_diff2 a b c) - - + + (* the derived input *) - + let show_or_not_ctl_tex2 astcocci ctls = if !Flag_cocci.show_ctl_tex then begin Ctltotex.totex ("/tmp/__cocci_ctl.tex") astcocci ctls; @@ -222,11 +222,10 @@ let show_or_not_ctl_tex2 astcocci ctls = "dvips __cocci_ctl.dvi -o __cocci_ctl.ps;" ^ "gv __cocci_ctl.ps &"); end -let show_or_not_ctl_tex a b = +let show_or_not_ctl_tex a b = Common.profile_code "show_xxx" (fun () -> show_or_not_ctl_tex2 a b) - - - + + let show_or_not_rule_name ast rulenb = if !Flag_cocci.show_ctl_text or !Flag.show_trying or !Flag.show_transinfo or !Flag_cocci.show_binding_in_out @@ -254,19 +253,19 @@ let show_or_not_scr_rule_name rulenb = let show_or_not_ctl_text2 ctl ast rulenb = if !Flag_cocci.show_ctl_text then begin - - adjust_pp_with_indent (fun () -> + + adjust_pp_with_indent (fun () -> Format.force_newline(); Pretty_print_cocci.print_plus_flag := true; Pretty_print_cocci.print_minus_flag := true; Pretty_print_cocci.unparse ast; ); - + pr "CTL = "; let (ctl,_) = ctl in - adjust_pp_with_indent (fun () -> + adjust_pp_with_indent (fun () -> Format.force_newline(); - Pretty_print_engine.pp_ctlcocci + Pretty_print_engine.pp_ctlcocci !Flag_cocci.show_mcodekind_in_ctl !Flag_cocci.inline_let_ctl ctl; ); pr ""; @@ -277,19 +276,19 @@ let show_or_not_ctl_text a b c = (* running information *) -let get_celem celem : string = - match celem with - Ast_c.Definition ({Ast_c.f_name = namefuncs;},_) -> +let get_celem celem : string = + match celem with + Ast_c.Definition ({Ast_c.f_name = namefuncs;},_) -> Ast_c.str_of_name namefuncs | Ast_c.Declaration - (Ast_c.DeclList ([{Ast_c.v_namei = Some (name, _);}, _], _)) -> + (Ast_c.DeclList ([{Ast_c.v_namei = Some (name, _);}, _], _)) -> Ast_c.str_of_name name | _ -> "" -let show_or_not_celem2 prelude celem = +let show_or_not_celem2 prelude celem = let (tag,trying) = - (match celem with - | Ast_c.Definition ({Ast_c.f_name = namefuncs},_) -> + (match celem with + | Ast_c.Definition ({Ast_c.f_name = namefuncs},_) -> let funcs = Ast_c.str_of_name namefuncs in Flag.current_element := funcs; (" function: ",funcs) @@ -303,12 +302,12 @@ let show_or_not_celem2 prelude celem = (" ","something else"); ) in if !Flag.show_trying then pr2 (prelude ^ tag ^ trying) - -let show_or_not_celem a b = + +let show_or_not_celem a b = Common.profile_code "show_xxx" (fun () -> show_or_not_celem2 a b) -let show_or_not_trans_info2 trans_info = +let show_or_not_trans_info2 trans_info = (* drop witness tree indices for printing *) let trans_info = List.map (function (index,trans_info) -> trans_info) trans_info in @@ -318,18 +317,18 @@ let show_or_not_trans_info2 trans_info = pr2 "transformation info returned:"; let trans_info = List.sort (function (i1,_,_) -> function (i2,_,_) -> compare i1 i2) - trans_info + trans_info in - indent_do (fun () -> - trans_info +> List.iter (fun (i, subst, re) -> + indent_do (fun () -> + trans_info +> List.iter (fun (i, subst, re) -> pr2 ("transform state: " ^ (Common.i_to_s i)); - indent_do (fun () -> - adjust_pp_with_indent_and_header "with rule_elem: " (fun () -> + indent_do (fun () -> + adjust_pp_with_indent_and_header "with rule_elem: " (fun () -> Pretty_print_cocci.print_plus_flag := true; Pretty_print_cocci.print_minus_flag := true; Pretty_print_cocci.rule_elem "" re; ); - adjust_pp_with_indent_and_header "with binding: " (fun () -> + adjust_pp_with_indent_and_header "with binding: " (fun () -> Pretty_print_engine.pp_binding subst; ); ) @@ -337,18 +336,18 @@ let show_or_not_trans_info2 trans_info = ) end end -let show_or_not_trans_info a = +let show_or_not_trans_info a = Common.profile_code "show_xxx" (fun () -> show_or_not_trans_info2 a) let show_or_not_binding2 s binding = if !Flag_cocci.show_binding_in_out then begin - adjust_pp_with_indent_and_header ("binding " ^ s ^ " = ") (fun () -> + adjust_pp_with_indent_and_header ("binding " ^ s ^ " = ") (fun () -> Pretty_print_engine.pp_binding binding ) end -let show_or_not_binding a b = +let show_or_not_binding a b = Common.profile_code "show_xxx" (fun () -> show_or_not_binding2 a b) @@ -357,7 +356,7 @@ let show_or_not_binding a b = (* Some helper functions *) (*****************************************************************************) -let worth_trying cfiles tokens = +let worth_trying cfiles tokens = (* drop the following line for a list of list by rules. since we don't allow multiple minirules, all the tokens within a rule should be in a single CFG entity *) @@ -365,15 +364,15 @@ let worth_trying cfiles tokens = if not !Flag_cocci.windows && not (null tokens) then (* could also modify the code in get_constants.ml *) - let tokens = tokens +> List.map (fun s -> - match () with - | _ when s =~ "^[A-Za-z_][A-Za-z_0-9]*$" -> + let tokens = tokens +> List.map (fun s -> + match () with + | _ when s =~ "^[A-Za-z_][A-Za-z_0-9]*$" -> "\\b" ^ s ^ "\\b" - | _ when s =~ "^[A-Za-z_]" -> + | _ when s =~ "^[A-Za-z_]" -> "\\b" ^ s - | _ when s =~ ".*[A-Za-z_]$" -> + | _ when s =~ ".*[A-Za-z_]$" -> s ^ "\\b" | _ -> s @@ -389,9 +388,9 @@ let worth_trying cfiles tokens = ) else true -let check_macro_in_sp_and_adjust tokens = +let check_macro_in_sp_and_adjust tokens = let tokens = Common.union_all tokens in - tokens +> List.iter (fun s -> + tokens +> List.iter (fun s -> if Hashtbl.mem !Parse_c._defs s then begin if !Flag_cocci.verbose_cocci then begin @@ -403,17 +402,17 @@ let check_macro_in_sp_and_adjust tokens = ) -let contain_loop gopt = +let contain_loop gopt = match gopt with - | Some g -> - g#nodes#tolist +> List.exists (fun (xi, node) -> + | Some g -> + g#nodes#tolist +> List.exists (fun (xi, node) -> Control_flow_c.extract_is_loop node ) | None -> true (* means nothing, if no g then will not model check *) -let sp_contain_typed_metavar_z toplevel_list_list = +let sp_contain_typed_metavar_z toplevel_list_list = let bind x y = x or y in let option_default = false in let mcode _ _ = option_default in @@ -423,24 +422,23 @@ let sp_contain_typed_metavar_z toplevel_list_list = match Ast_cocci.unwrap e with | Ast_cocci.MetaExpr (_,_,_,Some t,_,_) -> true | Ast_cocci.MetaExpr (_,_,_,_,Ast_cocci.LocalID,_) -> true - | _ -> k e + | _ -> k e in - let combiner = + let combiner = Visitor_ast.combiner bind option_default mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode donothing donothing donothing donothing donothing expression donothing donothing donothing donothing donothing - donothing donothing donothing donothing donothing + donothing donothing donothing donothing donothing in - toplevel_list_list +> + toplevel_list_list +> List.exists (function (nm,_,rule) -> (List.exists combiner.Visitor_ast.combiner_top_level rule)) - let sp_contain_typed_metavar rules = - sp_contain_typed_metavar_z + sp_contain_typed_metavar_z (List.map (function x -> match x with @@ -458,9 +456,9 @@ let sp_contain_typed_metavar rules = (* finding among the #include the one that we need to parse * because they may contain useful type definition or because * we may have to modify them - * + * * For the moment we base in part our heuristic on the name of the file, e.g. - * serio.c is related we think to #include + * serio.c is related we think to #include *) let interpret_include_path _ = @@ -476,16 +474,16 @@ let (includes_to_parse: | Flag_cocci.I_NO_INCLUDES -> [] | x -> let all_includes = x =*= Flag_cocci.I_ALL_INCLUDES in - xs +> List.map (fun (file, cs) -> + xs +> List.map (fun (file, cs) -> let dir = Common.dirname file in - - cs +> Common.map_filter (fun (c,_info_item) -> + + cs +> Common.map_filter (fun (c,_info_item) -> match c with | Ast_c.CppTop (Ast_c.Include - {Ast_c.i_include = ((x,ii)); i_rel_pos = info_h_pos;}) -> + {Ast_c.i_include = ((x,ii)); i_rel_pos = info_h_pos;}) -> (match x with - | Ast_c.Local xs -> + | Ast_c.Local xs -> let f = Filename.concat dir (Common.join "/" xs) in (* for our tests, all the files are flat in the current dir *) if not (Sys.file_exists f) && !Flag_cocci.relax_include_path @@ -497,10 +495,10 @@ let (includes_to_parse: else Some attempt2 else Some f - | Ast_c.NonLocal xs -> + | Ast_c.NonLocal xs -> if all_includes || Common.fileprefix (Common.last xs) =$= Common.fileprefix file - then + then Some (Filename.concat (interpret_include_path()) (Common.join "/" xs)) else None @@ -509,7 +507,7 @@ let (includes_to_parse: | _ -> None)) +> List.concat +> Common.uniq - + let rec interpret_dependencies local global = function Ast_cocci.Dep s -> List.mem s local | Ast_cocci.AntiDep s -> @@ -529,7 +527,7 @@ let rec interpret_dependencies local global = function (interpret_dependencies local global s2) | Ast_cocci.NoDep -> true | Ast_cocci.FailDep -> false - + let rec print_dependencies str local global dep = if !Flag_cocci.show_dependencies then @@ -569,30 +567,30 @@ let rec print_dependencies str local global dep = (* --------------------------------------------------------------------- *) (* #include relative position in the file *) (* --------------------------------------------------------------------- *) - + (* compute the set of new prefixes - * on + * on * "a/b/x"; (* in fact it is now a list of string so ["a";"b";"x"] *) * "a/b/c/x"; * "a/x"; * "b/x"; - * it would give for the first element + * it would give for the first element * ""; "a"; "a/b"; "a/b/x" * for the second * "a/b/c/x" - * + * * update: if the include is inside a ifdef a put nothing. cf -test incl. * this is because we dont want code added inside ifdef. *) -let compute_new_prefixes xs = - xs +> Common.map_withenv (fun already xs -> +let compute_new_prefixes xs = + xs +> Common.map_withenv (fun already xs -> let subdirs_prefixes = Common.inits xs in - let new_first = subdirs_prefixes +> List.filter (fun x -> + let new_first = subdirs_prefixes +> List.filter (fun x -> not (List.mem x already) ) in - new_first, + new_first, new_first @ already ) [] +> fst @@ -600,23 +598,23 @@ let compute_new_prefixes xs = (* does via side effect on the ref in the Include in Ast_c *) let rec update_include_rel_pos cs = - let only_include = cs +> Common.map_filter (fun c -> - match c with + let only_include = cs +> Common.map_filter (fun c -> + match c with | Ast_c.CppTop (Ast_c.Include {Ast_c.i_include = ((x,_)); i_rel_pos = aref; i_is_in_ifdef = inifdef}) -> (match x with | Ast_c.Weird _ -> None - | _ -> - if inifdef + | _ -> + if inifdef then None else Some (x, aref) ) | _ -> None ) in - let (locals, nonlocals) = - only_include +> Common.partition_either (fun (c, aref) -> + let (locals, nonlocals) = + only_include +> Common.partition_either (fun (c, aref) -> match c with | Ast_c.Local x -> Left (x, aref) | Ast_c.NonLocal x -> Right (x, aref) @@ -626,36 +624,32 @@ let rec update_include_rel_pos cs = update_rel_pos_bis locals; update_rel_pos_bis nonlocals; cs -and update_rel_pos_bis xs = +and update_rel_pos_bis xs = let xs' = List.map fst xs in let the_first = compute_new_prefixes xs' in let the_last = List.rev (compute_new_prefixes (List.rev xs')) in let merged = Common.zip xs (Common.zip the_first the_last) in - merged +> List.iter (fun ((x, aref), (the_first, the_last)) -> - aref := Some - { + merged +> List.iter (fun ((x, aref), (the_first, the_last)) -> + aref := Some + { Ast_c.first_of = the_first; Ast_c.last_of = the_last; } ) - - - - (*****************************************************************************) (* All the information needed around the C elements and Cocci rules *) (*****************************************************************************) -type toplevel_c_info = { +type toplevel_c_info = { ast_c: Ast_c.toplevel; (* contain refs so can be modified *) tokens_c: Parser_c.token list; fullstring: string; flow: Control_flow_c.cflow option; (* it's the "fixed" flow *) contain_loop: bool; - + env_typing_before: TAC.environment; env_typing_after: TAC.environment; @@ -665,7 +659,7 @@ type toplevel_c_info = { } type toplevel_cocci_info_script_rule = { - scr_ast_rule: string * (string * (string * string)) list * string; + scr_ast_rule: string * (string * Ast_cocci.meta_name) list * string; language: string; scr_dependencies: Ast_cocci.dependency; scr_ruleid: int; @@ -681,7 +675,7 @@ type toplevel_cocci_info_cocci_rule = { rulename: string; dependencies: Ast_cocci.dependency; (* There are also some hardcoded rule names in parse_cocci.ml: - * let reserved_names = ["all";"optional_storage";"optional_qualifier"] + * let reserved_names = ["all";"optional_storage";"optional_qualifier"] *) dropped_isos: string list; free_vars: Ast_cocci.meta_name list; @@ -695,7 +689,7 @@ type toplevel_cocci_info_cocci_rule = { was_matched: bool ref; } -type toplevel_cocci_info = +type toplevel_cocci_info = ScriptRuleCocciInfo of toplevel_cocci_info_script_rule | InitialScriptRuleCocciInfo of toplevel_cocci_info_script_rule | FinalScriptRuleCocciInfo of toplevel_cocci_info_script_rule @@ -703,8 +697,8 @@ type toplevel_cocci_info = type cocci_info = toplevel_cocci_info list * string list list (* tokens *) -type kind_file = Header | Source -type file_info = { +type kind_file = Header | Source +type file_info = { fname : string; full_fname : string; was_modified_once: bool ref; @@ -713,25 +707,25 @@ type file_info = { fkind : kind_file; } -let g_contain_typedmetavar = ref false +let g_contain_typedmetavar = ref false let last_env_toplevel_c_info xs = (Common.last xs).env_typing_after -let concat_headers_and_c (ccs: file_info list) - : (toplevel_c_info * string) list = - (List.concat (ccs +> List.map (fun x -> +let concat_headers_and_c (ccs: file_info list) + : (toplevel_c_info * string) list = + (List.concat (ccs +> List.map (fun x -> x.asts +> List.map (fun x' -> (x', x.fname))))) -let for_unparser xs = - xs +> List.map (fun x -> +let for_unparser xs = + xs +> List.map (fun x -> (x.ast_c, (x.fullstring, x.tokens_c)), Unparse_c.PPviastr ) let gen_pdf_graph () = - (Ctl_engine.get_graph_files ()) +> List.iter (fun outfile -> + (Ctl_engine.get_graph_files ()) +> List.iter (fun outfile -> Printf.printf "Generation of %s%!" outfile; let filename_stack = Ctl_engine.get_graph_comp_files outfile in List.iter (fun filename -> @@ -749,6 +743,27 @@ let gen_pdf_graph () = ) filename_stack; Printf.printf " - Done\n") +let local_python_code = + "from coccinelle import *\n" + +let python_code = + "import coccinelle\n"^ + "import coccilib\n"^ + "import coccilib.org\n"^ + "import coccilib.report\n" ^ + local_python_code ^ + "cocci = Cocci()\n" + +let make_init rulenb lang code = + let mv = [] in + let deps = Ast_cocci.NoDep in + { + scr_ast_rule = (lang, mv, code); + language = lang; + scr_dependencies = deps; + scr_ruleid = rulenb; + script_code = (if lang = "python" then python_code else "") ^code + } (* --------------------------------------------------------------------- *) let prepare_cocci ctls free_var_lists negated_pos_lists @@ -759,10 +774,10 @@ let prepare_cocci ctls free_var_lists negated_pos_lists free_var_lists) negated_pos_lists) ua) fua) fuas) positions_list) in - gathered +> List.map + gathered +> List.map (fun (((((((((ctl_toplevel_list,metavars),ast),free_var_list), - negated_pos_list),ua),fua),fuas),positions_list),rulenb) -> - + negated_pos_list),ua),fua),fuas),positions_list),rulenb) -> + let is_script_rule r = match r with Ast_cocci.ScriptRule _ @@ -774,7 +789,7 @@ let prepare_cocci ctls free_var_lists negated_pos_lists match ast with Ast_cocci.ScriptRule (lang,deps,mv,code) -> - let r = + let r = { scr_ast_rule = (lang, mv, code); language = lang; @@ -784,17 +799,8 @@ let prepare_cocci ctls free_var_lists negated_pos_lists } in ScriptRuleCocciInfo r | Ast_cocci.InitialScriptRule (lang,code) -> - let mv = [] in - let deps = Ast_cocci.NoDep in - let r = - { - scr_ast_rule = (lang, mv, code); - language = lang; - scr_dependencies = deps; - scr_ruleid = rulenb; - script_code = code; - } - in InitialScriptRuleCocciInfo r + let r = make_init rulenb lang code in + InitialScriptRuleCocciInfo r | Ast_cocci.FinalScriptRule (lang,code) -> let mv = [] in let deps = Ast_cocci.NoDep in @@ -831,27 +837,27 @@ let prepare_cocci ctls free_var_lists negated_pos_lists (* --------------------------------------------------------------------- *) -let build_info_program cprogram env = - - let (cs, parseinfos) = +let build_info_program cprogram env = + + let (cs, parseinfos) = Common.unzip cprogram in - let alltoks = + let alltoks = parseinfos +> List.map (fun (s,toks) -> toks) +> List.flatten in (* I use cs' but really annotate_xxx work by doing side effects on cs *) - let cs' = + let cs' = Comment_annotater_c.annotate_program alltoks cs in - let cs_with_envs = + let cs_with_envs = Type_annoter_c.annotate_program env (*!g_contain_typedmetavar*) cs' in - + zip cs_with_envs parseinfos +> List.map (fun ((c, (enva,envb)), parseinfo)-> let (fullstr, tokens) = parseinfo in - let flow = + let flow = ast_to_flow_with_error_messages c +> - Common.map_option (fun flow -> + Common.map_option (fun flow -> let flow = Ast_to_flow.annotate_loop_nodes flow in (* remove the fake nodes for julia *) @@ -872,7 +878,7 @@ let build_info_program cprogram env = flow = flow; contain_loop = contain_loop flow; - + env_typing_before = enva; env_typing_after = envb; @@ -883,19 +889,19 @@ let build_info_program cprogram env = (* Optimisation. Try not unparse/reparse the whole file when have modifs *) -let rebuild_info_program cs file isexp = +let rebuild_info_program cs file isexp = cs +> List.map (fun c -> if !(c.was_modified) then let file = Common.new_temp_file "cocci_small_output" ".c" in - cfile_of_program - [(c.ast_c, (c.fullstring, c.tokens_c)), Unparse_c.PPnormal] + cfile_of_program + [(c.ast_c, (c.fullstring, c.tokens_c)), Unparse_c.PPnormal] file; - + (* Common.command2 ("cat " ^ file); *) let cprogram = cprogram_of_file file in let xs = build_info_program cprogram c.env_typing_before in - + (* TODO: assert env has not changed, * if yes then must also reparse what follows even if not modified. * Do that only if contain_typedmetavar of course, so good opti. @@ -907,11 +913,11 @@ let rebuild_info_program cs file isexp = let rebuild_info_c_and_headers ccs isexp = - ccs +> List.iter (fun c_or_h -> + ccs +> List.iter (fun c_or_h -> if c_or_h.asts +> List.exists (fun c -> !(c.was_modified)) then c_or_h.was_modified_once := true; ); - ccs +> List.map (fun c_or_h -> + ccs +> List.map (fun c_or_h -> { c_or_h with asts = rebuild_info_program c_or_h.asts c_or_h.full_fname isexp } @@ -923,12 +929,12 @@ let rebuild_info_c_and_headers ccs isexp = -let prepare_c files choose_includes : file_info list = +let prepare_c files choose_includes : file_info list = let cprograms = List.map cprogram_of_file_cached files in let includes = includes_to_parse (zip files cprograms) choose_includes in (* todo?: may not be good to first have all the headers and then all the c *) - let all = + let all = (includes +> List.map (fun hpath -> Right hpath)) ++ ((zip files cprograms) +> List.map (fun (file, asts) -> Left (file, asts))) @@ -936,23 +942,23 @@ let prepare_c files choose_includes : file_info list = let env = ref !TAC.initial_env in - let ccs = all +> Common.map_filter (fun x -> - match x with - | Right hpath -> - if not (Common.lfile_exists hpath) - then begin - pr2 ("TYPE: header " ^ hpath ^ " not found"); - None + let ccs = all +> Common.map_filter (fun x -> + match x with + | Right hpath -> + if not (Common.lfile_exists hpath) + then begin + pr2 ("TYPE: header " ^ hpath ^ " not found"); + None end - else + else let h_cs = cprogram_of_file_cached hpath in let info_h_cs = build_info_program h_cs !env in - env := + env := if null info_h_cs then !env else last_env_toplevel_c_info info_h_cs ; - Some { + Some { fname = Common.basename hpath; full_fname = hpath; asts = info_h_cs; @@ -960,12 +966,12 @@ let prepare_c files choose_includes : file_info list = fpath = hpath; fkind = Header; } - | Left (file, cprogram) -> + | Left (file, cprogram) -> (* todo?: don't update env ? *) let cs = build_info_program cprogram !env in (* we do that only for the c, not for the h *) ignore(update_include_rel_pos (cs +> List.map (fun x -> x.ast_c))); - Some { + Some { fname = Common.basename file; full_fname = file; asts = cs; @@ -973,9 +979,9 @@ let prepare_c files choose_includes : file_info list = fpath = file; fkind = Source; } - ) + ) in - ccs + ccs (*****************************************************************************) @@ -983,31 +989,31 @@ let prepare_c files choose_includes : file_info list = (*****************************************************************************) (* The main algorithm =~ - * The algorithm is roughly: + * The algorithm is roughly: * for_all ctl rules in SP * for_all minirule in rule (no more) * for_all binding (computed during previous phase) * for_all C elements - * match control flow of function vs minirule - * with the binding and update the set of possible + * match control flow of function vs minirule + * with the binding and update the set of possible * bindings, and returned the possibly modified function. * pretty print modified C elements and reparse it. * - * + * * On ne prends que les newbinding ou returned_any_state est vrai. * Si ca ne donne rien, on prends ce qu'il y avait au depart. - * Mais au nouveau depart de quoi ? + * Mais au nouveau depart de quoi ? * - si ca donne rien apres avoir traité toutes les fonctions avec ce binding ? - * - ou alors si ca donne rien, apres avoir traité toutes les fonctions + * - ou alors si ca donne rien, apres avoir traité toutes les fonctions * avec tous les bindings du round d'avant ? - * + * * Julia pense qu'il faut prendre la premiere solution. * Example: on a deux environnements candidats, E1 et E2 apres avoir traité * la regle ctl 1. On arrive sur la regle ctl 2. * E1 ne donne rien pour la regle 2, on garde quand meme E1 pour la regle 3. * E2 donne un match a un endroit et rend E2' alors on utilise ca pour * la regle 3. - * + * * I have not to look at used_after_list to decide to restart from * scratch. I just need to look if the binding list is empty. * Indeed, let's suppose that a SP have 3 regions/rules. If we @@ -1019,7 +1025,7 @@ let prepare_c files choose_includes : file_info list = * region must bind some metavariables used after, and that we * dont find any such region, then mysat() will returns lots of * Right, and current_binding will not grow, and so we will have - * an empty list of binding, and we will catch such a case. + * an empty list of binding, and we will catch such a case. * * opti: julia says that because the binding is * determined by the used_after_list, the items in the list @@ -1067,13 +1073,16 @@ let apply_python_rule r cache newes e rules_that_have_matched else begin let (_, mv, _) = r.scr_ast_rule in - let not_bound x = not (Pycocci.contains_binding e x) in + let ve = + (List.map (function (n,v) -> (("virtual",n),Ast_c.MetaIdVal v)) + !Flag.defined_virtual_env) @ e in + let not_bound x = not (Pycocci.contains_binding ve x) in (match List.filter not_bound mv with [] -> let relevant_bindings = List.filter (function ((re,rm),_) -> - List.exists (function (_,(r,m)) -> r =$= re && m =$= rm) mv) + List.exists (function (_,(r,m)) -> r =*= re && m =$= rm) mv) e in let new_cache = if List.mem relevant_bindings cache @@ -1094,12 +1103,9 @@ let apply_python_rule r cache newes e rules_that_have_matched !rules_that_have_ever_matched r.scr_dependencies; show_or_not_binding "in" e; - Pycocci.build_classes (List.map (function (x,y) -> x) e); - Pycocci.construct_variables mv e; - let _ = Pycocci.pyrun_simplestring - ("import coccinelle\nfrom coccinelle "^ - "import *\ncocci = Cocci()\n" ^ - r.script_code) in + Pycocci.build_classes (List.map (function (x,y) -> x) ve); + Pycocci.construct_variables mv ve; + let _ = Pycocci.pyrun_simplestring (local_python_code ^r.script_code) in relevant_bindings :: cache end in if !Pycocci.inc_match @@ -1116,7 +1122,7 @@ let apply_python_rule r cache newes e rules_that_have_matched let rec apply_cocci_rule r rules_that_have_ever_matched es (ccs:file_info list ref) = - Common.profile_code r.rulename (fun () -> + Common.profile_code r.rulename (fun () -> show_or_not_rule_name r.ast_rule r.ruleid; show_or_not_ctl_text r.ctl r.ast_rule r.ruleid; @@ -1164,8 +1170,8 @@ let rec apply_cocci_rule r rules_that_have_ever_matched es .c and .h *) List.rev (concat_headers_and_c !ccs +> - List.fold_left (fun children_e (c,f) -> - if c.flow <> None + List.fold_left (fun children_e (c,f) -> + if c.flow <> None then (* does also some side effects on c and r *) let processed = @@ -1173,10 +1179,10 @@ let rec apply_cocci_rule r rules_that_have_ever_matched es relevant_bindings c f in match processed with | None -> children_e - | Some newbindings -> + | Some newbindings -> newbindings +> List.fold_left - (fun children_e newbinding -> + (fun children_e newbinding -> if List.mem newbinding children_e then children_e else newbinding :: children_e) @@ -1330,46 +1336,45 @@ and process_a_generated_a_env_a_toplevel2 r env = function let metavars = List.filter (function md -> - let (rl,_) = Ast_cocci.get_meta_name md in - rl =$= r.rulename) + let (rl,_) = Ast_cocci.get_meta_name md in rl =$= r.rulename) r.metavars in if Common.include_set free_vars env_domain then Unparse_hrule.pp_rule metavars r.ast_rule env cfile.full_fname | _ -> failwith "multiple files not supported" -and process_a_generated_a_env_a_toplevel rule env ccs = - Common.profile_code "process_a_ctl_a_env_a_toplevel" +and process_a_generated_a_env_a_toplevel rule env ccs = + Common.profile_code "process_a_ctl_a_env_a_toplevel" (fun () -> process_a_generated_a_env_a_toplevel2 rule env ccs) (* does side effects on C ast and on Cocci info rule *) -and process_a_ctl_a_env_a_toplevel2 r e c f = - indent_do (fun () -> +and process_a_ctl_a_env_a_toplevel2 r e c f = + indent_do (fun () -> show_or_not_celem "trying" c.ast_c; Flag.currentfile := Some (f ^ ":" ^get_celem c.ast_c); - let (trans_info, returned_any_states, inherited_bindings, newbindings) = - Common.save_excursion Flag_ctl.loop_in_src_code (fun () -> + let (trans_info, returned_any_states, inherited_bindings, newbindings) = + Common.save_excursion Flag_ctl.loop_in_src_code (fun () -> Flag_ctl.loop_in_src_code := !Flag_ctl.loop_in_src_code||c.contain_loop; - + (***************************************) (* !Main point! The call to the engine *) (***************************************) let model_ctl = CCI.model_for_ctl r.dropped_isos (Common.some c.flow) e in CCI.mysat model_ctl r.ctl (r.used_after, e) - ) + ) in - if not returned_any_states + if not returned_any_states then None else begin show_or_not_celem "found match in" c.ast_c; show_or_not_trans_info trans_info; - List.iter (show_or_not_binding "out") newbindings; + List.iter (show_or_not_binding "out") newbindings; r.was_matched := true; if not (null trans_info) then begin c.was_modified := true; - try + try (* les "more than one var in a decl" et "already tagged token" * font crasher coccinelle. Si on a 5 fichiers, donc on a 5 * failed. Le try limite le scope des crashes pendant la @@ -1384,9 +1389,9 @@ and process_a_ctl_a_env_a_toplevel2 r e c f = Some (List.map (function x -> x@inherited_bindings) newbindings) end ) - -and process_a_ctl_a_env_a_toplevel a b c f= - Common.profile_code "process_a_ctl_a_env_a_toplevel" + +and process_a_ctl_a_env_a_toplevel a b c f= + Common.profile_code "process_a_ctl_a_env_a_toplevel" (fun () -> process_a_ctl_a_env_a_toplevel2 a b c f) @@ -1397,16 +1402,16 @@ let rec bigloop2 rs (ccs: file_info list) = let rules_that_have_ever_matched = ref [] in (* looping over the rules *) - rs +> List.iter (fun r -> + rs +> List.iter (fun r -> match r with InitialScriptRuleCocciInfo r | FinalScriptRuleCocciInfo r -> () - | ScriptRuleCocciInfo r -> + | ScriptRuleCocciInfo r -> if !Flag_cocci.show_ctl_text then begin Common.pr_xxxxxxxxxxxxxxxxx (); pr ("script: " ^ r.language); Common.pr_xxxxxxxxxxxxxxxxx (); - - adjust_pp_with_indent (fun () -> + + adjust_pp_with_indent (fun () -> Format.force_newline(); let (l,mv,code) = r.scr_ast_rule in let deps = r.scr_dependencies in @@ -1425,8 +1430,8 @@ let rec bigloop2 rs (ccs: file_info list) = apply_python_rule r cache newes e rules_that_have_matched rules_that_have_ever_matched | "test" -> - concat_headers_and_c !ccs +> List.iter (fun (c,_) -> - if c.flow <> None + concat_headers_and_c !ccs +> List.iter (fun (c,_) -> + if c.flow <> None then Printf.printf "Flow: %s\r\nFlow!\r\n%!" c.fullstring); (cache, newes) @@ -1444,7 +1449,7 @@ let rec bigloop2 rs (ccs: file_info list) = if !Flag.sgrep_mode2 then begin (* sgrep can lead to code that is not parsable, but we must - * still call rebuild_info_c_and_headers to pretty print the + * still call rebuild_info_c_and_headers to pretty print the * action (MINUS), so that later the diff will show what was * matched by sgrep. But we don't want the parsing error message * hence the following flag setting. So this code propably @@ -1456,17 +1461,17 @@ let rec bigloop2 rs (ccs: file_info list) = end; !ccs (* return final C asts *) -let bigloop a b = +let bigloop a b = Common.profile_code "bigloop" (fun () -> bigloop2 a b) -let initial_final_bigloop2 ty rebuild r = +let initial_final_bigloop2 ty rebuild r = if !Flag_cocci.show_ctl_text then begin Common.pr_xxxxxxxxxxxxxxxxx (); pr (ty ^ ": " ^ r.language); Common.pr_xxxxxxxxxxxxxxxxx (); - adjust_pp_with_indent (fun () -> + adjust_pp_with_indent (fun () -> Format.force_newline(); Pretty_print_cocci.unparse(rebuild r.scr_ast_rule)); end; @@ -1481,7 +1486,7 @@ let initial_final_bigloop2 ty rebuild r = Printf.printf "Unknown language for initial/final script: %s\n" r.language -let initial_final_bigloop a b c = +let initial_final_bigloop a b c = Common.profile_code "initial_final_bigloop" (fun () -> initial_final_bigloop2 a b c) @@ -1493,9 +1498,9 @@ let pre_engine2 (coccifile, isofile) = show_or_not_cocci coccifile isofile; Pycocci.set_coccifile coccifile; - let isofile = + let isofile = if not (Common.lfile_exists isofile) - then begin + then begin pr2 ("warning: Can't find default iso file: " ^ isofile); None end @@ -1503,7 +1508,7 @@ let pre_engine2 (coccifile, isofile) = (* useful opti when use -dir *) let (metavars,astcocci,free_var_lists,negated_pos_lists,used_after_lists, - positions_lists,toks,_) = + positions_lists,toks,_) = sp_of_file coccifile isofile in let ctls = ctls_of_ast astcocci used_after_lists positions_lists in @@ -1517,33 +1522,57 @@ let pre_engine2 (coccifile, isofile) = prepare_cocci ctls free_var_lists negated_pos_lists used_after_lists positions_lists metavars astcocci in - let _ = + let used_languages = List.fold_left (function languages -> - function - InitialScriptRuleCocciInfo(r) -> - (if List.mem r.language languages - then failwith ("double initializer found for "^r.language)); - initial_final_bigloop "initial" - (function(x,_,y) -> Ast_cocci.InitialScriptRule(x,y)) - r; - r.language::languages - | _ -> languages) + function + ScriptRuleCocciInfo(r) -> + if List.mem r.language languages then + languages + else + r.language::languages + | _ -> languages) [] cocci_infos in + let initialized_languages = + List.fold_left + (function languages -> + function + InitialScriptRuleCocciInfo(r) -> + (if List.mem r.language languages + then failwith ("double initializer found for "^r.language)); + initial_final_bigloop "initial" + (function(x,_,y) -> Ast_cocci.InitialScriptRule(x,y)) + r; + r.language::languages + | _ -> languages) + [] cocci_infos in + + let uninitialized_languages = + List.filter + (fun used -> not (List.mem used initialized_languages)) + used_languages + in + List.iter (fun lgg -> + initial_final_bigloop "initial" + (function(x,_,y) -> Ast_cocci.InitialScriptRule(x,y)) + (make_init (-1) lgg ""); + ) + uninitialized_languages; + (cocci_infos,toks) -let pre_engine a = +let pre_engine a = Common.profile_code "pre_engine" (fun () -> pre_engine2 a) -let full_engine2 (cocci_infos,toks) cfiles = +let full_engine2 (cocci_infos,toks) cfiles = show_or_not_cfiles cfiles; (* optimisation allowing to launch coccinelle on all the drivers *) if !Flag_cocci.worth_trying_opt && not (worth_trying cfiles toks) then - begin + begin pr2 ("No matches found for " ^ (Common.join " " (Common.union_all toks)) ^ "\nSkipping:" ^ (Common.join " " cfiles)); cfiles +> List.map (fun s -> s, None) @@ -1572,7 +1601,7 @@ let full_engine2 (cocci_infos,toks) cfiles = if !Flag.show_misc then Common.pr_xxxxxxxxxxxxxxxxx (); if !Flag_ctl.graphical_trace then gen_pdf_graph (); - c_infos' +> List.map (fun c_or_h -> + c_infos' +> List.map (fun c_or_h -> if !(c_or_h.was_modified_once) then begin @@ -1594,7 +1623,7 @@ let full_engine2 (cocci_infos,toks) cfiles = else (c_or_h.fpath, None)) end -let full_engine a b = +let full_engine a b = Common.profile_code "full_engine" (fun () -> let res = full_engine2 a b in (*Gc.print_stat stderr; *)res) @@ -1614,37 +1643,37 @@ let post_engine2 (cocci_infos,_) = [] cocci_infos in () -let post_engine a = +let post_engine a = Common.profile_code "post_engine" (fun () -> post_engine2 a) (*****************************************************************************) (* check duplicate from result of full_engine *) (*****************************************************************************) -let check_duplicate_modif2 xs = +let check_duplicate_modif2 xs = (* opti: let groups = Common.groupBy (fun (a,resa) (b,resb) -> a =$= b) xs *) if !Flag_cocci.verbose_cocci then pr2 ("Check duplication for " ^ i_to_s (List.length xs) ^ " files"); let groups = Common.group_assoc_bykey_eff xs in - groups +> Common.map_filter (fun (file, xs) -> + groups +> Common.map_filter (fun (file, xs) -> match xs with | [] -> raise Impossible | [res] -> Some (file, res) - | res::xs -> - match res with - | None -> + | res::xs -> + match res with + | None -> if not (List.for_all (fun res2 -> res2 =*= None) xs) then begin pr2 ("different modification result for " ^ file); None end else Some (file, None) - | Some res -> - if not(List.for_all (fun res2 -> + | Some res -> + if not(List.for_all (fun res2 -> match res2 with | None -> false - | Some res2 -> + | Some res2 -> let diff = Common.cmd_to_list ("diff -u -b -B "^res^" "^res2) in null diff @@ -1653,9 +1682,7 @@ let check_duplicate_modif2 xs = None end else Some (file, Some res) - - ) -let check_duplicate_modif a = +let check_duplicate_modif a = Common.profile_code "check_duplicate" (fun () -> check_duplicate_modif2 a) diff --git a/cocci.mli b/cocci.mli index 42a1de8..f715356 100644 --- a/cocci.mli +++ b/cocci.mli @@ -1,5 +1,5 @@ (* - * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen + * Copyright 2005-2010, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * @@ -29,8 +29,8 @@ open Common * pre_engine does the compilation of the SmPL code and runs any initially * scripts * post_engine runs any finally scripts - * - * This function uses memoisation internally, which is useful when + * + * This function uses memoisation internally, which is useful when * using -dir to not redo twice the same work. So take care! *) type cocci_info @@ -39,13 +39,13 @@ val full_engine : cocci_info -> filename list -> (filename * filename option) list val post_engine : cocci_info -> unit -(* because of the #include "toto.c" and also because we may associate the +(* because of the #include "toto.c" and also because we may associate the * same C file to multiple drivers because they share code, we can - * modify multiple times the same file when use -dir. This check - * remove duplicates and check that the modification are consistent + * modify multiple times the same file when use -dir. This check + * remove duplicates and check that the modification are consistent * among the different drivers. *) -val check_duplicate_modif : +val check_duplicate_modif : (filename * filename option) list -> (filename * filename option) list (* provides memoization *) diff --git a/commitmsg b/commitmsg dissimilarity index 99% index f400be0..c988220 100644 --- a/commitmsg +++ b/commitmsg @@ -1,23 +1,3 @@ -Release coccinelle-0.2.0 - -** Features: - - Remove duplicated code in disjunctions - - Better error message when grep finds nothing relevant. Thanks to Joe - Perches for the suggestion. - - added -keep_comments option for the unparsing of the transformed code - - Option "-version" now also gives information about built-in - Python binding support. - - slightly faster environment manipulation in pathological cases - - hack added to accept well-formed #define after function header - -** Bugfix: - - Proper consideration of #define macro arguments in checking for the use - of metavariables and in computing the line numbers of complex terms - - Better parsing of included .cocci files - - Put included .cocci files in the right order - - Bind position variables only once for #include - - Fix bug in include_match that caused everything to halt when all matches - were discarded - - Merge unlikely/likely iso rules under a iso rule named unlikely - - Some fixes to coccicheck rules, thanks to Andrew Lunn - - Support groups in regular expression, thanks to Michael Stefaniuc +Release coccinelle-0.2.1-rc1 + +Relese Candidate 1 for coccinelle-0.2.1 diff --git a/commons/backtrace.ml b/commons/backtrace.ml index 9a0ee50..1d80d70 100644 --- a/commons/backtrace.ml +++ b/commons/backtrace.ml @@ -3,9 +3,9 @@ open Common (* This function is especially useful with lablgtk which intercepts * the exception and forbid them to reach the toplevel, or with LFS * where I can not allow any exception to stop mount.lfs. - * + * * src: Jane Street Core library. - * update: Normally no more needed in OCaml 3.11 as part of the + * update: Normally no more needed in OCaml 3.11 as part of the * default runtime. *) external print : unit -> unit = "print_exception_backtrace_stub" "noalloc" @@ -18,7 +18,7 @@ external print : unit -> unit = "print_exception_backtrace_stub" "noalloc" exception MyNot_Found let foo1 () = - if 1=1 + if 1=1 then raise MyNot_Found else 2 @@ -27,7 +27,7 @@ let foo2 () = let test_backtrace () = (try ignore(foo2 ()) - with exn -> + with exn -> pr2 (Common.exn_to_s exn); print(); failwith "other exn" @@ -35,7 +35,7 @@ let test_backtrace () = print_string "ok cool\n"; () -let actions () = +let actions () = [ "-test_backtrace", " ", Common.mk_action_0_arg test_backtrace; diff --git a/commons/common.ml b/commons/common.ml index 2786f23..9308319 100644 --- a/commons/common.ml +++ b/commons/common.ml @@ -1,12 +1,13 @@ (* Yoann Padioleau * + * Copyright (C) 2010 INRIA, University of Copenhagen DIKU * Copyright (C) 1998-2009 Yoann Padioleau * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License * version 2.1 as published by the Free Software Foundation, with the * special exception on linking described in file license.txt. - * + * * This library is distributed in the hope that it will be useful, but * WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file @@ -27,7 +28,7 @@ * functions depends on other functions from this common, it would * be tedious to add those dependencies. Here simpler (have just the * pb of the Prelude, but it's a small problem). - * + * * pixel means code from Pascal Rigaux * julia means code from Julia Lawall *) @@ -36,32 +37,32 @@ (*****************************************************************************) (* We use *) (*****************************************************************************) -(* +(* * modules: * - Pervasives, of course * - List * - Str * - Hashtbl - * - Format + * - Format * - Buffer * - Unix and Sys * - Arg - * - * functions: - * - =, <=, max min, abs, ... + * + * functions: + * - =, <=, max min, abs, ... * - List.rev, List.mem, List.partition, - * - List.fold*, List.concat, ... + * - List.fold*, List.concat, ... * - Str.global_replace * - Filename.is_relative * - String.uppercase, String.lowercase - * - * + * + * * The Format library allows to hide passing an indent_level variable. * You use as usual the print_string function except that there is * this automatic indent_level variable handled for you (and maybe * more services). src: julia in coccinelle unparse_cocci. - * - * Extra packages + * + * Extra packages * - ocamlbdb * - ocamlgtk, and gtksourceview * - ocamlgl @@ -70,10 +71,10 @@ * - ocamlfuse * - ocamlmpi * - ocamlcalendar - * + * * - pcre * - sdl - * + * * Many functions in this file were inspired by Haskell or Lisp librairies. *) @@ -93,7 +94,7 @@ let (+>) o f = f o let (++) = (@) exception Timeout -exception UnixExit of int +exception UnixExit of int let rec (do_n: int -> (unit -> unit) -> unit) = fun i f -> if i = 0 then () else (f(); do_n (i-1) f) @@ -106,11 +107,11 @@ let sum_int = List.fold_left (+) 0 let fold_left_with_index f acc = let rec fold_lwi_aux acc n = function | [] -> acc - | x::xs -> fold_lwi_aux (f acc x n) (n+1) xs + | x::xs -> fold_lwi_aux (f acc x n) (n+1) xs in fold_lwi_aux acc 0 -let rec drop n xs = +let rec drop n xs = match (n,xs) with | (0,_) -> xs | (_,[]) -> failwith "drop: not enough" @@ -118,15 +119,15 @@ let rec drop n xs = let rec enum_orig x n = if x = n then [n] else x::enum_orig (x+1) n -let enum x n = +let enum x n = if not(x <= n) then failwith (Printf.sprintf "bad values in enum, expect %d <= %d" x n); - let rec enum_aux acc x n = - if x = n then n::acc else enum_aux (x::acc) (x+1) n + let rec enum_aux acc x n = + if x = n then n::acc else enum_aux (x::acc) (x+1) n in List.rev (enum_aux [] x n) -let rec take n xs = +let rec take n xs = match (n,xs) with | (0,_) -> [] | (_,[]) -> failwith "take: not enough" @@ -141,12 +142,12 @@ let (list_of_string: string -> char list) = function "" -> [] | s -> (enum 0 ((String.length s) - 1) +> List.map (String.get s)) -let (lines: string -> string list) = fun s -> +let (lines: string -> string list) = fun s -> let rec lines_aux = function | [] -> [] - | [x] -> if x = "" then [] else [x] - | x::xs -> - x::lines_aux xs + | [x] -> if x = "" then [] else [x] + | x::xs -> + x::lines_aux xs in Str.split_delim (Str.regexp "\n") s +> lines_aux @@ -159,27 +160,27 @@ let null xs = match xs with [] -> true | _ -> false -let debugger = ref false +let debugger = ref false let unwind_protect f cleanup = - if !debugger then f() else + if !debugger then f() else try f () with e -> begin cleanup e; raise e end -let finalize f cleanup = - if !debugger then f() else - try +let finalize f cleanup = + if !debugger then f() else + try let res = f () in cleanup (); res - with e -> + with e -> cleanup (); raise e let command2 s = ignore(Sys.command s) -let (matched: int -> string -> string) = fun i s -> +let (matched: int -> string -> string) = fun i s -> Str.matched_group i s let matched1 = fun s -> matched 1 s @@ -204,10 +205,10 @@ let foldl1 p = function x::xs -> List.fold_left p x xs | _ -> failwith "foldl1" (* Debugging/logging *) (*****************************************************************************) -(* I used this in coccinelle where the huge logging of stuff ask for +(* I used this in coccinelle where the huge logging of stuff ask for * a more organized solution that use more visual indentation hints. - * - * todo? could maybe use log4j instead ? or use Format module more + * + * todo? could maybe use log4j instead ? or use Format module more * consistently ? *) @@ -217,20 +218,20 @@ let _tab_indent = 5 let _prefix_pr = ref "" -let indent_do f = +let indent_do f = _tab_level_print := !_tab_level_print + _tab_indent; - finalize f + finalize f (fun () -> _tab_level_print := !_tab_level_print - _tab_indent;) -let pr s = +let pr s = print_string !_prefix_pr; do_n !_tab_level_print (fun () -> print_string " "); print_string s; - print_string "\n"; + print_string "\n"; flush stdout -let pr_no_nl s = +let pr_no_nl s = print_string !_prefix_pr; do_n !_tab_level_print (fun () -> print_string " "); print_string s; @@ -243,57 +244,66 @@ let pr_no_nl s = let _chan_pr2 = ref (None: out_channel option) -let out_chan_pr2 ?(newline=true) s = +let out_chan_pr2 ?(newline=true) s = match !_chan_pr2 with | None -> () - | Some chan -> - output_string chan (s ^ (if newline then "\n" else "")); + | Some chan -> + output_string chan (s ^ (if newline then "\n" else "")); flush chan +let print_to_stderr = ref true -let pr2 s = - prerr_string !_prefix_pr; - do_n !_tab_level_print (fun () -> prerr_string " "); - prerr_string s; - prerr_string "\n"; - flush stderr; - out_chan_pr2 s; - () +let pr2 s = + if !print_to_stderr + then + begin + prerr_string !_prefix_pr; + do_n !_tab_level_print (fun () -> prerr_string " "); + prerr_string s; + prerr_string "\n"; + flush stderr; + out_chan_pr2 s; + () + end -let pr2_no_nl s = - prerr_string !_prefix_pr; - do_n !_tab_level_print (fun () -> prerr_string " "); - prerr_string s; - flush stderr; - out_chan_pr2 ~newline:false s; - () +let pr2_no_nl s = + if !print_to_stderr + then + begin + prerr_string !_prefix_pr; + do_n !_tab_level_print (fun () -> prerr_string " "); + prerr_string s; + flush stderr; + out_chan_pr2 ~newline:false s; + () + end -let pr_xxxxxxxxxxxxxxxxx () = +let pr_xxxxxxxxxxxxxxxxx () = pr "-----------------------------------------------------------------------" -let pr2_xxxxxxxxxxxxxxxxx () = +let pr2_xxxxxxxxxxxxxxxxx () = pr2 "-----------------------------------------------------------------------" let reset_pr_indent () = _tab_level_print := 0 -(* old: +(* old: * let pr s = (print_string s; print_string "\n"; flush stdout) - * let pr2 s = (prerr_string s; prerr_string "\n"; flush stderr) + * let pr2 s = (prerr_string s; prerr_string "\n"; flush stderr) *) (* ---------------------------------------------------------------------- *) -(* I can not use the _xxx ref tech that I use for common_extra.ml here because +(* I can not use the _xxx ref tech that I use for common_extra.ml here because * ocaml don't like the polymorphism of Dumper mixed with refs. - * - * let (_dump_func : ('a -> string) ref) = ref + * + * let (_dump_func : ('a -> string) ref) = ref * (fun x -> failwith "no dump yet, have you included common_extra.cmo?") * let (dump : 'a -> string) = fun x -> * !_dump_func x - * + * * So I have included directly dumper.ml in common.ml. It's more practical * when want to give script that use my common.ml, I just have to give * this file. @@ -303,7 +313,7 @@ let reset_pr_indent () = (* Dump an OCaml value into a printable string. * By Richard W.M. Jones (rich@annexia.org). - * dumper.ml 1.2 2005/02/06 12:38:21 rich Exp + * dumper.ml 1.2 2005/02/06 12:38:21 rich Exp *) open Printf open Obj @@ -403,11 +413,11 @@ let pr2_gen x = pr2 (dump x) let _already_printed = Hashtbl.create 101 -let disable_pr2_once = ref false +let disable_pr2_once = ref false -let xxx_once f s = +let xxx_once f s = if !disable_pr2_once then pr2 s - else + else if not (Hashtbl.mem _already_printed s) then begin Hashtbl.add _already_printed s true; @@ -491,10 +501,10 @@ let redirect_stdin_opt optfile f = | Some infile -> redirect_stdin infile f -(* cf end -let with_pr2_to_string f = +(* cf end +let with_pr2_to_string f = *) - + (* ---------------------------------------------------------------------- *) @@ -506,7 +516,7 @@ include Printf * val kprintf : (string -> 'a) -> ('b, unit, string, 'a) format4 -> 'b *) -(* ex of printf: +(* ex of printf: * printf "%02d" i * for padding *) @@ -516,11 +526,11 @@ let spf = sprintf (* ---------------------------------------------------------------------- *) let _chan = ref stderr -let start_log_file () = +let start_log_file () = let filename = (spf "/tmp/debugml%d:%d" (Unix.getuid()) (Unix.getpid())) in pr2 (spf "now using %s for logging" filename); _chan := open_out filename - + let dolog s = output_string !_chan (s ^ "\n"); flush !_chan @@ -541,7 +551,7 @@ let pause () = (pr2 "pause: type return"; ignore(read_line ())) (* src: from getopt from frish *) let bip () = Printf.printf "\007"; flush stdout -let wait () = Unix.sleep 1 +let wait () = Unix.sleep 1 (* was used by fix_caml *) let _trace_var = ref 0 @@ -549,9 +559,9 @@ let add_var() = incr _trace_var let dec_var() = decr _trace_var let get_var() = !_trace_var -let (print_n: int -> string -> unit) = fun i s -> +let (print_n: int -> string -> unit) = fun i s -> do_n i (fun () -> print_string s) -let (printerr_n: int -> string -> unit) = fun i s -> +let (printerr_n: int -> string -> unit) = fun i s -> do_n i (fun () -> prerr_string s) let _debug = ref true @@ -562,7 +572,7 @@ let debug f = if !_debug then f () else () (* now in prelude: - * let debugger = ref false + * let debugger = ref false *) @@ -581,18 +591,18 @@ let memory_stat () = Printf.sprintf "lives = %d Mo\n" (conv_mo stat.Gc.live_words) (* Printf.printf "fragments = %d Mo\n" (conv_mo stat.Gc.fragments); *) -let timenow () = +let timenow () = "sys:" ^ (string_of_float (Sys.time ())) ^ " seconds" ^ - ":real:" ^ + ":real:" ^ (let tm = Unix.time () +> Unix.gmtime in - tm.Unix.tm_min +> string_of_int ^ " min:" ^ + tm.Unix.tm_min +> string_of_int ^ " min:" ^ tm.Unix.tm_sec +> string_of_int ^ ".00 seconds") -let _count1 = ref 0 -let _count2 = ref 0 -let _count3 = ref 0 -let _count4 = ref 0 -let _count5 = ref 0 +let _count1 = ref 0 +let _count2 = ref 0 +let _count3 = ref 0 +let _count4 = ref 0 +let _count5 = ref 0 let count1 () = incr _count1 let count2 () = incr _count2 @@ -600,14 +610,14 @@ let count3 () = incr _count3 let count4 () = incr _count4 let count5 () = incr _count5 -let profile_diagnostic_basic () = - Printf.sprintf - "count1 = %d\ncount2 = %d\ncount3 = %d\ncount4 = %d\ncount5 = %d\n" +let profile_diagnostic_basic () = + Printf.sprintf + "count1 = %d\ncount2 = %d\ncount3 = %d\ncount4 = %d\ncount5 = %d\n" !_count1 !_count2 !_count3 !_count4 !_count5 -let time_func f = +let time_func f = (* let _ = Timing () in *) let x = f () in (* let _ = Timing () in *) @@ -628,9 +638,9 @@ let check_profile category = let _profile_table = ref (Hashtbl.create 100) let adjust_profile_entry category difftime = - let (xtime, xcount) = + let (xtime, xcount) = (try Hashtbl.find !_profile_table category - with Not_found -> + with Not_found -> let xtime = ref 0.0 in let xcount = ref 0 in Hashtbl.add !_profile_table category (xtime, xcount); @@ -646,17 +656,17 @@ let profile_end category = failwith "todo" (* subtil: don't forget to give all argumens to f, otherwise partial app * and will profile nothing. - * + * * todo: try also detect when complexity augment each time, so can - * detect the situation for a function gets worse and worse ? - *) -let profile_code category f = + * detect the situation for a function gets worse and worse ? + *) +let profile_code category f = if not (check_profile category) then f() else begin if !show_trace_profile then pr2 (spf "p: %s" category); let t = Unix.gettimeofday () in - let res, prefix = + let res, prefix = try Some (f ()), "" with Timeout -> None, "*" in @@ -671,60 +681,60 @@ let profile_code category f = end -let _is_in_exclusif = ref (None: string option) +let _is_in_exclusif = ref (None: string option) -let profile_code_exclusif category f = +let profile_code_exclusif category f = if not (check_profile category) - then f() + then f() else begin match !_is_in_exclusif with - | Some s -> + | Some s -> failwith (spf "profile_code_exclusif: %s but already in %s " category s); - | None -> + | None -> _is_in_exclusif := (Some category); - finalize - (fun () -> + finalize + (fun () -> profile_code category f - ) - (fun () -> + ) + (fun () -> _is_in_exclusif := None ) end -let profile_code_inside_exclusif_ok category f = +let profile_code_inside_exclusif_ok category f = failwith "Todo" (* todo: also put % ? also add % to see if coherent numbers *) -let profile_diagnostic () = +let profile_diagnostic () = if !profile = PNONE then "" else - let xs = - Hashtbl.fold (fun k v acc -> (k,v)::acc) !_profile_table [] + let xs = + Hashtbl.fold (fun k v acc -> (k,v)::acc) !_profile_table [] +> List.sort (fun (k1, (t1,n1)) (k2, (t2,n2)) -> compare t2 t1) in - with_open_stringbuf (fun (pr,_) -> + with_open_stringbuf (fun (pr,_) -> pr "---------------------"; pr "profiling result"; pr "---------------------"; - xs +> List.iter (fun (k, (t,n)) -> + xs +> List.iter (fun (k, (t,n)) -> pr (sprintf "%-40s : %10.3f sec %10d count" k !t !n) ) ) -let report_if_take_time timethreshold s f = +let report_if_take_time timethreshold s f = let t = Unix.gettimeofday () in let res = f () in let t' = Unix.gettimeofday () in - if (t' -. t > float_of_int timethreshold) + if (t' -. t > float_of_int timethreshold) then pr2 (sprintf "Note: processing took %7.1fs: %s" (t' -. t) s); res -let profile_code2 category f = - profile_code category (fun () -> +let profile_code2 category f = + profile_code category (fun () -> if !profile = PALL then pr2 ("starting: " ^ category); let t = Unix.gettimeofday () in @@ -734,7 +744,7 @@ let profile_code2 category f = then pr2 (spf "ending: %s, %fs" category (t' -. t)); res ) - + (*****************************************************************************) (* Test *) @@ -743,37 +753,37 @@ let example b = assert b let _ex1 = example (enum 1 4 = [1;2;3;4]) -let assert_equal a b = - if not (a = b) - then failwith ("assert_equal: those 2 values are not equal:\n\t" ^ +let assert_equal a b = + if not (a = b) + then failwith ("assert_equal: those 2 values are not equal:\n\t" ^ (dump a) ^ "\n\t" ^ (dump b) ^ "\n") -let (example2: string -> bool -> unit) = fun s b -> +let (example2: string -> bool -> unit) = fun s b -> try assert b with x -> failwith s (*-------------------------------------------------------------------*) let _list_bool = ref [] -let (example3: string -> bool -> unit) = fun s b -> +let (example3: string -> bool -> unit) = fun s b -> _list_bool := (s,b)::(!_list_bool) (* could introduce a fun () otherwise the calculus is made at compile time * and this can be long. This would require to redefine test_all. - * let (example3: string -> (unit -> bool) -> unit) = fun s func -> + * let (example3: string -> (unit -> bool) -> unit) = fun s func -> * _list_bool := (s,func):: (!_list_bool) - * + * * I would like to do as a func that take 2 terms, and make an = over it * avoid to add this ugly fun (), but pb of type, cant do that :( *) -let (test_all: unit -> unit) = fun () -> - List.iter (fun (s, b) -> +let (test_all: unit -> unit) = fun () -> + List.iter (fun (s, b) -> Printf.printf "%s: %s\n" s (if b then "passed" else "failed") ) !_list_bool -let (test: string -> unit) = fun s -> - Printf.printf "%s: %s\n" s +let (test: string -> unit) = fun s -> + Printf.printf "%s: %s\n" s (if (List.assoc s (!_list_bool)) then "passed" else "failed") let _ex = example3 "++" ([1;2]++[3;4;5] = [1;2;3;4;5]) @@ -782,7 +792,7 @@ let _ex = example3 "++" ([1;2]++[3;4;5] = [1;2;3;4;5]) (* Regression testing *) (*-------------------------------------------------------------------*) -(* cf end of file. It uses too many other common functions so I +(* cf end of file. It uses too many other common functions so I * have put the code at the end of this file. *) @@ -812,7 +822,7 @@ let reset () = ok_ref := 0; bug_ref := 0 -let test x s = +let test x s = if x then ok () else begin Printf.printf "%s\n" s; bug () end;; let test_exn x s = @@ -831,24 +841,24 @@ let test_exn x s = (* Better than quickcheck, cos cant do a test_all_prop in haskell cos * prop were functions, whereas here we have not prop_Unix x = ... but - * laws "unit" ... + * laws "unit" ... * * How to do without overloading ? objet ? can pass a generator as a * parameter, mais lourd, prefer automatic inferring of the * generator? But at the same time quickcheck does not do better cos - * we must explictly type the property. So between a - * prop_unit:: [Int] -> [Int] -> bool ... - * prop_unit x = reverse [x] == [x] - * and - * let _ = laws "unit" (fun x -> reverse [x] = [x]) (listg intg) - * there is no real differences. + * we must explictly type the property. So between a + * prop_unit:: [Int] -> [Int] -> bool ... + * prop_unit x = reverse [x] == [x] + * and + * let _ = laws "unit" (fun x -> reverse [x] = [x]) (listg intg) + * there is no real differences. * * Yes I define typeg generator but quickcheck too, he must define * class instance. I emulate the context Gen a => Gen [a] by making * listg take as a param a type generator. Moreover I have not the pb of - * monad. I can do random independently, so my code is more simple + * monad. I can do random independently, so my code is more simple * I think than the haskell code of quickcheck. - * + * * update: apparently Jane Street have copied some of my code for their * Ounit_util.ml and quichcheck.ml in their Core library :) *) @@ -860,34 +870,34 @@ type 'a gen = unit -> 'a let (ig: int gen) = fun () -> Random.int 10 -let (lg: ('a gen) -> ('a list) gen) = fun gen () -> +let (lg: ('a gen) -> ('a list) gen) = fun gen () -> foldn (fun acc i -> (gen ())::acc) [] (Random.int 10) -let (pg: ('a gen) -> ('b gen) -> ('a * 'b) gen) = fun gen1 gen2 () -> +let (pg: ('a gen) -> ('b gen) -> ('a * 'b) gen) = fun gen1 gen2 () -> (gen1 (), gen2 ()) let polyg = ig -let (ng: (string gen)) = fun () -> +let (ng: (string gen)) = fun () -> "a" ^ (string_of_int (ig ())) -let (oneofl: ('a list) -> 'a gen) = fun xs () -> - List.nth xs (Random.int (List.length xs)) +let (oneofl: ('a list) -> 'a gen) = fun xs () -> + List.nth xs (Random.int (List.length xs)) (* let oneofl l = oneof (List.map always l) *) -let (oneof: (('a gen) list) -> 'a gen) = fun xs -> - List.nth xs (Random.int (List.length xs)) +let (oneof: (('a gen) list) -> 'a gen) = fun xs -> + List.nth xs (Random.int (List.length xs)) let (always: 'a -> 'a gen) = fun e () -> e -let (frequency: ((int * ('a gen)) list) -> 'a gen) = fun xs -> +let (frequency: ((int * ('a gen)) list) -> 'a gen) = fun xs -> let sums = sum_int (List.map fst xs) in let i = Random.int sums in - let rec freq_aux acc = function - | (x,g)::xs -> if i < acc+x then g else freq_aux (acc+x) xs - | _ -> failwith "frequency" + let rec freq_aux acc = function + | (x,g)::xs -> if i < acc+x then g else freq_aux (acc+x) xs + | _ -> failwith "frequency" in freq_aux 0 xs let frequencyl l = frequency (List.map (fun (i,e) -> (i,always e)) l) -(* +(* let b = oneof [always true; always false] () let b = frequency [3, always true; 2, always false] () *) @@ -896,20 +906,20 @@ let b = frequency [3, always true; 2, always false] () * let rec (lg: ('a gen) -> ('a list) gen) = fun gen -> oneofl [[]; lg gen ()] * nor * let rec (lg: ('a gen) -> ('a list) gen) = fun gen -> oneof [always []; lg gen] - * + * * because caml is not as lazy as haskell :( fix the pb by introducing a size * limit. take the bounds/size as parameter. morover this is needed for * more complex type. - * + * * how make a bintreeg ?? we need recursion - * - * let rec (bintreeg: ('a gen) -> ('a bintree) gen) = fun gen () -> - * let rec aux n = + * + * let rec (bintreeg: ('a gen) -> ('a bintree) gen) = fun gen () -> + * let rec aux n = * if n = 0 then (Leaf (gen ())) * else frequencyl [1, Leaf (gen ()); 4, Branch ((aux (n / 2)), aux (n / 2))] * () * in aux 20 - * + * *) @@ -918,12 +928,12 @@ let b = frequency [3, always true; 2, always false] () (*---------------------------------------------------------------------------*) (* todo: a test_all_laws, better syntax (done already a little with ig in - * place of intg. En cas d'erreur, print the arg that not respect - * + * place of intg. En cas d'erreur, print the arg that not respect + * * todo: with monitoring, as in haskell, laws = laws2, no need for 2 func, * but hard i found - * - * todo classify, collect, forall + * + * todo classify, collect, forall *) @@ -942,11 +952,11 @@ let rec (statistic_number: ('a list) -> (int * 'a) list) = function let (statistic: ('a list) -> (int * 'a) list) = fun xs -> let stat_num = statistic_number xs in let totals = sum_int (List.map fst stat_num) in - List.map (fun (i, v) -> ((i * 100) / totals), v) stat_num - -let (laws2: - string -> ('a -> (bool * 'b)) -> ('a gen) -> - ('a option * ((int * 'b) list ))) = + List.map (fun (i, v) -> ((i * 100) / totals), v) stat_num + +let (laws2: + string -> ('a -> (bool * 'b)) -> ('a gen) -> + ('a option * ((int * 'b) list ))) = fun s func gen -> let res = foldn (fun acc i -> let n = gen() in (n, func n)::acc) [] 1000 in let stat = statistic (List.map (fun (x,(b,v)) -> v) res) in @@ -961,7 +971,7 @@ let b = laws "rev " (fun xs -> reverse (reverse xs) = xs let b = laws "appb" (fun (xs,ys) -> reverse (xs++ys) = reverse xs++reverse ys)(pg (lg ig)(lg ig)) let b = laws "max" (fun (x,y) -> x <= y ==> (max x y = y) )(pg ig ig) -let b = laws2 "max" (fun (x,y) -> ((x <= y ==> (max x y = y)), x <= y))(pg ig ig) +let b = laws2 "max" (fun (x,y) -> ((x <= y ==> (max x y = y)), x <= y))(pg ig ig) *) @@ -976,44 +986,44 @@ let b = laws "funs" (fun (f,g,h) -> x <= y ==> (max x y = y) )(pg ig ig) *) (* -let one_of xs = List.nth xs (Random.int (List.length xs)) +let one_of xs = List.nth xs (Random.int (List.length xs)) let take_one xs = if empty xs then failwith "Take_one: empty list" - else + else let i = Random.int (List.length xs) in List.nth xs i, filter_index (fun j _ -> i <> j) xs -*) +*) (*****************************************************************************) (* Persistence *) (*****************************************************************************) -let get_value filename = +let get_value filename = let chan = open_in filename in let x = input_value chan in (* <=> Marshal.from_channel *) (close_in chan; x) -let write_value valu filename = +let write_value valu filename = let chan = open_out filename in (output_value chan valu; (* <=> Marshal.to_channel *) (* Marshal.to_channel chan valu [Marshal.Closures]; *) - close_out chan) + close_out chan) -let write_back func filename = +let write_back func filename = write_value (func (get_value filename)) filename let read_value f = get_value f -let marshal__to_string2 v flags = +let marshal__to_string2 v flags = Marshal.to_string v flags -let marshal__to_string a b = +let marshal__to_string a b = profile_code "Marshalling" (fun () -> marshal__to_string2 a b) -let marshal__from_string2 v flags = +let marshal__from_string2 v flags = Marshal.from_string v flags -let marshal__from_string a b = +let marshal__from_string a b = profile_code "Marshalling" (fun () -> marshal__from_string2 a b) @@ -1038,11 +1048,11 @@ type timestamp = int (* To work with the macro system autogenerated string_of and print_ function (kind of deriving a la haskell) *) -(* int, bool, char, float, ref ?, string *) +(* int, bool, char, float, ref ?, string *) let string_of_string s = "\"" ^ s "\"" -let string_of_list f xs = +let string_of_list f xs = "[" ^ (xs +> List.map f +> String.concat ";" ) ^ "]" let string_of_unit () = "()" @@ -1063,15 +1073,15 @@ let print_option pr = function | None -> print_string "None" | Some x -> print_string "Some ("; pr x; print_string ")" -let print_list pr xs = +let print_list pr xs = begin - print_string "["; - List.iter (fun x -> pr x; print_string ",") xs; + print_string "["; + List.iter (fun x -> pr x; print_string ",") xs; print_string "]"; end -(* specialised -let (string_of_list: char list -> string) = +(* specialised +let (string_of_list: char list -> string) = List.fold_left (fun acc x -> acc^(Char.escaped x)) "" *) @@ -1084,15 +1094,15 @@ let rec print_between between fn = function -let adjust_pp_with_indent f = - Format.open_box !_tab_level_print; +let adjust_pp_with_indent f = + Format.open_box !_tab_level_print; (*Format.force_newline();*) - f(); + f(); Format.close_box (); Format.print_newline() -let adjust_pp_with_indent_and_header s f = - Format.open_box (!_tab_level_print + String.length s); +let adjust_pp_with_indent_and_header s f = + Format.open_box (!_tab_level_print + String.length s); do_n !_tab_level_print (fun () -> Format.print_string " "); Format.print_string s; f(); @@ -1104,22 +1114,22 @@ let adjust_pp_with_indent_and_header s f = let pp_do_in_box f = Format.open_box 1; f(); Format.close_box () let pp_do_in_zero_box f = Format.open_box 0; f(); Format.close_box () -let pp_f_in_box f = - Format.open_box 1; - let res = f() in +let pp_f_in_box f = + Format.open_box 1; + let res = f() in Format.close_box (); res let pp s = Format.print_string s -let mk_str_func_of_assoc_conv xs = +let mk_str_func_of_assoc_conv xs = let swap (x,y) = (y,x) in - (fun s -> + (fun s -> let xs' = List.map swap xs in List.assoc s xs' ), - (fun a -> + (fun a -> List.assoc a xs ) @@ -1138,7 +1148,7 @@ let format_to_string f = (*****************************************************************************) (* put your macro in macro.ml4, and you can test it interactivly as in lisp *) -let macro_expand s = +let macro_expand s = let c = open_out "/tmp/ttttt.ml" in begin output_string c s; close_out c; @@ -1159,24 +1169,24 @@ let t = macro_expand "{x = 2; x = 3}" let t = macro_expand "type 'a bintree = Leaf of 'a | Branch of ('a bintree * 'a bintree)" *) - + (*****************************************************************************) (* Composition/Control *) (*****************************************************************************) (* I like the obj.func object notation. In OCaml cant use '.' so I use +> - * + * * update: it seems that F# agrees with me :) but they use |> *) (* now in prelude: * let (+>) o f = f o *) -let (+!>) refo f = refo := f !refo -(* alternatives: +let (+!>) refo f = refo := f !refo +(* alternatives: * let ((@): 'a -> ('a -> 'b) -> 'b) = fun a b -> b a - * let o f g x = f (g x) + * let o f g x = f (g x) *) let ($) f g x = g (f x) @@ -1187,7 +1197,7 @@ let compose f g x = f (g x) by Keisuke Nakano on the caml mailing list. > let ( /* ) x y = y x > and ( */ ) x y = x y -or +or let ( <| ) x y = y x and ( |> ) x y = x y @@ -1205,17 +1215,17 @@ let do_nothing () = () let rec applyn n f o = if n = 0 then o else applyn (n-1) f (f o) -let forever f = +let forever f = while true do f(); done -class ['a] shared_variable_hook (x:'a) = +class ['a] shared_variable_hook (x:'a) = object(self) val mutable data = x val mutable registered = [] - method set x = + method set x = begin data <- x; pr "refresh registered"; @@ -1223,14 +1233,14 @@ class ['a] shared_variable_hook (x:'a) = end method get = data method modify f = self#set (f self#get) - method register f = - registered <- f :: registered - end + method register f = + registered <- f :: registered + end (* src: from aop project. was called ptFix *) let rec fixpoint trans elem = let image = trans elem in - if (image = elem) + if (image = elem) then elem (* point fixe *) else fixpoint trans image @@ -1240,69 +1250,69 @@ let rec fixpoint_for_object trans elem = if (image#equal elem) then elem (* point fixe *) else fixpoint_for_object trans image -let (add_hook: ('a -> ('a -> 'b) -> 'b) ref -> ('a -> ('a -> 'b) -> 'b) -> unit) = +let (add_hook: ('a -> ('a -> 'b) -> 'b) ref -> ('a -> ('a -> 'b) -> 'b) -> unit) = fun var f -> - let oldvar = !var in + let oldvar = !var in var := fun arg k -> f arg (fun x -> oldvar x k) -let (add_hook_action: ('a -> unit) -> ('a -> unit) list ref -> unit) = - fun f hooks -> +let (add_hook_action: ('a -> unit) -> ('a -> unit) list ref -> unit) = + fun f hooks -> push2 f hooks -let (run_hooks_action: 'a -> ('a -> unit) list ref -> unit) = - fun obj hooks -> +let (run_hooks_action: 'a -> ('a -> unit) list ref -> unit) = + fun obj hooks -> !hooks +> List.iter (fun f -> try f obj with _ -> ()) type 'a mylazy = (unit -> 'a) (* a la emacs *) -let save_excursion reference f = +let save_excursion reference f = let old = !reference in let res = try f() with e -> reference := old; raise e in reference := old; res -let save_excursion_and_disable reference f = - save_excursion reference (fun () -> +let save_excursion_and_disable reference f = + save_excursion reference (fun () -> reference := false; f () ) -let save_excursion_and_enable reference f = - save_excursion reference (fun () -> +let save_excursion_and_enable reference f = + save_excursion reference (fun () -> reference := true; f () ) -let memoized h k f = - try Hashtbl.find h k - with Not_found -> +let memoized h k f = + try Hashtbl.find h k + with Not_found -> let v = f () in begin Hashtbl.add h k v; v end -let cache_in_ref myref f = +let cache_in_ref myref f = match !myref with | Some e -> e - | None -> + | None -> let e = f () in myref := Some e; e -let once f = +let once f = let already = ref false in - (fun x -> + (fun x -> if not !already then begin already := true; f x end ) (* cache_file, cf below *) -let before_leaving f x = +let before_leaving f x = f x; x @@ -1317,7 +1327,7 @@ let rec y f = fun x -> f (y f) x (*****************************************************************************) (* from http://en.wikipedia.org/wiki/File_locking - * + * * "When using file locks, care must be taken to ensure that operations * are atomic. When creating the lock, the process must verify that it * does not exist and then create it, but without allowing another @@ -1326,12 +1336,12 @@ let rec y f = fun x -> f (y f) x * system calls designed for this purpose (but such system calls are * not usually available to shell scripts) or by creating the lock file * under a temporary name and then attempting to move it into place." - * + * * => can't use 'if(not (file_exist xxx)) then create_file xxx' because * file_exist/create_file are not in atomic section (classic problem). - * + * * from man open: - * + * * "O_EXCL When used with O_CREAT, if the file already exists it * is an error and the open() will fail. In this context, a * symbolic link exists, regardless of where it points to. @@ -1348,15 +1358,15 @@ let rec y f = fun x -> f (y f) x *) -exception FileAlreadyLocked +exception FileAlreadyLocked (* Racy if lock file on NFS!!! But still racy with recent Linux ? *) -let acquire_file_lock filename = +let acquire_file_lock filename = pr2 ("Locking file: " ^ filename); - try + try let _fd = Unix.openfile filename [Unix.O_CREAT;Unix.O_EXCL] 0o777 in () - with Unix.Unix_error (e, fm, argm) -> + with Unix.Unix_error (e, fm, argm) -> pr2 (spf "exn Unix_error: %s %s %s\n" (Unix.error_message e) fm argm); raise FileAlreadyLocked @@ -1390,15 +1400,15 @@ let myassert cond = if cond then () else failwith "assert error" (* before warning I was forced to do stuff like this: - * - * let (fixed_int_to_posmap: fixed_int -> posmap) = fun fixed -> + * + * let (fixed_int_to_posmap: fixed_int -> posmap) = fun fixed -> * let v = ((fix_to_i fixed) / (power 2 16)) in * let _ = Printf.printf "coord xy = %d\n" v in * v - * - * The need for printf make me force to name stuff :( + * + * The need for printf make me force to name stuff :( * How avoid ? use 'it' special keyword ? - * In fact dont have to name it, use +> (fun v -> ...) so when want + * In fact dont have to name it, use +> (fun v -> ...) so when want * erase debug just have to erase one line. *) let warning s v = (pr2 ("Warning: " ^ s ^ "; value = " ^ (dump v)); v) @@ -1406,7 +1416,7 @@ let warning s v = (pr2 ("Warning: " ^ s ^ "; value = " ^ (dump v)); v) -let exn_to_s exn = +let exn_to_s exn = Printexc.to_string exn (* alias *) @@ -1437,10 +1447,10 @@ let evoval = () (*****************************************************************************) let check_stack = ref true -let check_stack_size limit = +let check_stack_size limit = if !check_stack then begin pr2 "checking stack size (do ulimit -s 50000 if problem)"; - let rec aux i = + let rec aux i = if i = limit then 0 else 1 + aux (i + 1) @@ -1449,16 +1459,16 @@ let check_stack_size limit = () end -let test_check_stack_size limit = +let test_check_stack_size limit = (* bytecode: 100000000 *) (* native: 10000000 *) check_stack_size (int_of_string limit) (* only relevant in bytecode, in native the stacklimit is the os stacklimit - * (adjustable by ulimit -s) + * (adjustable by ulimit -s) *) -let _init_gc_stack = +let _init_gc_stack = Gc.set {(Gc.get ()) with Gc.stack_limit = 100 * 1024 * 1024} @@ -1468,7 +1478,7 @@ let _init_gc_stack = * so for this we are ready to spend some extra time at the beginning that * could save far more later. *) -let check_stack_nbfiles nbfiles = +let check_stack_nbfiles nbfiles = if nbfiles > 200 then check_stack_size 10000000 @@ -1476,86 +1486,86 @@ let check_stack_nbfiles nbfiles = (* Arguments/options and command line (cocci and acomment) *) (*****************************************************************************) -(* +(* * Why define wrappers ? Arg not good enough ? Well the Arg.Rest is not that * good and I need a way sometimes to get a list of argument. - * + * * I could define maybe a new Arg.spec such as - * | String_list of (string list -> unit), but the action may require + * | String_list of (string list -> unit), but the action may require * some flags to be set, so better to process this after all flags have * been set by parse_options. So have to split. Otherwise it would impose - * an order of the options such as + * an order of the options such as * -verbose_parsing -parse_c file1 file2. and I really like to use bash * history and add just at the end of my command a -profile for instance. - * - * + * + * * Why want a -action arg1 arg2 arg3 ? (which in turn requires this - * convulated scheme ...) Why not use Arg.String action such as - * "-parse_c", Arg.String (fun file -> ...) ? - * I want something that looks like ocaml function but at the UNIX - * command line level. So natural to have this scheme instead of + * convulated scheme ...) Why not use Arg.String action such as + * "-parse_c", Arg.String (fun file -> ...) ? + * I want something that looks like ocaml function but at the UNIX + * command line level. So natural to have this scheme instead of * -taxo_file arg2 -sample_file arg3 -parse_c arg1. - * - * - * Why not use the toplevel ? + * + * + * Why not use the toplevel ? * - because to debug, ocamldebug is far superior to the toplevel * (can go back, can go directly to a specific point, etc). - * I want a kind of testing at cmdline level. - * - Also I don't have file completion when in the ocaml toplevel. + * I want a kind of testing at cmdline level. + * - Also I don't have file completion when in the ocaml toplevel. * I have to type "/path/to/xxx" without help. - * - * - * Why having variable flags ? Why use 'if !verbose_parsing then ...' ? + * + * + * Why having variable flags ? Why use 'if !verbose_parsing then ...' ? * why not use strings and do stuff like the following * 'if (get_config "verbose_parsing") then ...' * Because I want to make the interface for flags easier for the code * that use it. The programmer should not be bothered wether this - * flag is set via args cmd line or a config file, so I want to make it + * flag is set via args cmd line or a config file, so I want to make it * as simple as possible, just use a global plain caml ref variable. - * + * * Same spirit a little for the action. Instead of having function such as * test_parsing_c, I could do it only via string. But I still prefer * to have plain caml test functions. Also it makes it easier to call * those functions from a toplevel for people who prefer the toplevel. - * - * - * So have flag_spec and action_spec. And in flag have debug_xxx flags, + * + * + * So have flag_spec and action_spec. And in flag have debug_xxx flags, * verbose_xxx flags and other flags. - * + * * I would like to not have to separate the -xxx actions spec from the * corresponding actions, but those actions may need more than one argument * and so have to wait for parse_options, which in turn need the options - * spec, so circle. - * + * spec, so circle. + * * Also I dont want to mix code with data structures, so it's better that the * options variable contain just a few stuff and have no side effects except * setting global variables. - * + * * Why not have a global variable such as Common.actions that * other modules modify ? No, I prefer to do less stuff behind programmer's * back so better to let the user merge the different options at call * site, but at least make it easier by providing shortcut for set of options. - * - * - * - * + * + * + * + * * todo? isn't unison or scott-mcpeak-lib-in-cil handles that kind of * stuff better ? That is the need to localize command line argument * while still being able to gathering them. Same for logging. * Similiar to the type prof = PALL | PNONE | PSOME of string list. * Same spirit of fine grain config in log4j ? - * + * * todo? how mercurial/cvs/git manage command line options ? because they * all have a kind of DSL around arguments with some common options, * specific options, conventions, etc. - * - * - * todo? generate the corresponding noxxx options ? + * + * + * todo? generate the corresponding noxxx options ? * todo? generate list of options and show their value ? - * - * todo? make it possible to set this value via a config file ? - * - * + * + * todo? make it possible to set this value via a config file ? + * + * *) type arg_spec_full = Arg.key * Arg.spec * Arg.doc @@ -1570,7 +1580,7 @@ type cmdline_sections = options_with_title list (* ---------------------------------------------------------------------- *) -(* now I use argv as I like at the call sites to show that +(* now I use argv as I like at the call sites to show that * this function internally use argv. *) let parse_options options usage_msg argv = @@ -1587,7 +1597,7 @@ let parse_options options usage_msg argv = -let usage usage_msg options = +let usage usage_msg options = Arg.usage (Arg.align options) usage_msg @@ -1598,21 +1608,21 @@ let arg_align2 xs = Arg.align xs +> List.rev +> drop 2 +> List.rev -let short_usage usage_msg ~short_opt = +let short_usage usage_msg ~short_opt = usage usage_msg short_opt -let long_usage usage_msg ~short_opt ~long_opt = +let long_usage usage_msg ~short_opt ~long_opt = pr usage_msg; pr ""; - let all_options_with_title = + let all_options_with_title = (("main options", "", short_opt)::long_opt) in - all_options_with_title +> List.iter - (fun (title, explanations, xs) -> + all_options_with_title +> List.iter + (fun (title, explanations, xs) -> pr title; pr_xxxxxxxxxxxxxxxxx(); - if explanations <> "" + if explanations <> "" then begin pr explanations; pr "" end; - arg_align2 xs +> List.iter (fun (key,action,s) -> + arg_align2 xs +> List.iter (fun (key,action,s) -> pr (" " ^ key ^ s) ); pr ""; @@ -1625,7 +1635,7 @@ let arg_parse2 l msg short_usage_fun = let args = ref [] in let f = (fun file -> args := file::!args) in let l = Arg.align l in - (try begin + (try begin Arg.parse_argv Sys.argv l f msg; args := List.rev !args; !args @@ -1643,88 +1653,88 @@ let arg_parse2 l msg short_usage_fun = (* ---------------------------------------------------------------------- *) -(* kind of unit testing framework, or toplevel like functionnality +(* kind of unit testing framework, or toplevel like functionnality * at shell command line. I realize than in fact It follows a current trend - * to have a main cmdline program where can then select different actions, + * to have a main cmdline program where can then select different actions, * as in cvs/hg/git where do hg , and the shell even * use a curried syntax :) - * - * + * + * * Not-perfect-but-basic-feels-right: an action * spec looks like this: - * + * * let actions () = [ - * "-parse_taxo", " ", + * "-parse_taxo", " ", * Common.mk_action_1_arg test_parse_taxo; * ... * ] - * + * * Not-perfect-but-basic-feels-right because for such functionality we * need a way to transform a string into a caml function and pass arguments * and the preceding design does exactly that, even if then the * functions that use this design are not so convenient to use (there * are 2 places where we need to pass those data, in the options and in the - * main dispatcher). - * + * main dispatcher). + * * Also it's not too much intrusive. Still have an - * action ref variable in the main.ml and can still use the previous + * action ref variable in the main.ml and can still use the previous * simpler way to do where the match args with in main.ml do the * dispatch. - * - * Use like this at option place: + * + * Use like this at option place: * (Common.options_of_actions actionref (Test_parsing_c.actions())) ++ - * Use like this at dispatch action place: - * | xs when List.mem !action (Common.action_list all_actions) -> + * Use like this at dispatch action place: + * | xs when List.mem !action (Common.action_list all_actions) -> * Common.do_action !action xs all_actions - * + * *) type flag_spec = Arg.key * Arg.spec * Arg.doc -type action_spec = Arg.key * Arg.doc * action_func +type action_spec = Arg.key * Arg.doc * action_func and action_func = (string list -> unit) type cmdline_actions = action_spec list exception WrongNumberOfArguments -let options_of_actions action_ref actions = - actions +> List.map (fun (key, doc, _func) -> +let options_of_actions action_ref actions = + actions +> List.map (fun (key, doc, _func) -> (key, (Arg.Unit (fun () -> action_ref := key)), doc) ) - -let (action_list: cmdline_actions -> Arg.key list) = fun xs -> - List.map (fun (a,b,c) -> a) xs + +let (action_list: cmdline_actions -> Arg.key list) = fun xs -> + List.map (fun (a,b,c) -> a) xs let (do_action: Arg.key -> string list (* args *) -> cmdline_actions -> unit) = - fun key args xs -> + fun key args xs -> let assoc = xs +> List.map (fun (a,b,c) -> (a,c)) in let action_func = List.assoc key assoc in action_func args -(* todo? if have a function with default argument ? would like a - * mk_action_0_or_1_arg ? +(* todo? if have a function with default argument ? would like a + * mk_action_0_or_1_arg ? *) -let mk_action_0_arg f = - (function +let mk_action_0_arg f = + (function | [] -> f () | _ -> raise WrongNumberOfArguments ) -let mk_action_1_arg f = - (function +let mk_action_1_arg f = + (function | [file] -> f file | _ -> raise WrongNumberOfArguments ) -let mk_action_2_arg f = - (function +let mk_action_2_arg f = + (function | [file1;file2] -> f file1 file2 | _ -> raise WrongNumberOfArguments ) -let mk_action_3_arg f = - (function +let mk_action_3_arg f = + (function | [file1;file2;file3] -> f file1 file2 file3 | _ -> raise WrongNumberOfArguments ) @@ -1754,7 +1764,7 @@ let (=:=) : bool -> bool -> bool = (=) (* the evil generic (=). I define another symbol to more easily detect * it, cos the '=' sign is syntaxically overloaded in caml. It is also - * used to define function. + * used to define function. *) let (=*=) = (=) @@ -1797,8 +1807,8 @@ let string_of_char c = String.make 1 c let is_single = String.contains ",;()[]{}_`" let is_symbol = String.contains "!@#$%&*+./<=>?\\^|:-~" let is_space = String.contains "\n\t " -let cbetween min max c = - (int_of_char c) <= (int_of_char max) && +let cbetween min max c = + (int_of_char c) <= (int_of_char max) && (int_of_char c) >= (int_of_char min) let is_upper = cbetween 'A' 'Z' let is_lower = cbetween 'a' 'z' @@ -1816,7 +1826,7 @@ let string_of_chars cs = cs +> List.map (String.make 1) +> String.concat "" (* since 3.08, div by 0 raise Div_by_rezo, and not anymore a hardware trap :)*) let (/!) x y = if y =|= 0 then (log "common.ml: div by 0"; 0) else x / y -(* now in prelude +(* now in prelude * let rec (do_n: int -> (unit -> unit) -> unit) = fun i f -> * if i = 0 then () else (f(); do_n (i-1) f) *) @@ -1848,25 +1858,25 @@ let rec power x n = if n =|= 0 then 1 else x * power x (n-1) let between i min max = i > min && i < max -let (between_strict: int -> int -> int -> bool) = fun a b c -> +let (between_strict: int -> int -> int -> bool) = fun a b c -> a < b && b < c let bitrange x p = let v = power 2 p in between x (-v) v (* descendant *) -let (prime1: int -> int option) = fun x -> - let rec prime1_aux n = +let (prime1: int -> int option) = fun x -> + let rec prime1_aux n = if n =|= 1 then None - else + else if (x / n) * n =|= x then Some n else prime1_aux (n-1) in if x =|= 1 then None else if x < 0 then failwith "negative" else prime1_aux (x-1) (* montant, better *) -let (prime: int -> int option) = fun x -> - let rec prime_aux n = +let (prime: int -> int option) = fun x -> + let rec prime_aux n = if n =|= x then None - else + else if (x / n) * n =|= x then Some n else prime_aux (n+1) in if x =|= 1 then None else if x < 0 then failwith "negative" else prime_aux 2 @@ -1874,14 +1884,14 @@ let sum xs = List.fold_left (+) 0 xs let product = List.fold_left ( * ) 1 -let decompose x = - let rec decompose x = +let decompose x = + let rec decompose x = if x =|= 1 then [] - else + else (match prime x with | None -> [x] | Some n -> n::decompose (x / n) - ) + ) in assert (product (decompose x) =|= x); decompose x let mysquare x = x * x @@ -1895,11 +1905,11 @@ let (<==>) a b = if a =*= b then 0 else if a < b then -1 else 1 type uint = int -let int_of_stringchar s = +let int_of_stringchar s = fold_left_with_index (fun acc e i -> acc + (Char.code e*(power 8 i))) 0 (List.rev (list_of_string s)) -let int_of_base s base = - fold_left_with_index (fun acc e i -> +let int_of_base s base = + fold_left_with_index (fun acc e i -> let j = Char.code e - Char.code '0' in if j >= base then failwith "not in good base" else acc + (j*(power base i)) @@ -1914,7 +1924,7 @@ let _ = example (int_of_octal "017" =|= 15) (* let int_of_hex s = int_of_base s 16, NONONONO cos 'A' - '0' does not give 10 !! *) -let int_of_all s = +let int_of_all s = if String.length s >= 2 && (String.get s 0 =<= '0') && is_digit (String.get s 1) then int_of_octal s else int_of_string s @@ -1922,24 +1932,24 @@ let int_of_all s = let (+=) ref v = ref := !ref + v let (-=) ref v = ref := !ref - v -let pourcent x total = +let pourcent x total = (x * 100) / total -let pourcent_float x total = +let pourcent_float x total = ((float_of_int x) *. 100.0) /. (float_of_int total) -let pourcent_float_of_floats x total = +let pourcent_float_of_floats x total = (x *. 100.0) /. total -let pourcent_good_bad good bad = +let pourcent_good_bad good bad = (good * 100) / (good + bad) -let pourcent_good_bad_float good bad = +let pourcent_good_bad_float good bad = (float_of_int good *. 100.0) /. (float_of_int good +. float_of_int bad) type 'a max_with_elem = int ref * 'a ref -let update_max_with_elem (aref, aelem) ~is_better (newv, newelem) = - if is_better newv aref +let update_max_with_elem (aref, aelem) ~is_better (newv, newelem) = + if is_better newv aref then begin aref := newv; aelem := newelem; @@ -1949,10 +1959,10 @@ let update_max_with_elem (aref, aelem) ~is_better (newv, newelem) = (* Numeric/overloading *) (*****************************************************************************) -type 'a numdict = - NumDict of (('a-> 'a -> 'a) * - ('a-> 'a -> 'a) * - ('a-> 'a -> 'a) * +type 'a numdict = + NumDict of (('a-> 'a -> 'a) * + ('a-> 'a -> 'a) * + ('a-> 'a -> 'a) * ('a -> 'a));; let add (NumDict(a, m, d, n)) = a;; @@ -1962,17 +1972,17 @@ let neg (NumDict(a, m, d, n)) = n;; let numd_int = NumDict(( + ),( * ),( / ),( ~- ));; let numd_float = NumDict(( +. ),( *. ), ( /. ),( ~-. ));; -let testd dict n = - let ( * ) x y = mul dict x y in - let ( / ) x y = div dict x y in - let ( + ) x y = add dict x y in - (* Now you can define all sorts of things in terms of *, /, + *) - let f num = (num * num) / (num + num) in +let testd dict n = + let ( * ) x y = mul dict x y in + let ( / ) x y = div dict x y in + let ( + ) x y = add dict x y in + (* Now you can define all sorts of things in terms of *, /, + *) + let f num = (num * num) / (num + num) in f n;; -module ArithFloatInfix = struct +module ArithFloatInfix = struct let (+..) = (+) let (-..) = (-) let (/..) = (/) @@ -2052,7 +2062,7 @@ let do_option f = function | None -> () | Some x -> f x -let optionise f = +let optionise f = try Some (f ()) with Not_found -> None @@ -2066,7 +2076,7 @@ let some_or = function let partition_either f l = let rec part_either left right = function | [] -> (List.rev left, List.rev right) - | x :: l -> + | x :: l -> (match f x with | Left e -> part_either (e :: left) right l | Right e -> part_either left (e :: right) l) in @@ -2075,7 +2085,7 @@ let partition_either f l = let partition_either3 f l = let rec part_either left middle right = function | [] -> (List.rev left, List.rev middle, List.rev right) - | x :: l -> + | x :: l -> (match f x with | Left3 e -> part_either (e :: left) middle right l | Middle3 e -> part_either left (e :: middle) right l @@ -2093,13 +2103,13 @@ let map_filter f xs = xs +> List.map f +> filter_some let rec find_some p = function | [] -> raise Not_found - | x :: l -> + | x :: l -> match p x with | Some v -> v | None -> find_some p l (* same -let map_find f xs = +let map_find f xs = xs +> List.map f +> List.find (function Some x -> true | None -> false) +> (function Some x -> x | None -> raise Impossible) *) @@ -2124,21 +2134,21 @@ type bool3 = True3 | False3 | TrueFalsePb3 of string (*****************************************************************************) (* Note: OCaml Str regexps are different from Perl regexp: - * - The OCaml regexp must match the entire way. - * So "testBee" =~ "Bee" is wrong + * - The OCaml regexp must match the entire way. + * So "testBee" =~ "Bee" is wrong * but "testBee" =~ ".*Bee" is right - * Can have the perl behavior if use Str.search_forward instead of + * Can have the perl behavior if use Str.search_forward instead of * Str.string_match. - * - Must add some additional \ in front of some special char. So use + * - Must add some additional \ in front of some special char. So use * \\( \\| and also \\b * - It does not always handle newlines very well. * - \\b does consider _ but not numbers in indentifiers. - * + * * Note: PCRE regexps are then different from Str regexps ... * - just use '(' ')' for grouping, not '\\)' * - still need \\b for word boundary, but this time it works ... * so can match some word that have some digits in them. - * + * *) (* put before String section because String section use some =~ *) @@ -2146,54 +2156,54 @@ type bool3 = True3 | False3 | TrueFalsePb3 of string (* let gsubst = global_replace *) -let (==~) s re = Str.string_match re s 0 +let (==~) s re = Str.string_match re s 0 let _memo_compiled_regexp = Hashtbl.create 101 -let candidate_match_func s re = +let candidate_match_func s re = (* old: Str.string_match (Str.regexp re) s 0 *) - let compile_re = - memoized _memo_compiled_regexp re (fun () -> Str.regexp re) + let compile_re = + memoized _memo_compiled_regexp re (fun () -> Str.regexp re) in Str.string_match compile_re s 0 -let match_func s re = +let match_func s re = profile_code "Common.=~" (fun () -> candidate_match_func s re) -let (=~) s re = +let (=~) s re = match_func s re -let string_match_substring re s = - try let _i = Str.search_forward re s 0 in true +let string_match_substring re s = + try let _i = Str.search_forward re s 0 in true with Not_found -> false -let _ = +let _ = example(string_match_substring (Str.regexp "foo") "a foo b") -let _ = +let _ = example(string_match_substring (Str.regexp "\\bfoo\\b") "a foo b") -let _ = +let _ = example(string_match_substring (Str.regexp "\\bfoo\\b") "a\n\nfoo b") -let _ = +let _ = example(string_match_substring (Str.regexp "\\bfoo_bar\\b") "a\n\nfoo_bar b") -(* does not work :( -let _ = +(* does not work :( +let _ = example(string_match_substring (Str.regexp "\\bfoo_bar2\\b") "a\n\nfoo_bar2 b") *) -let (regexp_match: string -> string -> string) = fun s re -> +let (regexp_match: string -> string -> string) = fun s re -> assert(s =~ re); Str.matched_group 1 s (* beurk, side effect code, but hey, it is convenient *) (* now in prelude - * let (matched: int -> string -> string) = fun i s -> + * let (matched: int -> string -> string) = fun i s -> * Str.matched_group i s - * + * * let matched1 = fun s -> matched 1 s * let matched2 = fun s -> (matched 1 s, matched 2 s) * let matched3 = fun s -> (matched 1 s, matched 2 s, matched 3 s) @@ -2220,12 +2230,12 @@ let (split_list_regexp: string -> string list -> (string * string list) list) = fun re xs -> let rec split_lr_aux (heading, accu) = function | [] -> [(heading, List.rev accu)] - | x::xs -> - if x =~ re + | x::xs -> + if x =~ re then (heading, List.rev accu)::split_lr_aux (x, []) xs else split_lr_aux (heading, x::accu) xs in - split_lr_aux ("__noheading__", []) xs + split_lr_aux ("__noheading__", []) xs +> (fun xs -> if (List.hd xs) =*= ("__noheading__",[]) then List.tl xs else xs) @@ -2234,10 +2244,10 @@ let regexp_alpha = Str.regexp "^[a-zA-Z_][A-Za-z_0-9]*$" -let all_match re s = +let all_match re s = let regexp = Str.regexp re in let res = ref [] in - let _ = Str.global_substitute regexp (fun _s -> + let _ = Str.global_substitute regexp (fun _s -> let substr = Str.matched_string s in assert(substr ==~ regexp); (* @Effect: also use it's side effect *) let paren_matched = matched1 substr in @@ -2246,27 +2256,27 @@ let all_match re s = ) s in List.rev !res -let _ = example (all_match "\\(@[A-Za-z]+\\)" "ca va @Et toi @Comment" +let _ = example (all_match "\\(@[A-Za-z]+\\)" "ca va @Et toi @Comment" =*= ["@Et";"@Comment"]) -let global_replace_regexp re f_on_substr s = +let global_replace_regexp re f_on_substr s = let regexp = Str.regexp re in - Str.global_substitute regexp (fun _wholestr -> + Str.global_substitute regexp (fun _wholestr -> let substr = Str.matched_string s in f_on_substr substr ) s -let regexp_word_str = +let regexp_word_str = "\\([a-zA-Z_][A-Za-z_0-9]*\\)" let regexp_word = Str.regexp regexp_word_str -let regular_words s = +let regular_words s = all_match regexp_word_str s -let contain_regular_word s = +let contain_regular_word s = let xs = regular_words s in List.length xs >= 1 @@ -2287,8 +2297,8 @@ let s_to_i = int_of_string (* strings take space in memory. Better when can share the space used by similar strings *) let _shareds = Hashtbl.create 100 -let (shared_string: string -> string) = fun s -> - try Hashtbl.find _shareds s +let (shared_string: string -> string) = fun s -> + try Hashtbl.find _shareds s with Not_found -> (Hashtbl.add _shareds s s; s) let chop = function @@ -2301,42 +2311,42 @@ let chop_dirsymbol = function | s -> s -let () s (i,j) = +let () s (i,j) = String.sub s i (if j < 0 then String.length s - i + j + 1 else j - i) (* let _ = example ( "tototati"(3,-2) = "otat" ) *) -let () s i = String.get s i +let () s i = String.get s i (* pixel *) let rec split_on_char c s = try let sp = String.index s c in - String.sub s 0 sp :: + String.sub s 0 sp :: split_on_char c (String.sub s (sp+1) (String.length s - sp - 1)) with Not_found -> [s] let lowercase = String.lowercase -let quote s = "\"" ^ s ^ "\"" +let quote s = "\"" ^ s ^ "\"" (* easier to have this to be passed as hof, because ocaml dont have * haskell "section" operators *) -let null_string s = - s =$= "" +let null_string s = + s =$= "" -let is_blank_string s = +let is_blank_string s = s =~ "^\\([ \t]\\)*$" (* src: lablgtk2/examples/entrycompletion.ml *) let is_string_prefix s1 s2 = - (String.length s1 <= String.length s2) && + (String.length s1 <= String.length s2) && (String.sub s2 0 (String.length s1) =$= s1) -let plural i s = +let plural i s = if i =|= 1 - then Printf.sprintf "%d %s" i s + then Printf.sprintf "%d %s" i s else Printf.sprintf "%d %ss" i s let showCodeHex xs = List.iter (fun i -> printf "%02x" i) xs @@ -2344,7 +2354,7 @@ let showCodeHex xs = List.iter (fun i -> printf "%02x" i) xs let take_string n s = String.sub s 0 (n-1) -let take_string_safe n s = +let take_string_safe n s = if n > String.length s then s else take_string n s @@ -2352,30 +2362,30 @@ let take_string_safe n s = (* used by LFS *) -let size_mo_ko i = +let size_mo_ko i = let ko = (i / 1024) mod 1024 in let mo = (i / 1024) / 1024 in - (if mo > 0 + (if mo > 0 then sprintf "%dMo%dKo" mo ko else sprintf "%dKo" ko ) -let size_ko i = +let size_ko i = let ko = i / 1024 in sprintf "%dKo" ko - -(* done in summer 2007 for julia + +(* done in summer 2007 for julia * Reference: P216 of gusfeld book * For two strings S1 and S2, D(i,j) is defined to be the edit distance of S1[1..i] to S2[1..j] * So edit distance of S1 (of length n) and S2 (of length m) is D(n,m) - * + * * Dynamic programming technique - * base: + * base: * D(i,0) = i for all i (cos to go from S1[1..i] to 0 characteres of S2 you have to delete all characters from S1[1..i] * D(0,j) = j for all j (cos j characters must be inserted) * recurrence: @@ -2383,23 +2393,23 @@ let size_ko i = * where t(i,j) is equal to 1 if S1(i) != S2(j) and 0 if equal * intuition = there is 4 possible action = deletion, insertion, substitution, or match * so Lemma = - * + * * D(i,j) must be one of the three * D(i, j-1) + 1 - * D(i-1, j)+1 - * D(i-1, j-1) + - * t(i,j) - * - * + * D(i-1, j)+1 + * D(i-1, j-1) + + * t(i,j) + * + * *) -let matrix_distance s1 s2 = +let matrix_distance s1 s2 = let n = (String.length s1) in - let m = (String.length s2) in + let m = (String.length s2) in let mat = Array.make_matrix (n+1) (m+1) 0 in - let t i j = + let t i j = if String.get s1 (i-1) =<= String.get s2 (j-1) then 0 - else 1 + else 1 in let min3 a b c = min (min a b) c in @@ -2412,13 +2422,13 @@ let matrix_distance s1 s2 = done; for i = 1 to n do for j = 1 to m do - mat.(i).(j) <- + mat.(i).(j) <- min3 (mat.(i).(j-1) + 1) (mat.(i-1).(j) + 1) (mat.(i-1).(j-1) + t i j) done done; mat end -let edit_distance s1 s2 = +let edit_distance s1 s2 = (matrix_distance s1 s2).(String.length s1).(String.length s2) @@ -2444,9 +2454,9 @@ module BasicType = struct end -let (filesuffix: filename -> string) = fun s -> +let (filesuffix: filename -> string) = fun s -> (try regexp_match s ".+\\.\\([a-zA-Z0-9_]+\\)$" with _ -> "NOEXT") -let (fileprefix: filename -> string) = fun s -> +let (fileprefix: filename -> string) = fun s -> (try regexp_match s "\\(.+\\)\\.\\([a-zA-Z0-9_]+\\)?$" with _ -> s) let _ = example (filesuffix "toto.c" =$= "c") @@ -2460,8 +2470,8 @@ let () = example "without" (withoutExtension "toto.s.toto" = "toto") *) -let adjust_ext_if_needed filename ext = - if String.get ext 0 <> '.' +let adjust_ext_if_needed filename ext = + if String.get ext 0 <> '.' then failwith "I need an extension such as .c not just c"; if not (filename =~ (".*\\" ^ ext)) @@ -2470,34 +2480,34 @@ let adjust_ext_if_needed filename ext = -let db_of_filename file = +let db_of_filename file = dirname file, basename file -let filename_of_db (basedir, file) = +let filename_of_db (basedir, file) = Filename.concat basedir file -let dbe_of_filename file = +let dbe_of_filename file = (* raise Invalid_argument if no ext, so safe to use later the unsafe * fileprefix and filesuffix functions. *) - ignore(Filename.chop_extension file); - Filename.dirname file, - Filename.basename file +> fileprefix, + ignore(Filename.chop_extension file); + Filename.dirname file, + Filename.basename file +> fileprefix, Filename.basename file +> filesuffix -let filename_of_dbe (dir, base, ext) = +let filename_of_dbe (dir, base, ext) = Filename.concat dir (base ^ "." ^ ext) -let dbe_of_filename_safe file = +let dbe_of_filename_safe file = try Left (dbe_of_filename file) - with Invalid_argument _ -> + with Invalid_argument _ -> Right (Filename.dirname file, Filename.basename file) -let dbe_of_filename_nodot file = +let dbe_of_filename_nodot file = let (d,b,e) = dbe_of_filename file in let d = if d =$= "." then "" else d in d,b,e @@ -2506,18 +2516,18 @@ let dbe_of_filename_nodot file = -let replace_ext file oldext newext = +let replace_ext file oldext newext = let (d,b,e) = dbe_of_filename file in assert(e =$= oldext); filename_of_dbe (d,b,newext) -let normalize_path file = +let normalize_path file = let (dir, filename) = Filename.dirname file, Filename.basename file in let xs = split "/" dir in let rec aux acc = function | [] -> List.rev acc - | x::xs -> + | x::xs -> (match x with | "." -> aux acc xs | ".." -> aux (List.tl acc) xs @@ -2530,9 +2540,9 @@ let normalize_path file = (* -let relative_to_absolute s = +let relative_to_absolute s = if Filename.is_relative s - then + then begin let old = Sys.getcwd () in Sys.chdir s; @@ -2543,7 +2553,7 @@ let relative_to_absolute s = else s *) -let relative_to_absolute s = +let relative_to_absolute s = if Filename.is_relative s then Sys.getcwd () ^ "/" ^ s else s @@ -2553,19 +2563,19 @@ let is_absolute s = not (is_relative s) (* @Pre: prj_path must not contain regexp symbol *) -let filename_without_leading_path prj_path s = +let filename_without_leading_path prj_path s = let prj_path = chop_dirsymbol prj_path in if s =~ ("^" ^ prj_path ^ "/\\(.*\\)$") then matched1 s - else - failwith + else + failwith (spf "cant find filename_without_project_path: %s %s" prj_path s) (*****************************************************************************) (* i18n *) (*****************************************************************************) -type langage = +type langage = | English | Francais | Deutsch @@ -2579,7 +2589,7 @@ type langage = (* maybe I should use ocamlcalendar, but I don't like all those functors ... *) -type month = +type month = | Jan | Feb | Mar | Apr | May | Jun | Jul | Aug | Sep | Oct | Nov | Dec type year = Year of int @@ -2607,10 +2617,10 @@ type float_time = float -let check_date_dmy (DMY (day, month, year)) = +let check_date_dmy (DMY (day, month, year)) = raise Todo -let check_time_dmy (TimeDMY (day, month, year)) = +let check_time_dmy (TimeDMY (day, month, year)) = raise Todo let check_time_hms (HMS (x,y,a)) = @@ -2621,7 +2631,7 @@ let check_time_hms (HMS (x,y,a)) = (* ---------------------------------------------------------------------- *) (* older code *) -let int_to_month i = +let int_to_month i = assert (i <= 12 && i >= 1); match i with @@ -2679,64 +2689,64 @@ let week_day_info = [ 6 , Saturday , "Sat" ,"Sam" , "Saturday"; ] -let i_to_month_h = +let i_to_month_h = month_info +> List.map (fun (i,month,monthstr,mlong,days) -> i, month) -let s_to_month_h = +let s_to_month_h = month_info +> List.map (fun (i,month,monthstr,mlong,days) -> monthstr, month) -let slong_to_month_h = +let slong_to_month_h = month_info +> List.map (fun (i,month,monthstr,mlong,days) -> mlong, month) -let month_to_s_h = +let month_to_s_h = month_info +> List.map (fun (i,month,monthstr,mlong,days) -> month, monthstr) -let month_to_i_h = +let month_to_i_h = month_info +> List.map (fun (i,month,monthstr,mlong,days) -> month, i) -let i_to_wday_h = +let i_to_wday_h = week_day_info +> List.map (fun (i,day,dayen,dayfr,daylong) -> i, day) let wday_to_en_h = week_day_info +> List.map (fun (i,day,dayen,dayfr,daylong) -> day, dayen) let wday_to_fr_h = week_day_info +> List.map (fun (i,day,dayen,dayfr,daylong) -> day, dayfr) -let month_of_string s = +let month_of_string s = List.assoc s s_to_month_h -let month_of_string_long s = +let month_of_string_long s = List.assoc s slong_to_month_h -let string_of_month s = +let string_of_month s = List.assoc s month_to_s_h -let month_of_int i = +let month_of_int i = List.assoc i i_to_month_h -let int_of_month m = +let int_of_month m = List.assoc m month_to_i_h -let wday_of_int i = +let wday_of_int i = List.assoc i i_to_wday_h -let string_en_of_wday wday = +let string_en_of_wday wday = List.assoc wday wday_to_en_h -let string_fr_of_wday wday = +let string_fr_of_wday wday = List.assoc wday wday_to_fr_h (* ---------------------------------------------------------------------- *) -let wday_str_of_int ~langage i = +let wday_str_of_int ~langage i = let wday = wday_of_int i in match langage with | English -> string_en_of_wday wday | Francais -> string_fr_of_wday wday | Deutsch -> raise Todo - -let string_of_date_dmy (DMY (Day n, month, Year y)) = + +let string_of_date_dmy (DMY (Day n, month, Year y)) = (spf "%02d-%s-%d" n (string_of_month month) y) -let string_of_unix_time ?(langage=English) tm = +let string_of_unix_time ?(langage=English) tm = let y = tm.Unix.tm_year + 1900 in let mon = string_of_month (month_of_int (tm.Unix.tm_mon + 1)) in let d = tm.Unix.tm_mday in @@ -2745,24 +2755,24 @@ let string_of_unix_time ?(langage=English) tm = let s = tm.Unix.tm_sec in let wday = wday_str_of_int ~langage tm.Unix.tm_wday in - + spf "%02d/%03s/%04d (%s) %02d:%02d:%02d" d mon y wday h min s (* ex: 21/Jul/2008 (Lun) 21:25:12 *) -let unix_time_of_string s = - if s =~ +let unix_time_of_string s = + if s =~ ("\\([0-9][0-9]\\)/\\(...\\)/\\([0-9][0-9][0-9][0-9]\\) " ^ "\\(.*\\) \\([0-9][0-9]\\):\\([0-9][0-9]\\):\\([0-9][0-9]\\)") then let (sday, smonth, syear, _sday, shour, smin, ssec) = matched7 s in let y = s_to_i syear - 1900 in - let mon = + let mon = smonth +> month_of_string +> int_of_month +> (fun i -> i -1) in let tm = Unix.localtime (Unix.time ()) in - { tm with + { tm with Unix.tm_year = y; Unix.tm_mon = mon; Unix.tm_mday = s_to_i sday; @@ -2774,7 +2784,7 @@ let unix_time_of_string s = -let short_string_of_unix_time ?(langage=English) tm = +let short_string_of_unix_time ?(langage=English) tm = let y = tm.Unix.tm_year + 1900 in let mon = string_of_month (month_of_int (tm.Unix.tm_mon + 1)) in let d = tm.Unix.tm_mday in @@ -2783,36 +2793,36 @@ let short_string_of_unix_time ?(langage=English) tm = let _s = tm.Unix.tm_sec in let wday = wday_str_of_int ~langage tm.Unix.tm_wday in - + spf "%02d/%03s/%04d (%s)" d mon y wday -let string_of_unix_time_lfs time = - spf "%02d--%s--%d" - time.Unix.tm_mday - (int_to_month (time.Unix.tm_mon + 1)) +let string_of_unix_time_lfs time = + spf "%02d--%s--%d" + time.Unix.tm_mday + (int_to_month (time.Unix.tm_mon + 1)) (time.Unix.tm_year + 1900) (* ---------------------------------------------------------------------- *) -let string_of_floattime ?langage i = +let string_of_floattime ?langage i = let tm = Unix.localtime i in string_of_unix_time ?langage tm -let short_string_of_floattime ?langage i = +let short_string_of_floattime ?langage i = let tm = Unix.localtime i in short_string_of_unix_time ?langage tm -let floattime_of_string s = +let floattime_of_string s = let tm = unix_time_of_string s in let (sec,_tm) = Unix.mktime tm in sec (* ---------------------------------------------------------------------- *) -let days_in_week_of_day day = - let tm = Unix.localtime day in - +let days_in_week_of_day day = + let tm = Unix.localtime day in + let wday = tm.Unix.tm_wday in let wday = if wday =|= 0 then 6 else wday -1 in @@ -2821,27 +2831,27 @@ let days_in_week_of_day day = let start_d = mday - wday in let end_d = mday + (6 - wday) in - enum start_d end_d +> List.map (fun mday -> + enum start_d end_d +> List.map (fun mday -> Unix.mktime {tm with Unix.tm_mday = mday} +> fst ) -let first_day_in_week_of_day day = +let first_day_in_week_of_day day = List.hd (days_in_week_of_day day) -let last_day_in_week_of_day day = +let last_day_in_week_of_day day = last (days_in_week_of_day day) (* ---------------------------------------------------------------------- *) (* (modified) copy paste from ocamlcalendar/src/date.ml *) -let days_month = +let days_month = [| 0; 31; 59; 90; 120; 151; 181; 212; 243; 273; 304; 334(*; 365*) |] -let rough_days_since_jesus (DMY (Day nday, month, Year year)) = - let n = - nday + +let rough_days_since_jesus (DMY (Day nday, month, Year year)) = + let n = + nday + (days_month.(int_of_month month -1)) + year * 365 in @@ -2849,47 +2859,47 @@ let rough_days_since_jesus (DMY (Day nday, month, Year year)) = -let is_more_recent d1 d2 = +let is_more_recent d1 d2 = let (Days n1) = rough_days_since_jesus d1 in let (Days n2) = rough_days_since_jesus d2 in - (n1 > n2) + (n1 > n2) -let max_dmy d1 d2 = - if is_more_recent d1 d2 +let max_dmy d1 d2 = + if is_more_recent d1 d2 then d1 else d2 -let min_dmy d1 d2 = - if is_more_recent d1 d2 +let min_dmy d1 d2 = + if is_more_recent d1 d2 then d2 else d1 -let maximum_dmy ds = +let maximum_dmy ds = foldl1 max_dmy ds -let minimum_dmy ds = +let minimum_dmy ds = foldl1 min_dmy ds - -let rough_days_between_dates d1 d2 = + +let rough_days_between_dates d1 d2 = let (Days n1) = rough_days_since_jesus d1 in let (Days n2) = rough_days_since_jesus d2 in Days (n2 - n1) -let _ = example - (rough_days_between_dates +let _ = example + (rough_days_between_dates (DMY (Day 7, Jan, Year 1977)) (DMY (Day 13, Jan, Year 1977)) =*= Days 6) (* because of rough days, it is a bit buggy, here it should return 1 *) (* let _ = assert_equal - (rough_days_between_dates + (rough_days_between_dates (DMY (Day 29, Feb, Year 1977)) - (DMY (Day 1, Mar , Year 1977))) + (DMY (Day 1, Mar , Year 1977))) (Days 1) *) @@ -2922,7 +2932,7 @@ let normalize (year,month,day,hour,minute,second) = *) -let mk_date_dmy day month year = +let mk_date_dmy day month year = let date = DMY (Day day, month_of_int month, Year year) in (* check_date_dmy date *) date @@ -2931,8 +2941,8 @@ let mk_date_dmy day month year = (* ---------------------------------------------------------------------- *) (* conversion to unix.tm *) -let dmy_to_unixtime (DMY (Day n, month, Year year)) = - let tm = { +let dmy_to_unixtime (DMY (Day n, month, Year year)) = + let tm = { Unix.tm_sec = 0; (** Seconds 0..60 *) tm_min = 0; (** Minutes 0..59 *) tm_hour = 12; (** Hours 0..23 *) @@ -2945,22 +2955,22 @@ let dmy_to_unixtime (DMY (Day n, month, Year year)) = } in Unix.mktime tm -let unixtime_to_dmy tm = +let unixtime_to_dmy tm = let n = tm.Unix.tm_mday in let month = month_of_int (tm.Unix.tm_mon + 1) in let year = tm.Unix.tm_year + 1900 in - + DMY (Day n, month, Year year) -let unixtime_to_floattime tm = +let unixtime_to_floattime tm = Unix.mktime tm +> fst -let floattime_to_unixtime sec = +let floattime_to_unixtime sec = Unix.localtime sec -let sec_to_days sec = +let sec_to_days sec = let minfactor = 60 in let hourfactor = 60 * 60 in let dayfactor = 60 * 60 * 24 in @@ -2970,12 +2980,12 @@ let sec_to_days sec = let mins = (sec mod hourfactor) / minfactor in let sec = (sec mod 60) in (* old: Printf.sprintf "%d days, %d hours, %d minutes" days hours mins *) - (if days > 0 then plural days "day" ^ " " else "") ^ + (if days > 0 then plural days "day" ^ " " else "") ^ (if hours > 0 then plural hours "hour" ^ " " else "") ^ (if mins > 0 then plural mins "min" ^ " " else "") ^ (spf "%dsec" sec) -let sec_to_hours sec = +let sec_to_hours sec = let minfactor = 60 in let hourfactor = 60 * 60 in @@ -2986,7 +2996,7 @@ let sec_to_hours sec = (if hours > 0 then plural hours "hour" ^ " " else "") ^ (if mins > 0 then plural mins "min" ^ " " else "") ^ (spf "%dsec" sec) - + let test_date_1 () = @@ -3008,12 +3018,12 @@ let lastweek : unit -> float = fun () -> (Unix.time () -. (7.0 *. day_secs)) let lastmonth : unit -> float = fun () -> (Unix.time () -. (30.0 *. day_secs)) -let week_before : float_time -> float_time = fun d -> +let week_before : float_time -> float_time = fun d -> (d -. (7.0 *. day_secs)) -let month_before : float_time -> float_time = fun d -> +let month_before : float_time -> float_time = fun d -> (d -. (30.0 *. day_secs)) -let week_after : float_time -> float_time = fun d -> +let week_after : float_time -> float_time = fun d -> (d +. (7.0 *. day_secs)) @@ -3023,33 +3033,33 @@ let week_after : float_time -> float_time = fun d -> (*****************************************************************************) (* now in prelude: - * let (list_of_string: string -> char list) = fun s -> + * let (list_of_string: string -> char list) = fun s -> * (enum 0 ((String.length s) - 1) +> List.map (String.get s)) *) let _ = example (list_of_string "abcd" =*= ['a';'b';'c';'d']) (* -let rec (list_of_stream: ('a Stream.t) -> 'a list) = +let rec (list_of_stream: ('a Stream.t) -> 'a list) = parser | [< 'c ; stream >] -> c :: list_of_stream stream | [<>] -> [] -let (list_of_string: string -> char list) = +let (list_of_string: string -> char list) = Stream.of_string $ list_of_stream *) -(* now in prelude: +(* now in prelude: * let (lines: string -> string list) = fun s -> ... *) -let (lines_with_nl: string -> string list) = fun s -> +let (lines_with_nl: string -> string list) = fun s -> let rec lines_aux = function | [] -> [] | [x] -> if x =$= "" then [] else [x ^ "\n"] (* old: [x] *) - | x::xs -> + | x::xs -> let e = x ^ "\n" in - e::lines_aux xs + e::lines_aux xs in (time_func (fun () -> Str.split_delim (Str.regexp "\n") s)) +> lines_aux @@ -3058,29 +3068,29 @@ let (lines_with_nl: string -> string list) = fun s -> (* +> List.map (fun s -> s ^ "\n") but add an \n even at the end => lines_aux *) (* old: slow let chars = list_of_string s in - chars +> List.fold_left (fun (acc, lines) char -> + chars +> List.fold_left (fun (acc, lines) char -> let newacc = acc ^ (String.make 1 char) in - if char = '\n' + if char = '\n' then ("", newacc::lines) else (newacc, lines) - ) ("", []) + ) ("", []) +> (fun (s, lines) -> List.rev (s::lines)) *) (* CHECK: unlines (lines x) = x *) -let (unlines: string list -> string) = fun s -> +let (unlines: string list -> string) = fun s -> (String.concat "\n" s) ^ "\n" -let (words: string -> string list) = fun s -> +let (words: string -> string list) = fun s -> Str.split (Str.regexp "[ \t()\";]+") s -let (unwords: string list -> string) = fun s -> +let (unwords: string list -> string) = fun s -> String.concat "" s -let (split_space: string -> string list) = fun s -> +let (split_space: string -> string list) = fun s -> Str.split (Str.regexp "[ \t\n]+") s (* todo opti ? *) -let nblines s = +let nblines s = lines s +> List.length let _ = example (nblines "" =|= 0) let _ = example (nblines "toto" =|= 1) @@ -3091,10 +3101,10 @@ let _ = example (nblines "toto\ntata\n" =|= 2) (*****************************************************************************) (* Process/Files *) (*****************************************************************************) -let cat_orig file = +let cat_orig file = let chan = open_in file in - let rec cat_orig_aux () = - try + let rec cat_orig_aux () = + try (* cant do input_line chan::aux() cos ocaml eval from right to left ! *) let l = input_line chan in l :: cat_orig_aux () @@ -3102,34 +3112,34 @@ let cat_orig file = cat_orig_aux() (* tail recursive efficient version *) -let cat file = +let cat file = let chan = open_in file in - let rec cat_aux acc () = + let rec cat_aux acc () = (* cant do input_line chan::aux() cos ocaml eval from right to left ! *) let (b, l) = try (true, input_line chan) with End_of_file -> (false, "") in - if b + if b then cat_aux (l::acc) () - else acc + else acc in cat_aux [] () +> List.rev +> (fun x -> close_in chan; x) -let cat_array file = - (""::cat file) +> Array.of_list +let cat_array file = + (""::cat file) +> Array.of_list -let interpolate str = +let interpolate str = begin command2 ("printf \"%s\\n\" " ^ str ^ ">/tmp/caml"); cat "/tmp/caml" end (* could do a print_string but printf dont like print_string *) -let echo s = printf "%s" s; flush stdout; s +let echo s = printf "%s" s; flush stdout; s let usleep s = for i = 1 to s do () done let sleep_little () = - (*old: *) + (*old: *) Unix.sleep 1 (*ignore(Sys.command ("usleep " ^ !_sleep_time))*) @@ -3138,26 +3148,26 @@ let sleep_little () = * let command2 s = ignore(Sys.command s) *) -let do_in_fork f = +let do_in_fork f = let pid = Unix.fork () in if pid =|= 0 - then - begin + then + begin (* Unix.setsid(); *) - Sys.set_signal Sys.sigint (Sys.Signal_handle (fun _ -> + Sys.set_signal Sys.sigint (Sys.Signal_handle (fun _ -> pr2 "being killed"; Unix.kill 0 Sys.sigkill; )); - f(); + f(); exit 0; end else pid -let process_output_to_list2 = fun command -> +let process_output_to_list2 = fun command -> let chan = Unix.open_process_in command in let res = ref ([] : string list) in - let rec process_otl_aux () = + let rec process_otl_aux () = let e = input_line chan in res := e::!res; process_otl_aux() in @@ -3171,11 +3181,11 @@ let cmd_to_list_and_status = process_output_to_list2 (* now in prelude: * let command2 s = ignore(Sys.command s) - *) + *) -let _batch_mode = ref false -let command2_y_or_no cmd = +let _batch_mode = ref false +let command2_y_or_no cmd = if !_batch_mode then begin command2 cmd; true end else begin @@ -3186,16 +3196,16 @@ let command2_y_or_no cmd = | _ -> failwith "answer by yes or no" end -let command2_y_or_no_exit_if_no cmd = +let command2_y_or_no_exit_if_no cmd = let res = command2_y_or_no cmd in if res then () else raise (UnixExit (1)) - -let mkdir ?(mode=0o770) file = + +let mkdir ?(mode=0o770) file = Unix.mkdir file mode let read_file_orig file = cat file +> unlines @@ -3208,69 +3218,69 @@ let read_file file = buf -let write_file ~file s = +let write_file ~file s = let chan = open_out file in (output_string chan s; close_out chan) -let filesize file = +let filesize file = (Unix.stat file).Unix.st_size -let filemtime file = +let filemtime file = (Unix.stat file).Unix.st_mtime (* opti? use wc -l ? *) -let nblines_file file = +let nblines_file file = cat file +> List.length -let lfile_exists filename = - try +let lfile_exists filename = + try (match (Unix.lstat filename).Unix.st_kind with | (Unix.S_REG | Unix.S_LNK) -> true | _ -> false ) with Unix.Unix_error (Unix.ENOENT, _, _) -> false -let is_directory file = +let is_directory file = (Unix.stat file).Unix.st_kind =*= Unix.S_DIR - - + + (* src: from chailloux et al book *) -let capsule_unix f args = - try (f args) - with Unix.Unix_error (e, fm, argm) -> +let capsule_unix f args = + try (f args) + with Unix.Unix_error (e, fm, argm) -> log (Printf.sprintf "exn Unix_error: %s %s %s\n" (Unix.error_message e) fm argm) -let (readdir_to_kind_list: string -> Unix.file_kind -> string list) = - fun path kind -> - Sys.readdir path - +> Array.to_list - +> List.filter (fun s -> - try +let (readdir_to_kind_list: string -> Unix.file_kind -> string list) = + fun path kind -> + Sys.readdir path + +> Array.to_list + +> List.filter (fun s -> + try let stat = Unix.lstat (path ^ "/" ^ s) in stat.Unix.st_kind =*= kind - with e -> + with e -> pr2 ("EXN pb stating file: " ^ s); false ) -let (readdir_to_dir_list: string -> string list) = fun path -> +let (readdir_to_dir_list: string -> string list) = fun path -> readdir_to_kind_list path Unix.S_DIR -let (readdir_to_file_list: string -> string list) = fun path -> +let (readdir_to_file_list: string -> string list) = fun path -> readdir_to_kind_list path Unix.S_REG -let (readdir_to_link_list: string -> string list) = fun path -> +let (readdir_to_link_list: string -> string list) = fun path -> readdir_to_kind_list path Unix.S_LNK -let (readdir_to_dir_size_list: string -> (string * int) list) = fun path -> - Sys.readdir path - +> Array.to_list - +> map_filter (fun s -> +let (readdir_to_dir_size_list: string -> (string * int) list) = fun path -> + Sys.readdir path + +> Array.to_list + +> map_filter (fun s -> let stat = Unix.lstat (path ^ "/" ^ s) in - if stat.Unix.st_kind =*= Unix.S_DIR - then Some (s, stat.Unix.st_size) + if stat.Unix.st_kind =*= Unix.S_DIR + then Some (s, stat.Unix.st_size) else None ) @@ -3280,14 +3290,14 @@ let (readdir_to_dir_size_list: string -> (string * int) list) = fun path -> * want put the cache_computation funcall in comment, so just easier to * pass this extra option. *) -let cache_computation2 ?(verbose=false) ?(use_cache=true) file ext_cache f = - if not use_cache +let cache_computation2 ?(verbose=false) ?(use_cache=true) file ext_cache f = + if not use_cache then f () else begin - if not (Sys.file_exists file) + if not (Sys.file_exists file) then failwith ("can't find: " ^ file); let file_cache = (file ^ ext_cache) in - if Sys.file_exists file_cache && + if Sys.file_exists file_cache && filemtime file_cache >= filemtime file then begin if verbose then pr2 ("using cache: " ^ file_cache); @@ -3299,31 +3309,31 @@ let cache_computation2 ?(verbose=false) ?(use_cache=true) file ext_cache f = res end end -let cache_computation ?verbose ?use_cache a b c = - profile_code "Common.cache_computation" (fun () -> +let cache_computation ?verbose ?use_cache a b c = + profile_code "Common.cache_computation" (fun () -> cache_computation2 ?verbose ?use_cache a b c) - -let cache_computation_robust2 - file ext_cache + +let cache_computation_robust2 + file ext_cache (need_no_changed_files, need_no_changed_variables) ext_depend - f = - if not (Sys.file_exists file) + f = + if not (Sys.file_exists file) then failwith ("can't find: " ^ file); let file_cache = (file ^ ext_cache) in let dependencies_cache = (file ^ ext_depend) in - let dependencies = + let dependencies = (* could do md5sum too *) - ((file::need_no_changed_files) +> List.map (fun f -> f, filemtime f), - need_no_changed_variables) + ((file::need_no_changed_files) +> List.map (fun f -> f, filemtime f), + need_no_changed_variables) in - if Sys.file_exists dependencies_cache && + if Sys.file_exists dependencies_cache && get_value dependencies_cache =*= dependencies then get_value file_cache - else begin + else begin pr2 ("cache computation recompute " ^ file); let res = f () in write_value dependencies dependencies_cache; @@ -3332,7 +3342,7 @@ let cache_computation_robust2 end let cache_computation_robust a b c d e = - profile_code "Common.cache_computation_robust" (fun () -> + profile_code "Common.cache_computation_robust" (fun () -> cache_computation_robust2 a b c d e) @@ -3347,19 +3357,19 @@ let glob pattern = (* update: have added the -type f, so normally need less the sanity_check_xxx * function below *) -let files_of_dir_or_files ext xs = - xs +> List.map (fun x -> +let files_of_dir_or_files ext xs = + xs +> List.map (fun x -> if is_directory x then cmd_to_list ("find " ^ x ^" -noleaf -type f -name \"*." ^ext^"\"") else [x] ) +> List.concat -let files_of_dir_or_files_no_vcs ext xs = - xs +> List.map (fun x -> +let files_of_dir_or_files_no_vcs ext xs = + xs +> List.map (fun x -> if is_directory x - then - cmd_to_list + then + cmd_to_list ("find " ^ x ^" -noleaf -type f -name \"*." ^ext^"\"" ^ "| grep -v /.hg/ |grep -v /CVS/ | grep -v /.git/ |grep -v /_darcs/" ) @@ -3367,11 +3377,11 @@ let files_of_dir_or_files_no_vcs ext xs = ) +> List.concat -let files_of_dir_or_files_no_vcs_post_filter regex xs = - xs +> List.map (fun x -> +let files_of_dir_or_files_no_vcs_post_filter regex xs = + xs +> List.map (fun x -> if is_directory x - then - cmd_to_list + then + cmd_to_list ("find " ^ x ^ " -noleaf -type f | grep -v /.hg/ |grep -v /CVS/ | grep -v /.git/ |grep -v /_darcs/" ) @@ -3381,32 +3391,32 @@ let files_of_dir_or_files_no_vcs_post_filter regex xs = let sanity_check_files_and_adjust ext files = - let files = files +> List.filter (fun file -> + let files = files +> List.filter (fun file -> if not (file =~ (".*\\."^ext)) - then begin + then begin pr2 ("warning: seems not a ."^ext^" file"); false end - else + else if is_directory file then begin pr2 (spf "warning: %s is a directory" file); false - end + end else true ) in files - - + + (* taken from mlfuse, the predecessor of ocamlfuse *) type rwx = [`R|`W|`X] list -let file_perm_of : u:rwx -> g:rwx -> o:rwx -> Unix.file_perm = +let file_perm_of : u:rwx -> g:rwx -> o:rwx -> Unix.file_perm = fun ~u ~g ~o -> - let to_oct l = + let to_oct l = List.fold_left (fun acc p -> acc lor ((function `R -> 4 | `W -> 2 | `X -> 1) p)) 0 l in - let perm = + let perm = ((to_oct u) lsl 6) lor ((to_oct g) lsl 3) lor (to_oct o) @@ -3415,17 +3425,17 @@ let file_perm_of : u:rwx -> g:rwx -> o:rwx -> Unix.file_perm = (* pixel *) -let has_env var = - try +let has_env var = + try let _ = Sys.getenv var in true with Not_found -> false (* emacs/lisp inspiration (eric cooper and yaron minsky use that too) *) -let (with_open_outfile: filename -> (((string -> unit) * out_channel) -> 'a) -> 'a) = +let (with_open_outfile: filename -> (((string -> unit) * out_channel) -> 'a) -> 'a) = fun file f -> let chan = open_out file in let pr s = output_string chan s in - unwind_protect (fun () -> + unwind_protect (fun () -> let res = f (pr, chan) in close_out chan; res) @@ -3433,18 +3443,18 @@ let (with_open_outfile: filename -> (((string -> unit) * out_channel) -> 'a) -> let (with_open_infile: filename -> ((in_channel) -> 'a) -> 'a) = fun file f -> let chan = open_in file in - unwind_protect (fun () -> + unwind_protect (fun () -> let res = f chan in close_in chan; res) (fun e -> close_in chan) -let (with_open_outfile_append: filename -> (((string -> unit) * out_channel) -> 'a) -> 'a) = +let (with_open_outfile_append: filename -> (((string -> unit) * out_channel) -> 'a) -> 'a) = fun file f -> let chan = open_out_gen [Open_creat;Open_append] 0o666 file in let pr s = output_string chan s in - unwind_protect (fun () -> + unwind_protect (fun () -> let res = f (pr, chan) in close_out chan; res) @@ -3456,24 +3466,24 @@ let (with_open_outfile_append: filename -> (((string -> unit) * out_channel) -> *) (* it seems that the toplevel block such signals, even with this explicit - * command :( + * command :( * let _ = Unix.sigprocmask Unix.SIG_UNBLOCK [Sys.sigalrm] *) (* could be in Control section *) -(* subtil: have to make sure that timeout is not intercepted before here, so +(* subtil: have to make sure that timeout is not intercepted before here, so * avoid exn handle such as try (...) with _ -> cos timeout will not bubble up - * enough. In such case, add a case before such as - * with Timeout -> raise Timeout | _ -> ... - * - * question: can we have a signal and so exn when in a exn handler ? + * enough. In such case, add a case before such as + * with Timeout -> raise Timeout | _ -> ... + * + * question: can we have a signal and so exn when in a exn handler ? *) let interval_timer = ref true -let timeout_function timeoutval = fun f -> - try +let timeout_function timeoutval = fun f -> + try if !interval_timer then begin @@ -3496,22 +3506,22 @@ let timeout_function timeoutval = fun f -> ignore(Unix.alarm 0); x end - with Timeout -> - begin + with Timeout -> + begin log "timeout (we abort)"; raise Timeout; end - | e -> + | e -> (* subtil: important to disable the alarm before relaunching the exn, * otherwise the alarm is still running. - * - * robust?: and if alarm launched after the log (...) ? + * + * robust?: and if alarm launched after the log (...) ? * Maybe signals are disabled when process an exception handler ? *) - begin + begin ignore(Unix.alarm 0); (* log ("exn while in transaction (we abort too, even if ...) = " ^ - Printexc.to_string e); + Printexc.to_string e); *) log "exn while in timeout_function"; raise e @@ -3521,7 +3531,7 @@ let timeout_function_opt timeoutvalopt f = match timeoutvalopt with | None -> f() | Some x -> timeout_function x f - + (* creation of tmp files, a la gcc *) @@ -3529,7 +3539,7 @@ let timeout_function_opt timeoutvalopt f = let _temp_files_created = ref ([] : filename list) (* ex: new_temp_file "cocci" ".c" will give "/tmp/cocci-3252-434465.c" *) -let new_temp_file prefix suffix = +let new_temp_file prefix suffix = let processid = i_to_s (Unix.getpid ()) in let tmp_file = Filename.temp_file (prefix ^ "-" ^ processid ^ "-") suffix in push2 tmp_file _temp_files_created; @@ -3537,9 +3547,9 @@ let new_temp_file prefix suffix = let save_tmp_files = ref false -let erase_temp_files () = +let erase_temp_files () = if not !save_tmp_files then begin - !_temp_files_created +> List.iter (fun s -> + !_temp_files_created +> List.iter (fun s -> (* pr2 ("erasing: " ^ s); *) command2 ("rm -f " ^ s) ); @@ -3555,15 +3565,15 @@ let erase_this_temp_file f = (* now in prelude: exception UnixExit of int *) -let exn_to_real_unixexit f = - try f() +let exn_to_real_unixexit f = + try f() with UnixExit x -> exit x -let uncat xs file = - with_open_outfile file (fun (pr,_chan) -> +let uncat xs file = + with_open_outfile file (fun (pr,_chan) -> xs +> List.iter (fun s -> pr s; pr "\n"); ) @@ -3586,29 +3596,29 @@ let safe_tl l = try List.tl l with _ -> [] let push l v = l := v :: !l -let rec zip xs ys = +let rec zip xs ys = match (xs,ys) with | ([],[]) -> [] | ([],_) -> failwith "zip: not same length" | (_,[]) -> failwith "zip: not same length" | (x::xs,y::ys) -> (x,y)::zip xs ys -let rec zip_safe xs ys = +let rec zip_safe xs ys = match (xs,ys) with | ([],_) -> [] | (_,[]) -> [] | (x::xs,y::ys) -> (x,y)::zip_safe xs ys -let rec unzip zs = - List.fold_right (fun e (xs, ys) -> +let rec unzip zs = + List.fold_right (fun e (xs, ys) -> (fst e::xs), (snd e::ys)) zs ([],[]) -let map_withkeep f xs = +let map_withkeep f xs = xs +> List.map (fun x -> f x, x) (* now in prelude - * let rec take n xs = + * let rec take n xs = * match (n,xs) with * | (0,_) -> [] * | (_,[]) -> failwith "take: not enough" @@ -3636,7 +3646,7 @@ let rec drop_while p = function | x::xs -> if p x then drop_while p xs else x::xs -let rec drop_until p xs = +let rec drop_until p xs = drop_while (fun x -> not (p x)) xs let _ = example (drop_until (fun x -> x =|= 3) [1;2;3;4;5] =*= [3;4;5]) @@ -3644,11 +3654,11 @@ let _ = example (drop_until (fun x -> x =|= 3) [1;2;3;4;5] =*= [3;4;5]) let span p xs = (take_while p xs, drop_while p xs) -let rec (span: ('a -> bool) -> 'a list -> 'a list * 'a list) = +let rec (span: ('a -> bool) -> 'a list -> 'a list * 'a list) = fun p -> function | [] -> ([], []) - | x::xs -> - if p x then + | x::xs -> + if p x then let (l1, l2) = span p xs in (x::l1, l2) else ([], x::xs) @@ -3657,16 +3667,16 @@ let _ = example ((span (fun x -> x <= 3) [1;2;3;4;1;2] =*= ([1;2;3],[4;1;2]))) let rec groupBy eq l = match l with | [] -> [] - | x::xs -> + | x::xs -> let (xs1,xs2) = List.partition (fun x' -> eq x x') xs in (x::xs1)::(groupBy eq xs2) let rec group_by_mapped_key fkey l = match l with | [] -> [] - | x::xs -> - let k = fkey x in - let (xs1,xs2) = List.partition (fun x' -> let k2 = fkey x' in k=*=k2) xs + | x::xs -> + let k = fkey x in + let (xs1,xs2) = List.partition (fun x' -> let k2 = fkey x' in k=*=k2) xs in (k, (x::xs1))::(group_by_mapped_key fkey xs2) @@ -3674,11 +3684,11 @@ let rec group_by_mapped_key fkey l = let (exclude_but_keep_attached: ('a -> bool) -> 'a list -> ('a * 'a list) list)= - fun f xs -> + fun f xs -> let rec aux_filter acc = function | [] -> [] (* drop what was accumulated because nothing to attach to *) - | x::xs -> - if f x + | x::xs -> + if f x then aux_filter (x::acc) xs else (x, List.rev acc)::aux_filter [] xs in @@ -3688,67 +3698,67 @@ let _ = example [(1,[3;3]);(2,[3])]) let (group_by_post: ('a -> bool) -> 'a list -> ('a list * 'a) list * 'a list)= - fun f xs -> + fun f xs -> let rec aux_filter grouped_acc acc = function - | [] -> + | [] -> List.rev grouped_acc, List.rev acc - | x::xs -> - if f x - then + | x::xs -> + if f x + then aux_filter ((List.rev acc,x)::grouped_acc) [] xs - else + else aux_filter grouped_acc (x::acc) xs in aux_filter [] [] xs let _ = example - (group_by_post (fun x -> x =|= 3) [1;1;3;2;3;4;5;3;6;6;6] =*= + (group_by_post (fun x -> x =|= 3) [1;1;3;2;3;4;5;3;6;6;6] =*= ([([1;1],3);([2],3);[4;5],3], [6;6;6])) let (group_by_pre: ('a -> bool) -> 'a list -> 'a list * ('a * 'a list) list)= - fun f xs -> + fun f xs -> let xs' = List.rev xs in let (ys, unclassified) = group_by_post f xs' in List.rev unclassified, ys +> List.rev +> List.map (fun (xs, x) -> x, List.rev xs ) let _ = example - (group_by_pre (fun x -> x =|= 3) [1;1;3;2;3;4;5;3;6;6;6] =*= + (group_by_pre (fun x -> x =|= 3) [1;1;3;2;3;4;5;3;6;6;6] =*= ([1;1], [(3,[2]); (3,[4;5]); (3,[6;6;6])])) - -let rec (split_when: ('a -> bool) -> 'a list -> 'a list * 'a * 'a list) = + +let rec (split_when: ('a -> bool) -> 'a list -> 'a list * 'a * 'a list) = fun p -> function | [] -> raise Not_found - | x::xs -> - if p x then - [], x, xs - else + | x::xs -> + if p x then + [], x, xs + else let (l1, a, l2) = split_when p xs in (x::l1, a, l2) -let _ = example (split_when (fun x -> x =|= 3) +let _ = example (split_when (fun x -> x =|= 3) [1;2;3;4;1;2] =*= ([1;2],3,[4;1;2])) (* not so easy to come up with ... used in aComment for split_paragraph *) -let rec split_gen_when_aux f acc xs = +let rec split_gen_when_aux f acc xs = match xs with - | [] -> + | [] -> if null acc then [] else [List.rev acc] - | (x::xs) -> + | (x::xs) -> (match f (x::xs) with - | None -> - split_gen_when_aux f (x::acc) xs - | Some (rest) -> + | None -> + split_gen_when_aux f (x::acc) xs + | Some (rest) -> let before = List.rev acc in if null before then split_gen_when_aux f [] rest else before::split_gen_when_aux f [] rest ) (* could avoid introduce extra aux function by using ?(acc = []) *) -let split_gen_when f xs = +let split_gen_when f xs = split_gen_when_aux f [] xs @@ -3756,8 +3766,8 @@ let split_gen_when f xs = (* generate exception (Failure "tl") if there is no element satisfying p *) let rec (skip_until: ('a list -> bool) -> 'a list -> 'a list) = fun p xs -> if p xs then xs else skip_until p (List.tl xs) -let _ = example - (skip_until (function 1::2::xs -> true | _ -> false) +let _ = example + (skip_until (function 1::2::xs -> true | _ -> false) [1;3;4;1;2;4;5] =*= [1;2;4;5]) let rec skipfirst e = function @@ -3771,32 +3781,32 @@ let rec skipfirst e = function *) -let index_list xs = +let index_list xs = if null xs then [] (* enum 0 (-1) generate an exception *) else zip xs (enum 0 ((List.length xs) -1)) -let index_list_and_total xs = +let index_list_and_total xs = let total = List.length xs in if null xs then [] (* enum 0 (-1) generate an exception *) - else zip xs (enum 0 ((List.length xs) -1)) + else zip xs (enum 0 ((List.length xs) -1)) +> List.map (fun (a,b) -> (a,b,total)) -let index_list_1 xs = +let index_list_1 xs = xs +> index_list +> List.map (fun (x,i) -> x, i+1) let or_list = List.fold_left (||) false let and_list = List.fold_left (&&) true -let avg_list xs = +let avg_list xs = let sum = sum_int xs in (float_of_int sum) /. (float_of_int (List.length xs)) let snoc x xs = xs @ [x] let cons x xs = x::xs -let head_middle_tail xs = +let head_middle_tail xs = match xs with - | x::y::xs -> + | x::y::xs -> let head = x in let reversed = List.rev (y::xs) in let tail = List.hd reversed in @@ -3807,29 +3817,29 @@ let head_middle_tail xs = let _ = assert_equal (head_middle_tail [1;2;3]) (1, [2], 3) let _ = assert_equal (head_middle_tail [1;3]) (1, [], 3) -(* now in prelude - * let (++) = (@) +(* now in prelude + * let (++) = (@) *) (* let (++) = (@), could do that, but if load many times the common, then pb *) (* let (++) l1 l2 = List.fold_right (fun x acc -> x::acc) l1 l2 *) -let remove x xs = +let remove x xs = let newxs = List.filter (fun y -> y <> x) xs in assert (List.length newxs =|= List.length xs - 1); newxs -let exclude p xs = +let exclude p xs = List.filter (fun x -> not (p x)) xs -(* now in prelude +(* now in prelude *) -let fold_k f lastk acc xs = +let fold_k f lastk acc xs = let rec fold_k_aux acc = function | [] -> lastk acc - | x::xs -> + | x::xs -> f acc x (fun acc -> fold_k_aux acc xs) in fold_k_aux acc xs @@ -3884,16 +3894,16 @@ let filter_index f l = (* pixel *) let do_withenv doit f env l = let r_env = ref env in - let l' = doit (fun e -> + let l' = doit (fun e -> let e', env' = f !r_env e in r_env := env' ; e' ) l in l', !r_env -(* now in prelude: +(* now in prelude: * let fold_left_with_index f acc = ... *) - + let map_withenv f env e = do_withenv List.map f env e let rec collect_accu f accu = function @@ -3907,7 +3917,7 @@ let collect f l = List.rev (collect_accu f [] l) let rec fpartition p l = let rec part yes no = function | [] -> (List.rev yes, List.rev no) - | x :: l -> + | x :: l -> (match p x with | None -> part yes (x :: no) l | Some v -> part (v :: yes) no l) in @@ -3951,8 +3961,8 @@ let minimum l = foldl1 min l (* do a map tail recursive, and result is reversed, it is a tail recursive map => efficient *) let map_eff_rev = fun f l -> - let rec map_eff_aux acc = - function + let rec map_eff_aux acc = + function | [] -> acc | x::xs -> map_eff_aux ((f x)::acc) xs in @@ -3973,15 +3983,15 @@ let rec uniq = function | [] -> [] | e::l -> if List.mem e l then uniq l else e :: uniq l -let has_no_duplicate xs = +let has_no_duplicate xs = List.length xs =|= List.length (uniq xs) let is_set_as_list = has_no_duplicate -let rec get_duplicates xs = +let rec get_duplicates xs = match xs with | [] -> [] - | x::xs -> + | x::xs -> if List.mem x xs then x::get_duplicates xs (* todo? could x from xs to avoid double dups?*) else get_duplicates xs @@ -4003,22 +4013,22 @@ let rec (return_when: ('a -> 'b option) -> 'a list -> 'b) = fun p -> function | [] -> raise Not_found | x::xs -> (match p x with None -> return_when p xs | Some b -> b) -let rec splitAt n xs = +let rec splitAt n xs = if n =|= 0 then ([],xs) - else + else (match xs with | [] -> ([],[]) | (x::xs) -> let (a,b) = splitAt (n-1) xs in (x::a, b) ) -let pack n xs = +let pack n xs = let rec pack_aux l i = function | [] -> failwith "not on a boundary" | [x] -> if i =|= n then [l++[x]] else failwith "not on a boundary" - | x::xs -> - if i =|= n - then (l++[x])::(pack_aux [] 1 xs) - else pack_aux (l++[x]) (i+1) xs + | x::xs -> + if i =|= n + then (l++[x])::(pack_aux [] 1 xs) + else pack_aux (l++[x]) (i+1) xs in pack_aux [] 1 xs @@ -4027,9 +4037,9 @@ let min_with f = function | e :: l -> let rec min_with_ min_val min_elt = function | [] -> min_elt - | e::l -> + | e::l -> let val_ = f e in - if val_ < min_val + if val_ < min_val then min_with_ val_ e l else min_with_ min_val min_elt l in min_with_ (f e) e l @@ -4038,18 +4048,18 @@ let two_mins_with f = function | e1 :: e2 :: l -> let rec min_with_ min_val min_elt min_val2 min_elt2 = function | [] -> min_elt, min_elt2 - | e::l -> + | e::l -> let val_ = f e in - if val_ < min_val2 + if val_ < min_val2 then if val_ < min_val then min_with_ val_ e min_val min_elt l else min_with_ min_val min_elt val_ e l else min_with_ min_val min_elt min_val2 min_elt2 l - in + in let v1 = f e1 in let v2 = f e2 in - if v1 < v2 then min_with_ v1 e1 v2 e2 l else min_with_ v2 e2 v1 e1 l + if v1 < v2 then min_with_ v1 e1 v2 e2 l else min_with_ v2 e2 v1 e1 l | _ -> raise Not_found let grep_with_previous f = function @@ -4069,8 +4079,8 @@ let iter_with_previous f = function in iter_with_previous_ e l -let iter_with_before_after f xs = - let rec aux before_rev after = +let iter_with_before_after f xs = + let rec aux before_rev after = match after with | [] -> () | x::xs -> @@ -4110,7 +4120,7 @@ let rec (permutation: 'a list -> 'a list list) = function | [] -> [] | [x] -> [[x]] | x::xs -> List.flatten (List.map (insert_in x) (permutation xs)) -(* permutation [1;2;3] = +(* permutation [1;2;3] = * [[1; 2; 3]; [2; 1; 3]; [2; 3; 1]; [1; 3; 2]; [3; 1; 2]; [3; 2; 1]] *) @@ -4122,54 +4132,54 @@ let rec remove_elem_pos pos xs = | n, x::xs -> x::(remove_elem_pos (n-1) xs) let rec insert_elem_pos (e, pos) xs = - match (pos, xs) with - | 0, xs -> e::xs + match (pos, xs) with + | 0, xs -> e::xs | n, x::xs -> x::(insert_elem_pos (e, (n-1)) xs) | n, [] -> failwith "insert_elem_pos" -let rec uncons_permut xs = +let rec uncons_permut xs = let indexed = index_list xs in indexed +> List.map (fun (x, pos) -> (x, pos), remove_elem_pos pos xs) -let _ = - example - (uncons_permut ['a';'b';'c'] =*= +let _ = + example + (uncons_permut ['a';'b';'c'] =*= [('a', 0), ['b';'c']; ('b', 1), ['a';'c']; ('c', 2), ['a';'b'] ]) -let rec uncons_permut_lazy xs = +let rec uncons_permut_lazy xs = let indexed = index_list xs in - indexed +> List.map (fun (x, pos) -> - (x, pos), + indexed +> List.map (fun (x, pos) -> + (x, pos), lazy (remove_elem_pos pos xs) ) - - - + + + (* pixel *) let rec map_flatten f l = - let rec map_flatten_aux accu = function + let rec map_flatten_aux accu = function | [] -> accu | e :: l -> map_flatten_aux (List.rev (f e) ++ accu) l in List.rev (map_flatten_aux [] l) -let rec repeat e n = +let rec repeat e n = let rec repeat_aux acc = function | 0 -> acc | n when n < 0 -> failwith "repeat" | n -> repeat_aux (e::acc) (n-1) in repeat_aux [] n -let rec map2 f = function +let rec map2 f = function | [] -> [] | x::xs -> let r = f x in r::map2 f xs -let rec map3 f l = +let rec map3 f l = let rec map3_aux acc = function - | [] -> acc + | [] -> acc | x::xs -> map3_aux (f x::acc) xs in map3_aux [] l @@ -4177,21 +4187,21 @@ let rec map3 f l = let tails2 xs = map rev (inits (rev xs)) let res = tails2 [1;2;3;4] let res = tails [1;2;3;4] -let id x = x +let id x = x *) -let pack_sorted same xs = - let rec pack_s_aux acc xs = +let pack_sorted same xs = + let rec pack_s_aux acc xs = match (acc,xs) with | ((cur,rest),[]) -> cur::rest - | ((cur,rest), y::ys) -> + | ((cur,rest), y::ys) -> if same (List.hd cur) y then pack_s_aux (y::cur, rest) ys else pack_s_aux ([y], cur::rest) ys in pack_s_aux ([List.hd xs],[]) (List.tl xs) +> List.rev let test = pack_sorted (=*=) [1;1;1;2;2;3;4] -let rec keep_best f = +let rec keep_best f = let rec partition e = function | [] -> e, [] | e' :: l -> @@ -4200,48 +4210,48 @@ let rec keep_best f = | Some e'' -> partition e'' l in function | [] -> [] - | e::l -> + | e::l -> let (e', l') = partition e l in e' :: keep_best f l' let rec sorted_keep_best f = function | [] -> [] | [a] -> [a] - | a :: b :: l -> + | a :: b :: l -> match f a b with | None -> a :: sorted_keep_best f (b :: l) | Some e -> sorted_keep_best f (e :: l) -let (cartesian_product: 'a list -> 'b list -> ('a * 'b) list) = fun xs ys -> +let (cartesian_product: 'a list -> 'b list -> ('a * 'b) list) = fun xs ys -> xs +> List.map (fun x -> ys +> List.map (fun y -> (x,y))) +> List.flatten -let _ = assert_equal - (cartesian_product [1;2] ["3";"4";"5"]) +let _ = assert_equal + (cartesian_product [1;2] ["3";"4";"5"]) [1,"3";1,"4";1,"5"; 2,"3";2,"4";2,"5"] -let sort_prof a b = +let sort_prof a b = profile_code "Common.sort_by_xxx" (fun () -> List.sort a b) -let sort_by_val_highfirst xs = +let sort_by_val_highfirst xs = sort_prof (fun (k1,v1) (k2,v2) -> compare v2 v1) xs -let sort_by_val_lowfirst xs = +let sort_by_val_lowfirst xs = sort_prof (fun (k1,v1) (k2,v2) -> compare v1 v2) xs -let sort_by_key_highfirst xs = +let sort_by_key_highfirst xs = sort_prof (fun (k1,v1) (k2,v2) -> compare k2 k1) xs -let sort_by_key_lowfirst xs = +let sort_by_key_lowfirst xs = sort_prof (fun (k1,v1) (k2,v2) -> compare k1 k2) xs let _ = example (sort_by_key_lowfirst [4, (); 7,()] =*= [4,(); 7,()]) let _ = example (sort_by_key_highfirst [4,(); 7,()] =*= [7,(); 4,()]) -let sortgen_by_key_highfirst xs = +let sortgen_by_key_highfirst xs = sort_prof (fun (k1,v1) (k2,v2) -> compare k2 k1) xs -let sortgen_by_key_lowfirst xs = +let sortgen_by_key_lowfirst xs = sort_prof (fun (k1,v1) (k2,v2) -> compare k1 k2) xs (*----------------------------------*) @@ -4249,7 +4259,7 @@ let sortgen_by_key_lowfirst xs = (* sur surEnsemble [p1;p2] [[p1;p2;p3] [p1;p2] ....] -> [[p1;p2;p3] ... *) (* mais pas p2;p3 *) (* (aop) *) -let surEnsemble liste_el liste_liste_el = +let surEnsemble liste_el liste_liste_el = List.filter (function liste_elbis -> List.for_all (function el -> List.mem el liste_elbis) liste_el @@ -4263,7 +4273,7 @@ let surEnsemble liste_el liste_liste_el = let rec realCombinaison = function | [] -> [] | [a] -> [[a]] - | a::l -> + | a::l -> let res = realCombinaison l in let res2 = List.map (function x -> a::x) res in res2 ++ res ++ [[a]] @@ -4284,25 +4294,25 @@ let rec combinaison = function (* ces listes, on ne fait rien *) let rec insere elem = function | [] -> [[elem]] - | a::l -> + | a::l -> if (List.mem elem a) then a::l else a::(insere elem l) let rec insereListeContenant lis el = function | [] -> [el::lis] - | a::l -> - if List.mem el a then + | a::l -> + if List.mem el a then (List.append lis a)::l else a::(insereListeContenant lis el l) (* fusionne les listes contenant et1 et et2 dans la liste de liste*) let rec fusionneListeContenant (et1, et2) = function | [] -> [[et1; et2]] - | a::l -> + | a::l -> (* si les deux sont deja dedans alors rien faire *) if List.mem et1 a then if List.mem et2 a then a::l - else + else insereListeContenant a et2 l else if List.mem et2 a then insereListeContenant a et1 l @@ -4327,7 +4337,7 @@ let array_find_index_via_elem f a = -type idx = Idx of int +type idx = Idx of int let next_idx (Idx i) = (Idx (i+1)) let int_of_idx (Idx i) = i @@ -4345,65 +4355,65 @@ let array_find_index_typed f a = type 'a matrix = 'a array array -let map_matrix f mat = +let map_matrix f mat = mat +> Array.map (fun arr -> arr +> Array.map f) -let (make_matrix_init: - nrow:int -> ncolumn:int -> (int -> int -> 'a) -> 'a matrix) = +let (make_matrix_init: + nrow:int -> ncolumn:int -> (int -> int -> 'a) -> 'a matrix) = fun ~nrow ~ncolumn f -> - Array.init nrow (fun i -> - Array.init ncolumn (fun j -> + Array.init nrow (fun i -> + Array.init ncolumn (fun j -> f i j ) ) -let iter_matrix f m = - Array.iteri (fun i e -> - Array.iteri (fun j x -> +let iter_matrix f m = + Array.iteri (fun i e -> + Array.iteri (fun j x -> f i j x ) e ) m -let nb_rows_matrix m = +let nb_rows_matrix m = Array.length m let nb_columns_matrix m = assert(Array.length m > 0); Array.length m.(0) - + (* check all nested arrays have the same size *) let invariant_matrix m = raise Todo -let (rows_of_matrix: 'a matrix -> 'a list list) = fun m -> +let (rows_of_matrix: 'a matrix -> 'a list list) = fun m -> Array.to_list m +> List.map Array.to_list - -let (columns_of_matrix: 'a matrix -> 'a list list) = fun m -> + +let (columns_of_matrix: 'a matrix -> 'a list list) = fun m -> let nbcols = nb_columns_matrix m in let nbrows = nb_rows_matrix m in - (enum 0 (nbcols -1)) +> List.map (fun j -> - (enum 0 (nbrows -1)) +> List.map (fun i -> + (enum 0 (nbcols -1)) +> List.map (fun j -> + (enum 0 (nbrows -1)) +> List.map (fun i -> m.(i).(j) )) -let all_elems_matrix_by_row m = - rows_of_matrix m +> List.flatten +let all_elems_matrix_by_row m = + rows_of_matrix m +> List.flatten -let ex_matrix1 = +let ex_matrix1 = [| [|0;1;2|]; [|3;4;5|]; [|6;7;8|]; |] -let ex_rows1 = +let ex_rows1 = [ [0;1;2]; [3;4;5]; [6;7;8]; ] -let ex_columns1 = +let ex_columns1 = [ [0;3;6]; [1;4;7]; @@ -4426,7 +4436,7 @@ open Bigarray *) -(* for the string_of auto generation of camlp4 +(* for the string_of auto generation of camlp4 val b_array_string_of_t : 'a -> 'b -> string val bigarray_string_of_int16_unsigned_elt : 'a -> string val bigarray_string_of_c_layout : 'a -> string @@ -4444,18 +4454,18 @@ type 'a set = 'a list (* with sexp *) let (empty_set: 'a set) = [] -let (insert_set: 'a -> 'a set -> 'a set) = fun x xs -> - if List.mem x xs - then (* let _ = print_string "warning insert: already exist" in *) - xs +let (insert_set: 'a -> 'a set -> 'a set) = fun x xs -> + if List.mem x xs + then (* let _ = print_string "warning insert: already exist" in *) + xs else x::xs -let is_set xs = +let is_set xs = has_no_duplicate xs let (single_set: 'a -> 'a set) = fun x -> insert_set x empty_set -let (set: 'a list -> 'a set) = fun xs -> - xs +> List.fold_left (flip insert_set) empty_set +let (set: 'a list -> 'a set) = fun xs -> + xs +> List.fold_left (flip insert_set) empty_set let (exists_set: ('a -> bool) -> 'a set -> bool) = List.exists let (forall_set: ('a -> bool) -> 'a set -> bool) = List.for_all @@ -4470,11 +4480,11 @@ let iter_set = List.iter let (top_set: 'a set -> 'a) = List.hd -let (inter_set: 'a set -> 'a set -> 'a set) = fun s1 s2 -> +let (inter_set: 'a set -> 'a set -> 'a set) = fun s1 s2 -> s1 +> fold_set (fun acc x -> if member_set x s2 then insert_set x acc else acc) empty_set -let (union_set: 'a set -> 'a set -> 'a set) = fun s1 s2 -> +let (union_set: 'a set -> 'a set -> 'a set) = fun s1 s2 -> s2 +> fold_set (fun acc x -> if member_set x s1 then acc else insert_set x acc) s1 -let (minus_set: 'a set -> 'a set -> 'a set) = fun s1 s2 -> +let (minus_set: 'a set -> 'a set -> 'a set) = fun s1 s2 -> s1 +> filter_set (fun x -> not (member_set x s2)) @@ -4484,12 +4494,12 @@ let big_union_set f xs = xs +> map_set f +> fold_set union_set empty_set let (card_set: 'a set -> int) = List.length -let (include_set: 'a set -> 'a set -> bool) = fun s1 s2 -> +let (include_set: 'a set -> 'a set -> bool) = fun s1 s2 -> (s1 +> forall_set (fun p -> member_set p s2)) let equal_set s1 s2 = include_set s1 s2 && include_set s2 s1 -let (include_set_strict: 'a set -> 'a set -> bool) = fun s1 s2 -> +let (include_set_strict: 'a set -> 'a set -> bool) = fun s1 s2 -> (card_set s1 < card_set s2) && (include_set s1 s2) let ($*$) = inter_set @@ -4501,7 +4511,7 @@ let ($<=$) = include_set let ($=$) = equal_set (* as $+$ but do not check for memberness, allow to have set of func *) -let ($@$) = fun a b -> a @ b +let ($@$) = fun a b -> a @ b let rec nub = function [] -> [] @@ -4511,7 +4521,7 @@ let rec nub = function (* Set as normal list *) (*****************************************************************************) (* -let (union: 'a list -> 'a list -> 'a list) = fun l1 l2 -> +let (union: 'a list -> 'a list -> 'a list) = fun l1 l2 -> List.fold_left (fun acc x -> if List.mem x l1 then acc else x::acc) l1 l2 let insert_normal x xs = union xs [x] @@ -4523,7 +4533,7 @@ let inter l1 l2 = List.fold_left (fun acc x -> if List.mem x l2 then x::acc else let union_list = List.fold_left union [] -let uniq lis = +let uniq lis = List.fold_left (function acc -> function el -> union [el] acc) [] lis (* pixel *) @@ -4534,7 +4544,7 @@ let rec non_uniq = function let rec inclu lis1 lis2 = List.for_all (function el -> List.mem el lis2) lis1 -let equivalent lis1 lis2 = +let equivalent lis1 lis2 = (inclu lis1 lis2) && (inclu lis2 lis1) *) @@ -4550,7 +4560,7 @@ let equivalent lis1 lis2 = (* let rec insert x = function | [] -> [x] - | y::ys -> + | y::ys -> if x = y then y::ys else (if x < y then x::y::ys else y::(insert x ys)) @@ -4559,9 +4569,9 @@ let rec intersect x y = match(x,y) with | [], y -> [] | x, [] -> [] - | x::xs, y::ys -> + | x::xs, y::ys -> if x = y then x::(intersect xs ys) - else + else (if x < y then intersect xs (y::ys) else intersect (x::xs) ys ) @@ -4576,11 +4586,11 @@ type ('a,'b) assoc = ('a * 'b) list let (assoc_to_function: ('a, 'b) assoc -> ('a -> 'b)) = fun xs -> - xs +> List.fold_left (fun acc (k, v) -> - (fun k' -> + xs +> List.fold_left (fun acc (k, v) -> + (fun k' -> if k =*= k' then v else acc k' )) (fun k -> failwith "no key in this assoc") -(* simpler: +(* simpler: let (assoc_to_function: ('a, 'b) assoc -> ('a -> 'b)) = fun xs -> fun k -> List.assoc k xs *) @@ -4600,7 +4610,7 @@ let lookup = assoc let del_assoc key xs = xs +> List.filter (fun (k,v) -> k <> key) let replace_assoc (key, v) xs = insert_assoc (key, v) (del_assoc key xs) -let apply_assoc key f xs = +let apply_assoc key f xs = let old = assoc key xs in replace_assoc (key, f old) xs @@ -4609,10 +4619,10 @@ let big_union_assoc f xs = xs +> map_assoc f +> fold_assoc union_set empty_set (* todo: pb normally can suppr fun l -> .... l but if do that, then strange type _a => assoc_map is strange too => equal dont work *) -let (assoc_reverse: (('a * 'b) list) -> (('b * 'a) list)) = fun l -> +let (assoc_reverse: (('a * 'b) list) -> (('b * 'a) list)) = fun l -> List.map (fun(x,y) -> (y,x)) l -let (assoc_map: (('a * 'b) list) -> (('a * 'b) list) -> (('a * 'a) list)) = +let (assoc_map: (('a * 'b) list) -> (('a * 'b) list) -> (('a * 'a) list)) = fun l1 l2 -> let (l1bis, l2bis) = (assoc_reverse l1, assoc_reverse l2) in List.map (fun (x,y) -> (y, List.assoc x l2bis )) l1bis @@ -4621,24 +4631,24 @@ let rec (lookup_list: 'a -> ('a , 'b) assoc list -> 'b) = fun el -> function | [] -> raise Not_found | (xs::xxs) -> try List.assoc el xs with Not_found -> lookup_list el xxs -let (lookup_list2: 'a -> ('a , 'b) assoc list -> ('b * int)) = fun el xxs -> +let (lookup_list2: 'a -> ('a , 'b) assoc list -> ('b * int)) = fun el xxs -> let rec lookup_l_aux i = function | [] -> raise Not_found - | (xs::xxs) -> - try let res = List.assoc el xs in (res,i) + | (xs::xxs) -> + try let res = List.assoc el xs in (res,i) with Not_found -> lookup_l_aux (i+1) xxs in lookup_l_aux 0 xxs -let _ = example +let _ = example (lookup_list2 "c" [["a",1;"b",2];["a",1;"b",3];["a",1;"c",7]] =*= (7,2)) -let assoc_option k l = +let assoc_option k l = optionise (fun () -> List.assoc k l) let assoc_with_err_msg k l = - try List.assoc k l - with Not_found -> + try List.assoc k l + with Not_found -> pr2 (spf "pb assoc_with_err_msg: %s" (dump k)); raise Not_found @@ -4650,7 +4660,7 @@ let assoc_with_err_msg k l = module IntMap = Map.Make (struct type t = int - let compare = compare + let compare = compare end) let intmap_to_list m = IntMap.fold (fun id v acc -> (id, v) :: acc) m [] let intmap_string_of_t f a = "" @@ -4658,7 +4668,7 @@ let intmap_string_of_t f a = "" module IntIntMap = Map.Make (struct type t = int * int - let compare = compare + let compare = compare end) let intintmap_to_list m = IntIntMap.fold (fun id v acc -> (id, v) :: acc) m [] @@ -4670,7 +4680,7 @@ let intintmap_string_of_t f a = "" (*****************************************************************************) (* il parait que better when choose a prime *) -let hcreate () = Hashtbl.create 401 +let hcreate () = Hashtbl.create 401 let hadd (k,v) h = Hashtbl.add h k v let hmem k h = Hashtbl.mem h k let hfind k h = Hashtbl.find h k @@ -4680,14 +4690,14 @@ let hfold = Hashtbl.fold let hremove k h = Hashtbl.remove h k -let hash_to_list h = - Hashtbl.fold (fun k v acc -> (k,v)::acc) h [] - +> List.sort compare +let hash_to_list h = + Hashtbl.fold (fun k v acc -> (k,v)::acc) h [] + +> List.sort compare -let hash_to_list_unsorted h = - Hashtbl.fold (fun k v acc -> (k,v)::acc) h [] +let hash_to_list_unsorted h = + Hashtbl.fold (fun k v acc -> (k,v)::acc) h [] -let hash_of_list xs = +let hash_of_list xs = let h = Hashtbl.create 101 in begin xs +> List.iter (fun (k, v) -> Hashtbl.add h k v); @@ -4696,21 +4706,21 @@ let hash_of_list xs = let _ = let h = Hashtbl.create 101 in - Hashtbl.add h "toto" 1; + Hashtbl.add h "toto" 1; Hashtbl.add h "toto" 1; assert(hash_to_list h =*= ["toto",1; "toto",1]) - -let hfind_default key value_if_not_found h = + +let hfind_default key value_if_not_found h = try Hashtbl.find h key - with Not_found -> + with Not_found -> (Hashtbl.add h key (value_if_not_found ()); Hashtbl.find h key) (* not as easy as Perl $h->{key}++; but still possible *) -let hupdate_default key op value_if_not_found h = +let hupdate_default key op value_if_not_found h = let old = hfind_default key value_if_not_found h in Hashtbl.replace h key (op old) - + let hfind_option key h = optionise (fun () -> Hashtbl.find h key) @@ -4723,80 +4733,80 @@ let hfind_option key h = (* Hash sets *) (*****************************************************************************) -type 'a hashset = ('a, bool) Hashtbl.t +type 'a hashset = ('a, bool) Hashtbl.t (* with sexp *) -let hash_hashset_add k e h = +let hash_hashset_add k e h = match optionise (fun () -> Hashtbl.find h k) with | Some hset -> Hashtbl.replace hset e true - | None -> + | None -> let hset = Hashtbl.create 11 in begin Hashtbl.add h k hset; Hashtbl.replace hset e true; end -let hashset_to_set baseset h = - h +> hash_to_list +> List.map fst +> (fun xs -> baseset#fromlist xs) +let hashset_to_set baseset h = + h +> hash_to_list +> List.map fst +> (fun xs -> baseset#fromlist xs) let hashset_to_list h = hash_to_list h +> List.map fst -let hashset_of_list xs = +let hashset_of_list xs = xs +> List.map (fun x -> x, true) +> hash_of_list -let hkeys h = +let hkeys h = let hkey = Hashtbl.create 101 in h +> Hashtbl.iter (fun k v -> Hashtbl.replace hkey k true); hashset_to_list hkey -let group_assoc_bykey_eff2 xs = - let h = Hashtbl.create 101 in +let group_assoc_bykey_eff2 xs = + let h = Hashtbl.create 101 in xs +> List.iter (fun (k, v) -> Hashtbl.add h k v); let keys = hkeys h in keys +> List.map (fun k -> k, Hashtbl.find_all h k) -let group_assoc_bykey_eff xs = - profile_code2 "Common.group_assoc_bykey_eff" (fun () -> +let group_assoc_bykey_eff xs = + profile_code2 "Common.group_assoc_bykey_eff" (fun () -> group_assoc_bykey_eff2 xs) - -let test_group_assoc () = + +let test_group_assoc () = let xs = enum 0 10000 +> List.map (fun i -> i_to_s i, i) in let xs = ("0", 2)::xs in (* let _ys = xs +> Common.groupBy (fun (a,resa) (b,resb) -> a =$= b) *) - let ys = xs +> group_assoc_bykey_eff + let ys = xs +> group_assoc_bykey_eff in pr2_gen ys -let uniq_eff xs = +let uniq_eff xs = let h = Hashtbl.create 101 in - xs +> List.iter (fun k -> + xs +> List.iter (fun k -> Hashtbl.add h k true ); hkeys h -let diff_two_say_set_eff xs1 xs2 = +let diff_two_say_set_eff xs1 xs2 = let h1 = hashset_of_list xs1 in let h2 = hashset_of_list xs2 in - + let hcommon = Hashtbl.create 101 in let honly_in_h1 = Hashtbl.create 101 in let honly_in_h2 = Hashtbl.create 101 in - - h1 +> Hashtbl.iter (fun k _ -> + + h1 +> Hashtbl.iter (fun k _ -> if Hashtbl.mem h2 k then Hashtbl.replace hcommon k true else Hashtbl.add honly_in_h1 k true ); - h2 +> Hashtbl.iter (fun k _ -> + h2 +> Hashtbl.iter (fun k _ -> if Hashtbl.mem h1 k then Hashtbl.replace hcommon k true else Hashtbl.add honly_in_h2 k true @@ -4805,7 +4815,7 @@ let diff_two_say_set_eff xs1 xs2 = hashset_to_list honly_in_h1, hashset_to_list honly_in_h2 - + (*****************************************************************************) (* Stack *) (*****************************************************************************) @@ -4822,13 +4832,13 @@ let top_option = function | x::xs -> Some x - + (* now in prelude: * let push2 v l = l := v :: !l *) -let pop2 l = +let pop2 l = let v = List.hd !l in begin l := List.tl !l; @@ -4846,32 +4856,32 @@ let pop2 l = type 'a undo_stack = 'a list * 'a list (* redo *) -let (empty_undo_stack: 'a undo_stack) = +let (empty_undo_stack: 'a undo_stack) = [], [] (* push erase the possible redo *) -let (push_undo: 'a -> 'a undo_stack -> 'a undo_stack) = fun x (undo,redo) -> - x::undo, [] +let (push_undo: 'a -> 'a undo_stack -> 'a undo_stack) = fun x (undo,redo) -> + x::undo, [] -let (top_undo: 'a undo_stack -> 'a) = fun (undo, redo) -> - List.hd undo +let (top_undo: 'a undo_stack -> 'a) = fun (undo, redo) -> + List.hd undo -let (pop_undo: 'a undo_stack -> 'a undo_stack) = fun (undo, redo) -> +let (pop_undo: 'a undo_stack -> 'a undo_stack) = fun (undo, redo) -> match undo with | [] -> failwith "empty undo stack" - | x::xs -> + | x::xs -> xs, x::redo -let (undo_pop: 'a undo_stack -> 'a undo_stack) = fun (undo, redo) -> +let (undo_pop: 'a undo_stack -> 'a undo_stack) = fun (undo, redo) -> match redo with | [] -> failwith "empty redo, nothing to redo" - | x::xs -> + | x::xs -> x::undo, xs -let redo_undo x = undo_pop x +let redo_undo x = undo_pop x -let top_undo_option = fun (undo, redo) -> +let top_undo_option = fun (undo, redo) -> match undo with | [] -> None | x::xs -> Some x @@ -4890,8 +4900,8 @@ type 'a bintree = Leaf of 'a | Branch of ('a bintree * 'a bintree) type 'a tree = Tree of 'a * ('a tree) list let rec (tree_iter: ('a -> unit) -> 'a tree -> unit) = fun f tree -> - match tree with - | Tree (node, xs) -> + match tree with + | Tree (node, xs) -> f node; xs +> List.iter (tree_iter f) @@ -4902,32 +4912,32 @@ let rec (tree_iter: ('a -> unit) -> 'a tree -> unit) = fun f tree -> (* no empty tree, must have one root at list *) -type 'a treeref = - | NodeRef of 'a * 'a treeref list ref +type 'a treeref = + | NodeRef of 'a * 'a treeref list ref -let treeref_children_ref tree = +let treeref_children_ref tree = match tree with | NodeRef (n, x) -> x -let rec (treeref_node_iter: -(* (('a * ('a, 'b) treeref list ref) -> unit) -> +let rec (treeref_node_iter: +(* (('a * ('a, 'b) treeref list ref) -> unit) -> ('a, 'b) treeref -> unit -*) 'a) - = - fun f tree -> +*) 'a) + = + fun f tree -> match tree with (* | LeafRef _ -> ()*) - | NodeRef (n, xs) -> + | NodeRef (n, xs) -> f (n, xs); !xs +> List.iter (treeref_node_iter f) -let find_treeref f tree = +let find_treeref f tree = let res = ref [] in - tree +> treeref_node_iter (fun (n, xs) -> + tree +> treeref_node_iter (fun (n, xs) -> if f (n,xs) then push2 (n, xs) res; ); @@ -4936,16 +4946,16 @@ let find_treeref f tree = | [] -> raise Not_found | x::y::zs -> raise Multi_found -let rec (treeref_node_iter_with_parents: - (* (('a * ('a, 'b) treeref list ref) -> ('a list) -> unit) -> - ('a, 'b) treeref -> unit) +let rec (treeref_node_iter_with_parents: + (* (('a * ('a, 'b) treeref list ref) -> ('a list) -> unit) -> + ('a, 'b) treeref -> unit) *) 'a) - = - fun f tree -> - let rec aux acc tree = + = + fun f tree -> + let rec aux acc tree = match tree with (* | LeafRef _ -> ()*) - | NodeRef (n, xs) -> + | NodeRef (n, xs) -> f (n, xs) acc ; !xs +> List.iter (aux (n::acc)) in @@ -4953,36 +4963,36 @@ let rec (treeref_node_iter_with_parents: (* ---------------------------------------------------------------------- *) -(* Leaf can seem redundant, but sometimes want to directly see if +(* Leaf can seem redundant, but sometimes want to directly see if * a children is a leaf without looking if the list is empty. *) -type ('a, 'b) treeref2 = - | NodeRef2 of 'a * ('a, 'b) treeref2 list ref +type ('a, 'b) treeref2 = + | NodeRef2 of 'a * ('a, 'b) treeref2 list ref | LeafRef2 of 'b -let treeref2_children_ref tree = +let treeref2_children_ref tree = match tree with | LeafRef2 _ -> failwith "treeref_tail: leaf" | NodeRef2 (n, x) -> x -let rec (treeref_node_iter2: - (('a * ('a, 'b) treeref2 list ref) -> unit) -> - ('a, 'b) treeref2 -> unit) = - fun f tree -> +let rec (treeref_node_iter2: + (('a * ('a, 'b) treeref2 list ref) -> unit) -> + ('a, 'b) treeref2 -> unit) = + fun f tree -> match tree with | LeafRef2 _ -> () - | NodeRef2 (n, xs) -> + | NodeRef2 (n, xs) -> f (n, xs); !xs +> List.iter (treeref_node_iter2 f) -let find_treeref2 f tree = +let find_treeref2 f tree = let res = ref [] in - tree +> treeref_node_iter2 (fun (n, xs) -> + tree +> treeref_node_iter2 (fun (n, xs) -> if f (n,xs) then push2 (n, xs) res; ); @@ -4994,14 +5004,14 @@ let find_treeref2 f tree = -let rec (treeref_node_iter_with_parents2: - (('a * ('a, 'b) treeref2 list ref) -> ('a list) -> unit) -> - ('a, 'b) treeref2 -> unit) = - fun f tree -> - let rec aux acc tree = +let rec (treeref_node_iter_with_parents2: + (('a * ('a, 'b) treeref2 list ref) -> ('a list) -> unit) -> + ('a, 'b) treeref2 -> unit) = + fun f tree -> + let rec aux acc tree = match tree with | LeafRef2 _ -> () - | NodeRef2 (n, xs) -> + | NodeRef2 (n, xs) -> f (n, xs) acc ; !xs +> List.iter (aux (n::acc)) in @@ -5019,10 +5029,10 @@ let rec (treeref_node_iter_with_parents2: -let find_treeref_with_parents_some f tree = +let find_treeref_with_parents_some f tree = let res = ref [] in - tree +> treeref_node_iter_with_parents (fun (n, xs) parents -> + tree +> treeref_node_iter_with_parents (fun (n, xs) parents -> match f (n,xs) parents with | Some v -> push2 v res; | None -> () @@ -5032,10 +5042,10 @@ let find_treeref_with_parents_some f tree = | [] -> raise Not_found | x::y::zs -> raise Multi_found -let find_multi_treeref_with_parents_some f tree = +let find_multi_treeref_with_parents_some f tree = let res = ref [] in - tree +> treeref_node_iter_with_parents (fun (n, xs) parents -> + tree +> treeref_node_iter_with_parents (fun (n, xs) parents -> match f (n,xs) parents with | Some v -> push2 v res; | None -> () @@ -5043,51 +5053,51 @@ let find_multi_treeref_with_parents_some f tree = match !res with | [v] -> !res | [] -> raise Not_found - | x::y::zs -> !res + | x::y::zs -> !res (*****************************************************************************) (* Graph. Have a look too at Ograph_*.mli *) (*****************************************************************************) -(* todo: generalise to put in common (need 'edge (and 'c ?), - * and take in param a display func, cos caml sux, no overloading of show :( +(* todo: generalise to put in common (need 'edge (and 'c ?), + * and take in param a display func, cos caml sux, no overloading of show :( * Simple impelemntation. Can do also matrix, or adjacent list, or pointer(ref) * todo: do some check (dont exist already, ...) *) type 'node graph = ('node set) * (('node * 'node) set) -let (add_node: 'a -> 'a graph -> 'a graph) = fun node (nodes, arcs) -> +let (add_node: 'a -> 'a graph -> 'a graph) = fun node (nodes, arcs) -> (node::nodes, arcs) -let (del_node: 'a -> 'a graph -> 'a graph) = fun node (nodes, arcs) -> - (nodes $-$ set [node], arcs) -(* could do more job: +let (del_node: 'a -> 'a graph -> 'a graph) = fun node (nodes, arcs) -> + (nodes $-$ set [node], arcs) +(* could do more job: let _ = assert (successors node (nodes, arcs) = empty) in +> List.filter (fun (src, dst) -> dst != node)) *) -let (add_arc: ('a * 'a) -> 'a graph -> 'a graph) = fun arc (nodes, arcs) -> +let (add_arc: ('a * 'a) -> 'a graph -> 'a graph) = fun arc (nodes, arcs) -> (nodes, set [arc] $+$ arcs) -let (del_arc: ('a * 'a) -> 'a graph -> 'a graph) = fun arc (nodes, arcs) -> +let (del_arc: ('a * 'a) -> 'a graph -> 'a graph) = fun arc (nodes, arcs) -> (nodes, arcs +> List.filter (fun a -> not (arc =*= a))) -let (successors: 'a -> 'a graph -> 'a set) = fun x (nodes, arcs) -> +let (successors: 'a -> 'a graph -> 'a set) = fun x (nodes, arcs) -> arcs +> List.filter (fun (src, dst) -> src =*= x) +> List.map snd -let (predecessors: 'a -> 'a graph -> 'a set) = fun x (nodes, arcs) -> +let (predecessors: 'a -> 'a graph -> 'a set) = fun x (nodes, arcs) -> arcs +> List.filter (fun (src, dst) -> dst =*= x) +> List.map fst let (nodes: 'a graph -> 'a set) = fun (nodes, arcs) -> nodes (* pre: no cycle *) -let rec (fold_upward: ('b -> 'a -> 'b) -> 'a set -> 'b -> 'a graph -> 'b) = - fun f xs acc graph -> +let rec (fold_upward: ('b -> 'a -> 'b) -> 'a set -> 'b -> 'a graph -> 'b) = + fun f xs acc graph -> match xs with | [] -> acc - | x::xs -> (f acc x) + | x::xs -> (f acc x) +> (fun newacc -> fold_upward f (graph +> predecessors x) newacc graph) - +> (fun newacc -> fold_upward f xs newacc graph) + +> (fun newacc -> fold_upward f xs newacc graph) (* TODO avoid already visited *) let empty_graph = ([], []) @@ -5095,22 +5105,22 @@ let empty_graph = ([], []) (* -let (add_arcs_toward: int -> (int list) -> 'a graph -> 'a graph) = fun i xs -> +let (add_arcs_toward: int -> (int list) -> 'a graph -> 'a graph) = fun i xs -> function (nodes, arcs) -> (nodes, (List.map (fun j -> (j,i) ) xs)++arcs) let (del_arcs_toward: int -> (int list) -> 'a graph -> 'a graph)= fun i xs g -> List.fold_left (fun acc el -> del_arc (el, i) acc) g xs -let (add_arcs_from: int -> (int list) -> 'a graph -> 'a graph) = fun i xs -> +let (add_arcs_from: int -> (int list) -> 'a graph -> 'a graph) = fun i xs -> function (nodes, arcs) -> (nodes, (List.map (fun j -> (i,j) ) xs)++arcs) -let (del_node: (int * 'node) -> 'node graph -> 'node graph) = fun node -> - function (nodes, arcs) -> +let (del_node: (int * 'node) -> 'node graph -> 'node graph) = fun node -> + function (nodes, arcs) -> let newnodes = List.filter (fun a -> not (node = a)) nodes in if newnodes = nodes then (raise Not_found) else (newnodes, arcs) -let (replace_node: int -> 'node -> 'node graph -> 'node graph) = fun i n -> - function (nodes, arcs) -> +let (replace_node: int -> 'node -> 'node graph -> 'node graph) = fun i n -> + function (nodes, arcs) -> let newnodes = List.filter (fun (j,_) -> not (i = j)) nodes in ((i,n)::newnodes, arcs) let (get_node: int -> 'node graph -> 'node) = fun i -> function @@ -5118,33 +5128,33 @@ let (get_node: int -> 'node graph -> 'node) = fun i -> function let (get_free: 'a graph -> int) = function (nodes, arcs) -> (maximum (List.map fst nodes))+1 -(* require no cycle !! +(* require no cycle !! TODO if cycle check that we have already visited a node *) let rec (succ_all: int -> 'a graph -> (int list)) = fun i -> function - (nodes, arcs) as g -> + (nodes, arcs) as g -> let direct = succ i g in union direct (union_list (List.map (fun i -> succ_all i g) direct)) let rec (pred_all: int -> 'a graph -> (int list)) = fun i -> function - (nodes, arcs) as g -> + (nodes, arcs) as g -> let direct = pred i g in union direct (union_list (List.map (fun i -> pred_all i g) direct)) (* require that the nodes are different !! *) let rec (equal: 'a graph -> 'a graph -> bool) = fun g1 g2 -> let ((nodes1, arcs1),(nodes2, arcs2)) = (g1,g2) in - try + try (* do 2 things, check same length and to assoc *) - let conv = assoc_map nodes1 nodes2 in - List.for_all (fun (i1,i2) -> + let conv = assoc_map nodes1 nodes2 in + List.for_all (fun (i1,i2) -> List.mem (List.assoc i1 conv, List.assoc i2 conv) arcs2) - arcs1 + arcs1 && (List.length arcs1 = List.length arcs2) (* could think that only forall is needed, but need check same lenth too*) with _ -> false -let (display: 'a graph -> ('a -> unit) -> unit) = fun g display_func -> - let rec aux depth i = +let (display: 'a graph -> ('a -> unit) -> unit) = fun g display_func -> + let rec aux depth i = print_n depth " "; - print_int i; print_string "->"; display_func (get_node i g); + print_int i; print_string "->"; display_func (get_node i g); print_string "\n"; List.iter (aux (depth+2)) (succ i g) in aux 0 1 @@ -5152,10 +5162,10 @@ let (display: 'a graph -> ('a -> unit) -> unit) = fun g display_func -> let (display_dot: 'a graph -> ('a -> string) -> unit)= fun (nodes,arcs) func -> let file = open_out "test.dot" in output_string file "digraph misc {\n" ; - List.iter (fun (n, node) -> + List.iter (fun (n, node) -> output_int file n; output_string file " [label=\""; output_string file (func node); output_string file " \"];\n"; ) nodes; - List.iter (fun (i1,i2) -> output_int file i1 ; output_string file " -> " ; + List.iter (fun (i1,i2) -> output_int file i1 ; output_string file " -> " ; output_int file i2 ; output_string file " ;\n"; ) arcs; output_string file "}\n" ; close_out file; @@ -5166,25 +5176,25 @@ let (display_dot: 'a graph -> ('a -> string) -> unit)= fun (nodes,arcs) func -> *) (* todo: mettre diff(modulo = !!) en rouge *) -let (display_dot2: 'a graph -> 'a graph -> ('a -> string) -> unit) = +let (display_dot2: 'a graph -> 'a graph -> ('a -> string) -> unit) = fun (nodes1, arcs1) (nodes2, arcs2) func -> let file = open_out "test.dot" in output_string file "digraph misc {\n" ; output_string file "rotate = 90;\n"; List.iter (fun (n, node) -> - output_string file "100"; output_int file n; + output_string file "100"; output_int file n; output_string file " [label=\""; output_string file (func node); output_string file " \"];\n"; ) nodes1; List.iter (fun (n, node) -> - output_string file "200"; output_int file n; + output_string file "200"; output_int file n; output_string file " [label=\""; output_string file (func node); output_string file " \"];\n"; ) nodes2; - List.iter (fun (i1,i2) -> - output_string file "100"; output_int file i1 ; output_string file " -> " ; - output_string file "100"; output_int file i2 ; output_string file " ;\n"; - ) + List.iter (fun (i1,i2) -> + output_string file "100"; output_int file i1 ; output_string file " -> " ; + output_string file "100"; output_int file i2 ; output_string file " ;\n"; + ) arcs1; - List.iter (fun (i1,i2) -> + List.iter (fun (i1,i2) -> output_string file "200"; output_int file i1 ; output_string file " -> " ; output_string file "200"; output_int file i2 ; output_string file " ;\n"; ) arcs2; @@ -5228,23 +5238,23 @@ type point = vector type color = vector (* color(0-1) *) (* todo: factorise *) -let (dotproduct: vector * vector -> float) = +let (dotproduct: vector * vector -> float) = fun ((x1,y1,z1),(x2,y2,z2)) -> (x1*.x2 +. y1*.y2 +. z1*.z2) -let (vector_length: vector -> float) = +let (vector_length: vector -> float) = fun (x,y,z) -> sqrt (square x +. square y +. square z) -let (minus_point: point * point -> vector) = +let (minus_point: point * point -> vector) = fun ((x1,y1,z1),(x2,y2,z2)) -> ((x1 -. x2),(y1 -. y2),(z1 -. z2)) -let (distance: point * point -> float) = +let (distance: point * point -> float) = fun (x1, x2) -> vector_length (minus_point (x2,x1)) -let (normalise: vector -> vector) = - fun (x,y,z) -> +let (normalise: vector -> vector) = + fun (x,y,z) -> let len = vector_length (x,y,z) in (x /. len, y /. len, z /. len) -let (mult_coeff: vector -> float -> vector) = +let (mult_coeff: vector -> float -> vector) = fun (x,y,z) c -> (x *. c, y *. c, z *. c) -let (add_vector: vector -> vector -> vector) = +let (add_vector: vector -> vector -> vector) = fun v1 v2 -> let ((x1,y1,z1),(x2,y2,z2)) = (v1,v2) in (x1+.x2, y1+.y2, z1+.z2) -let (mult_vector: vector -> vector -> vector) = +let (mult_vector: vector -> vector -> vector) = fun v1 v2 -> let ((x1,y1,z1),(x2,y2,z2)) = (v1,v2) in (x1*.x2, y1*.y2, z1*.z2) let sum_vector = List.fold_left add_vector (0.0,0.0,0.0) @@ -5264,13 +5274,13 @@ let (write_ppm: int -> int -> (pixel list) -> string -> unit) = fun output_string chan ((string_of_int width) ^ "\n"); output_string chan ((string_of_int height) ^ "\n"); output_string chan "255\n"; - List.iter (fun (r,g,b) -> + List.iter (fun (r,g,b) -> List.iter (fun byt -> output_byte chan byt) [r;g;b] ) xs; close_out chan end - -let test_ppm1 () = write_ppm 100 100 + +let test_ppm1 () = write_ppm 100 100 ((generate (50*100) (1,45,100)) ++ (generate (50*100) (1,1,100))) "img.ppm" @@ -5280,47 +5290,47 @@ let test_ppm1 () = write_ppm 100 100 type diff = Match | BnotinA | AnotinB let (diff: (int -> int -> diff -> unit)-> (string list * string list) -> unit)= - fun f (xs,ys) -> + fun f (xs,ys) -> let file1 = "/tmp/diff1-" ^ (string_of_int (Unix.getuid ())) in let file2 = "/tmp/diff2-" ^ (string_of_int (Unix.getuid ())) in let fileresult = "/tmp/diffresult-" ^ (string_of_int (Unix.getuid ())) in write_file file1 (unwords xs); write_file file2 (unwords ys); - command2 + command2 ("diff --side-by-side -W 1 " ^ file1 ^ " " ^ file2 ^ " > " ^ fileresult); let res = cat fileresult in let a = ref 0 in let b = ref 0 in - res +> List.iter (fun s -> + res +> List.iter (fun s -> match s with | ("" | " ") -> f !a !b Match; incr a; incr b; | ">" -> f !a !b BnotinA; incr b; - | ("|" | "/" | "\\" ) -> + | ("|" | "/" | "\\" ) -> f !a !b BnotinA; f !a !b AnotinB; incr a; incr b; | "<" -> f !a !b AnotinB; incr a; | _ -> raise Impossible ) -(* -let _ = - diff +(* +let _ = + diff ["0";"a";"b";"c";"d"; "f";"g";"h";"j";"q"; "z"] - [ "a";"b";"c";"d";"e";"f";"g";"i";"j";"k";"r";"x";"y";"z"] - (fun x y -> pr "match") - (fun x y -> pr "a_not_in_b") - (fun x y -> pr "b_not_in_a") + [ "a";"b";"c";"d";"e";"f";"g";"i";"j";"k";"r";"x";"y";"z"] + (fun x y -> pr "match") + (fun x y -> pr "a_not_in_b") + (fun x y -> pr "b_not_in_a") *) -let (diff2: (int -> int -> diff -> unit) -> (string * string) -> unit) = - fun f (xstr,ystr) -> +let (diff2: (int -> int -> diff -> unit) -> (string * string) -> unit) = + fun f (xstr,ystr) -> write_file "/tmp/diff1" xstr; write_file "/tmp/diff2" ystr; - command2 - ("diff --side-by-side --left-column -W 1 " ^ + command2 + ("diff --side-by-side --left-column -W 1 " ^ "/tmp/diff1 /tmp/diff2 > /tmp/diffresult"); let res = cat "/tmp/diffresult" in let a = ref 0 in let b = ref 0 in - res +> List.iter (fun s -> + res +> List.iter (fun s -> match s with | "(" -> f !a !b Match; incr a; incr b; | ">" -> f !a !b BnotinA; incr b; @@ -5335,7 +5345,7 @@ let (diff2: (int -> int -> diff -> unit) -> (string * string) -> unit) = (*****************************************************************************) let parserCommon lexbuf parserer lexer = - try + try let result = parserer lexer lexbuf in result with Parsing.Parse_error -> @@ -5348,14 +5358,14 @@ let parserCommon lexbuf parserer lexer = (* marche pas ca neuneu *) (* -let getDoubleParser parserer lexer string = +let getDoubleParser parserer lexer string = let lexbuf1 = Lexing.from_string string in let chan = open_in string in let lexbuf2 = Lexing.from_channel chan in (parserCommon lexbuf1 parserer lexer , parserCommon lexbuf2 parserer lexer ) *) -let getDoubleParser parserer lexer = +let getDoubleParser parserer lexer = ( (function string -> let lexbuf1 = Lexing.from_string string in @@ -5373,10 +5383,10 @@ let getDoubleParser parserer lexer = (*****************************************************************************) (* cf parser_combinators.ml - * - * Could also use ocaml stream. but not backtrack and forced to do LL, + * + * Could also use ocaml stream. but not backtrack and forced to do LL, * so combinators are better. - * + * *) @@ -5391,28 +5401,28 @@ type parse_info = { line: int; column: int; file: filename; - } + } (* with sexp *) -let fake_parse_info = { +let fake_parse_info = { charpos = -1; str = ""; line = -1; column = -1; file = ""; } -let string_of_parse_info x = +let string_of_parse_info x = spf "%s at %s:%d:%d" x.str x.file x.line x.column -let string_of_parse_info_bis x = +let string_of_parse_info_bis x = spf "%s:%d:%d" x.file x.line x.column -let (info_from_charpos2: int -> filename -> (int * int * string)) = +let (info_from_charpos2: int -> filename -> (int * int * string)) = fun charpos filename -> (* Currently lexing.ml does not handle the line number position. - * Even if there is some fields in the lexing structure, they are not + * Even if there is some fields in the lexing structure, they are not * maintained by the lexing engine :( So the following code does not work: - * let pos = Lexing.lexeme_end_p lexbuf in - * sprintf "at file %s, line %d, char %d" pos.pos_fname pos.pos_lnum - * (pos.pos_cnum - pos.pos_bol) in + * let pos = Lexing.lexeme_end_p lexbuf in + * sprintf "at file %s, line %d, char %d" pos.pos_fname pos.pos_lnum + * (pos.pos_cnum - pos.pos_bol) in * Hence this function to overcome the previous limitation. *) let chan = open_in filename in @@ -5436,12 +5446,12 @@ let (info_from_charpos2: int -> filename -> (int * int * string)) = charpos_to_pos_aux !posl; end | None -> (!linen, charpos - !posl, "\n") - in + in let res = charpos_to_pos_aux 0 in close_in chan; res -let info_from_charpos a b = +let info_from_charpos a b = profile_code "Common.info_from_charpos" (fun () -> info_from_charpos2 a b) @@ -5463,33 +5473,33 @@ let full_charpos_to_pos2 = fun filename -> incr line; (* '... +1 do' cos input_line dont return the trailing \n *) - for i = 0 to (slength s - 1) + 1 do + for i = 0 to (slength s - 1) + 1 do arr.(!charpos + i) <- (!line, i); done; charpos := !charpos + slength s + 1; full_charpos_to_pos_aux(); - - with End_of_file -> + + with End_of_file -> for i = !charpos to Array.length arr - 1 do arr.(i) <- (!line, 0); done; (); - in - begin + in + begin full_charpos_to_pos_aux (); close_in chan; arr end let full_charpos_to_pos a = profile_code "Common.full_charpos_to_pos" (fun () -> full_charpos_to_pos2 a) - -let test_charpos file = + +let test_charpos file = full_charpos_to_pos file +> dump +> pr2 -let complete_parse_info filename table x = - { x with +let complete_parse_info filename table x = + { x with file = filename; line = fst (table.(x.charpos)); column = snd (table.(x.charpos)); @@ -5502,9 +5512,9 @@ let full_charpos_to_pos_large2 = fun filename -> let size = (filesize filename + 2) in (* old: let arr = Array.create size (0,0) in *) - let arr1 = Bigarray.Array1.create + let arr1 = Bigarray.Array1.create Bigarray.int Bigarray.c_layout size in - let arr2 = Bigarray.Array1.create + let arr2 = Bigarray.Array1.create Bigarray.int Bigarray.c_layout size in Bigarray.Array1.fill arr1 0; Bigarray.Array1.fill arr2 0; @@ -5519,18 +5529,18 @@ let full_charpos_to_pos_large2 = fun filename -> incr line; (* '... +1 do' cos input_line dont return the trailing \n *) - for i = 0 to (slength s - 1) + 1 do + for i = 0 to (slength s - 1) + 1 do (* old: arr.(!charpos + i) <- (!line, i); *) arr1.{!charpos + i} <- (!line); arr2.{!charpos + i} <- i; done; charpos := !charpos + slength s + 1; full_charpos_to_pos_aux() in - begin + begin (try full_charpos_to_pos_aux (); - with End_of_file -> - for i = !charpos to (* old: Array.length arr *) + with End_of_file -> + for i = !charpos to (* old: Array.length arr *) Bigarray.Array1.dim arr1 - 1 do (* old: arr.(i) <- (!line, 0); *) arr1.{i} <- !line; @@ -5541,33 +5551,33 @@ let full_charpos_to_pos_large2 = fun filename -> (fun i -> arr1.{i}, arr2.{i}) end let full_charpos_to_pos_large a = - profile_code "Common.full_charpos_to_pos_large" + profile_code "Common.full_charpos_to_pos_large" (fun () -> full_charpos_to_pos_large2 a) -let complete_parse_info_large filename table x = - { x with +let complete_parse_info_large filename table x = + { x with file = filename; line = fst (table (x.charpos)); column = snd (table (x.charpos)); } (*---------------------------------------------------------------------------*) -(* Decalage is here to handle stuff such as cpp which include file and who +(* Decalage is here to handle stuff such as cpp which include file and who * can make shift. *) let (error_messagebis: filename -> (string * int) -> int -> string)= fun filename (lexeme, lexstart) decalage -> let charpos = lexstart + decalage in - let tok = lexeme in + let tok = lexeme in let (line, pos, linecontent) = info_from_charpos charpos filename in sprintf "File \"%s\", line %d, column %d, charpos = %d around = '%s', whole content = %s" filename line pos charpos tok (chop linecontent) -let error_message = fun filename (lexeme, lexstart) -> - try error_messagebis filename (lexeme, lexstart) 0 +let error_message = fun filename (lexeme, lexstart) -> + try error_messagebis filename (lexeme, lexstart) 0 with End_of_file -> ("PB in Common.error_message, position " ^ i_to_s lexstart ^ @@ -5575,18 +5585,18 @@ let error_message = fun filename (lexeme, lexstart) -> -let error_message_short = fun filename (lexeme, lexstart) -> - try +let error_message_short = fun filename (lexeme, lexstart) -> + try let charpos = lexstart in let (line, pos, linecontent) = info_from_charpos charpos filename in sprintf "File \"%s\", line %d" filename line - with End_of_file -> + with End_of_file -> begin ("PB in Common.error_message, position " ^ i_to_s lexstart ^ " given out of file:" ^ filename); end - + (*****************************************************************************) @@ -5595,17 +5605,17 @@ let error_message_short = fun filename (lexeme, lexstart) -> (* todo: keep also size of file, compute md5sum ? cos maybe the file * has changed!. - * + * * todo: could also compute the date, or some version info of the program, * can record the first date when was found a OK, the last date where - * was ok, and then first date when found fail. So the + * was ok, and then first date when found fail. So the * Common.Ok would have more information that would be passed * to the Common.Pb of date * date * date * string peut etre. - * + * * todo? maybe use plain text file instead of marshalling. *) -type score_result = Ok | Pb of string +type score_result = Ok | Pb of string (* with sexp *) type score = (string (* usually a filename *), score_result) Hashtbl.t (* with sexp *) @@ -5616,43 +5626,43 @@ let empty_score () = (Hashtbl.create 101 : score) -let regression_testing_vs newscore bestscore = +let regression_testing_vs newscore bestscore = let newbestscore = empty_score () in - let allres = + let allres = (hash_to_list newscore +> List.map fst) $+$ (hash_to_list bestscore +> List.map fst) in - begin - allres +> List.iter (fun res -> - match + begin + allres +> List.iter (fun res -> + match optionise (fun () -> Hashtbl.find newscore res), optionise (fun () -> Hashtbl.find bestscore res) with | None, None -> raise Impossible - | Some x, None -> + | Some x, None -> Printf.printf "new test file appeared: %s\n" res; Hashtbl.add newbestscore res x; - | None, Some x -> + | None, Some x -> Printf.printf "old test file disappeared: %s\n" res; - | Some newone, Some bestone -> + | Some newone, Some bestone -> (match newone, bestone with - | Ok, Ok -> + | Ok, Ok -> Hashtbl.add newbestscore res Ok - | Pb x, Ok -> + | Pb x, Ok -> Printf.printf "PBBBBBBBB: a test file does not work anymore!!! : %s\n" res; Printf.printf "Error : %s\n" x; Hashtbl.add newbestscore res Ok - | Ok, Pb x -> + | Ok, Pb x -> Printf.printf "Great: a test file now works: %s\n" res; Hashtbl.add newbestscore res Ok - | Pb x, Pb y -> + | Pb x, Pb y -> Hashtbl.add newbestscore res (Pb x); if not (x =$= y) - then begin + then begin Printf.printf "Semipb: still error but not same error : %s\n" res; Printf.printf "%s\n" (chop ("Old error: " ^ y)); @@ -5664,13 +5674,13 @@ let regression_testing_vs newscore bestscore = newbestscore end -let regression_testing newscore best_score_file = +let regression_testing newscore best_score_file = pr2 ("regression file: "^ best_score_file); - let (bestscore : score) = + let (bestscore : score) = if not (Sys.file_exists best_score_file) then write_value (empty_score()) best_score_file; - get_value best_score_file + get_value best_score_file in let newbestscore = regression_testing_vs newscore bestscore in write_value newbestscore (best_score_file ^ ".old"); @@ -5680,27 +5690,27 @@ let regression_testing newscore best_score_file = -let string_of_score_result v = - match v with - | Ok -> "Ok" +let string_of_score_result v = + match v with + | Ok -> "Ok" | Pb s -> "Pb: " ^ s -let total_scores score = +let total_scores score = let total = hash_to_list score +> List.length in let good = hash_to_list score +> List.filter (fun (s, v) -> v =*= Ok) +> List.length in good, total - -let print_total_score score = + +let print_total_score score = pr2 "--------------------------------"; pr2 "total score"; pr2 "--------------------------------"; let (good, total) = total_scores score in pr2 (sprintf "good = %d/%d" good total) -let print_score score = - score +> hash_to_list +> List.iter (fun (k, v) -> +let print_score score = + score +> hash_to_list +> List.iter (fun (k, v) -> pr2 (sprintf "% s --> %s" k (string_of_score_result v)) ); print_total_score score; @@ -5718,33 +5728,33 @@ let print_score score = type ('a, 'b) scoped_env = ('a, 'b) assoc list (* -let rec lookup_env f env = - match env with +let rec lookup_env f env = + match env with | [] -> raise Not_found | []::zs -> lookup_env f zs - | (x::xs)::zs -> + | (x::xs)::zs -> match f x with | None -> lookup_env f (xs::zs) | Some y -> y -let member_env_key k env = - try +let member_env_key k env = + try let _ = lookup_env (fun (k',v) -> if k = k' then Some v else None) env in true with Not_found -> false *) -let rec lookup_env k env = - match env with +let rec lookup_env k env = + match env with | [] -> raise Not_found | []::zs -> lookup_env k zs - | ((k',v)::xs)::zs -> + | ((k',v)::xs)::zs -> if k =*= k' - then v + then v else lookup_env k (xs::zs) -let member_env_key k env = +let member_env_key k env = match optionise (fun () -> lookup_env k env) with | None -> false | Some _ -> true @@ -5753,14 +5763,14 @@ let member_env_key k env = let new_scope scoped_env = scoped_env := []::!scoped_env let del_scope scoped_env = scoped_env := List.tl !scoped_env -let do_in_new_scope scoped_env f = +let do_in_new_scope scoped_env f = begin new_scope scoped_env; let res = f() in del_scope scoped_env; res end - + let add_in_scope scoped_env def = let (current, older) = uncons !scoped_env in scoped_env := (def::current)::older @@ -5782,33 +5792,33 @@ let empty_scoped_h_env () = { scoped_h = Hashtbl.create 101; scoped_list = [[]]; } -let clone_scoped_h_env x = +let clone_scoped_h_env x = { scoped_h = Hashtbl.copy x.scoped_h; scoped_list = x.scoped_list; } -let rec lookup_h_env k env = - Hashtbl.find env.scoped_h k +let rec lookup_h_env k env = + Hashtbl.find env.scoped_h k -let member_h_env_key k env = +let member_h_env_key k env = match optionise (fun () -> lookup_h_env k env) with | None -> false | Some _ -> true -let new_scope_h scoped_env = +let new_scope_h scoped_env = scoped_env := {!scoped_env with scoped_list = []::!scoped_env.scoped_list} -let del_scope_h scoped_env = +let del_scope_h scoped_env = begin List.hd !scoped_env.scoped_list +> List.iter (fun (k, v) -> Hashtbl.remove !scoped_env.scoped_h k ); - scoped_env := {!scoped_env with scoped_list = + scoped_env := {!scoped_env with scoped_list = List.tl !scoped_env.scoped_list } end -let do_in_new_scope_h scoped_env f = +let do_in_new_scope_h scoped_env f = begin new_scope_h scoped_env; let res = f() in @@ -5816,16 +5826,16 @@ let do_in_new_scope_h scoped_env f = res end -(* +(* let add_in_scope scoped_env def = let (current, older) = uncons !scoped_env in scoped_env := (def::current)::older *) -let add_in_scope_h x (k,v) = +let add_in_scope_h x (k,v) = begin Hashtbl.add !x.scoped_h k v; - x := { !x with scoped_list = + x := { !x with scoped_list = ((k,v)::(List.hd !x.scoped_list))::(List.tl !x.scoped_list); }; end @@ -5836,13 +5846,13 @@ let add_in_scope_h x (k,v) = (* let ansi_terminal = ref true *) -let (_execute_and_show_progress_func: (int (* length *) -> ((unit -> unit) -> unit) -> unit) ref) - = ref - (fun a b -> +let (_execute_and_show_progress_func: (int (* length *) -> ((unit -> unit) -> unit) -> unit) ref) + = ref + (fun a b -> failwith "no execute yet, have you included common_extra.cmo?" ) - + let execute_and_show_progress len f = !_execute_and_show_progress_func len f @@ -5858,27 +5868,27 @@ let execute_and_show_progress len f = let _init_random = Random.self_init () (* -let random_insert i l = +let random_insert i l = let p = Random.int (length l +1) - in let rec insert i p l = + in let rec insert i p l = if (p = 0) then i::l else (hd l)::insert i (p-1) (tl l) in insert i p l -let rec randomize_list = function +let rec randomize_list = function [] -> [] | a::l -> random_insert a (randomize_list l) *) -let random_list xs = - List.nth xs (Random.int (length xs)) +let random_list xs = + List.nth xs (Random.int (length xs)) (* todo_opti: use fisher/yates algorithm. - * ref: http://en.wikipedia.org/wiki/Knuth_shuffle - * - * public static void shuffle (int[] array) + * ref: http://en.wikipedia.org/wiki/Knuth_shuffle + * + * public static void shuffle (int[] array) * { * Random rng = new Random (); * int n = array.length; - * while (--n > 0) + * while (--n > 0) * { * int k = rng.nextInt(n + 1); // 0 <= k <= n (!) * int temp = array[n]; @@ -5888,7 +5898,7 @@ let random_list xs = * } *) -let randomize_list xs = +let randomize_list xs = let permut = permutation xs in random_list permut @@ -5897,8 +5907,8 @@ let randomize_list xs = let random_subset_of_list num xs = let array = Array.of_list xs in let len = Array.length array in - - let h = Hashtbl.create 101 in + + let h = Hashtbl.create 101 in let cnt = ref num in while !cnt > 0 do let x = Random.int len in @@ -5917,64 +5927,64 @@ let random_subset_of_list num xs = (* Flags and actions *) (*****************************************************************************) -(* I put it inside a func as it can help to give a chance to - * change the globals before getting the options as some +(* I put it inside a func as it can help to give a chance to + * change the globals before getting the options as some * options sometimes may want to show the default value. *) -let cmdline_flags_devel () = +let cmdline_flags_devel () = [ - "-debugger", Arg.Set debugger , + "-debugger", Arg.Set debugger , " option to set if launched inside ocamldebug"; - "-profile", Arg.Unit (fun () -> profile := PALL), + "-profile", Arg.Unit (fun () -> profile := PALL), " gather timing information about important functions"; ] let cmdline_flags_verbose () = [ - "-verbose_level", Arg.Set_int verbose_level, + "-verbose_level", Arg.Set_int verbose_level, " guess what"; - "-disable_pr2_once", Arg.Set disable_pr2_once, + "-disable_pr2_once", Arg.Set disable_pr2_once, " to print more messages"; - "-show_trace_profile", Arg.Set show_trace_profile, + "-show_trace_profile", Arg.Set show_trace_profile, " show trace"; ] -let cmdline_flags_other () = +let cmdline_flags_other () = [ - "-nocheck_stack", Arg.Clear check_stack, + "-nocheck_stack", Arg.Clear check_stack, " "; "-batch_mode", Arg.Set _batch_mode, " no interactivity" ] (* potentially other common options but not yet integrated: - - "-timeout", Arg.Set_int timeout, + + "-timeout", Arg.Set_int timeout, " interrupt LFS or buggy external plugins"; (* can't be factorized because of the $ cvs stuff, we want the date * of the main.ml file, not common.ml *) - "-version", Arg.Unit (fun () -> + "-version", Arg.Unit (fun () -> pr2 "version: _dollar_Date: 2008/06/14 00:54:22 _dollar_"; raise (Common.UnixExit 0) - ), + ), " guess what"; - "-shorthelp", Arg.Unit (fun () -> + "-shorthelp", Arg.Unit (fun () -> !short_usage_func(); raise (Common.UnixExit 0) - ), + ), " see short list of options"; - "-longhelp", Arg.Unit (fun () -> + "-longhelp", Arg.Unit (fun () -> !long_usage_func(); raise (Common.UnixExit 0) - ), - "-help", Arg.Unit (fun () -> + ), + "-help", Arg.Unit (fun () -> !long_usage_func(); raise (Common.UnixExit 0) ), " "; - "--help", Arg.Unit (fun () -> + "--help", Arg.Unit (fun () -> !long_usage_func(); raise (Common.UnixExit 0) ), @@ -5982,7 +5992,7 @@ let cmdline_flags_other () = *) -let cmdline_actions () = +let cmdline_actions () = [ "-test_check_stack", " ", mk_action_1_arg test_check_stack_size; @@ -5994,7 +6004,7 @@ let cmdline_actions () = (*****************************************************************************) (* stuff put here cos of of forward definition limitation of ocaml *) - + (* Infix trick, seen in jane street lib and harrop's code, and maybe in GMP *) module Infix = struct let (+>) = (+>) @@ -6003,15 +6013,15 @@ module Infix = struct end -let main_boilerplate f = - if not (!Sys.interactive) then - exn_to_real_unixexit (fun () -> +let main_boilerplate f = + if not (!Sys.interactive) then + exn_to_real_unixexit (fun () -> - Sys.set_signal Sys.sigint (Sys.Signal_handle (fun _ -> + Sys.set_signal Sys.sigint (Sys.Signal_handle (fun _ -> pr2 "C-c intercepted, will do some cleaning before exiting"; (* But if do some try ... with e -> and if do not reraise the exn, * the bubble never goes at top and so I cant really C-c. - * + * * A solution would be to not raise, but do the erase_temp_file in the * syshandler, here, and then exit. * The current solution is to not do some wild try ... with e @@ -6022,19 +6032,19 @@ let main_boilerplate f = )); (* The finalize below makes it tedious to go back to exn when use - * 'back' in the debugger. Hence this special case. But the - * Common.debugger will be set in main(), so too late, so + * 'back' in the debugger. Hence this special case. But the + * Common.debugger will be set in main(), so too late, so * have to be quicker *) if Sys.argv +> Array.to_list +> List.exists (fun x -> x =$= "-debugger") then debugger := true; - finalize (fun ()-> - pp_do_in_zero_box (fun () -> + finalize (fun ()-> + pp_do_in_zero_box (fun () -> f(); (* <---- here it is *) )) - (fun()-> - if !profile <> PNONE + (fun()-> + if !profile <> PNONE then pr2 (profile_diagnostic ()); erase_temp_files (); ) @@ -6048,14 +6058,14 @@ let md5sum_of_string s = (Filename.quote s) in match cmd_to_list com with - | [s] -> + | [s] -> (*pr2 s;*) s | _ -> failwith "md5sum_of_string wrong output" -let with_pr2_to_string f = +let with_pr2_to_string f = let file = new_temp_file "pr2" "out" in redirect_stdout_stderr file f; cat file @@ -6086,20 +6096,20 @@ let format_to_string f = (* Misc/test *) (*****************************************************************************) -let (generic_print: 'a -> string -> string) = fun v typ -> +let (generic_print: 'a -> string -> string) = fun v typ -> write_value v "/tmp/generic_print"; - command2 + command2 ("printf 'let (v:" ^ typ ^ ")= Common.get_value \"/tmp/generic_print\" " ^ " in v;;' " ^ - " | calc.top > /tmp/result_generic_print"); - cat "/tmp/result_generic_print" + " | calc.top > /tmp/result_generic_print"); + cat "/tmp/result_generic_print" +> drop_while (fun e -> not (e =~ "^#.*")) +> tail +> unlines - +> (fun s -> - if (s =~ ".*= \\(.+\\)") - then matched1 s + +> (fun s -> + if (s =~ ".*= \\(.+\\)") + then matched1 s else "error in generic_print, not good format:" ^ s) - + (* let main () = pr (generic_print [1;2;3;4] "int list") *) class ['a] olist (ys: 'a list) = @@ -6107,13 +6117,13 @@ class ['a] olist (ys: 'a list) = val xs = ys method view = xs (* method fold f a = List.fold_left f a xs *) - method fold : 'b. ('b -> 'a -> 'b) -> 'b -> 'b = + method fold : 'b. ('b -> 'a -> 'b) -> 'b -> 'b = fun f accu -> List.fold_left f accu xs end (* let _ = write_value ((new setb[])#add 1) "/tmp/test" *) -let typing_sux_test () = +let typing_sux_test () = let x = Obj.magic [1;2;3] in let f1 xs = List.iter print_int xs in let f2 xs = List.iter print_string xs in diff --git a/commons/common.mli b/commons/common.mli index d2920fc..0701066 100644 --- a/commons/common.mli +++ b/commons/common.mli @@ -4,17 +4,17 @@ (* Some conventions: * - * When I have some _xxx variables before some functions, it's - * because I want to show that those functions internally use a global + * When I have some _xxx variables before some functions, it's + * because I want to show that those functions internally use a global * variable. That does not mean I want people to modify this global. * In fact they are kind of private, but I still want to show them. * Maybe one day OCaml will have an effect type system so I don't need this. - * - * The variables that are called _init_xxx show the internal init + * + * The variables that are called _init_xxx show the internal init * side effect of the module (like static var trick used in C/C++) - * + * * Why not split the functionnalities of this file in different files ? - * Because when I write ocaml script I want simply to load one + * Because when I write ocaml script I want simply to load one * file, common.ml, and that's it. Cf common_extra.ml for more on this. *) @@ -22,7 +22,7 @@ (*****************************************************************************) (* Flags *) (*****************************************************************************) -(* see the corresponding section for the use of those flags. See also +(* see the corresponding section for the use of those flags. See also * the "Flags and actions" section at the end of this file. *) @@ -49,7 +49,7 @@ val save_tmp_files : bool ref (*****************************************************************************) (* Module side effect *) (*****************************************************************************) -(* +(* * I define a few unit tests via some let _ = example (... = ...). * I also initialize the random seed, cf _init_random . * I also set Gc.stack_size, cf _init_gc_stack . @@ -87,22 +87,22 @@ end (* * Another related trick, found via Jon Harrop to have an extended standard * lib is to do something like - * + * * module List = struct * include List * val map2 : ... * end - * + * * And then can put this "module extension" somewhere to open it. *) -(* This module defines the Timeout and UnixExit exceptions. - * You have to make sure that those exn are not intercepted. So +(* This module defines the Timeout and UnixExit exceptions. + * You have to make sure that those exn are not intercepted. So * avoid exn handler such as try (...) with _ -> cos Timeout will not bubble up - * enough. In such case, add a case before such as - * with Timeout -> raise Timeout | _ -> ... + * enough. In such case, add a case before such as + * with Timeout -> raise Timeout | _ -> ... * The same is true for UnixExit (see below). *) @@ -118,9 +118,9 @@ val reset_pr_indent : unit -> unit * They also add the _prefix_pr, for instance used in MPI to show which * worker is talking. * update: for pr2, it can also print into a log file. - * + * * The use of 2 in pr2 is because 2 is under UNIX the second descriptor - * which corresponds to stderr. + * which corresponds to stderr. *) val _prefix_pr : string ref @@ -130,6 +130,7 @@ val pr_xxxxxxxxxxxxxxxxx : unit -> unit (* pr2 print on stderr, but can also in addition print into a file *) val _chan_pr2: out_channel option ref +val print_to_stderr : bool ref val pr2 : string -> unit val pr2_no_nl : string -> unit val pr2_xxxxxxxxxxxxxxxxx : unit -> unit @@ -161,9 +162,9 @@ val sprintf : ('a, unit, string) format -> 'a val spf : ('a, unit, string) format -> 'a (* default = stderr *) -val _chan : out_channel ref +val _chan : out_channel ref (* generate & use a /tmp/debugml-xxx file *) -val start_log_file : unit -> unit +val start_log_file : unit -> unit (* see flag: val verbose_level : int ref *) val log : string -> unit @@ -242,9 +243,9 @@ val profile_code2 : string -> (unit -> 'a) -> 'a val example : bool -> unit (* generate failwith when pb *) -val example2 : string -> bool -> unit +val example2 : string -> bool -> unit (* use Dumper to report when pb *) -val assert_equal : 'a -> 'a -> unit +val assert_equal : 'a -> 'a -> unit val _list_bool : (string * bool) list ref val example3 : string -> bool -> unit @@ -252,11 +253,11 @@ val test_all : unit -> unit (* regression testing *) -type score_result = Ok | Pb of string +type score_result = Ok | Pb of string type score = (string (* usually a filename *), score_result) Hashtbl.t type score_list = (string (* usually a filename *) * score_result) list val empty_score : unit -> score -val regression_testing : +val regression_testing : score -> filename (* old score file on disk (usually in /tmp) *) -> unit val regression_testing_vs: score -> score -> score val total_scores : score -> int (* good *) * int (* total *) @@ -282,7 +283,7 @@ val frequencyl : (int * 'a) list -> 'a gen val laws : string -> ('a -> bool) -> 'a gen -> 'a option -(* example of use: +(* example of use: * let b = laws "unit" (fun x -> reverse [x] = [x]) ig *) @@ -351,7 +352,7 @@ val adjust_pp_with_indent : (unit -> unit) -> unit val adjust_pp_with_indent_and_header : string -> (unit -> unit) -> unit -val mk_str_func_of_assoc_conv: +val mk_str_func_of_assoc_conv: ('a * string) list -> (string -> 'a) * ('a -> string) (*****************************************************************************) @@ -419,24 +420,24 @@ val cache_in_ref : 'a option ref -> (unit -> 'a) -> 'a (* take file from which computation is done, an extension, and the function - * and will compute the function only once and then save result in + * and will compute the function only once and then save result in * file ^ extension *) -val cache_computation : - ?verbose:bool -> ?use_cache:bool -> filename -> string (* extension *) -> +val cache_computation : + ?verbose:bool -> ?use_cache:bool -> filename -> string (* extension *) -> (unit -> 'a) -> 'a -(* a more robust version where the client describes the dependencies of the - * computation so it will relaunch the computation in 'f' if needed. +(* a more robust version where the client describes the dependencies of the + * computation so it will relaunch the computation in 'f' if needed. *) val cache_computation_robust : - filename -> - string (* extension for marshalled object *) -> - (filename list * 'x) -> - string (* extension for marshalled dependencies *) -> - (unit -> 'a) -> + filename -> + string (* extension for marshalled object *) -> + (filename list * 'x) -> + string (* extension for marshalled dependencies *) -> + (unit -> 'a) -> 'a - + val once : ('a -> unit) -> ('a -> unit) @@ -455,7 +456,7 @@ val main_boilerplate : (unit -> unit) -> unit (*****************************************************************************) (* how ensure really atomic file creation ? hehe :) *) -exception FileAlreadyLocked +exception FileAlreadyLocked val acquire_file_lock : filename -> unit val release_file_lock : filename -> unit @@ -481,7 +482,7 @@ val exn_to_s : exn -> string (* alias *) val string_of_exn : exn -> string -type error = Error of string +type error = Error of string type evotype = unit val evoval : evotype @@ -492,7 +493,7 @@ val evoval : evotype val check_stack_size: int -> unit val check_stack_nbfiles: int -> unit - + (* internally common.ml set Gc. parameters *) val _init_gc_stack : unit @@ -508,10 +509,10 @@ type options_with_title = string * string * arg_spec_full list type cmdline_sections = options_with_title list -(* A wrapper around Arg modules that have more logical argument order, +(* A wrapper around Arg modules that have more logical argument order, * and returns the remaining args. *) -val parse_options : +val parse_options : cmdline_options -> Arg.usage_msg -> string array -> string list (* Another wrapper that does Arg.align automatically *) @@ -522,18 +523,18 @@ val usage : Arg.usage_msg -> cmdline_options -> unit (* Work with the options_with_title type way to organize a long * list of command line switches. *) -val short_usage : +val short_usage : Arg.usage_msg -> short_opt:cmdline_options -> unit -val long_usage : - Arg.usage_msg -> short_opt:cmdline_options -> long_opt:cmdline_sections -> +val long_usage : + Arg.usage_msg -> short_opt:cmdline_options -> long_opt:cmdline_sections -> unit (* With the options_with_title way, we don't want the default -help and --help * so need adapter of Arg module, not just wrapper. *) val arg_align2 : cmdline_options -> cmdline_options -val arg_parse2 : - cmdline_options -> Arg.usage_msg -> (unit -> unit) (* short_usage func *) -> +val arg_parse2 : + cmdline_options -> Arg.usage_msg -> (unit -> unit) (* short_usage func *) -> string list @@ -543,7 +544,7 @@ val arg_parse2 : (* The action lib. Useful to debug supart of your system. cf some of * my main.ml for example of use. *) type flag_spec = Arg.key * Arg.spec * Arg.doc -type action_spec = Arg.key * Arg.doc * action_func +type action_spec = Arg.key * Arg.doc * action_func and action_func = (string list -> unit) type cmdline_actions = action_spec list @@ -556,11 +557,11 @@ val mk_action_3_arg : (string -> string -> string -> unit) -> action_func val mk_action_n_arg : (string list -> unit) -> action_func -val options_of_actions: +val options_of_actions: string ref (* the action ref *) -> cmdline_actions -> cmdline_options -val action_list: +val action_list: cmdline_actions -> Arg.key list -val do_action: +val do_action: Arg.key -> string list (* args *) -> cmdline_actions -> unit (*****************************************************************************) @@ -588,7 +589,7 @@ val (=*=): 'a -> 'a -> bool (* if want to restrict the use of '=', uncomment this: * * val (=): unit -> unit -> bool - * + * * But it will not forbid you to use caml functions like List.find, List.mem * which internaly use this convenient but evolution-unfriendly (=) *) @@ -680,7 +681,7 @@ val int_of_all : string -> int val ( += ) : int ref -> int -> unit val ( -= ) : int ref -> int -> unit -val pourcent: int -> int -> int +val pourcent: int -> int -> int val pourcent_float: int -> int -> float val pourcent_float_of_floats: float -> float -> float @@ -688,7 +689,7 @@ val pourcent_good_bad: int -> int -> int val pourcent_good_bad_float: int -> int -> float type 'a max_with_elem = int ref * 'a ref -val update_max_with_elem: +val update_max_with_elem: 'a max_with_elem -> is_better:(int -> int ref -> bool) -> int * 'a -> unit (*****************************************************************************) (* Numeric/overloading *) @@ -708,7 +709,7 @@ val numd_float : float numdict val testd : 'a numdict -> 'a -> 'a -module ArithFloatInfix : sig +module ArithFloatInfix : sig val (+) : float -> float -> float val (-) : float -> float -> float val (/) : float -> float -> float @@ -844,9 +845,9 @@ val showCodeHex : int list -> unit val size_mo_ko : int -> string val size_ko : int -> string -val edit_distance: string -> string -> int +val edit_distance: string -> string -> int -val md5sum_of_string : string -> string +val md5sum_of_string : string -> string (*****************************************************************************) (* Regexp *) @@ -882,7 +883,7 @@ val join : string (* sep *) -> string list -> string val split_list_regexp : string -> string list -> (string * string list) list val all_match : string (* regexp *) -> string -> string list -val global_replace_regexp : +val global_replace_regexp : string (* regexp *) -> (string -> string) -> string -> string val regular_words: string -> string list @@ -909,7 +910,7 @@ val filename_of_db : (string * filename) -> filename val dbe_of_filename : filename -> string * string * string val dbe_of_filename_nodot : filename -> string * string * string (* Left (d,b,e) | Right (d,b) if file has no extension *) -val dbe_of_filename_safe : +val dbe_of_filename_safe : filename -> (string * string * string, string * string) either val filename_of_dbe : string * string * string -> filename @@ -930,7 +931,7 @@ val filename_without_leading_path : string -> filename -> filename (*****************************************************************************) (* i18n *) (*****************************************************************************) -type langage = +type langage = | English | Francais | Deutsch @@ -941,7 +942,7 @@ type langage = (* can also use ocamlcalendar, but heavier, use many modules ... *) -type month = +type month = | Jan | Feb | Mar | Apr | May | Jun | Jul | Aug | Sep | Oct | Nov | Dec type year = Year of int @@ -1092,7 +1093,7 @@ val readdir_to_link_list : string -> string list val readdir_to_dir_size_list : string -> (string * int) list val glob : string -> filename list -val files_of_dir_or_files : +val files_of_dir_or_files : string (* ext *) -> string list -> filename list val files_of_dir_or_files_no_vcs : string (* ext *) -> string list -> filename list @@ -1111,23 +1112,23 @@ val file_perm_of : u:rwx -> g:rwx -> o:rwx -> Unix.file_perm val has_env : string -> bool (* scheme spirit. do a finalize so no leak. *) -val with_open_outfile : +val with_open_outfile : filename -> ((string -> unit) * out_channel -> 'a) -> 'a -val with_open_infile : +val with_open_infile : filename -> (in_channel -> 'a) -> 'a -val with_open_outfile_append : +val with_open_outfile_append : filename -> ((string -> unit) * out_channel -> 'a) -> 'a -val with_open_stringbuf : +val with_open_stringbuf : (((string -> unit) * Buffer.t) -> unit) -> string exception Timeout -(* subtil: have to make sure that Timeout is not intercepted before here. So +(* subtil: have to make sure that Timeout is not intercepted before here. So * avoid exn handler such as try (...) with _ -> cos Timeout will not bubble up - * enough. In such case, add a case before such as - * with Timeout -> raise Timeout | _ -> ... - * + * enough. In such case, add a case before such as + * with Timeout -> raise Timeout | _ -> ... + * * The same is true for UnixExit (see below). *) val timeout_function : int -> (unit -> 'a) -> 'a @@ -1135,8 +1136,8 @@ val timeout_function : int -> (unit -> 'a) -> 'a val timeout_function_opt : int option -> (unit -> 'a) -> 'a -(* creation of /tmp files, a la gcc - * ex: new_temp_file "cocci" ".c" will give "/tmp/cocci-3252-434465.c" +(* creation of /tmp files, a la gcc + * ex: new_temp_file "cocci" ".c" will give "/tmp/cocci-3252-434465.c" *) val _temp_files_created : string list ref (* see flag: val save_tmp_files : bool ref *) @@ -1148,11 +1149,11 @@ val erase_this_temp_file : filename -> unit * exit and do something before exiting. There is exn handler for exit 0 * so better never use exit 0 but instead use an exception and just at * the very toplevel transform this exn in a unix exit code. - * + * * subtil: same problem than with Timeout. Do not intercept such exception * with some blind try (...) with _ -> ... *) -exception UnixExit of int +exception UnixExit of int val exn_to_real_unixexit : (unit -> 'a) -> 'a @@ -1281,7 +1282,7 @@ val exclude : ('a -> bool) -> 'a list -> 'a list * line. Here we delete any repeated line (here list element). *) val uniq : 'a list -> 'a list -val uniq_eff: 'a list -> 'a list +val uniq_eff: 'a list -> 'a list val has_no_duplicate: 'a list -> bool val is_set_as_list: 'a list -> bool @@ -1313,7 +1314,7 @@ val and_list : bool list -> bool val sum_float : float list -> float val sum_int : int list -> int -val avg_list: int list -> float +val avg_list: int list -> float val return_when : ('a -> 'b option) -> 'a list -> 'b @@ -1321,7 +1322,7 @@ val return_when : ('a -> 'b option) -> 'a list -> 'b val grep_with_previous : ('a -> 'a -> bool) -> 'a list -> 'a list val iter_with_previous : ('a -> 'a -> 'b) -> 'a list -> unit -val iter_with_before_after : +val iter_with_before_after : ('a list -> 'a -> 'a list -> unit) -> 'a list -> unit val get_pair : 'a list -> ('a * 'a) list @@ -1360,7 +1361,7 @@ val array_find_index_via_elem : ('a -> bool) -> 'a array -> int (* for better type checking, as sometimes when have an 'int array', can * easily mess up the index from the value. *) -type idx = Idx of int +type idx = Idx of int val next_idx: idx -> idx val int_of_idx: idx -> int @@ -1374,13 +1375,13 @@ type 'a matrix = 'a array array val map_matrix : ('a -> 'b) -> 'a matrix -> 'b matrix -val make_matrix_init: +val make_matrix_init: nrow:int -> ncolumn:int -> (int -> int -> 'a) -> 'a matrix -val iter_matrix: +val iter_matrix: (int -> int -> 'a -> unit) -> 'a matrix -> unit -val nb_rows_matrix: 'a matrix -> int +val nb_rows_matrix: 'a matrix -> int val nb_columns_matrix: 'a matrix -> int val rows_of_matrix: 'a matrix -> 'a list list @@ -1451,19 +1452,19 @@ val ( $@$ ) : 'a list -> 'a list -> 'a list val nub : 'a list -> 'a list -(* use internally a hash and return - * - the common part, - * - part only in a, +(* use internally a hash and return + * - the common part, + * - part only in a, * - part only in b *) -val diff_two_say_set_eff : 'a list -> 'a list -> +val diff_two_say_set_eff : 'a list -> 'a list -> 'a list * 'a list * 'a list (*****************************************************************************) (* Set as normal list *) (*****************************************************************************) -(* cf above *) +(* cf above *) (*****************************************************************************) (* Set as sorted list *) @@ -1474,10 +1475,10 @@ val diff_two_say_set_eff : 'a list -> 'a list -> (* Sets specialized *) (*****************************************************************************) -(* +(* module StringSet = Set.Make(struct type t = string let compare = compare end) *) - + (*****************************************************************************) (* Assoc. But have a look too at Mapb.mli; it's better. Or use Hashtbl. *) @@ -1574,8 +1575,8 @@ val intintmap_string_of_t : 'a -> 'b -> string (* Note that Hashtbl keep old binding to a key so if want a hash * of a list, then can use the Hashtbl as is. Use Hashtbl.find_all then * to get the list of bindings - * - * Note that Hashtbl module use different convention :( the object is + * + * Note that Hashtbl module use different convention :( the object is * the first argument, not last as for List or Map. *) @@ -1592,7 +1593,7 @@ val hremove : 'a -> ('a, 'b) Hashtbl.t -> unit val hfind_default : 'a -> (unit -> 'b) -> ('a, 'b) Hashtbl.t -> 'b val hfind_option : 'a -> ('a, 'b) Hashtbl.t -> 'b option -val hupdate_default : +val hupdate_default : 'a -> ('b -> 'b) -> (unit -> 'b) -> ('a, 'b) Hashtbl.t -> unit val hash_to_list : ('a, 'b) Hashtbl.t -> ('a * 'b) list @@ -1600,19 +1601,19 @@ val hash_to_list_unsorted : ('a, 'b) Hashtbl.t -> ('a * 'b) list val hash_of_list : ('a * 'b) list -> ('a, 'b) Hashtbl.t -val hkeys : ('a, 'b) Hashtbl.t -> 'a list +val hkeys : ('a, 'b) Hashtbl.t -> 'a list (*****************************************************************************) (* Hash sets *) (*****************************************************************************) -type 'a hashset = ('a, bool) Hashtbl.t +type 'a hashset = ('a, bool) Hashtbl.t (* common use of hashset, in a hash of hash *) val hash_hashset_add : 'a -> 'b -> ('a, 'b hashset) Hashtbl.t -> unit -val hashset_to_set : +val hashset_to_set : < fromlist : ('a ) list -> 'c; .. > -> ('a, 'b) Hashtbl.t -> 'c val hashset_to_list : 'a hashset -> 'a list @@ -1669,21 +1670,21 @@ val tree_iter : ('a -> unit) -> 'a tree -> unit (*****************************************************************************) (* no empty tree, must have one root at least *) -type 'a treeref = - | NodeRef of 'a * 'a treeref list ref +type 'a treeref = + | NodeRef of 'a * 'a treeref list ref -val treeref_node_iter: +val treeref_node_iter: (('a * 'a treeref list ref) -> unit) -> 'a treeref -> unit -val treeref_node_iter_with_parents: - (('a * 'a treeref list ref) -> ('a list) -> unit) -> +val treeref_node_iter_with_parents: + (('a * 'a treeref list ref) -> ('a list) -> unit) -> 'a treeref -> unit -val find_treeref: - (('a * 'a treeref list ref) -> bool) -> +val find_treeref: + (('a * 'a treeref list ref) -> bool) -> 'a treeref -> 'a treeref -val treeref_children_ref: - 'a treeref -> 'a treeref list ref +val treeref_children_ref: + 'a treeref -> 'a treeref list ref val find_treeref_with_parents_some: ('a * 'a treeref list ref -> 'a list -> 'c option) -> @@ -1694,29 +1695,29 @@ val find_multi_treeref_with_parents_some: 'a treeref -> 'c list -(* Leaf can seem redundant, but sometimes want to directly see if +(* Leaf can seem redundant, but sometimes want to directly see if * a children is a leaf without looking if the list is empty. *) -type ('a, 'b) treeref2 = - | NodeRef2 of 'a * ('a, 'b) treeref2 list ref +type ('a, 'b) treeref2 = + | NodeRef2 of 'a * ('a, 'b) treeref2 list ref | LeafRef2 of 'b -val find_treeref2: - (('a * ('a, 'b) treeref2 list ref) -> bool) -> +val find_treeref2: + (('a * ('a, 'b) treeref2 list ref) -> bool) -> ('a, 'b) treeref2 -> ('a, 'b) treeref2 -val treeref_node_iter_with_parents2: - (('a * ('a, 'b) treeref2 list ref) -> ('a list) -> unit) -> +val treeref_node_iter_with_parents2: + (('a * ('a, 'b) treeref2 list ref) -> ('a list) -> unit) -> ('a, 'b) treeref2 -> unit -val treeref_node_iter2: +val treeref_node_iter2: (('a * ('a, 'b) treeref2 list ref) -> unit) -> ('a, 'b) treeref2 -> unit (* -val treeref_children_ref: ('a, 'b) treeref -> ('a, 'b) treeref list ref +val treeref_children_ref: ('a, 'b) treeref -> ('a, 'b) treeref list ref val find_treeref_with_parents_some: ('a * ('a, 'b) treeref list ref -> 'a list -> 'c option) -> @@ -1872,13 +1873,13 @@ val getDoubleParser : (* Currently lexing.ml does not handle the line number position. - * Even if there is some fields in the lexing structure, they are not + * Even if there is some fields in the lexing structure, they are not * maintained by the lexing engine :( So the following code does not work: - * - * let pos = Lexing.lexeme_end_p lexbuf in - * sprintf "at file %s, line %d, char %d" pos.pos_fname pos.pos_lnum - * (pos.pos_cnum - pos.pos_bol) in - * + * + * let pos = Lexing.lexeme_end_p lexbuf in + * sprintf "at file %s, line %d, char %d" pos.pos_fname pos.pos_lnum + * (pos.pos_cnum - pos.pos_bol) in + * * Hence those functions to overcome the previous limitation. *) @@ -1889,7 +1890,7 @@ type parse_info = { line: int; column: int; file: filename; - } + } val fake_parse_info : parse_info val string_of_parse_info : parse_info -> string val string_of_parse_info_bis : parse_info -> string @@ -1899,13 +1900,13 @@ val full_charpos_to_pos : filename -> (int * int) array (* fill in the line and column field of parse_info that were not set * during lexing because of limitations of ocamllex. *) -val complete_parse_info : +val complete_parse_info : filename -> (int * int) array -> parse_info -> parse_info -val full_charpos_to_pos_large: +val full_charpos_to_pos_large: filename -> (int -> (int * int)) -val complete_parse_info_large : +val complete_parse_info_large : filename -> (int -> (int * int)) -> parse_info -> parse_info (* return line x col x str_line from a charpos. This function is quite @@ -1917,7 +1918,7 @@ val info_from_charpos : int -> filename -> (int * int * string) val error_message : filename -> (string * int) -> string val error_message_short : filename -> (string * int) -> string -(* add a 'decalage/shift' argument to handle stuff such as cpp which includes +(* add a 'decalage/shift' argument to handle stuff such as cpp which includes * files and who can make shift. *) val error_messagebis : filename -> (string * int) -> int -> string @@ -1936,7 +1937,7 @@ val new_scope : ('a, 'b) scoped_env ref -> unit val del_scope : ('a, 'b) scoped_env ref -> unit val do_in_new_scope : ('a, 'b) scoped_env ref -> (unit -> unit) -> unit - + val add_in_scope : ('a, 'b) scoped_env ref -> 'a * 'b -> unit @@ -1967,8 +1968,8 @@ val add_in_scope_h : ('a, 'b) scoped_h_env ref -> 'a * 'b -> unit (* don't forget to call Common_extra.set_link () *) val _execute_and_show_progress_func : - (int (* length *) -> ((unit -> unit) -> unit) -> unit) ref -val execute_and_show_progress : + (int (* length *) -> ((unit -> unit) -> unit) -> unit) ref +val execute_and_show_progress : int (* length *) -> ((unit -> unit) -> unit) -> unit (*****************************************************************************) diff --git a/commons/common_extra.ml b/commons/common_extra.ml index 8091494..e289793 100644 --- a/commons/common_extra.ml +++ b/commons/common_extra.ml @@ -3,8 +3,8 @@ * make ocaml script that just do a load common.ml without the need * to load many other files (like dumper.ml, or ANSITerminal.ml and * other recursive dependencies). - * - * Note that you can still use the functions below from an open Common. + * + * Note that you can still use the functions below from an open Common. * You don't need to do a 'open Common_extra'; loading the commons.cma is * enough to make the connexions. *) @@ -12,34 +12,34 @@ (* how to use it ? ex in LFS: * Common.execute_and_show_progress (w.prop_iprop#length) (fun k -> - * w.prop_iprop#iter (fun (p, ip) -> + * w.prop_iprop#iter (fun (p, ip) -> * k (); * ... * )); - * + * *) -let execute_and_show_progress len f = +let execute_and_show_progress len f = let _count = ref 0 in (* kind of continuation passed to f *) - let continue_pourcentage () = + let continue_pourcentage () = incr _count; ANSITerminal.set_cursor 1 (-1); ANSITerminal.printf [] "%d / %d" !_count len; flush stdout; in - let nothing () = () in + let nothing () = () in ANSITerminal.printf [] "0 / %d" len; flush stdout; - if !Common._batch_mode + if !Common._batch_mode then f nothing else f continue_pourcentage ; Common.pr2 "" -let set_link () = +let set_link () = Common._execute_and_show_progress_func := execute_and_show_progress -let _init_execute = +let _init_execute = set_link () diff --git a/commons/copyright.txt b/commons/copyright.txt index 87f67b9..48e9da3 100644 --- a/commons/copyright.txt +++ b/commons/copyright.txt @@ -1,3 +1,4 @@ +Copyright (C) 2010 INRIA, University of Copenhagen DIKU Copyright (C) 1998-2009 Yoann Padioleau This library is free software; you can redistribute it and/or diff --git a/commons/glimpse.ml b/commons/glimpse.ml index 6c7d60a..232ad83 100644 --- a/commons/glimpse.ml +++ b/commons/glimpse.ml @@ -5,19 +5,19 @@ open Common (*****************************************************************************) (* was first used for LFS, then a little for cocci, and then for aComment *) -type glimpse_search = +type glimpse_search = (* -i insensitive search *) | GlimpseCaseInsensitive - (* -w match on complete words. But not always good idea, for instance - * if file contain chazarain_j then dont work with -w + (* -w match on complete words. But not always good idea, for instance + * if file contain chazarain_j then dont work with -w *) | GlimpseWholeWord -let default_glimpse_search = [GlimpseWholeWord] +let default_glimpse_search = [GlimpseWholeWord] let s_of_glimpse_search = function | GlimpseCaseInsensitive -> "-i" - | GlimpseWholeWord -> "-w" + | GlimpseWholeWord -> "-w" type glimpsedir = Common.dirname @@ -26,8 +26,8 @@ type glimpsedir = Common.dirname (* Helpers *) (*****************************************************************************) -let check_have_glimpse () = - let xs = +let check_have_glimpse () = + let xs = Common.cmd_to_list ("glimpse -V") +> Common.exclude Common.null_string in (match xs with | ["This is glimpse version 4.18.2, 2006."] -> () @@ -35,7 +35,7 @@ let check_have_glimpse () = | _ -> failwith "glimpse not found or bad version" ) -let s_of_glimpse_options xs = +let s_of_glimpse_options xs = xs +> List.map s_of_glimpse_search +> Common.join " " @@ -43,57 +43,57 @@ let s_of_glimpse_options xs = (* Indexing *) (*****************************************************************************) -(* +(* * note: - * - -o or -b for glimpseindex => bigger index, faster search - * - no need to use -b with our way to use glimpse - * cos we use -l so dont need to know what is the place of the word + * - -o or -b for glimpseindex => bigger index, faster search + * - no need to use -b with our way to use glimpse + * cos we use -l so dont need to know what is the place of the word * in the file - * - -f is for incremental indexing. Handle when files are deleted ? + * - -f is for incremental indexing. Handle when files are deleted ? * I think that not that bad cos yes certainly in the index there will * have some no-more-valid pointers, but as glimpse actually then do * a real search on the file, he will see that dont exist anymore and - * so using -f is slower but very very little slower + * so using -f is slower but very very little slower * - for -z the order is important in .glimpse_filters => put - * the case of compressed file first + * the case of compressed file first * - -F receive the list of files to index from stdin * - -H target index dir * - -n for indexing numbers as sometimes some glimpse request are looking * for a number - * - * - * Note que glimpseindex index pas forcement tous les fichiers texte. - * Si le fichier texte est trop petit, contient par exemple un seul mot, - * alors il l'indexe pas. Si veut indexer quand meme, il faudrait ajouter + * + * + * Note que glimpseindex index pas forcement tous les fichiers texte. + * Si le fichier texte est trop petit, contient par exemple un seul mot, + * alors il l'indexe pas. Si veut indexer quand meme, il faudrait ajouter * l'option -E - * + * * command2 "echo '*_backup' > glimpse/.glimpse_exclude"; * command2 "echo '*_backup,v' >> glimpse/.glimpse_exclude"; - * - * ex: glimpseindex -o -H . home - * + * + * ex: glimpseindex -o -H . home + * *) let glimpse_cmd s = spf "glimpseindex -o -H %s -n -F" s -let glimpseindex ext dir indexdir = +let glimpseindex ext dir indexdir = check_have_glimpse (); Common.command2(spf "mkdir -p %s" indexdir); - Common.command2 + Common.command2 (spf "find %s -name \"*.%s\" | %s" dir ext (glimpse_cmd indexdir) ); () -let glimpseindex_files files indexdir = +let glimpseindex_files files indexdir = check_have_glimpse (); Common.command2(spf "mkdir -p %s" indexdir); let tmpfile = Common.new_temp_file "glimpse" "list" in (* "/tmp/pad_glimpseindex_files.list" *) - + Common.uncat files tmpfile; - Common.command2 + Common.command2 (spf "cat %s | %s" tmpfile (glimpse_cmd indexdir)); () @@ -105,38 +105,38 @@ let glimpseindex_files files indexdir = (* note: * - -y dont ask for prompt - * - -N allow far faster search as it does not actually search the file + * - -N allow far faster search as it does not actually search the file * => when pdf/ps files no filtering done of them => far faster. - * the -N fait pas un grep, donc si file deteled ou modified entre temps, + * the -N fait pas un grep, donc si file deteled ou modified entre temps, * bah il le voit pas. Ca veut dire aussi que si y'a pas -N, et bien * glimpse fait des grep si le fichier a ete modifié entre temps pour - * toujours filer quelque chose de valide (pas de false positive, mais + * toujours filer quelque chose de valide (pas de false positive, mais * y'a quand meme peut etre des miss). Est ce qu'il utilise la date du * fichier pour eviter de faire des grep inutile ? - * the -N can actually return wrong result. cos a file may + * the -N can actually return wrong result. cos a file may * contain "peter norvig" - * => better to not use -N at first - * + * => better to not use -N at first + * * - -N also just show the filename on output * - -l show just the filename too, but the files are still searched so * at least no false positives. - * - if use -z for glimpseindex, dont forget the -z too for glimpse + * - if use -z for glimpseindex, dont forget the -z too for glimpse * - -W for boolean and queries to not be done on line level but file level - * + * * query langage: good;bad for conjunction. good,bad for disjunction. - * + * * ex: glimpse -y -H . -N -W -w pattern;pattern2 - * + * *) -let glimpse query ?(options=default_glimpse_search) dir = +let glimpse query ?(options=default_glimpse_search) dir = let str_options = s_of_glimpse_options options in - let res = - Common.cmd_to_list + let res = + Common.cmd_to_list (spf "glimpse -y -H %s -N -W %s '%s'" dir str_options query) in res (* grep -i -l -I *) -let grep query = +let grep query = raise Todo diff --git a/commons/interfaces.ml b/commons/interfaces.ml index bbef599..e197ffc 100644 --- a/commons/interfaces.ml +++ b/commons/interfaces.ml @@ -5,34 +5,34 @@ open Common.BasicType (*****************************************************************************) (* * Use this not so much for functors, I hate functors, but - * more to force me to have consistent naming of stuff. - * + * more to force me to have consistent naming of stuff. + * * It's related to objet.ml in some way, but use a different scheme. - * - * src: (strongly) inspired by Jane Street core lib, which in turn + * + * src: (strongly) inspired by Jane Street core lib, which in turn * may have been strongly inspired by Java Interfaces or Haskell * TypeClass. - * - * - * + * + * + * * Example of use in .mli: - * + * * open Interfaces * include Stringable with type stringable = t * include Comparable with type comparable = t - * + * * Example of use in .ml: - * + * * type xxx * type stringable = xxx * let of_string = bool_of_string * let to_string = string_of_bool - * - * + * + * * No this file is not about (graphical) user interface. See gui.ml for that. - * - * - * todo? but as in type class, or object, can not have default method + * + * + * todo? but as in type class, or object, can not have default method * with this scheme ? *) @@ -45,11 +45,11 @@ open Common.BasicType (* note: less need for cloneable, copyable as in Java. Only needed * when use ref, but refs should be avoided anyway so better not to * encourage it. - * + * * Often found this in haskell: - * + * * data x = ... deriving (Read, Show, Eq, Ord, Enum, Bounded) - * + * * Apparently this is what is considered basic by haskell. *) @@ -72,7 +72,7 @@ end -(* Same, should not use compare normally, dangerous when evolve code. +(* Same, should not use compare normally, dangerous when evolve code. * Called Ord in haskell. Inherit Eq normally. *) module type Compare_able = sig @@ -82,7 +82,7 @@ end (* Jane street have also some binable, sexpable *) -(* Haskell have lots of related type class after Num such as +(* Haskell have lots of related type class after Num such as * Real, Fractional, Integral, RealFrac, Floating, RealFloat *) module type Num_able = sig @@ -167,17 +167,17 @@ end (*****************************************************************************) (* Idea taken from Jane Street Core library, slightly changed. - * - * It's another way to organize data structures, module instead of objects. - * It's also the Java way. - * + * + * It's another way to organize data structures, module instead of objects. + * It's also the Java way. + * * It makes some code looks a little bit like Haskell* typeclass. - * + * *) (* In Jane Street they put each interface in its own file but then have to * do that: - * + * * module type Stringable = Stringable.S * module type Comparable = Comparable.S * module type Floatable = Floatable.S @@ -188,7 +188,7 @@ end * module type Setable = Setable.S * module type Sexpable = Sexpable.S * module type Binable = Binable.S - * + * * And I dont like having too much files, especially as all those xxable * end with able, not start, so don't see them together in the directory. *) diff --git a/commons/oarray.ml b/commons/oarray.ml index ac421e8..1d3432f 100644 --- a/commons/oarray.ml +++ b/commons/oarray.ml @@ -2,28 +2,28 @@ open Common open Osequence -(* growing array ? initialise with None, - * and generate exception when not defined or have an arraydefault +(* growing array ? initialise with None, + * and generate exception when not defined or have an arraydefault * update: can use dynArray ? *) (* !!take care!!, this is not a pure data structure *) -class ['a] oarray n el = +class ['a] oarray n el = object(o: 'o) inherit ['a] osequence val data = Array.make n el method empty = raise Todo - method add (i,v) = - Array.set data i v; + method add (i,v) = + Array.set data i v; o - method iter f = + method iter f = Array.iteri (curry f) data method view = raise Todo - method assoc i = + method assoc i = Array.get data i method null = raise Todo @@ -33,14 +33,14 @@ object(o: 'o) method first = raise Todo method delkey = raise Todo - method keys = raise Todo + method keys = raise Todo method del = raise Todo method fromlist = raise Todo - method length = + method length = Array.length data - (* method create: int -> 'a -> 'o = + (* method create: int -> 'a -> 'o = raise Todo *) (* method put: make more explicit the fact that array do side effect *) diff --git a/commons/oassoc.ml b/commons/oassoc.ml index 7aa9f13..773c5c0 100644 --- a/commons/oassoc.ml +++ b/commons/oassoc.ml @@ -3,54 +3,54 @@ open Common open Ocollection (* assoc, also called map or dictionnary *) -class virtual ['a,'b] oassoc = +class virtual ['a,'b] oassoc = object(o: 'o) inherit ['a * 'b] ocollection - + method virtual assoc: 'a -> 'b method virtual delkey: 'a -> 'o - + (* pre: must be in *) - method replkey: ('a * 'b) -> 'o = - fun (k,v) -> o#add (k,v) + method replkey: ('a * 'b) -> 'o = + fun (k,v) -> o#add (k,v) (* pre: must not be in *) (* method add: ('a * 'b) -> 'o = *) (* - method keys = + method keys = List.map fst (o#tolist) *) method virtual keys: 'a list (* or 'a oset ? *) - method find: 'a -> 'b = fun k -> + method find: 'a -> 'b = fun k -> o#assoc k - method find_opt: 'a -> 'b option = fun k -> - try + method find_opt: 'a -> 'b option = fun k -> + try let res = o#assoc k in Some res with Not_found -> None - method haskey: 'a -> bool = fun k -> - try (ignore(o#assoc k); true) + method haskey: 'a -> bool = fun k -> + try (ignore(o#assoc k); true) with Not_found -> false - - method apply: 'a -> ('b -> 'b) -> 'o = fun k f -> - let old = o#assoc k in + + method apply: 'a -> ('b -> 'b) -> 'o = fun k f -> + let old = o#assoc k in o#replkey (k, f old) (* apply default, assoc_default, take in class parameters a default value *) - method apply_with_default: 'a -> ('b -> 'b) -> (unit -> 'b) -> 'o = - fun k f default -> - let old = + method apply_with_default: 'a -> ('b -> 'b) -> (unit -> 'b) -> 'o = + fun k f default -> + let old = try o#assoc k with Not_found -> default () in o#replkey (k, f old) - method apply_with_default2 = fun k f default -> + method apply_with_default2 = fun k f default -> o#apply_with_default k f default +> ignore - + end diff --git a/commons/objet.ml b/commons/objet.ml index 273b0f4..447cc89 100644 --- a/commons/objet.ml +++ b/commons/objet.ml @@ -1,29 +1,29 @@ open Common (* TypeClass via objects. Cf also now interfaces.ml - * + * * todo? get more inspiration from Java to put fundamental interfaces * here ? such as cloneable, equaable, showable, debugable, etc *) class virtual objet = object(o:'o) - method invariant: unit -> unit = fun () -> + method invariant: unit -> unit = fun () -> raise Todo - (* method check: unit -> unit = fun () -> + (* method check: unit -> unit = fun () -> assert(o#invariant()); *) - method of_string: string -> unit = + method of_string: string -> unit = raise Todo - method to_string: unit -> string = + method to_string: unit -> string = raise Todo - method debug: unit -> unit = + method debug: unit -> unit = raise Todo - method misc_op_hook: unit -> 'o = + method misc_op_hook: unit -> 'o = raise Todo - method misc_op_hook2: unit = + method misc_op_hook2: unit = () end diff --git a/commons/ocamlextra/dumper.ml b/commons/ocamlextra/dumper.ml index 1540da0..32491bc 100644 --- a/commons/ocamlextra/dumper.ml +++ b/commons/ocamlextra/dumper.ml @@ -1,6 +1,6 @@ (* Dump an OCaml value into a printable string. * By Richard W.M. Jones (rich@annexia.org). - * dumper.ml 1.2 2005/02/06 12:38:21 rich Exp + * dumper.ml 1.2 2005/02/06 12:38:21 rich Exp *) open Printf diff --git a/commons/ocamlextra/dumper.mli b/commons/ocamlextra/dumper.mli index d74853b..0f80e10 100644 --- a/commons/ocamlextra/dumper.mli +++ b/commons/ocamlextra/dumper.mli @@ -1,6 +1,6 @@ (* Dump an OCaml value into a printable string. * By Richard W.M. Jones (rich@annexia.org). - * dumper.mli 1.1 2005/02/03 23:07:47 rich Exp + * dumper.mli 1.1 2005/02/03 23:07:47 rich Exp *) val dump : 'a -> string diff --git a/commons/ocamlextra/mapb.ml b/commons/ocamlextra/mapb.ml index 5bd1ea7..5592d73 100644 --- a/commons/ocamlextra/mapb.ml +++ b/commons/ocamlextra/mapb.ml @@ -23,7 +23,7 @@ Empty | Node of 'a t * key * 'a * 'a t * int *) - type ('key, 'v) t = + type ('key, 'v) t = Empty | Node of ('key, 'v) t * 'key * 'v * ('key, 'v) t * int diff --git a/commons/ocamlextra/setPt.ml b/commons/ocamlextra/setPt.ml index 3df6944..1b9c016 100644 --- a/commons/ocamlextra/setPt.ml +++ b/commons/ocamlextra/setPt.ml @@ -1,15 +1,15 @@ (* * Ptset: Sets of integers implemented as Patricia trees. * Copyright (C) 2000 Jean-Christophe FILLIATRE - * + * * This software is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License version 2, as published by the Free Software Foundation. - * + * * This software is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. - * + * * See the GNU Library General Public License version 2 for more details * (enclosed in the file LGPL). *) @@ -50,7 +50,7 @@ type t = $$\mathtt{Branch~(0,~1,~Leaf~4,~Branch~(1,~4,~Leaf~1,~Leaf~5))}$$ The first branching bit is the bit 0 (and the corresponding prefix is [0b0], not of use here), with $\{4\}$ on the left and $\{1,5\}$ on the - right. Then the right subtree branches on bit 2 (and so has a branching + right. Then the right subtree branches on bit 2 (and so has a branching value of $2^2 = 4$), with prefix [0b01 = 1]. *) (*s Empty set and singletons. *) @@ -90,9 +90,9 @@ let mask p m = p land (m-1) let join (p0,t0,p1,t1) = let m = branching_bit p0 p1 in - if zero_bit p0 m then + if zero_bit p0 m then Branch (mask p0 m, m, t0, t1) - else + else Branch (mask p0 m, m, t1, t0) (*s Then the insertion of value [k] in set [t] is easily implemented @@ -108,11 +108,11 @@ let match_prefix k p m = (mask k m) == p let add k t = let rec ins = function | Empty -> Leaf k - | Leaf j as t -> + | Leaf j as t -> if j == k then t else join (k, Leaf k, j, t) | Branch (p,m,t0,t1) as t -> if match_prefix k p m then - if zero_bit k m then + if zero_bit k m then Branch (p, m, ins t0, t1) else Branch (p, m, t0, ins t1) @@ -123,7 +123,7 @@ let add k t = (*s The code to remove an element is basically similar to the code of insertion. But since we have to maintain the invariant that both - subtrees of a [Branch] node are non-empty, we use here the + subtrees of a [Branch] node are non-empty, we use here the ``smart constructor'' [branch] instead of [Branch]. *) let branch = function @@ -135,7 +135,7 @@ let remove k t = let rec rmv = function | Empty -> Empty | Leaf j as t -> if k == j then Empty else t - | Branch (p,m,t0,t1) as t -> + | Branch (p,m,t0,t1) as t -> if match_prefix k p m then if zero_bit k m then branch (p, m, rmv t0, t1) @@ -166,9 +166,9 @@ let rec merge = function Branch (p, m, merge (s0,t0), merge (s1,t1)) else if m < n && match_prefix q p m then (* [q] contains [p]. Merge [t] with a subtree of [s]. *) - if zero_bit q m then + if zero_bit q m then Branch (p, m, merge (s0,t), s1) - else + else Branch (p, m, s0, merge (s1,t)) else if m > n && match_prefix p q n then (* [p] contains [q]. Merge [s] with a subtree of [t]. *) @@ -196,9 +196,9 @@ let rec subset s1 s2 = match (s1,s2) with if m1 == m2 && p1 == p2 then subset l1 l2 && subset r1 r2 else if m1 > m2 && match_prefix p1 p2 m2 then - if zero_bit p1 m2 then + if zero_bit p1 m2 then subset l1 l2 && subset r1 l2 - else + else subset l1 r2 && subset r1 r2 else false @@ -213,7 +213,7 @@ let rec inter s1 s2 = match (s1,s2) with | Leaf k1, _ -> if mem k1 s2 then s1 else Empty | _, Leaf k2 -> if mem k2 s1 then s2 else Empty | Branch (p1,m1,l1,r1), Branch (p2,m2,l2,r2) -> - if m1 == m2 && p1 == p2 then + if m1 == m2 && p1 == p2 then merge (inter l1 l2, inter r1 r2) else if m1 < m2 && match_prefix p2 p1 m1 then inter (if zero_bit p2 m1 then l1 else r1) s2 @@ -231,9 +231,9 @@ let rec diff s1 s2 = match (s1,s2) with if m1 == m2 && p1 == p2 then merge (diff l1 l2, diff r1 r2) else if m1 < m2 && match_prefix p2 p1 m1 then - if zero_bit p2 m1 then - merge (diff l1 s2, r1) - else + if zero_bit p2 m1 then + merge (diff l1 s2, r1) + else merge (l1, diff r1 s2) else if m1 > m2 && match_prefix p1 p2 m2 then if zero_bit p1 m2 then diff s1 l2 else diff s1 r2 @@ -253,7 +253,7 @@ let rec iter f = function | Empty -> () | Leaf k -> f k | Branch (_,_,t0,t1) -> iter f t0; iter f t1 - + let rec fold f s accu = match s with | Empty -> accu | Leaf k -> f k accu @@ -269,7 +269,7 @@ let rec exists p = function | Leaf k -> p k | Branch (_,_,t0,t1) -> exists p t0 || exists p t1 -let filter p s = +let filter p s = let rec filt acc = function | Empty -> acc | Leaf k -> if p k then add k acc else acc diff --git a/commons/ocamlextra/setb.mli b/commons/ocamlextra/setb.mli index b59c8d9..0bd6a65 100644 --- a/commons/ocamlextra/setb.mli +++ b/commons/ocamlextra/setb.mli @@ -22,10 +22,10 @@ are purely applicative (no side-effects). The implementation uses balanced binary trees, and is therefore reasonably efficient: insertion and membership take time - logarithmic in the size of the set, for instance. + logarithmic in the size of the set, for instance. *) (* pad: -module type OrderedType = +module type OrderedType = sig type t (** The type of the set elements. *) @@ -107,7 +107,7 @@ module type S = val exists: ('elt -> bool) -> 'elt t -> bool (** [exists p s] checks if at least one element of the set satisfies the predicate [p]. *) - + val filter: ('elt -> bool) -> 'elt t -> 'elt t (** [filter p s] returns the set of all elements in [s] that satisfy predicate [p]. *) diff --git a/commons/ocamlextra/suffix_tree.ml b/commons/ocamlextra/suffix_tree.ml index 5c606ce..0635d05 100644 --- a/commons/ocamlextra/suffix_tree.ml +++ b/commons/ocamlextra/suffix_tree.ml @@ -137,7 +137,7 @@ let add_link root pred_opt explicit = | Some n -> (*if n.link = None then*) n.link <- explicit | None -> () -(* ------------ +(* ------------ suffix links ------------ *) @@ -259,7 +259,7 @@ and implicit_node_aux (seqar,node) implicit = if !a < l then raise Not_found else implicit_node_aux (seqar,child) (subseq_sub implicit !a (w - !a)) - else (node,implicit,child) + else (node,implicit,child) (* let rec synthesized (seqar,root : t) (f : 'a list -> node -> 'a) = @@ -311,7 +311,7 @@ let exact_matches : t -> string -> (int * int) list = -let contained_string gst word = +let contained_string gst word = List.map (fun (i,j) -> Array.get (fst gst) i) (exact_matches gst word) diff --git a/commons/ocamlextra/suffix_tree.mli b/commons/ocamlextra/suffix_tree.mli index 545cccd..6c39e26 100644 --- a/commons/ocamlextra/suffix_tree.mli +++ b/commons/ocamlextra/suffix_tree.mli @@ -71,7 +71,7 @@ val fold_node : t -> ('h -> node -> bool) -> ('h -> node -> 'h) -> ('s list -> ' (** Same as [fold], except the computation starts and finishes at the last argument node. *) val fold_s : t -> ('s list -> node -> 's) -> 's - (** [fold_s gst synth] is equivalent to [fold gst filter herit synth init], where there is no filtering, and + (** [fold_s gst synth] is equivalent to [fold gst filter herit synth init], where there is no filtering, and no inherited values: purely synthetic. *) val fold_s_node : t -> ('s list -> node -> 's) -> node -> 's diff --git a/commons/ocamlextra/suffix_tree_ext.ml b/commons/ocamlextra/suffix_tree_ext.ml index fd5b8c8..4a363ad 100644 --- a/commons/ocamlextra/suffix_tree_ext.ml +++ b/commons/ocamlextra/suffix_tree_ext.ml @@ -137,7 +137,7 @@ let add_link root pred_opt explicit = | Some n -> (*if n.link = None then*) n.link <- explicit | None -> () -(* ------------ +(* ------------ suffix links ------------ *) @@ -218,8 +218,8 @@ let make : string list -> t = st -let add (s: string) (seqar,root : t) = - let k = DynArray.length seqar in +let add (s: string) (seqar,root : t) = + let k = DynArray.length seqar in DynArray.add seqar s; let st = (seqar, root) in let seq = s in @@ -276,7 +276,7 @@ and implicit_node_aux (seqar,node) implicit = if !a < l then raise Not_found else implicit_node_aux (seqar,child) (subseq_sub implicit !a (w - !a)) - else (node,implicit,child) + else (node,implicit,child) (* let rec synthesized (seqar,root : t) (f : 'a list -> node -> 'a) = @@ -328,7 +328,7 @@ let exact_matches : t -> string -> (int * int) list = -let contained_string gst word = +let contained_string gst word = List.map (fun (i,j) -> DynArray.get (fst gst) i) (exact_matches gst word) diff --git a/commons/ocamlextra/suffix_tree_ext.mli b/commons/ocamlextra/suffix_tree_ext.mli index 0185d92..6029608 100644 --- a/commons/ocamlextra/suffix_tree_ext.mli +++ b/commons/ocamlextra/suffix_tree_ext.mli @@ -8,7 +8,7 @@ Node-based accesses are provided (sequences, root, children, suffix links, node labels, index), as well as a functional for synthesizing attributes from a GST. A readable representation of GSTs is derived from the later. - + *) (* made by Sebastien Ferre *) @@ -79,7 +79,7 @@ val fold_node : t -> ('h -> node -> bool) -> ('h -> node -> 'h) -> ('s list -> ' (** Same as [fold], except the computation starts and finishes at the last argument node. *) val fold_s : t -> ('s list -> node -> 's) -> 's - (** [fold_s gst synth] is equivalent to [fold gst filter herit synth init], where there is no filtering, and + (** [fold_s gst synth] is equivalent to [fold gst filter herit synth init], where there is no filtering, and no inherited values: purely synthetic. *) val fold_s_node : t -> ('s list -> node -> 's) -> node -> 's diff --git a/commons/ocollection.ml b/commons/ocollection.ml index e6b2a3d..3fa2dcc 100644 --- a/commons/ocollection.ml +++ b/commons/ocollection.ml @@ -3,59 +3,59 @@ open Common (*****************************************************************************) (* Collection *) (*****************************************************************************) -(* +(* * The derived classes of collections: - * - sequence(next, nth): array, list, stack, queue, and mixed + * - sequence(next, nth): array, list, stack, queue, and mixed * (fast cons, fast snoc, fast append, cf okasaki) - * - set(union): setl, setb, seti, seth + * - set(union): setl, setb, seti, seth * - assoc(find): assocl, mapb, hash, btree, multimap (mais bof, can do * with map of set) * - graph: graph1way, graph2way, graphref, graphmatrix? - * + * * Some features/notes: * - views a la wadler to make it cool (I hate get/set). * - take list in parameters to be able to construct value as is easily * - take the comparaison function in parameters (=> functorial set made cool) - * make l [], h [], ... as in perl, and pass the func from pervasive + * make l [], h [], ... as in perl, and pass the func from pervasive * in oo form (list, ...) * - pure/impure: could put 2 interface, with one that show that inpure * by making the operation return unit, but simpler to have one interface. * - the core method and default method (via virtual classes) * better to use virtual than typeclass, virtual play both roles: * an interface and default code - * + * * - pb binary methods: use tosetb tricks, or via (not safe) Obj.magic. * - array/list are both a sequence _and_ a dictionnary, so are both * a collection(a) and a collection(i,a) at the same time. But cant do that. - * So for array, I see it mainly as an assoc => favor assoc, and + * So for array, I see it mainly as an assoc => favor assoc, and * for list, I see it mainly as a collection => favor collection - * - * ??mixins: comparable, iterator, via virtual class in ocaml - * ?? kind of haskell class + default value - * - * ?? persistence, caching, peut prendre en param le type de map qu'il cache, + * + * ??mixins: comparable, iterator, via virtual class in ocaml + * ?? kind of haskell class + default value + * + * ?? persistence, caching, peut prendre en param le type de map qu'il cache, * comme en perl, evite du marshalling kan wrapped = bdb. - * - * ?? lazy wrapper, how avoid complexity of having to define each time + * + * ?? lazy wrapper, how avoid complexity of having to define each time * a hashP, hashC, hashL, hashPCL, ... ? - * + * * ?? I define those classes cos their name are cool, say what is intended to * do with - * - * todo: cf book on algo, a la rivest/sedgewick - * todo: recreate collection hierarchy, inspire smalltalk ? haskell ? merd ? + * + * todo: cf book on algo, a la rivest/sedgewick + * todo: recreate collection hierarchy, inspire smalltalk ? haskell ? merd ? * todo: put a clean sequence (inherit collection) and make array a special * class * todo: make ostack (FIFO), oqueue (LIFO) - * - * + * + * * influences: okasaki, merd (pixel), java classes, smalltalk classes *) (*---------------------------------------------------------------------------*) type ('a, 'b) view = Empty | Cons of 'a * 'b -class virtual ['a] ocollection = +class virtual ['a] ocollection = object(o: 'o) inherit Objet.objet @@ -71,36 +71,36 @@ object(o: 'o) method virtual null: bool (* can do default with: lenght(tolist)= 0 *) - method add2: 'a -> unit = fun a -> + method add2: 'a -> unit = fun a -> o#add a +> ignore; () - method del2: 'a -> unit = fun a -> + method del2: 'a -> unit = fun a -> o#del a +> ignore; () - method clear: unit = + method clear: unit = o#iter (fun e -> o#del2 e); - - method fold: 'b. ('b -> 'a -> 'b) -> 'b -> 'b = fun f a -> - let a = ref a in + + method fold: 'b. ('b -> 'a -> 'b) -> 'b -> 'b = fun f a -> + let a = ref a in o#iter (fun e -> a := f !a e); !a - method tolist: 'a list = + method tolist: 'a list = List.rev (o#fold (fun acc e -> e::acc) []) - method fromlist: 'a list -> 'o = + method fromlist: 'a list -> 'o = fun xs -> xs +> List.fold_left (fun o e -> o#add e) o#empty - method length: int = + method length: int = (* oldsimple: o#tolist +> List.length *) (* opti: *) let count = ref 0 in o#iter (fun e -> incr count); !count - method exists: ('a -> bool) -> bool = fun f -> + method exists: ('a -> bool) -> bool = fun f -> o#tolist +> List.exists f method filter: ('a -> bool) -> 'o = fun f -> @@ -109,9 +109,9 @@ object(o: 'o) (* forall, fold, map *) - method getone: 'a = + method getone: 'a = match o#view with Cons (e,tl) -> e | Empty -> failwith "no head" - method others: 'o = + method others: 'o = match o#view with Cons (e,tl) -> tl | Empty -> failwith "no tail" end diff --git a/commons/ocollection.mli b/commons/ocollection.mli index 6ab9595..70213c8 100644 --- a/commons/ocollection.mli +++ b/commons/ocollection.mli @@ -1,5 +1,5 @@ -type ('a, 'b) view = - | Empty +type ('a, 'b) view = + | Empty | Cons of 'a * 'b class virtual ['a] ocollection : diff --git a/commons/ocollection/oassoc_buffer.ml b/commons/ocollection/oassoc_buffer.ml index 85f430c..973c8ec 100644 --- a/commons/ocollection/oassoc_buffer.ml +++ b/commons/ocollection/oassoc_buffer.ml @@ -6,45 +6,45 @@ open Oassocb open Osetb (* Take care that must often redefine all function in the original - * oassoc.ml because if some methods are not redefined, for instance + * oassoc.ml because if some methods are not redefined, for instance * #clear, then if do wrapper over a oassocdbm, then even if oassocdbm * redefine #clear, it will not be called, but instead the default * method will be called that internally will call another method. * So better delegate all the methods and override even the method * with a default definition. - * + * * In the same way sometimes an exn can occur at weird time. When * we add an element, sometimes this may raise an exn such as Out_of_memory, * but as we dont add directly but only at flush time, the exn * may happen far later the user added something in this oassoc. - * Also in the case of Out_of_memory, even if the entry is not + * Also in the case of Out_of_memory, even if the entry is not * added in the wrapped, it will still be present in the cache * and so the next flush will still generate an exn that again * may not be cached. So for the moment if Out_of_memory then * do something special and erase the entry in the cache. - * + * * Cf also oassoc_cache.ml which can be even more efficient. *) (* !!take care!!: this class has side effect, not a pure oassoc *) (* can not make it pure, cos the assoc have side effect on the cache *) -class ['a,'b] oassoc_buffer max cached = +class ['a,'b] oassoc_buffer max cached = object(o) inherit ['a,'b] oassoc val counter = ref 0 - val cache = ref (new oassocb []) + val cache = ref (new oassocb []) val dirty = ref (new osetb Setb.empty) val wrapped = ref cached - method private myflush = + method private myflush = - let has_a_raised = ref false in + let has_a_raised = ref false in - !dirty#iter (fun k -> - try + !dirty#iter (fun k -> + try wrapped := !wrapped#add (k, !cache#assoc k) - with Out_of_memory -> + with Out_of_memory -> pr2 "PBBBBBB: Out_of_memory in oassoc_buffer, but still empty cache"; has_a_raised := true; ); @@ -53,59 +53,59 @@ object(o) counter := 0; if !has_a_raised then raise Out_of_memory - + method misc_op_hook2 = o#myflush - - method empty = + + method empty = raise Todo - + (* what happens in k is already present ? or if add multiple times * the same k ? cache is a oassocb and so the previous binding is - * still there, but dirty is a set, and in myflush we iter based + * still there, but dirty is a set, and in myflush we iter based * on dirty so we will flush only the last 'k' in the cache. *) - method add (k,v) = + method add (k,v) = cache := !cache#add (k,v); dirty := !dirty#add k; incr counter; if !counter > max then o#myflush; o - method iter f = + method iter f = o#myflush; (* bugfix: have to flush !!! *) !wrapped#iter f - method keys = + method keys = o#myflush; (* bugfix: have to flush !!! *) !wrapped#keys - method clear = + method clear = o#myflush; (* bugfix: have to flush !!! *) !wrapped#clear - method length = + method length = o#myflush; !wrapped#length - method view = + method view = raise Todo - method del (k,v) = - cache := !cache#del (k,v); + method del (k,v) = + cache := !cache#del (k,v); (* TODO as for delkey, do a try over wrapped *) - wrapped := !wrapped#del (k,v); + wrapped := !wrapped#del (k,v); dirty := !dirty#del k; o method mem e = raise Todo method null = raise Todo - method assoc k = - try !cache#assoc k - with Not_found -> + method assoc k = + try !cache#assoc k + with Not_found -> (* may launch Not_found, but this time, dont catch it *) - let v = !wrapped#assoc k in + let v = !wrapped#assoc k in begin cache := !cache#add (k,v); (* otherwise can use too much mem *) @@ -113,22 +113,22 @@ object(o) if !counter > max then o#myflush; v end - - method delkey k = - cache := !cache#delkey k; + + method delkey k = + cache := !cache#delkey k; (* sometimes have not yet flushed, so may not be yet in, (could * also flush in place of doing try). - * + * * TODO would be better to see if was in cache (in case mean that * perhaps not flushed and do try and in other case just cos del * (without try) cos forcement flushed ou was an error *) - begin - try wrapped := !wrapped#delkey k + begin + try wrapped := !wrapped#delkey k with Not_found -> () end; dirty := !dirty#del k; o -end +end diff --git a/commons/ocollection/oassoc_buffer.mli b/commons/ocollection/oassoc_buffer.mli index 9cff0d7..bb71433 100644 --- a/commons/ocollection/oassoc_buffer.mli +++ b/commons/ocollection/oassoc_buffer.mli @@ -2,7 +2,7 @@ class ['a, 'b] oassoc_buffer : int -> (< add : 'a * 'b -> 'd; assoc : 'a -> 'b; del : 'a * 'b -> 'd; - delkey : 'a -> 'd; iter : ('a * 'b -> unit) -> unit; length : int; + delkey : 'a -> 'd; iter : ('a * 'b -> unit) -> unit; length : int; keys: 'a list; clear: unit; .. > as 'd) -> diff --git a/commons/ocollection/oassoc_cache.ml b/commons/ocollection/oassoc_cache.ml index e62936f..5fb5080 100644 --- a/commons/ocollection/oassoc_cache.ml +++ b/commons/ocollection/oassoc_cache.ml @@ -8,27 +8,27 @@ open Osetb (* todo: gather stat of use per key, so when flush, try keep * entries that are used above a certain threshold, and if after * this step, there is still too much, then erase also those keys. - * - * todo: limit number of entries, and erase all (then better do a ltu) - * - * todo: another cache that behave as in lfs1, - * every 100 operation do a flush - * - * todo: choose between oassocb and oassoch ? - * + * + * todo: limit number of entries, and erase all (then better do a ltu) + * + * todo: another cache that behave as in lfs1, + * every 100 operation do a flush + * + * todo: choose between oassocb and oassoch ? + * * Also take care that must often redefine all function in the original - * oassoc.ml because if some methods are not redefined, for instance + * oassoc.ml because if some methods are not redefined, for instance * #clear, then if do wrapper over a oassocdbm, then even if oassocdbm * redefine #clear, it will not be called, but instead the default * method will be called that internally will call another method. * So better delegate all the methods and override even the method * with a default definition. - * + * * In the same way sometimes an exn can occur at weird time. When * we add an element, sometimes this may raise an exn such as Out_of_memory, * but as we dont add directly but only at flush time, the exn * may happen far later the user added something in this oassoc. - * Also in the case of Out_of_memory, even if the entry is not + * Also in the case of Out_of_memory, even if the entry is not * added in the wrapped, it will still be present in the cache * and so the next flush will still generate an exn that again * may not be cached. So for the moment if Out_of_memory then @@ -37,23 +37,23 @@ open Osetb (* !!take care!!: this class has side effect, not a pure oassoc *) (* can not make it pure, cos the assoc have side effect on the cache *) -class ['a,'b] oassoc_buffer max cached = +class ['a,'b] oassoc_buffer max cached = object(o) inherit ['a,'b] oassoc val counter = ref 0 - val cache = ref (new oassocb []) + val cache = ref (new oassocb []) val dirty = ref (new osetb Setb.empty) val wrapped = ref cached - method private myflush = + method private myflush = - let has_a_raised = ref false in + let has_a_raised = ref false in - !dirty#iter (fun k -> - try + !dirty#iter (fun k -> + try wrapped := !wrapped#add (k, !cache#assoc k) - with Out_of_memory -> + with Out_of_memory -> pr2 "PBBBBBB: Out_of_memory in oassoc_buffer, but still empty cache"; has_a_raised := true; ); @@ -62,59 +62,59 @@ object(o) counter := 0; if !has_a_raised then raise Out_of_memory - + method misc_op_hook2 = o#myflush - - method empty = + + method empty = raise Todo - + (* what happens in k is already present ? or if add multiple times * the same k ? cache is a oassocb and so the previous binding is - * still there, but dirty is a set, and in myflush we iter based + * still there, but dirty is a set, and in myflush we iter based * on dirty so we will flush only the last 'k' in the cache. *) - method add (k,v) = + method add (k,v) = cache := !cache#add (k,v); dirty := !dirty#add k; incr counter; if !counter > max then o#myflush; o - method iter f = + method iter f = o#myflush; (* bugfix: have to flush !!! *) !wrapped#iter f - method keys = + method keys = o#myflush; (* bugfix: have to flush !!! *) !wrapped#keys - method clear = + method clear = o#myflush; (* bugfix: have to flush !!! *) !wrapped#clear - method length = + method length = o#myflush; !wrapped#length - method view = + method view = raise Todo - method del (k,v) = - cache := !cache#del (k,v); + method del (k,v) = + cache := !cache#del (k,v); (* TODO as for delkey, do a try over wrapped *) - wrapped := !wrapped#del (k,v); + wrapped := !wrapped#del (k,v); dirty := !dirty#del k; o method mem e = raise Todo method null = raise Todo - method assoc k = - try !cache#assoc k - with Not_found -> + method assoc k = + try !cache#assoc k + with Not_found -> (* may launch Not_found, but this time, dont catch it *) - let v = !wrapped#assoc k in + let v = !wrapped#assoc k in begin cache := !cache#add (k,v); (* otherwise can use too much mem *) @@ -122,50 +122,50 @@ object(o) if !counter > max then o#myflush; v end - - method delkey k = - cache := !cache#delkey k; + + method delkey k = + cache := !cache#delkey k; (* sometimes have not yet flushed, so may not be yet in, (could * also flush in place of doing try). - * + * * TODO would be better to see if was in cache (in case mean that * perhaps not flushed and do try and in other case just cos del * (without try) cos forcement flushed ou was an error *) - begin - try wrapped := !wrapped#delkey k + begin + try wrapped := !wrapped#delkey k with Not_found -> () end; dirty := !dirty#del k; o -end +end (* -class ['a,'b] oassoc_cache cache cached max = - object(o) - inherit ['a,'b] oassoc - - val full = ref 0 - val max = max - val cache = cache - val cached = cached - val lru = TODO - - val data = Hashtbl.create 100 - - method empty = raise Todo - method add (k,v) = (Hashtbl.add data k v; o) - method iter f = cached#iter f - method view = raise Todo - - method del (k,v) = (cache#del (k,v); cached#del (k,v); o) - method mem e = raise Todo - method null = raise Todo - - method assoc k = Hashtbl.find data k - method delkey k = (cache#delkey (k,v); cached#del (k,v); o) -end +class ['a,'b] oassoc_cache cache cached max = + object(o) + inherit ['a,'b] oassoc + + val full = ref 0 + val max = max + val cache = cache + val cached = cached + val lru = TODO + + val data = Hashtbl.create 100 + + method empty = raise Todo + method add (k,v) = (Hashtbl.add data k v; o) + method iter f = cached#iter f + method view = raise Todo + + method del (k,v) = (cache#del (k,v); cached#del (k,v); o) + method mem e = raise Todo + method null = raise Todo + + method assoc k = Hashtbl.find data k + method delkey k = (cache#delkey (k,v); cached#del (k,v); o) +end *) diff --git a/commons/ocollection/oassoc_cache.mli b/commons/ocollection/oassoc_cache.mli index 9cff0d7..bb71433 100644 --- a/commons/ocollection/oassoc_cache.mli +++ b/commons/ocollection/oassoc_cache.mli @@ -2,7 +2,7 @@ class ['a, 'b] oassoc_buffer : int -> (< add : 'a * 'b -> 'd; assoc : 'a -> 'b; del : 'a * 'b -> 'd; - delkey : 'a -> 'd; iter : ('a * 'b -> unit) -> unit; length : int; + delkey : 'a -> 'd; iter : ('a * 'b -> unit) -> unit; length : int; keys: 'a list; clear: unit; .. > as 'd) -> diff --git a/commons/ocollection/oassocb.ml b/commons/ocollection/oassocb.ml index fe727ed..ec74cc6 100644 --- a/commons/ocollection/oassocb.ml +++ b/commons/ocollection/oassocb.ml @@ -2,7 +2,7 @@ open Common open Oassoc -class ['a,'b] oassocb xs = +class ['a,'b] oassocb xs = object(o) inherit ['a,'b] oassoc @@ -21,7 +21,7 @@ class ['a,'b] oassocb xs = method assoc k = Mapb.find k data method delkey k = {< data = Mapb.remove k data >} - method keys = + method keys = List.map fst (o#tolist) -end +end diff --git a/commons/ocollection/oassocbdb.ml b/commons/ocollection/oassocbdb.ml index a395131..56978a7 100644 --- a/commons/ocollection/oassocbdb.ml +++ b/commons/ocollection/oassocbdb.ml @@ -4,103 +4,103 @@ open Bdb open Oassoc -(* !!take care!!: this class does side effect, not a pure oassoc +(* !!take care!!: this class does side effect, not a pure oassoc * * The fv/unv are to give the opportunity to translate the value from * the dbm, before marshalling. Cf oassocdbm.mli for more about this. - * + * * Quite similar to oassocdbm.ml. New: Take transact argument. - * + * * How to optimize when using this oassoc is slow ? * - use oassoc_buffer as a front-end of this oassoc * - reduce the size of the key or value *) -class ['a,'b] oassoc_btree db namedb transact (*fkey unkey*) fv unv = +class ['a,'b] oassoc_btree db namedb transact (*fkey unkey*) fv unv = let namedb = if namedb = "" then "" else "(" ^ namedb ^ ")" in object(o) inherit ['a,'b] oassoc - + val data = db - - method empty = + + method empty = raise Todo - method private addbis (k,v) = + method private addbis (k,v) = (* pr2 (fkey k); *) (* pr2 (debugv v); *) - (* try Db.del data None - (Marshal.to_string k []) [] + (* try Db.del data None + (Marshal.to_string k []) [] with Not_found -> ()); *) let k' = Common.marshal__to_string k [] in - let v' = + let v' = try - Common.marshal__to_string (fv v) [(*Marshal.Closures*)] - with Out_of_memory -> + Common.marshal__to_string (fv v) [(*Marshal.Closures*)] + with Out_of_memory -> pr2 ("PBBBBBBB Out_of_memory in: " ^ namedb); raise Out_of_memory - + in (* still clos? *) - Db.put data (transact()) k' v' []; + Db.put data (transact()) k' v' []; (* minsky wrapper ? Db.put data ~txn:(transact()) ~key:k' ~data:v' *) o - method add x = + method add x = Common.profile_code ("Btree.add" ^ namedb) (fun () -> o#addbis x) - (* bugfix: if not tail call (because of a try for instance), - * then strange behaviour in native mode + (* bugfix: if not tail call (because of a try for instance), + * then strange behaviour in native mode *) - method private iter2 f = + method private iter2 f = let dbc = Cursor.db_cursor db (transact()) [] in (* minsky wrapper? Cursor.create ~writecursor:false ~txn:(transact()) db *) - let rec aux dbc = + let rec aux dbc = if - (try + (try let a = Cursor.dbc_get dbc [Cursor.DB_NEXT] in (* minsky ? Cursor.get dbc Cursor.NEXT [] *) - let key = (* unkey *) Common.marshal__from_string (fst a) 0 in + let key = (* unkey *) Common.marshal__from_string (fst a) 0 in let valu = unv (Common.marshal__from_string (snd a) 0) in f (key, valu); true with Failure "ending" -> false - ) + ) then aux dbc else () - - in - aux dbc; + + in + aux dbc; Cursor.dbc_close dbc (* minsky Cursor.close dbc *) - method iter x = + method iter x = Common.profile_code ("Btree.iter" ^ namedb) (fun () -> o#iter2 x) - method view = + method view = raise Todo - - method private length2 = + + method private length2 = let dbc = Cursor.db_cursor db (transact()) [] in let count = ref 0 in - let rec aux dbc = + let rec aux dbc = if ( - try + try let _a = Cursor.dbc_get dbc [Cursor.DB_NEXT] in incr count; true - with Failure "ending" -> false + with Failure "ending" -> false ) then aux dbc else () - in - aux dbc; - Cursor.dbc_close dbc; - !count + in + aux dbc; + Cursor.dbc_close dbc; + !count - method length = + method length = Common.profile_code ("Btree.length" ^ namedb) (fun () -> o#length2) @@ -108,67 +108,67 @@ object(o) method mem e = raise Todo method null = raise Todo - method private assoc2 k = - try + method private assoc2 k = + try let k' = Common.marshal__to_string k [] in let vget = Db.get data (transact()) k' [] in (* minsky ? Db.get data ~txn:(transact() *) unv (Common.marshal__from_string vget 0) - with Not_found -> - log3 ("pb assoc with k = " ^ (Dumper.dump k)); + with Not_found -> + log3 ("pb assoc with k = " ^ (Dumper.dump k)); raise Not_found - method assoc x = + method assoc x = Common.profile_code ("Btree.assoc" ^ namedb) (fun () -> o#assoc2 x) - method private delkey2 k = + method private delkey2 k = let k' = Common.marshal__to_string k [] in - Db.del data (transact()) k' []; + Db.del data (transact()) k' []; o - method delkey x = + method delkey x = Common.profile_code ("Btree.delkey" ^ namedb) (fun () -> o#delkey2 x) - method keys = - let res = ref [] in + method keys = + let res = ref [] in let dbc = Cursor.db_cursor db (transact()) [] in - let rec aux dbc = + let rec aux dbc = if - (try + (try let a = Cursor.dbc_get dbc [Cursor.DB_NEXT] in (* minsky ? Cursor.get dbc Cursor.NEXT [] *) - let key = (* unkey *) Common.marshal__from_string (fst a) 0 in - (* + let key = (* unkey *) Common.marshal__from_string (fst a) 0 in + (* let valu = unv (Common.marshal__from_string (snd a) 0) in f (key, valu); *) Common.push2 key res; true with Failure "ending" -> false - ) + ) then aux dbc else () - - in - aux dbc; + + in + aux dbc; Cursor.dbc_close dbc (* minsky Cursor.close dbc *); !res - method clear = + method clear = let dbc = Cursor.db_cursor db (transact()) [] in - let rec aux dbc = + let rec aux dbc = if - (try + (try let a = Cursor.dbc_get dbc [Cursor.DB_NEXT] in - Db.del data (transact()) (fst a) []; + Db.del data (transact()) (fst a) []; true with Failure "ending" -> false - ) + ) then aux dbc else () - - in - aux dbc; + + in + aux dbc; Cursor.dbc_close dbc (* minsky Cursor.close dbc *); () @@ -176,10 +176,10 @@ end let create_bdb metapath dbname env transact (fv, unv) size_buffer_oassoc_buffer = - let db = Bdb.Db.create env [] in - Bdb.Db.db_open db (transact()) - (spf "%s/%s.db4" metapath dbname) - (spf "/%s.db4" dbname) + let db = Bdb.Db.create env [] in + Bdb.Db.db_open db (transact()) + (spf "%s/%s.db4" metapath dbname) + (spf "/%s.db4" dbname) Bdb.Db.DB_BTREE [Bdb.Db.DB_CREATE] 0; db, new Oassoc_buffer.oassoc_buffer size_buffer_oassoc_buffer diff --git a/commons/ocollection/oassocbdb.mli b/commons/ocollection/oassocbdb.mli index b01a4ab..b9be623 100644 --- a/commons/ocollection/oassocbdb.mli +++ b/commons/ocollection/oassocbdb.mli @@ -1,14 +1,14 @@ (* !!take care!!: this class does side effect, not a pure oassoc. - * + * * Also can not put structure with ref or mutable field because when * you will modify those refs or fields, you will modify it in the memory, - * not in the disk. The only way to modify on the disk is to call + * not in the disk. The only way to modify on the disk is to call * #add or #replace with what you modified. Oassocbdb has no way * to know that you modified it. *) -class ['a,'b] oassoc_btree : - Bdb.db -> - string (* db name, for profiling *) -> +class ['a,'b] oassoc_btree : + Bdb.db -> + string (* db name, for profiling *) -> (unit -> Bdb.dbtxn option) (* transaction handler *) -> ('b -> 'e) -> ('e -> 'b) (* marshaller/unmarshaller wrappers *) -> object('o) @@ -33,11 +33,11 @@ object('o) end -val create_bdb: +val create_bdb: string -> string -> Bdb.dbenv -> (unit -> Bdb.dbtxn option) -> ('a -> 'b) * ('c -> 'a) -> - int -> - Bdb.db * ('d, 'a) Oassoc_buffer.oassoc_buffer + int -> + Bdb.db * ('d, 'a) Oassoc_buffer.oassoc_buffer diff --git a/commons/ocollection/oassocbdb_string.ml b/commons/ocollection/oassocbdb_string.ml index e5bcf5b..d9f6a24 100644 --- a/commons/ocollection/oassocbdb_string.ml +++ b/commons/ocollection/oassocbdb_string.ml @@ -6,85 +6,85 @@ open Bdb open Oassoc -(* !!take care!!: this class does side effect, not a pure oassoc +(* !!take care!!: this class does side effect, not a pure oassoc *) -class ['b] oassoc_btree_string db namedb transact = +class ['b] oassoc_btree_string db namedb transact = let namedb = if namedb = "" then "" else "(" ^ namedb ^ ")" in object(o) inherit [string,'b] oassoc - + val data = db - - method empty = + + method empty = raise Todo - method private addbis (k,v) = + method private addbis (k,v) = let k' = k in - let v' = - try Common.marshal__to_string v [] - with Out_of_memory -> + let v' = + try Common.marshal__to_string v [] + with Out_of_memory -> pr2 ("PBBBBBBB Out_of_memory in: " ^ namedb); raise Out_of_memory - + in (* still clos? *) - Db.put data (transact()) k' v' []; + Db.put data (transact()) k' v' []; o - method add x = + method add x = Common.profile_code ("Btree.add" ^ namedb) (fun () -> o#addbis x) - (* bugfix: if not tail call (because of a try for instance), - * then strange behaviour in native mode + (* bugfix: if not tail call (because of a try for instance), + * then strange behaviour in native mode *) - method private iter2 f = + method private iter2 f = let dbc = Cursor.db_cursor db (transact()) [] in (* minsky wrapper? Cursor.create ~writecursor:false ~txn:(transact()) db *) - let rec aux dbc = + let rec aux dbc = if - (try + (try let a = Cursor.dbc_get dbc [Cursor.DB_NEXT] in (* minsky ? Cursor.get dbc Cursor.NEXT [] *) - let key = (fst a) in + let key = (fst a) in let valu = (Common.marshal__from_string (snd a) 0) in f (key, valu); true with Failure "ending" -> false - ) + ) then aux dbc else () - - in - aux dbc; + + in + aux dbc; Cursor.dbc_close dbc (* minsky Cursor.close dbc *) - method iter x = + method iter x = Common.profile_code ("Btree.iter" ^ namedb) (fun () -> o#iter2 x) - method view = + method view = raise Todo - - method private length2 = + + method private length2 = let dbc = Cursor.db_cursor db (transact()) [] in let count = ref 0 in - let rec aux dbc = + let rec aux dbc = if ( - try + try let _a = Cursor.dbc_get dbc [Cursor.DB_NEXT] in incr count; true - with Failure "ending" -> false + with Failure "ending" -> false ) then aux dbc else () - in - aux dbc; - Cursor.dbc_close dbc; - !count + in + aux dbc; + Cursor.dbc_close dbc; + !count - method length = + method length = Common.profile_code ("Btree.length" ^ namedb) (fun () -> o#length2) @@ -92,67 +92,67 @@ object(o) method mem e = raise Todo method null = raise Todo - method private assoc2 k = - try + method private assoc2 k = + try let k' = k in let vget = Db.get data (transact()) k' [] in (* minsky ? Db.get data ~txn:(transact() *) (Common.marshal__from_string vget 0) - with Not_found -> - log3 ("pb assoc with k = " ^ (k)); + with Not_found -> + log3 ("pb assoc with k = " ^ (k)); raise Not_found - method assoc x = + method assoc x = Common.profile_code ("Btree.assoc" ^ namedb) (fun () -> o#assoc2 x) - method private delkey2 k = + method private delkey2 k = let k' = k in - Db.del data (transact()) k' []; + Db.del data (transact()) k' []; o - method delkey x = + method delkey x = Common.profile_code ("Btree.delkey" ^ namedb) (fun () -> o#delkey2 x) - method keys = - let res = ref [] in + method keys = + let res = ref [] in let dbc = Cursor.db_cursor db (transact()) [] in - let rec aux dbc = + let rec aux dbc = if - (try + (try let a = Cursor.dbc_get dbc [Cursor.DB_NEXT] in (* minsky ? Cursor.get dbc Cursor.NEXT [] *) - let key = (fst a) in - (* + let key = (fst a) in + (* let valu = unv (Common.marshal__from_string (snd a) 0) in f (key, valu); *) Common.push2 key res; true with Failure "ending" -> false - ) + ) then aux dbc else () - - in - aux dbc; + + in + aux dbc; Cursor.dbc_close dbc (* minsky Cursor.close dbc *); !res - method clear = + method clear = let dbc = Cursor.db_cursor db (transact()) [] in - let rec aux dbc = + let rec aux dbc = if - (try + (try let a = Cursor.dbc_get dbc [Cursor.DB_NEXT] in - Db.del data (transact()) (fst a) []; + Db.del data (transact()) (fst a) []; true with Failure "ending" -> false - ) + ) then aux dbc else () - - in - aux dbc; + + in + aux dbc; Cursor.dbc_close dbc (* minsky Cursor.close dbc *); () @@ -160,10 +160,10 @@ end let create_bdb metapath dbname env transact size_buffer_oassoc_buffer = - let db = Bdb.Db.create env [] in - Bdb.Db.db_open db (transact()) - (spf "%s/%s.db4" metapath dbname) - (spf "/%s.db4" dbname) + let db = Bdb.Db.create env [] in + Bdb.Db.db_open db (transact()) + (spf "%s/%s.db4" metapath dbname) + (spf "/%s.db4" dbname) Bdb.Db.DB_BTREE [Bdb.Db.DB_CREATE] 0; db, new Oassoc_buffer.oassoc_buffer size_buffer_oassoc_buffer diff --git a/commons/ocollection/oassocbdb_string.mli b/commons/ocollection/oassocbdb_string.mli index d1f3c59..dc2f029 100644 --- a/commons/ocollection/oassocbdb_string.mli +++ b/commons/ocollection/oassocbdb_string.mli @@ -1,14 +1,14 @@ (* !!take care!!: this class does side effect, not a pure oassoc. - * + * * Also can not put structure with ref or mutable field because when * you will modify those refs or fields, you will modify it in the memory, - * not in the disk. The only way to modify on the disk is to call + * not in the disk. The only way to modify on the disk is to call * #add or #replace with what you modified. Oassocbdb has no way * to know that you modified it. *) -class ['b] oassoc_btree_string : - Bdb.db -> - string (* db name, for profiling *) -> +class ['b] oassoc_btree_string : + Bdb.db -> + string (* db name, for profiling *) -> (unit -> Bdb.dbtxn option) (* transaction handler *) -> object('o) inherit [string,'b] Oassoc.oassoc @@ -32,10 +32,10 @@ object('o) end -val create_bdb: +val create_bdb: string -> string -> Bdb.dbenv -> (unit -> Bdb.dbtxn option) -> - int -> - Bdb.db * (string, 'a) Oassoc_buffer.oassoc_buffer + int -> + Bdb.db * (string, 'a) Oassoc_buffer.oassoc_buffer diff --git a/commons/ocollection/oassocdbm.ml b/commons/ocollection/oassocdbm.ml index 9a24d1f..d2523ed 100644 --- a/commons/ocollection/oassocdbm.ml +++ b/commons/ocollection/oassocdbm.ml @@ -3,7 +3,7 @@ open Common open Oassoc (* !!take care!!: this class does side effect, not a pure oassoc. - * + * * The fv/unv are here to give the opportunity to translate the value * from the dbm, before marshalling. This is useful for instance if you * want to store objects such as oset. Indeed we cant marshall @@ -15,58 +15,58 @@ open Oassoc * get them from the dbm. Hence fv/unv. You can do the same for the key * with fkey/unkey, but as key are usually simple data structures, * there is less need for them, so I have commented them. *) -class ['a,'b] oassocdbm xs db (*fkey unkey*) fv unv = +class ['a,'b] oassocdbm xs db (*fkey unkey*) fv unv = object(o) inherit ['a,'b] oassoc - + val db = db - + method empty = raise Todo - method add (k,v) = + method add (k,v) = (* pr2 (fkey k); *) (* pr2 (debugv v); *) - (* try Db.del data None - (Marshal.to_string k []) [] + (* try Db.del data None + (Marshal.to_string k []) [] with Not_found -> ()); *) let k' = Common.marshal__to_string k [] in let v' = (Common.marshal__to_string (fv v) [(*Common.marshal__Closures*)]) in - (try Dbm.add db k' v' + (try Dbm.add db k' v' with _ -> Dbm.replace db k' v' ); o - method iter f = - db +> Dbm.iter (fun key data -> - let k' = (* unkey *) Common.marshal__from_string key 0 in + method iter f = + db +> Dbm.iter (fun key data -> + let k' = (* unkey *) Common.marshal__from_string key 0 in let v' = unv (Common.marshal__from_string data 0) in f (k', v') - ) - + ) + method view = raise Todo - + method del (k,v) = raise Todo method mem e = raise Todo method null = raise Todo - - method assoc k = + + method assoc k = let k' = Common.marshal__to_string k [] in unv (Common.marshal__from_string (Dbm.find db k') 0) - method delkey k = + method delkey k = let k' = Common.marshal__to_string k [] in - try + try Dbm.remove db k'; o - with Dbm.Dbm_error "dbm_delete" -> + with Dbm.Dbm_error "dbm_delete" -> raise Not_found - method keys = - let res = ref [] in - db +> Dbm.iter (fun key data -> - let k' = (* unkey *) Common.marshal__from_string key 0 in - (* + method keys = + let res = ref [] in + db +> Dbm.iter (fun key data -> + let k' = (* unkey *) Common.marshal__from_string key 0 in + (* let v' = unv (Common.marshal__from_string data 0) in f (k', v') *) @@ -78,7 +78,7 @@ end let create_dbm metapath dbname = - let x_db = Dbm.opendbm (metapath^dbname) [Dbm.Dbm_create;Dbm.Dbm_rdwr] 0o777 + let x_db = Dbm.opendbm (metapath^dbname) [Dbm.Dbm_create;Dbm.Dbm_rdwr] 0o777 in let assoc = new oassocdbm [] x_db id id in x_db, assoc diff --git a/commons/ocollection/oassocdbm.mli b/commons/ocollection/oassocdbm.mli index 7efe4d7..078a872 100644 --- a/commons/ocollection/oassocdbm.mli +++ b/commons/ocollection/oassocdbm.mli @@ -26,5 +26,5 @@ object ('o) end -val create_dbm : +val create_dbm : Common.filename -> string -> Dbm.t * ('a, 'b) oassocdbm diff --git a/commons/ocollection/oassoch.ml b/commons/ocollection/oassoch.ml index 94d5d7a..60dc6b3 100644 --- a/commons/ocollection/oassoch.ml +++ b/commons/ocollection/oassoch.ml @@ -3,7 +3,7 @@ open Common open Oassoc (* !!take care!!: this class does side effect, not a pure oassoc *) -class ['a,'b] oassoch xs = +class ['a,'b] oassoch xs = let h = Common.hash_of_list xs in object(o) inherit ['a,'b] oassoc @@ -24,15 +24,15 @@ class ['a,'b] oassoch xs = method mem e = raise Todo method null = (try (Hashtbl.iter (fun k v -> raise ReturnExn) data; false) with ReturnExn -> true) - method assoc k = - try + method assoc k = + try Hashtbl.find data k - with Not_found -> (log3 ("pb assoc with k = " ^ (Dumper.dump k)); raise Not_found) - + with Not_found -> (log3 ("pb assoc with k = " ^ (Dumper.dump k)); raise Not_found) + method delkey k = (Hashtbl.remove data k; o) - method keys = + method keys = List.map fst (o#tolist) -end +end diff --git a/commons/ocollection/oassocid.ml b/commons/ocollection/oassocid.ml index df8bd2b..5bea6c1 100644 --- a/commons/ocollection/oassocid.ml +++ b/commons/ocollection/oassocid.ml @@ -2,7 +2,7 @@ open Common open Oassoc (* just a class that behave as fun x -> x *) -class ['a] oassoc_id xs = +class ['a] oassoc_id xs = object(o) inherit ['a,'a] oassoc @@ -18,7 +18,7 @@ class ['a] oassoc_id xs = method assoc k = k method delkey k = {< >} - method keys = + method keys = List.map fst (o#tolist) -end +end diff --git a/commons/ocollection/ograph2way.ml b/commons/ocollection/ograph2way.ml index 3434080..a5d2e8c 100644 --- a/commons/ocollection/ograph2way.ml +++ b/commons/ocollection/ograph2way.ml @@ -7,20 +7,20 @@ open Ograph open Osetb (* graph2way prend en parametre le type de finitemap et set a prendre - * todo? add_arc doit ramer, car del la key, puis add => - * better to have a ref to a set - * todo: efficient graph: with pointers and a tag: visited + * todo? add_arc doit ramer, car del la key, puis add => + * better to have a ref to a set + * todo: efficient graph: with pointers and a tag: visited * => need keep global value visited_counter * check(that node is in, ...), display - * - * pourrait remettre val nods, a la place de les calculer. mais bon + * + * pourrait remettre val nods, a la place de les calculer. mais bon * s'en sert pas vraiment car y'a pas de notion d'identifiant de noeud * et de label. - * + * * invariant: key in pred is also in succ (completness) and value in * either table is a key also *) -class ['a] ograph2way asucc apred (*f1*) f2 = +class ['a] ograph2way asucc apred (*f1*) f2 = object(o) inherit ['a] ograph @@ -41,11 +41,11 @@ object(o) pred = pred#delkey e; succ = succ#delkey e; >} - method add_arc (a,b) = {< + method add_arc (a,b) = {< succ = succ#replkey (a, (succ#find a)#add b); pred = pred#replkey (b, (pred#find b)#add a); >} - method del_arc (a,b) = {< + method del_arc (a,b) = {< succ = succ#replkey (a, (succ#find a)#del b); pred = pred#replkey (b, (pred#find b)#del a); >} @@ -58,29 +58,29 @@ object(o) succ#iter (fun (k,v) -> a := !a#add k); !a - - method ancestors xs = - let rec aux xs acc = + + method ancestors xs = + let rec aux xs acc = match xs#view with (* could be done with an iter *) | Empty -> acc - | Cons(x, xs) -> (acc#add x) + | Cons(x, xs) -> (acc#add x) +> (fun newacc -> aux (o#predecessors x) newacc) +> (fun newacc -> aux xs newacc) in aux xs (f2()) (* (new osetb []) *) - method children xs = - let rec aux xs acc = + method children xs = + let rec aux xs acc = match xs#view with (* could be done with an iter *) | Empty -> acc - | Cons(x, xs) -> (acc#add x) + | Cons(x, xs) -> (acc#add x) +> (fun newacc -> aux (o#successors x) newacc) +> (fun newacc -> aux xs newacc) in aux xs (f2()) (* (new osetb []) *) - method brothers x = + method brothers x = let parents = o#predecessors x in (parents#fold (fun acc e -> acc $++$ o#successors e) (f2()))#del x - -end + +end diff --git a/commons/ocollection/osetb.ml b/commons/ocollection/osetb.ml index 3cf83a0..0734cac 100644 --- a/commons/ocollection/osetb.ml +++ b/commons/ocollection/osetb.ml @@ -3,7 +3,7 @@ open Oset let empty = Setb.empty -class ['a] osetb xs = +class ['a] osetb xs = object(o) inherit ['a] oset @@ -11,14 +11,14 @@ class ['a] osetb xs = method tosetb = data (* if put [] then no segfault, if [11] then segfault *) - method toset = Obj.magic data + method toset = Obj.magic data method empty = {< data = Setb.empty >} method add e = {< data = Setb.add e data >} method iter f = Setb.iter f data - method view = - if Setb.is_empty data - then Empty + method view = + if Setb.is_empty data + then Empty else let el = Setb.choose data in Cons (el, o#del el) method del e = {< data = Setb.remove e data >} @@ -32,5 +32,5 @@ class ['a] osetb xs = method inter s = {< data = Setb.inter data s#tosetb >} method minus s = {< data = Setb.diff data s#tosetb >} (* todo: include, ... *) - + end diff --git a/commons/ocollection/oseth.ml b/commons/ocollection/oseth.ml index 2e74439..0b1bcdf 100644 --- a/commons/ocollection/oseth.ml +++ b/commons/ocollection/oseth.ml @@ -3,60 +3,60 @@ open Common open Oset (* !!take care!!: this class does side effect, not a pure oassoc *) -class ['a] oseth xs = +class ['a] oseth xs = object(o) inherit ['a] oset val data = Hashtbl.create 100 - + (* if put [] then no segfault, if [11] then segfault *) - method toset = Obj.magic data + method toset = Obj.magic data method empty = {< data = Hashtbl.create 100 >} - method add k = - Hashtbl.add data k true; + method add k = + Hashtbl.add data k true; o - + method iter f = Hashtbl.iter (fun k v -> f k) data method view = raise Todo - - method del k = - Hashtbl.remove data k; + + method del k = + Hashtbl.remove data k; o - method mem k = - try (ignore(Hashtbl.find data k); true) + method mem k = + try (ignore(Hashtbl.find data k); true) with Not_found -> false - method null = - try (Hashtbl.iter (fun k v -> raise ReturnExn) data; false) + method null = + try (Hashtbl.iter (fun k v -> raise ReturnExn) data; false) with ReturnExn -> true (* TODO method length *) - method union s = - let v = Hashtbl.create 100 in + method union s = + let v = Hashtbl.create 100 in o#iter (fun k -> Hashtbl.add v k true); s#iter (fun k -> Hashtbl.add v k true); {< data = v >} - method inter s = - let v = Hashtbl.create 100 in + method inter s = + let v = Hashtbl.create 100 in o#iter (fun k -> if s#mem k then Hashtbl.add v k true); {< data = v >} - method minus s = - let v = Hashtbl.create 100 in + method minus s = + let v = Hashtbl.create 100 in o#iter (fun k -> if not(s#mem k) then Hashtbl.add v k true); {< data = v >} (* override default *) - method getone = + method getone = let x = ref None in try ( - Hashtbl.iter (fun k _ -> x := Some k; raise ReturnExn) data; + Hashtbl.iter (fun k _ -> x := Some k; raise ReturnExn) data; raise Not_found - ) + ) with ReturnExn -> some !x - - + + end diff --git a/commons/ocollection/oseti.ml b/commons/ocollection/oseti.ml index a0c8512..a276557 100644 --- a/commons/ocollection/oseti.ml +++ b/commons/ocollection/oseti.ml @@ -1,7 +1,7 @@ open Ocollection open Oset -class ['a] oseti xs = +class ['a] oseti xs = object(o) inherit [int] oset @@ -12,9 +12,9 @@ class ['a] oseti xs = method empty = {< data = Seti.empty >} method add e = {< data = Seti.add e data >} method iter f = Seti.iter f data - method view = - if Seti.is_empty data - then Empty + method view = + if Seti.is_empty data + then Empty else let el = Seti.choose data in Cons (el, o#del el) method del e = {< data = Seti.remove e data >} @@ -27,7 +27,7 @@ class ['a] oseti xs = method union s = {< data = Seti.union data s#toseti >} method inter s = {< data = Seti.inter data s#toseti >} method minus s = {< data = Seti.diff data s#toseti >} - + method invariant () = Seti.invariant data method to_string () = Seti.string_of_seti data diff --git a/commons/ocollection/osetpt.ml b/commons/ocollection/osetpt.ml index 5ef3a6d..1d7a45f 100644 --- a/commons/ocollection/osetpt.ml +++ b/commons/ocollection/osetpt.ml @@ -2,21 +2,21 @@ open Ocollection open Oset -class ['a] osetpt xs = +class ['a] osetpt xs = object(o) inherit [int] oset val data = SetPt.empty method tosetpt = data (* if put [] then no segfault, if [11] then segfault *) - method toset = Obj.magic data + method toset = Obj.magic data method empty = {< data = SetPt.empty >} method add e = {< data = SetPt.add e data >} method iter f = SetPt.iter f data - method view = - if SetPt.is_empty data - then Empty + method view = + if SetPt.is_empty data + then Empty else let el = SetPt.choose data in Cons (el, o#del el) method del e = {< data = SetPt.remove e data >} @@ -29,5 +29,5 @@ class ['a] osetpt xs = method union s = {< data = SetPt.union data s#tosetpt >} method inter s = {< data = SetPt.inter data s#tosetpt >} method minus s = {< data = SetPt.diff data s#tosetpt >} - + end diff --git a/commons/ofullcommon.ml b/commons/ofullcommon.ml index 8f00d99..9635477 100644 --- a/commons/ofullcommon.ml +++ b/commons/ofullcommon.ml @@ -1,11 +1,11 @@ (* Do a 'open Fullcommon' to access most of the functions in commons/ * without needing to qualify them. - * + * * update: Jane Street use a similar trick, to have a more complete * Pervasives, but for far more. They can define a module Std that * correspond to old std lib and a module Std_internal that instead * include all their extensions over the standard lib (a more complete - * List module, Arg, etc) + * List module, Arg, etc) *) include Common diff --git a/commons/ograph.ml b/commons/ograph.ml index e97cdb7..8188542 100644 --- a/commons/ograph.ml +++ b/commons/ograph.ml @@ -1,8 +1,8 @@ open Common -(* todo: +(* todo: * invariant succesors/predecessors - * see c++ library, GTL ... + * see c++ library, GTL ... * (cf paper from ASTL, cf paper from jfla05 on ocamlgraph) *) @@ -25,6 +25,6 @@ object(o: 'o) method virtual children: 'a Oset.oset -> 'a Oset.oset method virtual brothers: 'a -> 'a Oset.oset - method mydebug: ('a * 'a list) list = + method mydebug: ('a * 'a list) list = (o#nodes)#tolist +> map (fun a -> (a, (o#successors a)#tolist)) end diff --git a/commons/ograph_extended.ml b/commons/ograph_extended.ml index 0c9f3a2..e4d9a73 100644 --- a/commons/ograph_extended.ml +++ b/commons/ograph_extended.ml @@ -8,32 +8,32 @@ open Oassoc open Oassocb open Osetb -(* - * graph structure: +(* + * graph structure: * - node: index -> nodevalue * - arc: (index * index) * edgevalue - * - * invariant: key in pred is also in succ (completness) and value in + * + * invariant: key in pred is also in succ (completness) and value in * either assoc is a key also. - * + * * How ? matrix ? but no growing array :( - * + * * When need index ? Must have an index when can't just use nodevalue * as a key, cos sometimes may have 2 times the same key, but it must * be 2 different nodes. For instance in program f(); f(); we want 2 * nodes, one per f(); hence the index. If each node is different, * then no problem, can omit index. - * + * * todo?: prend en parametre le type de finitemap et set a prendre - * todo?: add_arc doit ramer, car del la key, puis add => better to + * todo?: add_arc doit ramer, car del la key, puis add => better to * have a ref to a set. - * - * opti: graph with pointers and a tag visited => need keep global value + * + * opti: graph with pointers and a tag visited => need keep global value * visited_counter. check(that node is in, ...), display. - * opti: when the graph structure is stable, have a method compact, that - * transforms that in a matrix (assert that all number between 0 and + * opti: when the graph structure is stable, have a method compact, that + * transforms that in a matrix (assert that all number between 0 and * free_index are used, or do some defrag-like-move/renaming). - * + * *) type nodei = int @@ -44,57 +44,57 @@ class ['a,'b] ograph_extended = object(o) (* inherit ['a] ograph *) - + val free_index = 0 val succ = build_assoc() val pred = build_assoc() val nods = build_assoc() - method add_node (e: 'a) = + method add_node (e: 'a) = let i = free_index in - ({< - nods = nods#add (i, e); + ({< + nods = nods#add (i, e); pred = pred#add (i, build_set() ); succ = succ#add (i, build_set() ); free_index = i + 1; >}, i) - method add_nodei i (e: 'a) = - ({< - nods = nods#add (i, e); + method add_nodei i (e: 'a) = + ({< + nods = nods#add (i, e); pred = pred#add (i, build_set() ); succ = succ#add (i, build_set() ); free_index = (max free_index i) + 1; >}, i) - method del_node (i) = + method del_node (i) = {< - (* check: e is effectively the index associated with e, + (* check: e is effectively the index associated with e, and check that already in *) (* todo: assert that have no pred and succ, otherwise - * will have some dangling pointers + * will have some dangling pointers *) - nods = nods#delkey i; + nods = nods#delkey i; pred = pred#delkey i; succ = succ#delkey i; >} - method replace_node (i, (e: 'a)) = + method replace_node (i, (e: 'a)) = assert (nods#haskey i); {< nods = nods#replkey (i, e); >} - method add_arc ((a,b),(v: 'b)) = - {< + method add_arc ((a,b),(v: 'b)) = + {< succ = succ#replkey (a, (succ#find a)#add (b, v)); pred = pred#replkey (b, (pred#find b)#add (a, v)); >} method del_arc ((a,b),v) = - {< + {< succ = succ#replkey (a, (succ#find a)#del (b,v)); pred = pred#replkey (b, (pred#find b)#del (a,v)); >} @@ -106,31 +106,31 @@ class ['a,'b] ograph_extended = method allsuccessors = succ (* - method ancestors xs = - let rec aux xs acc = + method ancestors xs = + let rec aux xs acc = match xs#view with (* could be done with an iter *) | Empty -> acc - | Cons(x, xs) -> (acc#add x) + | Cons(x, xs) -> (acc#add x) +> (fun newacc -> aux (o#predecessors x) newacc) +> (fun newacc -> aux xs newacc) in aux xs (f2()) (* (new osetb []) *) - method children xs = - let rec aux xs acc = + method children xs = + let rec aux xs acc = match xs#view with (* could be done with an iter *) | Empty -> acc - | Cons(x, xs) -> (acc#add x) + | Cons(x, xs) -> (acc#add x) +> (fun newacc -> aux (o#successors x) newacc) +> (fun newacc -> aux xs newacc) in aux xs (f2()) (* (new osetb []) *) - method brothers x = + method brothers x = let parents = o#predecessors x in (parents#fold (fun acc e -> acc $++$ o#successors e) (f2()))#del x *) - end + end @@ -140,44 +140,44 @@ class ['a,'b] ograph_mutable = let build_set () = new osetb Setb.empty in object(o) - + val mutable free_index = 0 val mutable succ = build_assoc() val mutable pred = build_assoc() val mutable nods = build_assoc() - method add_node (e: 'a) = + method add_node (e: 'a) = let i = free_index in - nods <- nods#add (i, e); + nods <- nods#add (i, e); pred <- pred#add (i, build_set() ); succ <- succ#add (i, build_set() ); free_index <- i + 1; i - method add_nodei i (e: 'a) = - nods <- nods#add (i, e); + method add_nodei i (e: 'a) = + nods <- nods#add (i, e); pred <- pred#add (i, build_set() ); succ <- succ#add (i, build_set() ); free_index <- (max free_index i) + 1; - method del_node (i) = - (* check: e is effectively the index associated with e, + method del_node (i) = + (* check: e is effectively the index associated with e, and check that already in *) (* todo: assert that have no pred and succ, otherwise - * will have some dangling pointers + * will have some dangling pointers *) - nods <- nods#delkey i; + nods <- nods#delkey i; pred <- pred#delkey i; succ <- succ#delkey i; - method replace_node (i, (e: 'a)) = + method replace_node (i, (e: 'a)) = assert (nods#haskey i); nods <- nods#replkey (i, e); - - method add_arc ((a,b),(v: 'b)) = + + method add_arc ((a,b),(v: 'b)) = succ <- succ#replkey (a, (succ#find a)#add (b, v)); pred <- pred#replkey (b, (pred#find b)#add (a, v)); method del_arc ((a,b),v) = @@ -190,14 +190,14 @@ class ['a,'b] ograph_mutable = method nodes = nods method allsuccessors = succ - end + end (* depth first search *) let dfs_iter xi f g = let already = Hashtbl.create 101 in - let rec aux_dfs xs = - xs +> List.iter (fun xi -> + let rec aux_dfs xs = + xs +> List.iter (fun xi -> if Hashtbl.mem already xi then () else begin Hashtbl.add already xi true; @@ -209,23 +209,23 @@ let dfs_iter xi f g = aux_dfs [xi] -let dfs_iter_with_path xi f g = +let dfs_iter_with_path xi f g = let already = Hashtbl.create 101 in - let rec aux_dfs path xi = + let rec aux_dfs path xi = if Hashtbl.mem already xi then () else begin Hashtbl.add already xi true; f xi path; let succ = g#successors xi in let succ' = succ#tolist +> List.map fst in - succ' +> List.iter (fun yi -> + succ' +> List.iter (fun yi -> aux_dfs (xi::path) yi ); end in aux_dfs [] xi - - + + let generate_ograph_generic g label fnode filename = Common.with_open_outfile filename (fun (pr,_) -> @@ -236,7 +236,7 @@ let generate_ograph_generic g label fnode filename = | Some x -> pr (Printf.sprintf "label = \"%s\";\n" x)); let nodes = g#nodes in - nodes#iter (fun (k,node) -> + nodes#iter (fun (k,node) -> let (str,border_color,inner_color) = fnode (k, node) in let color = match inner_color with @@ -246,13 +246,13 @@ let generate_ograph_generic g label fnode filename = | Some x -> Printf.sprintf ", style=\"setlinewidth(3)\", color = %s" x) | Some x -> (match border_color with - None -> Printf.sprintf ", style=\"setlinewidth(3),filled\", fillcolor = %s" x + None -> Printf.sprintf ", style=\"setlinewidth(3),filled\", fillcolor = %s" x | Some x' -> Printf.sprintf ", style=\"setlinewidth(3),filled\", fillcolor = %s, color = %s" x x') in - (* so can see if nodes without arcs were created *) + (* so can see if nodes without arcs were created *) pr (sprintf "%d [label=\"%s [%d]\"%s];\n" k str k color) ); - nodes#iter (fun (k,node) -> + nodes#iter (fun (k,node) -> let succ = g#successors k in succ#iter (fun (j,edge) -> pr (sprintf "%d -> %d;\n" k j); @@ -269,12 +269,12 @@ let generate_ograph_xxx g filename = pr "size = \"10,10\";\n" ; let nodes = g#nodes in - nodes#iter (fun (k,(node, s)) -> - (* so can see if nodes without arcs were created *) + nodes#iter (fun (k,(node, s)) -> + (* so can see if nodes without arcs were created *) pr (sprintf "%d [label=\"%s [%d]\"];\n" k s k) ); - nodes#iter (fun (k,node) -> + nodes#iter (fun (k,node) -> let succ = g#successors k in succ#iter (fun (j,edge) -> pr (sprintf "%d -> %d;\n" k j); @@ -286,23 +286,23 @@ let generate_ograph_xxx g filename = let launch_gv_cmd filename = - let _status = + let _status = Unix.system ("dot " ^ filename ^ " -Tps -o " ^ filename ^ ".ps;") in let _status = Unix.system ("gv " ^ filename ^ ".ps &") in (* zarb: I need this when I launch the program via eshell, otherwise gv do not get the chance to be launched *) - Unix.sleep 1; + Unix.sleep 1; () -let print_ograph_extended g filename launchgv = +let print_ograph_extended g filename launchgv = generate_ograph_xxx g filename; if launchgv then launch_gv_cmd filename -let print_ograph_mutable g filename launchgv = +let print_ograph_mutable g filename launchgv = generate_ograph_xxx g filename; if launchgv then launch_gv_cmd filename -let print_ograph_mutable_generic g label fnode ~output_file ~launch_gv = +let print_ograph_mutable_generic g label fnode ~output_file ~launch_gv = generate_ograph_generic g label fnode output_file; if launch_gv then launch_gv_cmd output_file diff --git a/commons/ograph_extended.mli b/commons/ograph_extended.mli index c9f3936..9debfde 100644 --- a/commons/ograph_extended.mli +++ b/commons/ograph_extended.mli @@ -2,17 +2,17 @@ open Common type nodei = int -(* graph structure: - * - node: index -> nodevalue +(* graph structure: + * - node: index -> nodevalue * - arc: (index * index) * edgevalue - * + * * How ? matrix ? but no growing array :( - * + * * When need index ? Must have an index when can't just use the nodevalue * as a key, cos sometimes may have 2 times the same key, but it must * be 2 different nodes. For instance in a C program 'f(); f();' we want 2 * nodes, one per 'f();' hence the index. If each node is different, then - * no problem, can omit index. + * no problem, can omit index. *) class ['node, 'edge] ograph_extended : @@ -51,31 +51,31 @@ object ('o) end -val dfs_iter : +val dfs_iter : nodei -> (nodei -> unit) -> ('node, 'edge) ograph_mutable -> unit -val dfs_iter_with_path : - nodei -> (nodei -> nodei list -> unit) -> ('node, 'edge) ograph_mutable -> +val dfs_iter_with_path : + nodei -> (nodei -> nodei list -> unit) -> ('node, 'edge) ograph_mutable -> unit -val print_ograph_mutable_generic : - ('node, 'edge) ograph_mutable -> +val print_ograph_mutable_generic : + ('node, 'edge) ograph_mutable -> string option -> (* label for the entire graph *) (* what string to print for a node and how to color it *) ((nodei * 'node) -> (string * string option * string option)) -> - output_file:filename -> - launch_gv:bool -> + output_file:filename -> + launch_gv:bool -> unit -val print_ograph_extended : - ('node * string, 'edge) ograph_extended -> - filename (* output file *) -> - bool (* launch gv ? *) -> +val print_ograph_extended : + ('node * string, 'edge) ograph_extended -> + filename (* output file *) -> + bool (* launch gv ? *) -> unit -val print_ograph_mutable : - ('node * string, 'edge) ograph_mutable -> - filename (* output file *) -> - bool (* launch gv ? *) -> +val print_ograph_mutable : + ('node * string, 'edge) ograph_mutable -> + filename (* output file *) -> + bool (* launch gv ? *) -> unit diff --git a/commons/ograph_simple.ml b/commons/ograph_simple.ml index 45a9028..815ae93 100644 --- a/commons/ograph_simple.ml +++ b/commons/ograph_simple.ml @@ -13,7 +13,7 @@ open Osetb * in ograph_extended we dont force the user to have a key and we * generate those keys as he add nodes. Here we assume the user already * have an idea of what kind of key he wants to use (a string, a - * filename, a, int, whatever) + * filename, a, int, whatever) *) class ['key, 'a,'b] ograph_mutable = @@ -21,54 +21,54 @@ class ['key, 'a,'b] ograph_mutable = let build_set () = new osetb Setb.empty in object(o) - + val mutable succ = build_assoc() val mutable pred = build_assoc() val mutable nods = (build_assoc() : ('key, 'a) Oassocb.oassocb) - method add_node i (e: 'a) = - nods <- nods#add (i, e); + method add_node i (e: 'a) = + nods <- nods#add (i, e); pred <- pred#add (i, build_set() ); succ <- succ#add (i, build_set() ); - method del_node (i) = - (* check: e is effectively the index associated with e, + method del_node (i) = + (* check: e is effectively the index associated with e, and check that already in *) (* todo: assert that have no pred and succ, otherwise - * will have some dangling pointers + * will have some dangling pointers *) - nods <- nods#delkey i; + nods <- nods#delkey i; pred <- pred#delkey i; succ <- succ#delkey i; - method del_leaf_node_and_its_edges (i) = + method del_leaf_node_and_its_edges (i) = let succ = o#successors i in if not (succ#null) then failwith "del_leaf_node_and_its_edges: have some successors" else begin let pred = o#predecessors i in - pred#tolist +> List.iter (fun (k, edge) -> + pred#tolist +> List.iter (fun (k, edge) -> o#del_arc (k,i) edge; ); o#del_node i end - - method leaf_nodes () = + + method leaf_nodes () = let (set : 'key Oset.oset) = build_set () in - o#nodes#tolist +> List.fold_left (fun acc (k,v) -> + o#nodes#tolist +> List.fold_left (fun acc (k,v) -> if (o#successors k)#null then acc#add k else acc ) set - - method replace_node i (e: 'a) = + + method replace_node i (e: 'a) = assert (nods#haskey i); nods <- nods#replkey (i, e); - - method add_arc (a,b) (v: 'b) = + + method add_arc (a,b) (v: 'b) = succ <- succ#replkey (a, (succ#find a)#add (b, v)); pred <- pred#replkey (b, (pred#find b)#add (a, v)); method del_arc (a,b) v = @@ -82,14 +82,14 @@ object(o) method allsuccessors = succ (* detect if no loop ? *) - method ancestors k = + method ancestors k = let empty_set = build_set() in - - let rec aux acc x = + + let rec aux acc x = if acc#mem x - then - (* bugfix: have_loop := true; ? not, not necessarally. + then + (* bugfix: have_loop := true; ? not, not necessarally. * if you got a diamon, seeing a second time the same * x does not mean we are in a loop *) @@ -107,7 +107,7 @@ object(o) -end +end let print_ograph_generic ~str_of_key ~str_of_node filename g = @@ -116,10 +116,10 @@ let print_ograph_generic ~str_of_key ~str_of_node filename g = pr "size = \"10,10\";\n" ; let nodes = g#nodes in - nodes#iter (fun (k,node) -> + nodes#iter (fun (k,node) -> pr (spf "%s [label=\"%s\"];\n" (str_of_key k) (str_of_node k node)) ); - nodes#iter (fun (k,node) -> + nodes#iter (fun (k,node) -> let succ = g#successors k in succ#iter (fun (j,edge) -> pr (spf "%s -> %s;\n" (str_of_key k) (str_of_key j)); diff --git a/commons/ograph_simple.mli b/commons/ograph_simple.mli index 1070fea..e3f24af 100644 --- a/commons/ograph_simple.mli +++ b/commons/ograph_simple.mli @@ -26,9 +26,9 @@ object ('o) end -val print_ograph_generic: - str_of_key:('key -> string) -> - str_of_node:('key -> 'node -> string) -> - Common.filename -> - ('key, 'node,'edge) ograph_mutable -> +val print_ograph_generic: + str_of_key:('key -> string) -> + str_of_node:('key -> 'node -> string) -> + Common.filename -> + ('key, 'node,'edge) ograph_mutable -> unit diff --git a/commons/oset.ml b/commons/oset.ml index 5116627..aef78e7 100644 --- a/commons/oset.ml +++ b/commons/oset.ml @@ -10,7 +10,7 @@ object(o: 'o) method virtual union: 'o -> 'o method virtual inter: 'o -> 'o method virtual minus: 'o -> 'o - + (* allow binary methods tricks, generate exception when not good type *) method tosetb: 'a Setb.t = raise Impossible method tosetpt: SetPt.t = raise Impossible @@ -18,21 +18,21 @@ object(o: 'o) method virtual toset: 'b. 'b (* generic (not safe) tricks *) (* is_intersect, equal, subset *) - method is_subset_of: 'o -> bool = fun o2 -> + method is_subset_of: 'o -> bool = fun o2 -> ((o2#minus o)#cardinal >= 0) && ((o#minus o2)#cardinal =|= 0) - method is_equal: 'o -> bool = fun o2 -> + method is_equal: 'o -> bool = fun o2 -> ((o2#minus o)#cardinal =|= 0) && ((o#minus o2)#cardinal =|= 0) - + method is_singleton: bool = (* can be short circuited *) o#length =|= 1 method cardinal: int = (* just to keep naming conventions *) - o#length - (* dont work: - method big_union: 'b. ('a -> 'b oset) -> 'b oset = fun f -> todo() + o#length + (* dont work: + method big_union: 'b. ('a -> 'b oset) -> 'b oset = fun f -> todo() *) - + end let ($??$) e xs = xs#mem e @@ -42,9 +42,9 @@ let ($--$) xs ys = xs#minus ys let ($<<=$) xs ys = xs#is_subset_of ys let ($==$) xs ys = xs#is_equal ys -(* todo: pas beau le seed. I dont put the type otherwise have to - * put explicit :> +(* todo: pas beau le seed. I dont put the type otherwise have to + * put explicit :> *) -let (mapo: ('a -> 'b) -> 'b oset -> 'a oset -> 'b oset) = fun f seed xs -> +let (mapo: ('a -> 'b) -> 'b oset -> 'a oset -> 'b oset) = fun f seed xs -> xs#fold (fun acc x -> acc#add (f x)) seed diff --git a/commons/oset.mli b/commons/oset.mli index 72b8e46..9cb456d 100644 --- a/commons/oset.mli +++ b/commons/oset.mli @@ -3,15 +3,15 @@ object ('o) inherit ['a] Ocollection.ocollection method cardinal : int - + method virtual inter : 'o -> 'o method virtual minus : 'o -> 'o method virtual union : 'o -> 'o - + method is_singleton : bool method is_subset_of : 'o -> bool method is_equal : 'o -> bool - + method virtual toset : 'd method tosetb : 'a Setb.t method toseti : Seti.seti diff --git a/commons/parser_combinators.ml b/commons/parser_combinators.ml index 0e44cb8..453ee58 100644 --- a/commons/parser_combinators.ml +++ b/commons/parser_combinators.ml @@ -1,7 +1,7 @@ (*****************************************************************************) (* *) (*****************************************************************************) -(* src: Jon Harrop. +(* src: Jon Harrop. * * "Certain applications are extremely well suited to functional * programming and parsing is one of them. Specifically, the ability to @@ -11,23 +11,23 @@ * conventional parser generators such as ocamllex and ocamlyacc. This * article explains how parser combinators may be designed and * implemented in OCaml, using the standard example of a calculator." - * + * * Based on haskell articles I guess like meijer functional pearl or * graham hutton articles. Also maybe based on haskell parsec. - * + * * pad: a few bugfix. I also put more restrictive and descriptive types. - * pad: I remember having coded such a library, maybe not in ocaml. + * pad: I remember having coded such a library, maybe not in ocaml. * Or maybe it was during a "TP compilation" at INSA ? I remember having * a generic lexer. Or maybe it was genlex ? - * - * - * - * + * + * + * + * * alternatives: genlex + parser extension of ocaml (streams). * cf genlex doc: - * + * * Example: a lexer suitable for a desk calculator is obtained by - * let lexer = make_lexer ["+";"-";"*";"/";"let";"="; "("; ")"] + * let lexer = make_lexer ["+";"-";"*";"/";"let";"="; "("; ")"] * let parse_expr = parser * [< 'Int n >] -> n * | [< 'Kwd "("; n = parse_expr; 'Kwd ")" >] -> n @@ -42,8 +42,8 @@ * | Float of float * | String of string * | Char of char - * - * + * + * * Cf also ocaml manual * let rec parse_expr = parser * [< e1 = parse_mult; e = parse_more_adds e1 >] -> e @@ -64,7 +64,7 @@ * | [< 'Kwd "("; e = parse_expr; 'Kwd ")" >] -> e;; * But see how they are forced to use a LL(1) grammar which denatures the * grammar "parse_more_xxx" - * + * *) (*****************************************************************************) @@ -85,11 +85,11 @@ let val_of_parser = fst (* pad: could also do it by returning a Maybe and use monad *) let ( ||| ) p1 p2 s = - try - p1 s - with Not_found -> + try + p1 s + with Not_found -> p2 s - + let ( +++ ) p1 p2 s = let e1, s = p1 s in let e2, s = p2 s in @@ -146,12 +146,12 @@ let alpha = function let symbol = function - | '(' | ')' - | '{' | '}' - | '[' | ']' - | '<' | '>' - | '+' | '-' | '*' | '/' - | '&' | '|' | '!' + | '(' | ')' + | '{' | '}' + | '[' | ']' + | '<' | '>' + | '+' | '-' | '*' | '/' + | '&' | '|' | '!' | '=' | '~' | '@' -> true @@ -180,7 +180,7 @@ let alphanum_under_minus c = digit c || alpha c || (c = '-') || (c = '_') let (+>) o f = f o -let string_of_chars cs = +let string_of_chars cs = cs +> List.map (String.make 1) +> String.concat "" @@ -231,17 +231,17 @@ let rawkeyword = (* todo: handle antislash *) -let rawstring = - pred stringquote +++ +let rawstring = + pred stringquote +++ several (fun c -> not (stringquote c)) +++ pred stringquote - >| (fun ((c1, cs), c3) -> + >| (fun ((c1, cs), c3) -> let s = string_of_chars cs in STR s (* exclude the marker *) ) -let lex_gen tokenf str = +let lex_gen tokenf str = let alltoks = (many tokenf) +++ fin >| fst in val_of_parser (alltoks (list_of_string str)) @@ -266,9 +266,9 @@ let lex (string : string) = -let test1 () = +let test1 () = Common.example - (lex "a x^2 + b x + c" + (lex "a x^2 + b x + c" = [IDENT "a"; IDENT "x"; KWD "^"; INT "2"; KWD "+"; IDENT "b"; IDENT "x"; KWD "+"; IDENT "c"] @@ -321,30 +321,30 @@ let string = function * indefinitely until a stack overflow occurs. Consequently, our * implementation of the factor parser is careful to parse an atom first, * and term calls factor first, to avoid this problem." - * + * * pad: bugfix, added the KWD "*". *) -(* pad: I think I remembered you cant eta-factorize the parameter +(* pad: I think I remembered you cant eta-factorize the parameter * when you use mutually recursive *) let rec atom s = ( - (int >| fun n -> Int(int_of_string n)) + (int >| fun n -> Int(int_of_string n)) ||| - (ident >| fun x -> Var x) + (ident >| fun x -> Var x) ||| (a (KWD "(") +++ term +++ a (KWD ")") >| fun ((_, e), _) -> e) ) s and factor s = ( - (atom +++ a (KWD "*") +++ factor >| fun ((f, _), g) -> Mul (f,g)) + (atom +++ a (KWD "*") +++ factor >| fun ((f, _), g) -> Mul (f,g)) ||| atom ) s and term s = ( - (factor +++ a (KWD "+") +++ term >| fun ((f, _), g) -> Add (f,g)) + (factor +++ a (KWD "+") +++ term >| fun ((f, _), g) -> Add (f,g)) ||| factor ) s @@ -356,7 +356,7 @@ let expr = let parse p string = val_of_parser(p(lex string)) -(* +(* parse expr "a x x + b x + c" *) diff --git a/commons/parser_combinators.mli b/commons/parser_combinators.mli index 791218c..b14c53b 100644 --- a/commons/parser_combinators.mli +++ b/commons/parser_combinators.mli @@ -1,5 +1,5 @@ (*****************************************************************************) -(* src: Jon Harrop. +(* src: Jon Harrop. * * "Certain applications are extremely well suited to functional * programming and parsing is one of them. Specifically, the ability to @@ -9,9 +9,9 @@ * conventional parser generators such as ocamllex and ocamlyacc. This * article explains how parser combinators may be designed and * implemented in OCaml, using the standard example of a calculator." - * + * * pad: a few bugfixes. I also put more restrictive and descriptive types. - * + * *) (*****************************************************************************) @@ -102,7 +102,7 @@ val rawstring : lexer val lex_gen : lexer -> string -> token list (*****************************************************************************) -val token : lexer +val token : lexer (* char list -> token * char list *) val tokens : (char, token list) genp (* char list -> token list * char list *) diff --git a/commons/seti.ml b/commons/seti.ml index 8313657..19896b2 100644 --- a/commons/seti.ml +++ b/commons/seti.ml @@ -5,38 +5,38 @@ open Common (* todo: could take an incr/decr func in param, to make it generic * opti: remember the min/max (optimisation to have intersect biggest x -> x) - * opti: avoid all those rev, and avoid the intervise + * opti: avoid all those rev, and avoid the intervise * (but yes the algo are then more complex :) - * opti: balanced set intervalle + * opti: balanced set intervalle *) (*****************************************************************************) type seti = elt list (* last elements is in first pos, ordered reverse *) and elt = Exact of int | Interv of int * int -(* invariant= ordered list, no incoherent interv (one elem or zero elem), +(* invariant= ordered list, no incoherent interv (one elem or zero elem), * merged (intervalle are separated) *) -let invariant xs = - let rec aux min xs = - xs +> List.fold_left (fun min e -> - match e with - | Exact i -> +let invariant xs = + let rec aux min xs = + xs +> List.fold_left (fun min e -> + match e with + | Exact i -> if i <= min then pr2 (sprintf "i = %d, min = %d" i min); (* todo: should be even stronger, shoud be i > min+1 *) assert (i > min); i - | Interv (i,j) -> + | Interv (i,j) -> assert (i > min); assert (j > i); j ) min in - ignore(aux min_int (List.rev xs)); + ignore(aux min_int (List.rev xs)); () -let string_of_seti xs = - "[" ^ - join "," (xs +> List.rev +> map (function +let string_of_seti xs = + "[" ^ + join "," (xs +> List.rev +> map (function | (Exact i) -> string_of_int i | (Interv (i,j)) -> Printf.sprintf "%d - %d" i j)) ^ "]" @@ -46,42 +46,42 @@ let empty = [] let pack newi j = function | [] -> [Interv (newi,j)] - | (Exact z)::xs -> + | (Exact z)::xs -> (Interv (newi, j))::(if newi =|= z then xs else (Exact z)::xs) - | (Interv (i', j'))::xs -> - if newi =|= j' + | (Interv (i', j'))::xs -> + if newi =|= j' then (Interv (i', j))::xs (* merge *) else (Interv (newi, j))::(Interv (i', j'))::xs - + (* the only possible merges are when x = i-1, otherwise, the job is done before *) -let rec (add2: int -> seti -> seti) = fun x -> function +let rec (add2: int -> seti -> seti) = fun x -> function | [] -> [Exact x] | (Exact i)::xs when x > i+1 -> (Exact x)::(Exact i)::xs | (Interv (i,j)::xs) when x > j+1 -> (Exact x)::(Interv (i,j))::xs | (Interv (i,j)::xs) when x =|= j+1 -> (Interv (i,x))::xs | (Exact i)::xs when x =|= i+1 -> (Interv (i,x))::xs - + | (Exact i)::xs when i =|= x -> (Exact i)::xs | (Interv (i,j)::xs) when x <= j && x >= i -> (Interv (i,j))::xs - | other -> + | other -> (* let _ = log "Cache miss" in *) let _ = count2 () in (match other with - | (Exact i)::xs when x =|= i-1 -> pack x i xs + | (Exact i)::xs when x =|= i-1 -> pack x i xs | (Exact i)::xs when x < i-1 -> (Exact i)::add x xs - + | (Interv (i,j)::xs) when x =|= i-1 -> pack x j xs | (Interv (i,j)::xs) when x < i-1 -> (Interv (i,j))::add x xs | _ -> raise Impossible ) -and add x y = let _ = count5 () in add2 x y +and add x y = let _ = count5 () in add2 x y + - let rec tolist2 = function | [] -> [] | (Exact i)::xs -> i::tolist2 xs - | (Interv (i,j))::xs -> enum i j @ tolist2 xs + | (Interv (i,j))::xs -> enum i j @ tolist2 xs let rec tolist xs = List.rev (tolist2 xs) let rec fromlist = function xs -> List.fold_left (fun a e -> add e a) empty xs @@ -95,18 +95,18 @@ let exactize = function let exactize2 x y = if x =|= y then Exact x else Interv (x,y) -let rec (remove: int -> seti -> seti) = fun x xs -> +let rec (remove: int -> seti -> seti) = fun x xs -> match xs with | [] -> [] (* pb, not in *) - | (Exact z)::zs -> + | (Exact z)::zs -> (match x <=> z with | Equal -> zs | Sup -> xs (* pb, not in *) | Inf -> (Exact z)::remove x zs - ) - | (Interv (i,j)::zs) -> + ) + | (Interv (i,j)::zs) -> if x > j then xs (* pb not in *) - else + else if x >= i && x <= j then ( let _ = assert (j > i) in (* otherwise can lead to construct seti such as [7,6] when removing 6 from [6,6] *) @@ -126,51 +126,51 @@ let _ = assert_equal (remove 3 [Interv (1, 7)]) [Interv (4,7); Interv (1,2)] let _ = assert_equal (remove 4 [Interv (3, 4)]) [Exact (3);] (* let _ = example (try (ignore(remove 6 [Interv (6, 6)] = []); false) with _ -> true) *) - + let rec mem e = function - | [] -> false - | (Exact x)::xs -> + | [] -> false + | (Exact x)::xs -> (match e <=> x with | Equal -> true | Sup -> false | Inf -> mem e xs - ) - | (Interv (i,j)::xs) -> + ) + | (Interv (i,j)::xs) -> if e > j then false - else + else if e >= i && e <= j then true else mem e xs -let iter f xs = xs +> List.iter +let iter f xs = xs +> List.iter (function | Exact i -> f i | Interv (i, j) -> for k = i to j do f k done ) - + let is_empty xs = xs =*= [] let choose = function | [] -> failwith "not supposed to be called with empty set" | (Exact i)::xs -> i | (Interv (i,j))::xs -> i - + let elements xs = tolist xs let rec cardinal = function | [] -> 0 | (Exact _)::xs -> 1+cardinal xs | (Interv (i,j)::xs) -> (j-i) +1 + cardinal xs - + (*****************************************************************************) (* TODO: could return corresponding osetb ? *) -let rec inter xs ys = - let rec aux = fun xs ys -> +let rec inter xs ys = + let rec aux = fun xs ys -> match (xs, ys) with | (_, []) -> [] | ([],_) -> [] - | (x::xs, y::ys) -> + | (x::xs, y::ys) -> (match (x, y) with - | (Interv (i1, j1), Interv (i2, j2)) -> + | (Interv (i1, j1), Interv (i2, j2)) -> (match i1 <=> i2 with - | Equal -> + | Equal -> (match j1 <=> j2 with | Equal -> (Interv (i1,j1))::aux xs ys (* [ ] *) @@ -182,11 +182,11 @@ let rec inter xs ys = (* [ ] *) (* [ ] [ same *) ) - | Inf -> + | Inf -> if j1 < i2 then aux xs (y::ys) (* need order ? *) (* [ ] *) (* [ ] *) - else + else (match j1 <=> j2 with | Equal -> (Interv (i2, j1))::aux xs ys (* [ ] *) @@ -205,17 +205,17 @@ let rec inter xs ys = in (* TODO avoid the rev rev, but aux good ? need order ? *) List.rev_map exactize (aux (List.rev_map intervise xs) (List.rev_map intervise ys)) - -let union xs ys = - let rec aux = fun xs ys -> + +let union xs ys = + let rec aux = fun xs ys -> match (xs, ys) with | (vs, []) -> vs | ([],vs) -> vs - | (x::xs, y::ys) -> + | (x::xs, y::ys) -> (match (x, y) with - | (Interv (i1, j1), Interv (i2, j2)) -> + | (Interv (i1, j1), Interv (i2, j2)) -> (match i1 <=> i2 with - | Equal -> + | Equal -> (match j1 <=> j2 with | Equal -> (Interv (i1,j1))::aux xs ys (* [ ] *) @@ -227,11 +227,11 @@ let union xs ys = (* [ ] *) (* [ ] [ same *) ) - | Inf -> + | Inf -> if j1 < i2 then Interv (i1, j1):: aux xs (y::ys) (* [ ] *) (* [ ] *) - else + else (match j1 <=> j2 with | Equal -> (Interv (i1, j1))::aux xs ys (* [ ] *) @@ -255,16 +255,16 @@ let union xs ys = * not very strong, should return (Interv (1,4)) *) (* let _ = Example (union [Interv (1, 4)] [Interv (1, 3)] = ([Exact 4; Interv (1,3)])) *) -let diff xs ys = - let rec aux = fun xs ys -> +let diff xs ys = + let rec aux = fun xs ys -> match (xs, ys) with | (vs, []) -> vs | ([],vs) -> [] - | (x::xs, y::ys) -> + | (x::xs, y::ys) -> (match (x, y) with - | (Interv (i1, j1), Interv (i2, j2)) -> + | (Interv (i1, j1), Interv (i2, j2)) -> (match i1 <=> i2 with - | Equal -> + | Equal -> (match j1 <=> j2 with | Equal -> aux xs ys (* [ ] *) @@ -276,11 +276,11 @@ let diff xs ys = (* [ ] *) (* [ ] *) ) - | Inf -> + | Inf -> if j1 < i2 then Interv (i1, j1):: aux xs (y::ys) (* [ ] *) (* [ ] *) - else + else (match j1 <=> j2 with | Equal -> (Interv (i1, i2-1))::aux xs ys (* -1 cos exlude [ *) (* [ ] *) @@ -292,11 +292,11 @@ let diff xs ys = (* [ ] *) (* [ ] *) ) - | Sup -> + | Sup -> if j2 < i1 then aux (x::xs) ys (* [ ] *) (* [ ] *) - else + else (match j1 <=> j2 with | Equal -> aux xs ys (* [ ] *) @@ -317,7 +317,7 @@ let diff xs ys = (* let _ = Example (diff [Interv (3,7)] [Interv (4,5)] = [Interv (6, 7); Exact 3]) *) - + (*****************************************************************************) let rec debug = function | [] -> "" @@ -327,22 +327,22 @@ let rec debug = function (*****************************************************************************) (* if operation return wrong result, then may later have to patch them *) let patch1 xs = List.map exactize xs -let patch2 xs = xs +> List.map (fun e -> +let patch2 xs = xs +> List.map (fun e -> match e with - | Interv (i,j) when i > j && i =|= j+1 -> + | Interv (i,j) when i > j && i =|= j+1 -> let _ = pr2 (sprintf "i = %d, j = %d" i j) in Exact i | e -> e ) -let patch3 xs = - let rec aux min xs = - xs +> List.fold_left (fun (min,acc) e -> - match e with - | Exact i -> - if i =|= min +let patch3 xs = + let rec aux min xs = + xs +> List.fold_left (fun (min,acc) e -> + match e with + | Exact i -> + if i =|= min then (min, acc) else (i, (Exact i)::acc) - | Interv (i,j) -> + | Interv (i,j) -> (j, (Interv (i,j)::acc)) ) (min, []) in diff --git a/commons/sexp_common.ml b/commons/sexp_common.ml index 208d760..70ea49c 100644 --- a/commons/sexp_common.ml +++ b/commons/sexp_common.ml @@ -25,14 +25,14 @@ let either_of_sexp__ = Conv_error.nested_list_invalid_sum _loc sexp | (Sexp.List [] as sexp) -> Conv_error.empty_list_invalid_sum _loc sexp | sexp -> Conv_error.unexpected_stag _loc sexp - + let either_of_sexp _of_a _of_b sexp = either_of_sexp__ _of_a _of_b sexp - + let sexp_of_either _of_a _of_b = function | Left v1 -> let v1 = _of_a v1 in Sexp.List [ Sexp.Atom "Left"; v1 ] | Right v1 -> let v1 = _of_b v1 in Sexp.List [ Sexp.Atom "Right"; v1 ] - + let either3_of_sexp__ = let _loc = "Xxx.either3" in @@ -63,46 +63,46 @@ let either3_of_sexp__ = Conv_error.nested_list_invalid_sum _loc sexp | (Sexp.List [] as sexp) -> Conv_error.empty_list_invalid_sum _loc sexp | sexp -> Conv_error.unexpected_stag _loc sexp - + let either3_of_sexp _of_a _of_b _of_c sexp = either3_of_sexp__ _of_a _of_b _of_c sexp - + let sexp_of_either3 _of_a _of_b _of_c = function | Left3 v1 -> let v1 = _of_a v1 in Sexp.List [ Sexp.Atom "Left3"; v1 ] | Middle3 v1 -> let v1 = _of_b v1 in Sexp.List [ Sexp.Atom "Middle3"; v1 ] | Right3 v1 -> let v1 = _of_c v1 in Sexp.List [ Sexp.Atom "Right3"; v1 ] - + let filename_of_sexp__ = let _loc = "Xxx.filename" in fun sexp -> Conv.string_of_sexp sexp - + let filename_of_sexp sexp = try filename_of_sexp__ sexp with | Conv_error.No_variant_match ((msg, sexp)) -> Conv.of_sexp_error msg sexp - + let sexp_of_filename v = Conv.sexp_of_string v - + let dirname_of_sexp__ = let _loc = "Xxx.dirname" in fun sexp -> Conv.string_of_sexp sexp - + let dirname_of_sexp sexp = try dirname_of_sexp__ sexp with | Conv_error.No_variant_match ((msg, sexp)) -> Conv.of_sexp_error msg sexp - + let sexp_of_dirname v = Conv.sexp_of_string v - + let set_of_sexp__ = let _loc = "Xxx.set" in fun _of_a -> Conv.list_of_sexp _of_a - + let set_of_sexp _of_a sexp = try set_of_sexp__ _of_a sexp with | Conv_error.No_variant_match ((msg, sexp)) -> Conv.of_sexp_error msg sexp - + let sexp_of_set _of_a = Conv.sexp_of_list _of_a - + let assoc_of_sexp__ = let _loc = "Xxx.assoc" in @@ -112,38 +112,38 @@ let assoc_of_sexp__ = | Sexp.List ([ v1; v2 ]) -> let v1 = _of_a v1 and v2 = _of_b v2 in (v1, v2) | sexp -> Conv_error.tuple_of_size_n_expected _loc 2 sexp) - + let assoc_of_sexp _of_a _of_b sexp = try assoc_of_sexp__ _of_a _of_b sexp with | Conv_error.No_variant_match ((msg, sexp)) -> Conv.of_sexp_error msg sexp - + let sexp_of_assoc _of_a _of_b = Conv.sexp_of_list (fun (v1, v2) -> let v1 = _of_a v1 and v2 = _of_b v2 in Sexp.List [ v1; v2 ]) - + let hashset_of_sexp__ = let _loc = "Xxx.hashset" in fun _of_a -> Conv.hashtbl_of_sexp _of_a Conv.bool_of_sexp - + let hashset_of_sexp _of_a sexp = try hashset_of_sexp__ _of_a sexp with | Conv_error.No_variant_match ((msg, sexp)) -> Conv.of_sexp_error msg sexp - + let sexp_of_hashset _of_a = Conv.sexp_of_hashtbl _of_a Conv.sexp_of_bool - + let stack_of_sexp__ = let _loc = "Xxx.stack" in fun _of_a -> Conv.list_of_sexp _of_a - + let stack_of_sexp _of_a sexp = try stack_of_sexp__ _of_a sexp with | Conv_error.No_variant_match ((msg, sexp)) -> Conv.of_sexp_error msg sexp - + let sexp_of_stack _of_a = Conv.sexp_of_list _of_a - + let parse_info_of_sexp__ = let _loc = "Xxx.parse_info" in @@ -222,9 +222,9 @@ let parse_info_of_sexp__ = ((!column_field = None), "column"); ((!file_field = None), "file") ])) | (Sexp.Atom _ as sexp) -> Conv_error.record_list_instead_atom _loc sexp - + let parse_info_of_sexp sexp = parse_info_of_sexp__ sexp - + let sexp_of_parse_info { str = v_str; charpos = v_charpos; @@ -248,7 +248,7 @@ let sexp_of_parse_info { let arg = Conv.sexp_of_string v_str in let bnd = Sexp.List [ Sexp.Atom "str"; arg ] in let bnds = bnd :: bnds in Sexp.List bnds - + let score_result_of_sexp__ = @@ -268,29 +268,29 @@ let score_result_of_sexp__ = Conv_error.nested_list_invalid_sum _loc sexp | (Sexp.List [] as sexp) -> Conv_error.empty_list_invalid_sum _loc sexp | sexp -> Conv_error.unexpected_stag _loc sexp - + let score_result_of_sexp sexp = score_result_of_sexp__ sexp - + let sexp_of_score_result = function | Ok -> Sexp.Atom "Ok" | Pb v1 -> let v1 = Conv.sexp_of_string v1 in Sexp.List [ Sexp.Atom "Pb"; v1 ] - + let score_of_sexp__ = let _loc = "Xxx.score" in fun sexp -> Conv.hashtbl_of_sexp Conv.string_of_sexp score_result_of_sexp sexp - + let score_of_sexp sexp = try score_of_sexp__ sexp with | Conv_error.No_variant_match ((msg, sexp)) -> Conv.of_sexp_error msg sexp - + let sexp_of_score v = Conv.sexp_of_hashtbl Conv.sexp_of_string sexp_of_score_result v - + let score_list_of_sexp__ = let _loc = "Xxx.score_list" @@ -304,12 +304,12 @@ let score_list_of_sexp__ = in (v1, v2) | sexp -> Conv_error.tuple_of_size_n_expected _loc 2 sexp) sexp - + let score_list_of_sexp sexp = try score_list_of_sexp__ sexp with | Conv_error.No_variant_match ((msg, sexp)) -> Conv.of_sexp_error msg sexp - + let sexp_of_score_list v = Conv.sexp_of_list (fun (v1, v2) -> diff --git a/configure b/configure index 904e421..7520c8c 100755 --- a/configure +++ b/configure @@ -28,18 +28,15 @@ my $projectcmdline = my $prefix="/usr/local"; my $python=1; -my $trac=0; my $opt=".opt"; my $tarzan=1; local $_ = join ' ', @ARGV; # Parse options -/-h/ || /--help/ and die "usage: $0 [--prefix=path] [--without-python] [--with-trac] [--no-opt]\n\n\t--no-opt\tDo not use the optimimized version of OCaml\n\t--opt\tUse the optimimized version of OCaml\n\n"; +/-h/ || /--help/ and die "usage: $0 [--prefix=path] [--without-python] [--no-opt]\n\n\t--no-opt\tDo not use the optimimized version of OCaml\n\t--opt\tUse the optimimized version of OCaml\n\n"; /--prefix=([^ ]*)/ and $prefix = $1; /--without-python/ and $python = 0; -/--without-trac/ and $trac = 0; -/--with-trac/ and $trac = 1; /--no-opt/ and $opt = ""; /--opt/ and $opt = ".opt"; @@ -301,17 +298,3 @@ my $pythonprefix = $python ? "yes_" : "no_"; my $command = "perl -p -e 's#Not_found.\*#Not_found->\\\"$src\\\"#' globals/config.ml.in > globals/config.ml"; `$command`; -# -# Configuration of python with or without trac -# -`cd python/coccilib; ln -sf output_base.py output.py;`; -if($trac) { -# Switch between implementation -# in python/coccilib -pr2 "Selecting python trac extension"; -`cd python/coccilib; ln -sf output_trac.py output.py;`; -} - - - - diff --git a/copyright.txt b/copyright.txt index b1d1ee7..0381f28 100644 --- a/copyright.txt +++ b/copyright.txt @@ -1,5 +1,6 @@ -Coccinelle - Julia Lawall, Yoann Padioleau, Rene Rydhof Hansen, Henrik Stuart +Coccinelle - Julia Lawall, Yoann Padioleau, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix +Copyright (C) 2010 INRIA, University of Copenhagen DIKU Copyright (C) 2005-2009 University of Copenhagen DIKU, Ecole des Mines de Nantes This program is free software; you can redistribute it and/or diff --git a/ctl/Makefile b/ctl/Makefile index 77e1919..2e7ee66 100644 --- a/ctl/Makefile +++ b/ctl/Makefile @@ -1,4 +1,4 @@ -# Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen +# Copyright 2005-2010, Ecole des Mines de Nantes, University of Copenhagen # Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix # This file is part of Coccinelle. # diff --git a/ctl/ast_ctl.ml b/ctl/ast_ctl.ml index e2417c8..4f86223 100644 --- a/ctl/ast_ctl.ml +++ b/ctl/ast_ctl.ml @@ -1,5 +1,5 @@ (* - * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen + * Copyright 2005-2010, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * @@ -30,21 +30,21 @@ type strict = STRICT | NONSTRICT type keep_binding = bool (* true = put in witness tree *) (* CTL parameterised on basic predicates and metavar's*) -type ('pred,'mvar,'anno) generic_ctl = +type ('pred,'mvar,'anno) generic_ctl = | False | True | Pred of 'pred | Not of (('pred,'mvar,'anno) generic_ctl) | Exists of keep_binding * 'mvar * (('pred,'mvar,'anno) generic_ctl) - | And of strict * (('pred,'mvar,'anno) generic_ctl) * + | And of strict * (('pred,'mvar,'anno) generic_ctl) * (('pred,'mvar,'anno) generic_ctl) - | AndAny of direction * strict * (('pred,'mvar,'anno) generic_ctl) * + | AndAny of direction * strict * (('pred,'mvar,'anno) generic_ctl) * (('pred,'mvar,'anno) generic_ctl) - | HackForStmt of direction * strict * (('pred,'mvar,'anno) generic_ctl) * + | HackForStmt of direction * strict * (('pred,'mvar,'anno) generic_ctl) * (('pred,'mvar,'anno) generic_ctl) - | Or of (('pred,'mvar,'anno) generic_ctl) * + | Or of (('pred,'mvar,'anno) generic_ctl) * (('pred,'mvar,'anno) generic_ctl) - | Implies of (('pred,'mvar,'anno) generic_ctl) * + | Implies of (('pred,'mvar,'anno) generic_ctl) * (('pred,'mvar,'anno) generic_ctl) | AF of direction * strict * (('pred,'mvar,'anno) generic_ctl) | AX of direction * strict * (('pred,'mvar,'anno) generic_ctl) @@ -58,16 +58,16 @@ type ('pred,'mvar,'anno) generic_ctl = | EF of direction * (('pred,'mvar,'anno) generic_ctl) | EX of direction * (('pred,'mvar,'anno) generic_ctl) | EG of direction * (('pred,'mvar,'anno) generic_ctl) - | EU of direction * (('pred,'mvar,'anno) generic_ctl) * + | EU of direction * (('pred,'mvar,'anno) generic_ctl) * (('pred,'mvar,'anno) generic_ctl) - | Let of string * - (('pred,'mvar,'anno) generic_ctl) * + | Let of string * + (('pred,'mvar,'anno) generic_ctl) * (('pred,'mvar,'anno) generic_ctl) | LetR of direction * string * (* evals phi1 wrt reachable states *) - (('pred,'mvar,'anno) generic_ctl) * + (('pred,'mvar,'anno) generic_ctl) * (('pred,'mvar,'anno) generic_ctl) | Ref of string - | SeqOr of (('pred,'mvar,'anno) generic_ctl) * + | SeqOr of (('pred,'mvar,'anno) generic_ctl) * (('pred,'mvar,'anno) generic_ctl) | Uncheck of (('pred,'mvar,'anno) generic_ctl) | InnerAnd of (('pred,'mvar,'anno) generic_ctl) @@ -81,7 +81,7 @@ let get_line (_,l) = l (* NOTE: No explicit representation of the bottom subst., i.e., FALSE *) -type ('mvar,'value) generic_subst = +type ('mvar,'value) generic_subst = | Subst of 'mvar * 'value | NegSubst of 'mvar * 'value type ('mvar,'value) generic_substitution = ('mvar,'value) generic_subst list diff --git a/ctl/ctl_engine.ml b/ctl/ctl_engine.ml index b202ad8..ee029fb 100644 --- a/ctl/ctl_engine.ml +++ b/ctl/ctl_engine.ml @@ -1,5 +1,5 @@ (* - * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen + * Copyright 2005-2010, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * @@ -95,8 +95,8 @@ let new_let _ = (* ********************************************************************** * - * Implementation of a Witness Tree model checking engine for CTL-FVex - * + * Implementation of a Witness Tree model checking engine for CTL-FVex + * * * **********************************************************************) @@ -134,7 +134,7 @@ module type GRAPH = end ;; -module OGRAPHEXT_GRAPH = +module OGRAPHEXT_GRAPH = struct type node = int;; type cfg = (string,unit) Ograph_extended.ograph_mutable;; @@ -165,7 +165,7 @@ let get_graph_comp_files outfile = Hashtbl.find_all graph_hash outfile let head = List.hd -let tail l = +let tail l = match l with [] -> [] | (x::xs) -> xs @@ -203,13 +203,13 @@ let rec some_tolist opts = match opts with | [] -> [] | (Some x)::rest -> x::(some_tolist rest) - | _::rest -> some_tolist rest + | _::rest -> some_tolist rest ;; let rec groupBy eq l = match l with [] -> [] - | (x::xs) -> + | (x::xs) -> let (xs1,xs2) = partition (fun x' -> eq x x') xs in (x::xs1)::(groupBy eq xs2) ;; @@ -282,7 +282,7 @@ let get_states l = nub (List.map (function (s,_,_) -> s) l) (* ********************************************************************** *) module CTL_ENGINE = - functor (SUB : SUBST) -> + functor (SUB : SUBST) -> functor (G : GRAPH) -> functor (P : PREDICATE) -> struct @@ -307,7 +307,7 @@ let (print_generic_substitution : substitution -> unit) = fun substxs -> let print_generic_subst = function A.Subst (mvar, v) -> SUB.print_mvar mvar; Format.print_string " --> "; SUB.print_value v - | A.NegSubst (mvar, v) -> + | A.NegSubst (mvar, v) -> SUB.print_mvar mvar; Format.print_string " -/-> "; SUB.print_value v in Format.print_string "["; Common.print_between (fun () -> Format.print_string ";" ) @@ -316,16 +316,16 @@ let (print_generic_substitution : substitution -> unit) = fun substxs -> let rec (print_generic_witness: ('pred, 'anno) witness -> unit) = function - | A.Wit (state, subst, anno, childrens) -> + | A.Wit (state, subst, anno, childrens) -> Format.print_string "wit "; G.print_node state; print_generic_substitution subst; (match childrens with [] -> Format.print_string "{}" - | _ -> + | _ -> Format.force_newline(); Format.print_string " "; Format.open_box 0; print_generic_witnesstree childrens; Format.close_box()) - | A.NegWit(wit) -> + | A.NegWit(wit) -> Format.print_string "!"; print_generic_witness wit @@ -334,17 +334,17 @@ and (print_generic_witnesstree: ('pred,'anno) witness list -> unit) = Format.open_box 1; Format.print_string "{"; Common.print_between - (fun () -> Format.print_string ";"; Format.force_newline() ) + (fun () -> Format.print_string ";"; Format.force_newline() ) print_generic_witness witnesstree; Format.print_string "}"; Format.close_box() - + and print_generic_triple (node,subst,tree) = G.print_node node; print_generic_substitution subst; print_generic_witnesstree tree -and (print_generic_algo : ('pred,'anno) triples -> unit) = fun xs -> +and (print_generic_algo : ('pred,'anno) triples -> unit) = fun xs -> Format.print_string "<"; Common.print_between (fun () -> Format.print_string ";"; Format.force_newline()) @@ -358,7 +358,7 @@ let print_state (str : string) (l : ('pred,'anno) triples) = print_generic_triple x; Format.print_newline(); flush stdout) (List.sort compare l); Printf.printf "\n" - + let print_required_states = function None -> Printf.printf "no required states\n" | Some states -> @@ -396,8 +396,8 @@ let print_graph grp required_states res str = function ) in (if not (List.mem file !graph_stack) then graph_stack := file :: !graph_stack); - let filename = Filename.temp_file (file^":") ".dot" in - Hashtbl.add graph_hash file filename; + let filename = Filename.temp_file (file^":") ".dot" in + Hashtbl.add graph_hash file filename; G.print_graph grp (if !Flag_ctl.gt_without_label then None else (Some label)) (match required_states with @@ -413,26 +413,26 @@ let print_graph_c grp required_states res ctr phi = (* ---------------------------------------------------------------------- *) (* *) (* ---------------------------------------------------------------------- *) - - + + (* ************************* *) (* Substitutions *) (* ************************* *) - + let dom_sub sub = match sub with | A.Subst(x,_) -> x | A.NegSubst(x,_) -> x ;; - + let ran_sub sub = match sub with | A.Subst(_,x) -> x | A.NegSubst(_,x) -> x ;; - + let eq_subBy eqx eqv sub sub' = - match (sub,sub') with + match (sub,sub') with | (A.Subst(x,v),A.Subst(x',v')) -> (eqx x x') && (eqv v v') | (A.NegSubst(x,v),A.NegSubst(x',v')) -> (eqx x x') && (eqv v v') | _ -> false @@ -446,7 +446,7 @@ let eq_subst th th' = setequalBy eq_sub th th';; let merge_subBy eqx (===) (>+<) sub sub' = (* variable part is guaranteed to be the same *) match (sub,sub') with - (A.Subst (x,v),A.Subst (x',v')) -> + (A.Subst (x,v),A.Subst (x',v')) -> if (v === v') then Some [A.Subst(x, v >+< v')] else None @@ -471,17 +471,17 @@ let merge_subBy eqx (===) (>+<) sub sub' = ;; (* NOTE: functor *) -let merge_sub sub sub' = +let merge_sub sub sub' = merge_subBy SUB.eq_mvar SUB.eq_val SUB.merge_val sub sub' let clean_substBy eq cmp theta = List.sort cmp (nubBy eq theta);; (* NOTE: we sort by using the generic "compare" on (meta-)variable - * names; we could also require a definition of compare for meta-variables + * names; we could also require a definition of compare for meta-variables * or substitutions but that seems like overkill for sorting *) -let clean_subst theta = - let res = +let clean_subst theta = + let res = clean_substBy eq_sub (fun s s' -> let res = compare (dom_sub s) (dom_sub s') in @@ -504,7 +504,7 @@ let top_subst = [];; (* Always TRUE subst. *) (* Split a theta in two parts: one with (only) "x" and one without *) (* NOTE: functor *) -let split_subst theta x = +let split_subst theta x = partition (fun sub -> SUB.eq_mvar (dom_sub sub) x) theta;; exception SUBST_MISMATCH @@ -652,7 +652,7 @@ let normalize trips = List.map (function (st,th,wit) -> (st,List.sort compare th,List.sort compare wit)) trips - + (* conj opt doesn't work ((1,[],{{x=3}}) v (1,[],{{x=4}})) & (1,[],{{x=4}}) = (1,[],{{x=3},{x=4}}), not (1,[],{{x=4}}) *) @@ -751,11 +751,11 @@ type ('a) state = ;; let compatible_states = function - (PosState s1, PosState s2) -> + (PosState s1, PosState s2) -> if s1 = s2 then Some (PosState s1) else None - | (PosState s1, NegState s2) -> + | (PosState s1, NegState s2) -> if List.mem s1 s2 then None else Some (PosState s1) - | (NegState s1, PosState s2) -> + | (NegState s1, PosState s2) -> if List.mem s2 s1 then None else Some (PosState s2) | (NegState s1, NegState s2) -> Some (NegState (s1 @ s2)) ;; @@ -789,7 +789,7 @@ let triples_state_conj trips trips' = shared trips ;; -let triple_negate (s,th,wits) = +let triple_negate (s,th,wits) = let negstates = (NegState [s],top_subst,top_wit) in let negths = map (fun th -> (PosState s,th,top_wit)) (negate_subst th) in let negwits = map (fun nwit -> (PosState s,th,nwit)) (negate_wits wits) in @@ -841,7 +841,7 @@ let triples_complement states (trips : ('pred, 'anno) triples) = (negstates x @ negths x @ negwits x) xs) ;; -let triple_negate (s,th,wits) = +let triple_negate (s,th,wits) = let negths = map (fun th -> (s,th,top_wit)) (negate_subst th) in let negwits = map (fun nwit -> (s,th,nwit)) (negate_wits wits) in ([s], negths @ negwits) (* all different *) @@ -943,7 +943,7 @@ let triples_witness x unchecked not_keep trips = List.for_all (function A.NegWit _ -> true | A.Wit _ -> false) in let negtopos = List.map (function A.NegWit w -> w | A.Wit _ -> failwith "bad wit")in - let res = + let res = List.fold_left (function prev -> function (s,th,wit) as t -> @@ -1050,7 +1050,7 @@ let pre_forall dir (grp,_,states) y all reqst = | _ -> (*normalize*) (foldl1 (@) (List.map (foldl1 triples_conj) neighbor_triples)) - + let pre_forall_AW dir (grp,_,states) y all reqst = let check s = match reqst with @@ -1088,15 +1088,15 @@ let pre_forall_AW dir (grp,_,states) y all reqst = match neighbor_triples with [] -> [] | _ -> foldl1 (@) (List.map (foldl1 triples_conj_AW) neighbor_triples) - + (* drop_negwits will call setify *) let satEX dir m s reqst = pre_exist dir m s reqst;; - + let satAX dir m s reqst = pre_forall dir m s s reqst ;; (* E[phi1 U phi2] == phi2 \/ (phi1 /\ EXE[phi1 U phi2]) *) -let satEU dir ((_,_,states) as m) s1 s2 reqst print_graph = +let satEU dir ((_,_,states) as m) s1 s2 reqst print_graph = (*Printf.printf "EU\n"; let ctr = ref 0 in*) inc satEU_calls; @@ -1134,7 +1134,7 @@ let satEU dir ((_,_,states) as m) s1 s2 reqst print_graph = ;; (* EF phi == E[true U phi] *) -let satEF dir m s2 reqst = +let satEF dir m s2 reqst = inc satEF_calls; (*let ctr = ref 0 in*) if !pNEW_INFO_OPT @@ -1293,7 +1293,7 @@ let satAW dir ((grp,_,states) as m) s1 s2 reqst = setgfix f (triples_union (nub(drop_wits s1)) s2) ;; -let satAF dir m s reqst = +let satAF dir m s reqst = inc satAF_calls; if !pNEW_INFO_OPT then @@ -1393,7 +1393,7 @@ let left_strict_triples_conj strict states trips trips' = triples_union res fail_left else res -let strict_A1 strict op failop dir ((_,_,states) as m) trips required_states = +let strict_A1 strict op failop dir ((_,_,states) as m) trips required_states = let res = op dir m trips required_states in if !Flag_ctl.partial_match && strict = A.STRICT then @@ -1403,7 +1403,7 @@ let strict_A1 strict op failop dir ((_,_,states) as m) trips required_states = else res let strict_A2 strict op failop dir ((_,_,states) as m) trips trips' - required_states = + required_states = let res = op dir m trips trips' required_states in if !Flag_ctl.partial_match && strict = A.STRICT then @@ -1411,9 +1411,9 @@ let strict_A2 strict op failop dir ((_,_,states) as m) trips trips' let fail = filter_conj states res (failop dir m trips' required_states) in triples_union res fail else res - + let strict_A2au strict op failop dir ((_,_,states) as m) trips trips' - required_states print_graph = + required_states print_graph = match op dir m trips trips' required_states print_graph with AUok res -> if !Flag_ctl.partial_match && strict = A.STRICT @@ -1424,7 +1424,7 @@ let strict_A2au strict op failop dir ((_,_,states) as m) trips trips' AUok (triples_union res fail) else AUok res | AUfailed res -> AUfailed res - + (* ********************* *) (* Environment functions *) (* ********************* *) @@ -1843,9 +1843,9 @@ let rec satloop unchecked required required_states let res = drop_wits required_states res phi (* ) *) in print_graph grp required_states res "" phi; res in - + loop unchecked required required_states phi -;; +;; (* SAT with tracking *) @@ -1870,19 +1870,19 @@ let rec sat_verbose_loop unchecked required required_states annot maxlvl lvl let (child1,res1) = satv unchecked required required_states phi1 env in Printf.printf "uncheck\n"; flush stdout; anno res1 [child1] - | A.Not(phi1) -> + | A.Not(phi1) -> let (child,res) = satv unchecked required required_states phi1 env in Printf.printf "not\n"; flush stdout; anno (triples_complement (mkstates states required_states) res) [child] - | A.Or(phi1,phi2) -> + | A.Or(phi1,phi2) -> let (child1,res1) = satv unchecked required required_states phi1 env in let (child2,res2) = satv unchecked required required_states phi2 env in Printf.printf "or\n"; flush stdout; anno (triples_union res1 res2) [child1; child2] - | A.SeqOr(phi1,phi2) -> + | A.SeqOr(phi1,phi2) -> let (child1,res1) = satv unchecked required required_states phi1 env in let (child2,res2) = @@ -1896,7 +1896,7 @@ let rec sat_verbose_loop unchecked required required_states annot maxlvl lvl res1neg) res2)) [child1; child2] - | A.And(strict,phi1,phi2) -> + | A.And(strict,phi1,phi2) -> let pm = !Flag_ctl.partial_match in (match (pm,satv unchecked required required_states phi1 env) with (false,(child1,[])) -> @@ -1916,7 +1916,7 @@ let rec sat_verbose_loop unchecked required required_states annot maxlvl lvl res1 res2 in anno res [child1; child2])) | A.AndAny(dir,strict,phi1,phi2) -> - let pm = !Flag_ctl.partial_match in + let pm = !Flag_ctl.partial_match in (match (pm,satv unchecked required required_states phi1 env) with (false,(child1,[])) -> Printf.printf "and\n"; flush stdout; anno [] [child1] @@ -1935,7 +1935,7 @@ let rec sat_verbose_loop unchecked required required_states annot maxlvl lvl [] -> (* !Flag_ctl.partial_match must be true *) if res2 = [] then anno [] [child1; child2] - else + else let res = let s = mkstates states required_states in List.fold_left @@ -1958,7 +1958,7 @@ let rec sat_verbose_loop unchecked required required_states annot maxlvl lvl failwith "only one result allowed for the left arg of AndAny"))) | A.HackForStmt(dir,strict,phi1,phi2) -> - let pm = !Flag_ctl.partial_match in + let pm = !Flag_ctl.partial_match in (match (pm,satv unchecked required required_states phi1 env) with (false,(child1,[])) -> Printf.printf "and\n"; flush stdout; anno [] [child1] @@ -1988,14 +1988,14 @@ let rec sat_verbose_loop unchecked required required_states annot maxlvl lvl let (child1,res1) = satv unchecked required required_states phi1 env in Printf.printf "uncheck\n"; flush stdout; anno (inner_and res1) [child1] - | A.EX(dir,phi1) -> + | A.EX(dir,phi1) -> let new_required_states = get_children_required_states dir m required_states in let (child,res) = satv unchecked required new_required_states phi1 env in Printf.printf "EX\n"; flush stdout; anno (satEX dir m res required_states) [child] - | A.AX(dir,strict,phi1) -> + | A.AX(dir,strict,phi1) -> let new_required_states = get_children_required_states dir m required_states in let (child,res) = @@ -2003,13 +2003,13 @@ let rec sat_verbose_loop unchecked required required_states annot maxlvl lvl Printf.printf "AX\n"; flush stdout; let res = strict_A1 strict satAX satEX dir m res required_states in anno res [child] - | A.EF(dir,phi1) -> + | A.EF(dir,phi1) -> let new_required_states = get_reachable dir m required_states in let (child,res) = satv unchecked required new_required_states phi1 env in Printf.printf "EF\n"; flush stdout; anno (satEF dir m res new_required_states) [child] - | A.AF(dir,strict,phi1) -> + | A.AF(dir,strict,phi1) -> if !Flag_ctl.loop_in_src_code then satv unchecked required required_states @@ -2023,21 +2023,21 @@ let rec sat_verbose_loop unchecked required required_states annot maxlvl lvl let res = strict_A1 strict satAF satEF dir m res new_required_states in anno res [child]) - | A.EG(dir,phi1) -> + | A.EG(dir,phi1) -> let new_required_states = get_reachable dir m required_states in let (child,res) = satv unchecked required new_required_states phi1 env in Printf.printf "EG\n"; flush stdout; anno (satEG dir m res new_required_states) [child] - | A.AG(dir,strict,phi1) -> + | A.AG(dir,strict,phi1) -> let new_required_states = get_reachable dir m required_states in let (child,res) = satv unchecked required new_required_states phi1 env in Printf.printf "AG\n"; flush stdout; let res = strict_A1 strict satAG satEF dir m res new_required_states in anno res [child] - - | A.EU(dir,phi1,phi2) -> + + | A.EU(dir,phi1,phi2) -> let new_required_states = get_reachable dir m required_states in (match satv unchecked required new_required_states phi2 env with (child2,[]) -> @@ -2050,7 +2050,7 @@ let rec sat_verbose_loop unchecked required required_states annot maxlvl lvl Printf.printf "EU\n"; flush stdout; anno (satEU dir m res1 res2 new_required_states (fun y str -> ())) [child1; child2]) - | A.AW(dir,strict,phi1,phi2) -> + | A.AW(dir,strict,phi1,phi2) -> failwith "should not be used" (* let new_required_states = get_reachable dir m required_states in (match satv unchecked required new_required_states phi2 env with @@ -2065,7 +2065,7 @@ let rec sat_verbose_loop unchecked required required_states annot maxlvl lvl strict_A2 strict satAW satEF dir m res1 res2 new_required_states in anno res [child1; child2]) *) - | A.AU(dir,strict,phi1,phi2) -> + | A.AU(dir,strict,phi1,phi2) -> let new_required_states = get_reachable dir m required_states in (match satv unchecked required new_required_states phi2 env with (child2,[]) -> @@ -2097,11 +2097,11 @@ let rec sat_verbose_loop unchecked required required_states annot maxlvl lvl let res = strict_A2 strict satAW satEF dir m s1 s2 new_required_states in anno res [child1; child2])) - | A.Implies(phi1,phi2) -> + | A.Implies(phi1,phi2) -> satv unchecked required required_states (A.Or(A.Not phi1,phi2)) env - | A.Exists (keep,v,phi1) -> + | A.Exists (keep,v,phi1) -> let new_required = drop_required v required in let (child,res) = satv unchecked new_required required_states phi1 env in @@ -2136,7 +2136,7 @@ let rec sat_verbose_loop unchecked required required_states annot maxlvl lvl print_required_states required_states; print_state "after drop_wits" res1 end; (child,res1) - + ;; let sat_verbose annotate maxlvl lvl m phi = @@ -2156,8 +2156,8 @@ let sat m phi = satloop m phi [] *) let simpleanno l phi res = - let pp s = - Format.print_string ("\n" ^ s ^ "\n------------------------------\n"); + let pp s = + Format.print_string ("\n" ^ s ^ "\n------------------------------\n"); print_generic_algo (List.sort compare res); Format.print_string "\n------------------------------\n\n" in let pp_dir = function @@ -2195,11 +2195,11 @@ let simpleanno l phi res = (* pad: Rene, you can now use the module pretty_print_ctl.ml to print a ctl formula more accurately if you want. - Use the print_xxx provided in the different module to call + Use the print_xxx provided in the different module to call Pretty_print_ctl.pp_ctl. *) -let simpleanno2 l phi res = +let simpleanno2 l phi res = begin Pretty_print_ctl.pp_ctl (P.print_predicate, SUB.print_mvar) false phi; Format.print_newline (); @@ -2376,7 +2376,7 @@ let bench_sat (_,_,states) fn = (List.iter (print_state "a state") answers; Printf.printf "something doesn't work\n"); res) - + let print_bench _ = let iterct = !Flag_ctl.bench in if iterct > 0 diff --git a/ctl/ctl_engine.mli b/ctl/ctl_engine.mli index eae3732..d7f9735 100644 --- a/ctl/ctl_engine.mli +++ b/ctl/ctl_engine.mli @@ -1,5 +1,5 @@ (* - * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen + * Copyright 2005-2010, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * @@ -34,9 +34,9 @@ module type SUBST = end module type GRAPH = - sig - type node - type cfg + sig + type node + type cfg val predecessors: cfg -> node -> node list val successors: cfg -> node -> node list val extract_is_loop : cfg -> node -> bool @@ -89,4 +89,4 @@ module CTL_ENGINE : val get_graph_files : unit -> string list val get_graph_comp_files : string -> string list - + diff --git a/ctl/flag_ctl.ml b/ctl/flag_ctl.ml index 87b584e..50c5d41 100644 --- a/ctl/flag_ctl.ml +++ b/ctl/flag_ctl.ml @@ -1,5 +1,5 @@ (* - * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen + * Copyright 2005-2010, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * diff --git a/ctl/pretty_print_ctl.ml b/ctl/pretty_print_ctl.ml index 75dfa88..3f4cfdf 100644 --- a/ctl/pretty_print_ctl.ml +++ b/ctl/pretty_print_ctl.ml @@ -1,5 +1,5 @@ (* - * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen + * Copyright 2005-2010, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * @@ -44,15 +44,15 @@ let char_not = "-|" *) (* need introduce the Val constructor, or use -rectype. *) -type ('a,'b,'c) environment = (string, ('a,'b,'c) binding_val) Common.assoc -and ('a, 'b, 'c) binding_val = +type ('a,'b,'c) environment = (string, ('a,'b,'c) binding_val) Common.assoc +and ('a, 'b, 'c) binding_val = Val of ('a,'b,'c) generic_ctl * ('a,'b,'c) environment -let rec (pp_ctl: - ('pred -> unit) * ('mvar -> unit) -> bool -> - ('pred, 'mvar, 'info) generic_ctl -> - unit) = - fun (pp_pred, pp_mvar) inline_let_def ctl -> +let rec (pp_ctl: + ('pred -> unit) * ('mvar -> unit) -> bool -> + ('pred, 'mvar, 'info) generic_ctl -> + unit) = + fun (pp_pred, pp_mvar) inline_let_def ctl -> let rec pp_aux env = function False -> pp "False" @@ -60,43 +60,43 @@ let rec (pp_ctl: | Pred(p) -> pp_pred p | Not(phi) -> pp char_not; Common.pp_do_in_box (fun () -> pp_aux env phi) - | Exists(keep,v,phi) -> + | Exists(keep,v,phi) -> pp "("; if keep then pp ("Ex ") else pp ("Ex_ "); pp_mvar v; - pp " . "; + pp " . "; print_cut(); - Common.pp_do_in_box (fun () -> pp_aux env phi); + Common.pp_do_in_box (fun () -> pp_aux env phi); pp ")"; | AndAny(dir,s,phi1,phi2) -> - pp_2args env (char_and_any^(pp_dirc dir)^(pp_sc s)) phi1 phi2; + pp_2args env (char_and_any^(pp_dirc dir)^(pp_sc s)) phi1 phi2; | HackForStmt(dir,s,phi1,phi2) -> - pp_2args env (char_hack^(pp_dirc dir)^(pp_sc s)) phi1 phi2; - | And(s,phi1,phi2) -> pp_2args env (char_and^(pp_sc s)) phi1 phi2; - | Or(phi1,phi2) -> pp_2args env char_or phi1 phi2; - | SeqOr(phi1,phi2) -> pp_2args env char_seqor phi1 phi2; + pp_2args env (char_hack^(pp_dirc dir)^(pp_sc s)) phi1 phi2; + | And(s,phi1,phi2) -> pp_2args env (char_and^(pp_sc s)) phi1 phi2; + | Or(phi1,phi2) -> pp_2args env char_or phi1 phi2; + | SeqOr(phi1,phi2) -> pp_2args env char_seqor phi1 phi2; | Implies(phi1,phi2) -> pp_2args env "=>" phi1 phi2; - | AF(dir,s,phi1) -> pp "AF"; pp_dir dir; pp_s s; pp_arg_paren env phi1; - | AX(dir,s,phi1) -> pp "AX"; pp_dir dir; pp_s s; pp_arg_paren env phi1; + | AF(dir,s,phi1) -> pp "AF"; pp_dir dir; pp_s s; pp_arg_paren env phi1; + | AX(dir,s,phi1) -> pp "AX"; pp_dir dir; pp_s s; pp_arg_paren env phi1; | AG(dir,s,phi1) -> pp "AG"; pp_dir dir; pp_s s; pp_arg_paren env phi1; | EF(dir,phi1) -> pp "EF"; pp_dir dir; pp_arg_paren env phi1; - | EX(dir,phi1) -> pp "EX"; pp_dir dir; pp_arg_paren env phi1; - | EG(dir,phi1) -> pp "EG"; pp_dir dir; pp_arg_paren env phi1; + | EX(dir,phi1) -> pp "EX"; pp_dir dir; pp_arg_paren env phi1; + | EG(dir,phi1) -> pp "EG"; pp_dir dir; pp_arg_paren env phi1; | AW(dir,s,phi1,phi2) -> - pp "A"; pp_dir dir; pp_s s; pp "["; - pp_2args_bis env "W" phi1 phi2; - pp "]" + pp "A"; pp_dir dir; pp_s s; pp "["; + pp_2args_bis env "W" phi1 phi2; + pp "]" | AU(dir,s,phi1,phi2) -> - pp "A"; pp_dir dir; pp_s s; pp "["; - pp_2args_bis env "U" phi1 phi2; - pp "]" + pp "A"; pp_dir dir; pp_s s; pp "["; + pp_2args_bis env "U" phi1 phi2; + pp "]" | EU(dir,phi1,phi2) -> - pp "E"; pp_dir dir; pp "["; - pp_2args_bis env "U" phi1 phi2; - pp "]" - | Let (x,phi1,phi2) -> + pp "E"; pp_dir dir; pp "["; + pp_2args_bis env "U" phi1 phi2; + pp "]" + | Let (x,phi1,phi2) -> let env' = (x, (Val (phi1,env)))::env in - + if not inline_let_def then begin @@ -105,13 +105,13 @@ let rec (pp_ctl: print_cut(); Common.pp_do_in_box (fun () -> pp_aux env phi1); print_space (); - pp "in"; + pp "in"; print_space (); end; pp_do_in_zero_box (fun () -> pp_aux env' phi2); - | LetR (dir,x,phi1,phi2) -> + | LetR (dir,x,phi1,phi2) -> let env' = (x, (Val (phi1,env)))::env in - + if not inline_let_def then begin @@ -120,18 +120,18 @@ let rec (pp_ctl: print_cut(); Common.pp_do_in_box (fun () -> pp_aux env phi1); print_space (); - pp "in"; + pp "in"; print_space (); end; pp_do_in_zero_box (fun () -> pp_aux env' phi2); - | Ref(s) -> + | Ref(s) -> if inline_let_def then let Val (phi1,env') = List.assoc s env in pp_aux env' phi1 - else + else (* pp "Ref("; *) - pp s + pp s (* pp ")" *) | Uncheck(phi1) -> pp "Uncheck"; pp_arg_paren env phi1 @@ -142,42 +142,42 @@ let rec (pp_ctl: and pp_dir = function FORWARD -> () | BACKWARD -> pp char_back - + and pp_dirc = function FORWARD -> "" | BACKWARD -> char_back - + and pp_s = function STRICT -> if !Flag_ctl.partial_match then pp "," else () | NONSTRICT -> () - + and pp_sc = function STRICT -> "," | NONSTRICT -> "" - - and pp_2args env sym phi1 phi2 = + + and pp_2args env sym phi1 phi2 = begin pp "("; - Common.pp_do_in_box (fun () -> pp_aux env phi1); + Common.pp_do_in_box (fun () -> pp_aux env phi1); print_space(); pp sym; print_space (); Common.pp_do_in_box (fun () -> pp_aux env phi2); pp ")"; end - and pp_2args_bis env sym phi1 phi2 = + and pp_2args_bis env sym phi1 phi2 = begin - Common.pp_do_in_box (fun () -> pp_aux env phi1); + Common.pp_do_in_box (fun () -> pp_aux env phi1); print_space(); pp sym; print_space(); Common.pp_do_in_box (fun () -> pp_aux env phi2); end - - and pp_arg_paren env phi = Common.pp_do_in_box (fun () -> + + and pp_arg_paren env phi = Common.pp_do_in_box (fun () -> pp "("; pp_aux env phi; pp ")"; - ) + ) in Common.pp_do_in_box (fun () -> pp_aux [] ctl;) diff --git a/ctl/pretty_print_ctl.mli b/ctl/pretty_print_ctl.mli index ed74fd0..9fbafe3 100644 --- a/ctl/pretty_print_ctl.mli +++ b/ctl/pretty_print_ctl.mli @@ -1,5 +1,5 @@ (* - * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen + * Copyright 2005-2010, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * @@ -21,6 +21,6 @@ -val pp_ctl: +val pp_ctl: ('pred -> unit) * ('mvar -> unit) -> bool (* inline_let_def *) -> ('pred, 'mvar, 'info) Ast_ctl.generic_ctl -> unit diff --git a/ctl/test_ctl.ml b/ctl/test_ctl.ml index 56630c1..32ab52a 100644 --- a/ctl/test_ctl.ml +++ b/ctl/test_ctl.ml @@ -1,5 +1,5 @@ (* - * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen + * Copyright 2005-2010, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * @@ -37,12 +37,12 @@ module SIMPLE_ENV = ;; (* Simple predicates *) -module WRAPPER_PRED = +module WRAPPER_PRED = struct type predicate = string end -module EXAMPLE_ENGINE = +module EXAMPLE_ENGINE = Wrapper_ctl.CTL_ENGINE_BIS (SIMPLE_ENV) (Ctl_engine.OGRAPHEXT_GRAPH) (WRAPPER_PRED) let top_wit = [] @@ -69,17 +69,17 @@ let (-->) x v = Subst (x,v);; (* FIX ME: move to ENGINE module *) let (-/->) x v = NegSubst(x,v);; -let mkgraph nodes edges = +let mkgraph nodes edges = let g = ref (new Ograph_extended.ograph_extended) in - let addn (n,x) = - (* let (g',i) = (!g)#add_node x in *) - (* now I need to force the nodei of a node, because of the state(vx) predicates + let addn (n,x) = + (* let (g',i) = (!g)#add_node x in *) + (* now I need to force the nodei of a node, because of the state(vx) predicates hence add_node -> add_nodei *) let (g', i) = !g#add_nodei n x in assert (i = n); g := g'; (n,i) in - let adde anodes (n1,n2,x) = + let adde anodes (n1,n2,x) = let g' = (!g)#add_arc ((List.assoc n1 anodes,List.assoc n2 anodes),x) in g := g'; () in let add_nodes = List.map addn nodes in @@ -89,7 +89,7 @@ let mkgraph nodes edges = (* CTL parameterised on basic predicates and metavar's*) -type ('pred,'mvar) old_gen_ctl = +type ('pred,'mvar) old_gen_ctl = | False_ | True_ | Pred_ of 'pred @@ -148,8 +148,8 @@ let ex1lab s = | _ -> [] ;; -let ex1graph = - let nodes = +let ex1graph = + let nodes = [(0,"f(1)");(1,"f(2)");(2,"< >");(3,"g(1)");(4,"g(2)");(5,"")] in let edges = [(0,2); (1,2); (2,3); (2,4); (3,5); (4,5); (5,5)] in mkgraph nodes (List.map (fun (x,y) -> (x,y,())) edges) @@ -185,7 +185,7 @@ let ex1s8c = Exists_("x",ex1s7c);; let ex1phi1 = ex1s4;; let ex1phi2 = ex1s5a;; -let ex1phi3 = +let ex1phi3 = And_ (Exists_ ("x", (Exists_ ("v3", @@ -197,7 +197,7 @@ let ex1phi3 = Pred_ ("g(y)", Modif "v0") ))))));; -let ex1phi4 = +let ex1phi4 = Exists_ ("x", And_ ( (Exists_ ("v3", @@ -212,14 +212,14 @@ let ex1phi4 = let ex1phi5 = AU_(True_,Exists_("y", Exists_("v0",Pred_("g(y)",Modif "v0"))));; -let ex1phi6 = +let ex1phi6 = AU_( Not_(Exists_("x",Exists_("v1",Pred_("f(x)",UnModif "v1")))), Exists_("y", Exists_("v0",Pred_("g(y)",Modif "v0"))) );; (* use with ex1nc *) -let ex1phi7 = +let ex1phi7 = AU_( Not_(Or_(Pred_("f(1)",Control),Pred_("f(2)",Control))), Exists_("y", Exists_("v0",Pred_("g(y)",Modif "v0"))) @@ -238,13 +238,13 @@ let ex2lab s = | "p" -> [0,[]] | "{" -> [(1,[]); (2,[])] | "}" -> [(3,[]); (4,[])] - | "paren(v)" -> [(1,["v" --> "1"]); (2,["v" --> "2"]); + | "paren(v)" -> [(1,["v" --> "1"]); (2,["v" --> "2"]); (3,["v" --> "2"]); (4,["v" --> "1"])] | _ -> [] ;; -let ex2graph = - let nodes = +let ex2graph = + let nodes = [(0,"p");(1,"{");(2,"{");(3,"}");(4,"}");(5,"")] in let edges = [(0,1); (1,2); (2,3); (3,4); (4,5); (5,5)] in mkgraph nodes (List.map (fun (x,y) -> (x,y,())) edges) diff --git a/ctl/wrapper_ctl.ml b/ctl/wrapper_ctl.ml index 45bdd58..34448df 100644 --- a/ctl/wrapper_ctl.ml +++ b/ctl/wrapper_ctl.ml @@ -1,5 +1,5 @@ (* - * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen + * Copyright 2005-2010, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * @@ -23,29 +23,29 @@ (* ********************************************************************** * * Wrapping for FUNCTORS and MODULES - * * - * $Id: wrapper_ctl.ml,v 1.67 2007/11/20 12:57:25 julia Exp $ + * + * $Id: wrapper_ctl.ml,v 1.68 2010/01/28 14:23:46 npalix Exp $ * * **********************************************************************) type info = int -type ('pred, 'mvar) wrapped_ctl = +type ('pred, 'mvar) wrapped_ctl = ('pred * 'mvar Ast_ctl.modif, 'mvar, info) Ast_ctl.generic_ctl -type ('value, 'pred) wrapped_binding = +type ('value, 'pred) wrapped_binding = | ClassicVal of 'value | PredVal of 'pred Ast_ctl.modif type ('pred,'state,'mvar,'value) labelfunc = - 'pred -> + 'pred -> ('state * ('pred * ('mvar, 'value) Ast_ctl.generic_substitution)) list (* pad: what is 'wit ? *) type ('pred,'state,'mvar,'value,'wit) wrapped_labelfunc = - ('pred * 'mvar Ast_ctl.modif) -> - ('state * + ('pred * 'mvar Ast_ctl.modif) -> + ('state * ('mvar,('value,'pred) wrapped_binding) Ast_ctl.generic_substitution * 'wit ) list @@ -78,19 +78,19 @@ struct type mvar = SUB.mvar type value = (SUB.value,predicate) wrapped_binding let eq_mvar = SUB.eq_mvar - let eq_val wv1 wv2 = + let eq_val wv1 wv2 = match (wv1,wv2) with | (ClassicVal(v1),ClassicVal(v2)) -> SUB.eq_val v1 v2 | (PredVal(v1),PredVal(v2)) -> v1 = v2 (* FIX ME: ok? *) | _ -> false - let merge_val wv1 wv2 = + let merge_val wv1 wv2 = match (wv1,wv2) with | (ClassicVal(v1),ClassicVal(v2)) -> ClassicVal(SUB.merge_val v1 v2) | _ -> wv1 (* FIX ME: ok? *) let print_mvar x = SUB.print_mvar x - let print_value x = + let print_value x = match x with ClassicVal v -> SUB.print_value v | PredVal(A.Modif v) -> P.print_predicate v @@ -98,10 +98,10 @@ struct | PredVal(A.Control) -> Format.print_string "no value" end - module WRAPPER_PRED = - struct + module WRAPPER_PRED = + struct type t = P.t * SUB.mvar Ast_ctl.modif - let print_predicate (pred, modif) = + let print_predicate (pred, modif) = begin P.print_predicate pred; (match modif with @@ -116,12 +116,12 @@ struct Ctl_engine.CTL_ENGINE (WRAPPER_ENV) (G) (WRAPPER_PRED) (* Wrap a label function *) - let (wrap_label: ('pred,'state,'mvar,'value) labelfunc -> - ('pred,'state,'mvar,'value,'wit) wrapped_labelfunc) = + let (wrap_label: ('pred,'state,'mvar,'value) labelfunc -> + ('pred,'state,'mvar,'value,'wit) wrapped_labelfunc) = fun oldlabelfunc -> fun (p, predvar) -> - let penv p' = + let penv p' = match predvar with | A.Modif(x) -> [A.Subst(x,PredVal(A.Modif(p')))] | A.UnModif(x) -> [A.Subst(x,PredVal(A.UnModif(p')))] @@ -132,8 +132,8 @@ struct | A.Subst(x,v) -> A.Subst(x,ClassicVal(v)) | A.NegSubst(x,v) -> A.NegSubst(x,ClassicVal(v)) in - let conv_trip (s,(p',env)) = - (s,penv p' @ (List.map conv_sub env),[](*pad: ?*)) + let conv_trip (s,(p',env)) = + (s,penv p' @ (List.map conv_sub env),[](*pad: ?*)) in List.map conv_trip (oldlabelfunc p) @@ -222,12 +222,12 @@ struct let satbis_noclean (grp,lab,states) (phi,reqopt) : ('pred,'anno) WRAPPER_ENGINE.triples = WRAPPER_ENGINE.sat (grp,wrap_label lab,states) phi reqopt - + (* Returns the "cleaned up" result from satbis_noclean *) let (satbis : G.cfg * (predicate,G.node,SUB.mvar,SUB.value) labelfunc * - G.node list -> + G.node list -> ((predicate,SUB.mvar) wrapped_ctl * (WRAPPER_PRED.t list list)) -> (WRAPPER_ENV.mvar list * (SUB.mvar * SUB.value) list) -> diff --git a/ctl/wrapper_ctl.mli b/ctl/wrapper_ctl.mli index 0d078d3..231dc2c 100644 --- a/ctl/wrapper_ctl.mli +++ b/ctl/wrapper_ctl.mli @@ -1,5 +1,5 @@ (* - * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen + * Copyright 2005-2010, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * @@ -22,7 +22,7 @@ type info = int -type ('pred, 'mvar) wrapped_ctl = +type ('pred, 'mvar) wrapped_ctl = ('pred * 'mvar Ast_ctl.modif, 'mvar, info) Ast_ctl.generic_ctl type ('a, 'b) wrapped_binding = @@ -30,7 +30,7 @@ type ('a, 'b) wrapped_binding = | PredVal of 'b Ast_ctl.modif type ('pred,'state,'mvar,'value) labelfunc = - 'pred -> + 'pred -> ('state * ('pred * ('mvar, 'value) Ast_ctl.generic_substitution)) list module CTL_ENGINE_BIS : @@ -73,7 +73,7 @@ module CTL_ENGINE_BIS : val satbis : G.cfg * (predicate,G.node,SUB.mvar,SUB.value) labelfunc * - G.node list -> + G.node list -> ((predicate,SUB.mvar) wrapped_ctl * (WRAPPER_PRED.t list list)) -> (WRAPPER_ENV.mvar list * (SUB.mvar * SUB.value) list) -> diff --git a/demos/orgmode.cocci b/demos/orgmode.cocci index 39395d7..d72baad 100644 --- a/demos/orgmode.cocci +++ b/demos/orgmode.cocci @@ -1,6 +1,6 @@ @initialize:python@ -from coccilib.org import print_todo, print_link +from coccilib.org import print_todo, print_safe_todo, print_link, print_safe_link @r@ position p1, p2; @@ -21,6 +21,21 @@ print_link (p2[0]) print "" +print_safe_todo (p1[0], "arr[i]") +print_safe_link (p2[0], "arr[i]") + +print "" + +coccilib.org.print_todo (p1[0]) +coccilib.org.print_link (p2[0]) + +print "" + +coccilib.org.print_safe_todo (p1[0], "arr[i]") +coccilib.org.print_safe_link (p2[0], "arr[i]") + +print "" + cocci.print_main ("foo", p1) cocci.print_sec ("foo", p2) cocci.print_secs ("foo", p2) diff --git a/demos/orgmode2.cocci b/demos/orgmode2.cocci new file mode 100644 index 0000000..3768514 --- /dev/null +++ b/demos/orgmode2.cocci @@ -0,0 +1,34 @@ + +@r@ +position p1, p2; +identifier f; +expression E; +@@ + +f@p1(E@p2) + +@ script:python @ +p1 << r.p1; +p2 << r.p2; +f << r.f; +@@ + +coccilib.org.print_todo (p1[0]) +coccilib.org.print_link (p2[0]) + +print "" + +coccilib.org.print_safe_todo (p1[0], "arr[i]") +coccilib.org.print_safe_link (p2[0], "arr[i]") + +print "" + +cocci.print_main ("foo", p1) +cocci.print_sec ("foo", p2) +cocci.print_secs ("foo", p2) + +print "" + +cocci.print_main ("foo", p1, "ovl-face3") +cocci.print_sec ("foo", p2, "ovl-face4") +cocci.print_secs ("foo", p2, "ovl-face4") diff --git a/demos/vm.c b/demos/vm.c new file mode 100644 index 0000000..b046ce1 --- /dev/null +++ b/demos/vm.c @@ -0,0 +1,5 @@ +int main () { + x = kmalloc(); + r = 15; + kfree(x); +} diff --git a/demos/vm.cocci b/demos/vm.cocci new file mode 100644 index 0000000..8779637 --- /dev/null +++ b/demos/vm.cocci @@ -0,0 +1,19 @@ +// Options: -D alloc=kmalloc -D free=kfree + +@r@ +identifier virtual.alloc, virtual.free; +expression x; +position p1,p2; +@@ + +x = alloc@p1(...); +... +free@p2(x); + +@script:python@ +p1 << r.p1; +p2 << r.p2; +alloc << virtual.alloc; +@@ +cocci.print_main(alloc,p1); +cocci.print_secs("free",p2); \ No newline at end of file diff --git a/docs/manual/cocci_syntax.tex b/docs/manual/cocci_syntax.tex index e589e48..ddb36b4 100644 --- a/docs/manual/cocci_syntax.tex +++ b/docs/manual/cocci_syntax.tex @@ -144,7 +144,7 @@ constrained by its type. \RULE{\rt{metadecl}} \CASE{fresh identifier \NT{ids} ;} \CASE{identifier \NT{COMMA\_LIST}\mth{(}\NT{pmid\_with\_regexp}\mth{)} ;} - \CASE{identifier \NT{COMMA\_LIST}\mth{(}\NT{pmid\_with\_not\_eq}\mth{)} ;} + \CASE{identifier \NT{COMMA\_LIST}\mth{(}\NT{pmid\_with\_virt\_or\_not\_eq}\mth{)} ;} \CASE{parameter \opt{list} \NT{ids} ;} \CASE{parameter list [ \NT{id} ] \NT{ids} ;} \CASE{type \NT{ids} ;} @@ -195,9 +195,14 @@ constrained by its type. \CASE{\NT{pmid} \OPT{!= \ttlb~\NT{COMMA\_LIST}\mth{(}\T{id}\mth{)} \ttrb}} \RULE{\rt{pmid\_with\_not\_ceq}} + \CASE{virtual.\T{id}} \CASE{\NT{pmid} \OPT{!= \NT{id\_or\_cst}}} \CASE{\NT{pmid} \OPT{!= \ttlb~\NT{COMMA\_LIST}\mth{(}\NT{id\_or\_cst}\mth{)} \ttrb}} + \RULE{\rt{pmid\_with\_virt\_or\_not\_ceq}} + \CASE{virtual.\T{id}} + \CASE{\rt{pmid\_with\_not\_ceq}} + \RULE{\rt{id\_or\_cst}} \CASE{\T{id}} \CASE{\T{integer}} @@ -217,6 +222,13 @@ The \NT{ctype} and \NT{ctypes} nonterminals are used by both the grammar of metavariable declarations and the grammar of transformations, and are defined on page~\pageref{types}. +An identifier metavariable with {\tt virtual} as its ``rule name'' is given +a value on the command line. For example, if a semantic patch contains a +rule that declares an identifier metavariable with the name {\tt + virtual.alloc}, then the command line could contain {\tt -D + alloc=kmalloc}. There should not be space around the {\tt =}. An +example is in {\tt demos/vm.cocci} and {\tt demos/vm.c}. + \section{Metavariables for scripts} Metavariables for scripts can only be inherited from transformation rules. diff --git a/docs/manual/copyright.txt b/docs/manual/copyright.txt index e6ad334..3b35fcb 100644 --- a/docs/manual/copyright.txt +++ b/docs/manual/copyright.txt @@ -1,6 +1,7 @@ -Coccinelle manual - Julia Lawall, Yoann Padioleau +Coccinelle manual - Julia Lawall, Yoann Padioleau, Nicolas Palix -Copyright (C) 2009, Julia Lawall, Yoann Padioleau +Copyright (C) 2010 INRIA, University of Copenhagen DIKU +Copyright (C) 2009, Julia Lawall, Yoann Padioleau, Nicolas Palix Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.3. diff --git a/docs/manual/license.txt b/docs/manual/license.txt index 2f7e03c..c7449da 100644 --- a/docs/manual/license.txt +++ b/docs/manual/license.txt @@ -401,20 +401,20 @@ public wiki that anybody can edit is an example of such a server. A "Massive Multiauthor Collaboration" (or "MMC") contained in the site means any set of copyrightable works thus published on the MMC site. -"CC-BY-SA" means the Creative Commons Attribution-Share Alike 3.0 -license published by Creative Commons Corporation, a not-for-profit -corporation with a principal place of business in San Francisco, -California, as well as future copyleft versions of that license +"CC-BY-SA" means the Creative Commons Attribution-Share Alike 3.0 +license published by Creative Commons Corporation, a not-for-profit +corporation with a principal place of business in San Francisco, +California, as well as future copyleft versions of that license published by that same organization. -"Incorporate" means to publish or republish a Document, in whole or in +"Incorporate" means to publish or republish a Document, in whole or in part, as part of another Document. -An MMC is "eligible for relicensing" if it is licensed under this -License, and if all works that were first published under this License -somewhere other than this MMC, and subsequently incorporated in whole or -in part into the MMC, (1) had no cover texts or invariant sections, and -(2) were thus incorporated prior to November 1, 2008. +An MMC is "eligible for relicensing" if it is licensed under this +License, and if all works that were first published under this License +somewhere other than this MMC, and subsequently incorporated in whole +or in part into the MMC, (1) had no cover texts or invariant sections, +and (2) were thus incorporated prior to November 1, 2008. The operator of an MMC Site may republish an MMC contained in the site under CC-BY-SA on the same site at any time before August 1, 2009, diff --git a/docs/manual/main.tex b/docs/manual/main.tex index 9d064e0..c06003a 100644 --- a/docs/manual/main.tex +++ b/docs/manual/main.tex @@ -127,8 +127,9 @@ It is organized as follows: \section*{Copyright} %coupling: copyright.txt -Coccinelle is copyright \copyright 2005, 2006, 2007, 2008, 2009 -University of Copenhagen DIKU and Ecole des Mines de Nantes. +Coccinelle copyright is\\ +\copyright 2010, University of Copenhagen DIKU and INRIA.\\ +\copyright 2005-2009, University of Copenhagen DIKU and Ecole des Mines de Nantes. Coccinelle is open source and can be freely redistributed under the terms of the GNU General Public License version 2. See the file diff --git a/docs/manual/main_grammar.pdf b/docs/manual/main_grammar.pdf index 5ed40d52eb4d75f6e3e619b96315615abf7b6470..dd2eafcee74df93dbcb9ff67c981fa6ed63f153c 100644 GIT binary patch delta 61352 zcma%Dc_3EJ_wQP=?>i;Qmi5^eyGkk9DHK^!h|r#;N0P`AZn;H>%9cVUMP;c-+9X2O zXjQbAO8w4#9=yH1@Av!t{pHNeXU?3NIWzYx^SIU|F>z0#d?r8Zs@5FiI$u+3hYD>u zreIinV*0zF?N*ysJX6(r+&wWjVduja-yWRu&M#|?-f?YsOoJl8Rp=ETyE4tRuP41; z{MB%1^-a{Q*0o*yeIMq8j#rR?e1@t0m38uT%= zove+dW;7@J+4^4XknxdgRWVl$Fuvc??Jq59=6Ub55Oap+c#HDw7Zo2_;xmSFUz&T- zRCXO}R1UOT|6n+JnX9qhya4X+QL7hg$~mf>`XKMup=a6UW+Q$*f%QiBa$dh*`SFs+ zxlB2EM^(GJCESOPhwyd1sXtn@K4;12Cl6yI#N#*RbskC;Vyc@CoAbI|PY8M(G%VyL zy|Zpdr%HN-{8f_$r}_AAe{o*Ky8U2y*$sih0!6)a*>kn#w#QQh^|*3!DYGvfwy4v- zz3B2;tZix6e60iH!=601Ek0}Cbl1NzAS2c6;$1*k&=pr#;kEh%t6=;1zJgP(D-xmy zrO$cJi<)QPzxYVj`=clQp7mz8Ih7Jr@8mnIdVJM>;A!j1eH(Vxuj0Szoqw1h&3evk zWVYW~)%3jC@j{KK^|4NkG0Kc}w%lIkigiffzzj*+8iA}UQXOFjO*M}VOzcVdHSuF& zJJ0D=Lif3=ogd$dIl1$KZG3ZkNa?q{T{SV5O9q#X^72*NV{0ETmApgEJTu!^caKbo zpVn~9p?9;MJP%MbGd1nl+`P`i=-F$3W!CPhsMmf*k)My;x$D#)+*KJ{TD=%MPpwT}tQ({<-IUr0l1mrrMAbE~|H2KXaCUHTt0F-d*$9S(;~(>XdG0C8;NL z?q)ewd{Mq0bk_3FIbH4}a)+t=1u8!eFS~Frv#HR>!W20rWBqDPQ0g{^SY^g_g_iv_ zF~8KUoxkW>h=sXYEI8d<}2C{BgN#(TUoM zZvsPga)N95oV?DSG2j0B=P%x6Wg6qBD0&5|C;VBW-X;#SL_ZhV*v-G}Em!uo!24EB zTt#I-)5{N;Bi|pm)(f``-I#ZiQ7(G9bnB3fS_#)ozjBH5mBXe_l6Ti-U%vQRneN

hs6u@J_oXF`?8 zLWSeW>YXA%@k!aYFV2^Xo0ADgZnQ18fOn&18QfOIoJpLZ>k?{j1E&Qlx1GS+Qg zoYeibwPd+}r;d}^%m$0GkNm!}FD#+gAD5%Q+=m4woYW_s*zgx1CFu*%@YJRWcIuyo#_tB-Z^`t;2Ce zMWq#s=g5C}Ec=-jy!hrP)6}=8dJ{8OUTz!`{W$02nL{TtZI;W$d_CQ+u5!9eaD#ls zM8D;?OSPgMmc@iM4L@yWv5q}`d^(tPkT7?dq5g2-FxS*b}G40z8l%l zb!o2YyF|VGWG#M^1r^uC_*c1Q)pe%cA@BYs!rD}^vL{Pm&l>KE*_pDGZJt~?eb%an zMN`auI}`W}gSm4G#^er2?>`c_AjHn?M#!?=A1`(KI^?u@#yuG*mEaNcV>K{a_TIQr zd*<36x!R3i3Fc~7`W%iGod3Ch*E$P-VVmA4d67%)-{+WL*!AvG?q|0PN9ze>dTI8- z(#vOVC7w5kbj+Arv%e-_OO-*b_T6`6w;p(MMbxTH@27q2 zdIL|b5RZ%3F1$Fpiofc7+3oY61GMzMI(;2SwMUIp(yhH@!)o^hpY|Lyi`{mcl(Nua zcUBU=QqTL=+8nbVqH6CeK4TJ(5UFzvu|Q285`nSMgTAk1CuoZ8)z1Ca}&XZXCjmmZ+p zP?~!Ea@=^cMXE-WZ-dqY=W8Msi~0G+?fB)mSNojn6YV}>zN}pF&l(+oo;hvC&p@m#z^wov+I!R>J%6 z#B%u)54)*%xr?+MH@)%vpk{C(%|1@J*rJc;dO_NgC!tI7CBsTb??%1+pf2>Zcihx= z&f<`y?i(SN1NFi};;TbgTC9yL!=g0=pPl?vPub1u<1}JEYVG8?$nx?Gvk48o`+;i} z?{TdSQ+g+=VXY8b{L=bRuif#|ZHdy6YHIYai(0PnE@3<~)LhIJyQD_GN7qfV899-xazv4 z(Al(hrM_mXak*Rgk-DrI866uHSgsa#4r;bgRFJ*WwBYnDa!XO0ZBOdWS6F=MubWex zslX%P*ZJu9Guw32IAa-wlO{&|H{1h^!mI6?aIBp2TR=zSJ=${C9YkoB^eiP zxT{ox+gD3Ge7&hi>&C#o;GCoxjm-`vs=Y>^0*Y$`A0B+Q-l)Cod(j%xK(T^>`dJ+& zR_DbYNSuo~!lQoNg1N*>O<`dvtBmkM-i7SnCb6xmzA;5SUTW*b7XO6TQK>&hS)DyM zbAEgkRzABl=3dQ9gYRm?X=59tA817`={l6&b)%}IuFBBnxaQ1F*w#D_0<{B*eY)%dGxLRkFv8_zaUZ8HKq7uAbaJ<5Nfo%Tr} zhnA&%sJFsZox)aeE0JTa9{Yer{B#)xb6 z=QQ5;Xp?U;xXqm>HP0%WYty?+=WFCP&OQ?&KH5~sr9*IhuV=b}@}?{GtaGQqArFI< zt*o_XkK$i+d}+#OC?zMz_ucl5*tAK)SfHvtyiI-qlH{p+t}$<-RQB+OIcr9@F91?H7;xB;Bgg(^mJ~EZWY> zD6cxsEf~gcVv;=JYJ6zvNYg#h#Xa+tsp?N}9B1iUd=h++%cbPrcDj$}_>s8Cn62T5 zRtmjYzcrhC>$Yz%H8S`0)E*5{sqs~@I`k!E@2p1;t7g@BzuH#5K~mAsyKa_)kxiff zA`zBW-)P&gQPsc|-fbZT_xP=rq55qhq9fV)La%!ty?nopwO!;SzuxTLHGyqm+5>s- z?Y_0CUKM27o{eR`v`w-L)OnL)Q12ISey}_{%~C+^4qe8zTHSJN-ifczL+vdjS4FLQ z+8$N8l8){C@ma$*ar}+d{=v4^!-~YnIoDiTyk+mb4$Z!zmocj7hb>LB>^l8Dps+hQ z|Lev@yqB%>TXr5@nL6I>lBuT>b8MNL5RYldiHBLcV%k|T4%{hfQlEHyqIGujbPirb zR%{NPy*|%v{^Gd~{le6^AHwr)(<9a!+Gsd9d~jafG>9lyAL%`BJR#K28%o}D*nQ|~ z^HA}^tP@HfpV}}*>Dw;R$ttq9Chlii`ek`7KdGp{{4!xKHhj|$c=vbyy0gtOHL2?g1= zr}B3^TX!jX-u=YDv37?*zo6_z1Dj?KR|m|BER*?lFNWs#^yEU8h)b?>9OIpph*!F~ zvIy;$v9n;(4v`FfZ@CuPrHXg-YVDDmgqOZ>l_euxSxqiu-^H+w6UTgK!6TVmO-``wW zlN~LyIDwil^Sp1`p#pE;-B(Wa)XrSq+x|#oMHE5jekR|S_OE^Rk%Ec)=w z-*k;F*Rl^yck5)23~x(*II^mHo_D9^j5imTnJ)`{hD>bxJZu)OO&U0tX`(xmk3yj7 z(-{<$prwm?SvzuX3)qAbS7@N2n>EpLJHvB(7xifT@gV@Ij;gqrprWCsN|Tcz!NSmK#7T}Mb}j1dsXjRy2{b>{ zcs58)Wl&Y7v2=nynMqUm4Lv6;XPP6Gsm~z5(zBO`(+5op_=}_DCgW*2C$UpPk@RU4*d<&bCiEtgK^M?4f_mCLel!}HiLT#qRG323r;=cEfDHqEN0CD3?Nk<> zs-!aXnPdtou~Q25**SZnYmfO!z1fpFkC3V?l%EejC?s@mC?ysF=eb_z7>^deNcl60F+Vh6CGn?;C$$RUInL zv&nfudj9?>qaq!*jx)R$hOOQQ(^7w#^tS1_rLW(fU6cA`x7-HGtCufxet!Gpsy`~b z>D?!x=6hy+m%k2IRwO!~u&udq=Z$JdqU+MRHkU7U>G$c@cvQHLFx;Mf8ccOr72bs% z%C+_WcAnM$S=t3V)c$H;R_%eW14#q@ZTT#Z@oTwvKcLQW-r98Cj%5jy{jB(>7Z?xUXpV`hmVLM^%%950 zdvXz*VIy(>TEg)1&Fd5%@KI8ZpIeaAaBJ_`2G_zX$8H6ry^vO;H3V3nSXa41vh+(; ze#;6&_p7Vs6a1XkWku}{T(W6r;)ksZ4TAd)Hk}cPSCQLrdhfOrd8vg0!rq_ay=Uo# zn4Ierz5OF7$A!WwIyJ!^r8%-B^zDF#-^!q!QBHH>k8Lsm=z^zN23AC;>hg z>lyQNMCUtKu6cdWGjh}{-FhXOO;3&5c6k^CMcmp>xpldt=y~UZe$y>RwbWU*RV{{! z+1)WSAMevPI>=xwMLsmrLuBJ!fxyDP#o`-;P%4zK`noDiv@= zQ&=FM74tMb?dfv0Ej*&7hsp&`SsK+^&g~az;Ei!l(3}A3HzS+z}9tv*2#uTTeRQID>c)~NjbQSi>0d7>AslE&1dpP zTfisu)k9{)TnhzV55>>3@?W&sEnM!CmbsfpQrX$Vsy9_XvC1Mxc6;)A>c)mmj_qZs zBVx$Jqi(Bs>PTDO+-d_m8z<-42i4{Dh*6IZTMG(bTwU+K+NxAZaH-wc2JR%|qvr41 z-nr79+oLb%7R1ExE-#2@9XNdPMf~lRdWYrPQ#KuVIlffk@Rzy14)nh9I(n(qX}>vx zkrrPI_ZYvl+_V3|%E}9-p~=h+zxJI{x*EEjcdmYLR4Gk&J`iAaNZ`_w$5CBx7HGss z$L;RR3cE=`e7)Vb>|v5))6e@^?y*5m9@M;2zr17yMcQrqjED!u%37ufYgcri*hj7| zmoXv2f}n?d0q0hvt{>WwA@FUB^ny)-&if0r)l*zz>L<<&NX(DjleR!$XZ%uCp5dW{ zR;~wUPGTO7+%E)XypJ)<@78`Bq;x%5&r=Z2Q!wyaORzr7^@;Ai#EhqJ4*#gRR>cyrXj0+gaoC!v|I3r0 z$ahynUi9ku!#mH%-Q4$ZxPYWHXI!UJtzuB-hQLuNl{R+Hw$NSJVtPF z_IIUxRI~KVUpwwExn;&mJ|TO96Z4mwB<8T>&gMyMC54Zxo4gNSb&U7P;mtcecZ__! zp>Ux5f_bwQqEcKZakklY;~KG8iD{jiA3)^F9%#R*Q;6+Mh!@jdQK8VVM6PrTT#!<}{W zsodr7tlK3QTlc!8rM}nNUlp<;v%!{le~y~HOYe+jRa?uSt`I#o8Xf=RUD4Ao;yVW$ z&9jM@#8t0{a5YD#O&pf2+8V7cMXw#IyVxK4;>bxmvPAXmf>@~lW&diupJCeCtO)Lq zgGcVX|LpuUs%I!&M*3)tlx#(YfKqsd%VVmh-D622E3>?Ghh6x9pNrGjqfTju#<>rC zJKjW&+F@(jXP0S;^PHmTw&nF@jM(p5@L}h^?XTbNI=J_T@@;j#FYl<|-tVZCN>f}u zV*m*{5ccYAobRgq<6qBhxi#|i@(+(z=Z_5)LdOS7gd3d`y_RM#j9M!&|5E>lrr03vnw;H zR?f-%7FOXO<+e2y+)T_1;kqp?DQFn9Ib)f^_nvq5$182?9X}|EAJ9!oYpKyNnx%4J zfru5;W#D6!1zE+_dNwO&@VjOHP`jLr@UyqNsW;clAHDg0bW!x$v)j&|Tk@-5?1ERr zo;7BB%TN4zabr)Jvv{&F{Y2?d)E@rwF>~c2b%jg?^GHuFDEDm$+1&DGn9<5inp94@&KG=IYo7Iu7Vz>Z_$?xqQ>WXH6lLf7Rl zd9}DCt9@DT_kch8V5V|Mab{`TM1^KtO>uti8N<hj>emFWlDm z^1ICL*w-^`H++{qvCQ(Qn#I;8pL0*wEY;83g&q!FXteW)JD^_1O?wlzW}C6g&ZGN0!Asf6Zr?=6^Q1T))y#K|Zw1rY2=~(n!mqw$Dq8^-{i$nOoeLXf@;4 z)fiZ$@NJ>qOlylFQ7yMdyNB1M%j;7s%Vi=G_4-!vM7)TMHjI+|yz;D>m}pp^KkLpc zjfN3>-T6ogp~oO)@O8YBlTB%etM~kJlKI))bFy`JxvyRx^}**tfNqenNPla+$F;FX zCp<6LH>hJZ)o)6|ReOH8S{-OEc6C>YY(at$uNkzu>}O7Pxwn?IIbGV{U$)f5^pNkP z%lo$Yzq;2KGJE5<&$U&SA4_ZZ)UdXlX4TfbU8DBAw(#fd+cWO1G|^mrL@LL4NOR(?VA<6MvGt|YYNhkE`#yCuYh?<*r!M#yace^4 z#Om*6HkVrWo$MKpDsFoyx%=_r#Wt^~WnbIwB>tKa`eMT#LBEY_H*eYG=N*hwV3G>{Wgbe-Q?@H8N3)88X`tV-^Ix*lc*H1VjZE5%KqyiXlkl5 z$%F*%-*&`Ifk>pO(7=fT;}#qmrasv8G$Pp3B(^ujN>D&|hZ!l886hI8F8j@&60=QGqn+o3G6qEwq9*Oif=#}_IXkVr=YLdVwMP-81Ndqq%90?|Y2;C^y z;Cw_2#fRRU#rC-fbfOBCK?H{ncXq+u0tbZ3Bw@MQlenAN!ZR1CtRhkAsKtJgG?mVt zu7RtYy9)TRH0VmhynAs^V80~m_f{gftRz@O8u);8DoJJI)}WxjtrCs!n;*a#;xFD) zy{UAPK7&F3m)^vG_LjwWge}^1cN%zGSZf!^XP+n`^SgW?J%tL+CKVk_mI?qT^)IL7 zPhm)8d@6MC%8B|UCgWd(!IfdkrTLG&=}dia&e)^jO7lPQ5F8;h{%thc|ED)ZEGT4r zG!_ltv;R37g{)7Z|Jy?U?ymjExsi$Bmj2r&GgW;5AA{pD6A<$sIzs>NI>H3+pR7Wp zGqAxTL>fJHQdIp<35js<*dRD&5Jlk(fvzr4_|Hf@Ix?lO=vaZm?ElCU{B1Hew+xXA zAkqJu3QP+DjyeUxJO7;Le^ZF*-Vj`%U=@2onJ*TJD*Y)H8FZZj7su3cut>0-|9S1F z;lD4;@3$EJzis?<@81{eZ@rmlR*BF*mTtP=^wQ~(82@dPr#o<#4n-2B=KsslpFa81 z_`eoQ;HW5eSpgBmo{u1k=!m=sR$c~#UW70jm#WQ0BVl5Lh_(V5uIs;+Ybr27pi=P+ zrWWg|;^R$^X`fBjyV9G*>j;Yt`B>Mvv=mVwqK~JuVh`&7V3TSD!A{wB9<83_9Fk(XxNfR zZ_Zeh6EjB}chhT@4L#5p+n=R;_DWgJ>zh~WUC`M#zig$G zw%0?(ePHGo5;l;#Uv6f5E);O!sVM1I)M5STFeOKdn)dvPnO8V(iLJs? zMy{T`x~j~T*P8{`&1&OXj`G{jZ=R7iG0=66Wf)Hk%#_IU7jx>ctmN)L7uvi$O&9T> z;j1vHn-!K{-$fMzvg|E zch#O@8$M7~!AjzmXD&sNyqt54>YCtLt7!#CU0n?83g`CSUpeb~NMo^>E7!v7M^jw$ z=LXwrSSjlCPngCSuBa~3f4s46cK4yeSe<}3CB`-3%eeQebouan($ujfNm_qymDzsf zRPrd7BJo|_IkT2z<3-}14%#0Y?|!TLN#&VuxcsNC)}mhzSxYi*&)DPG@G1#av(|ix zL<&f%uAPJCatk|Iac_C@IfD1H<~iBc1vkPzF4f9Sh&>S`91)NhP}eN2=AHFu_9HtF8t_&v&n&$G&PY@62yf6ddSKyo~QL1YxvWZig33r`#O2fyXr~t3D7fL((iGuO-$Z&_jTpMLBWB| z=?)F^S=$$%`A`xSk4j&)c8QldcEo&LmV4xr0!`kV?-YNg-P&hd9C@?WY5c2y@J+SZ z>lM=We?OvsFsrZa-G$1lJy=V^Qv0^`?!#+&cS+p6+NZe7&|B+FSh)N_&pw{&=J9~G0L>otlEXzw;|`{J zkH@+qkZQ5@uZU~raLqZohxMW4Tj&>IJUp7rPdh5qdS%?lCHw*hb;>ME zG8Qi~I0I^{B3zpZ6VJX{6C=(I(roJH!xlGq3Qc!*ylG9<0mqH{%Sq zm^Lqc$Lb=B1uAXrkMH(IW=2#$SS_Aac)4+n6Y}<~q~~iHl^;)f=SKFuviI>N9zFP3(u41z zhSdeLtNOD<4Qc9~I!8XvloE~+VYyHI;E($lCM+bV-zf3wTr}b4O@9B`_K^$B^%k-^ zcetlJtm+t9w*A_jlPiBPwk%y3_-*^m;-*c9gKiG(<~g75AKynZG&qXXQ`F22b}PFT zh_zZ<$X1U@hA8#Ma5MOBWorgq2;Qe@k~6=KQEZrDpsaJbk9HuzuT^*O;|%2v*2znX zKijXLXKqqF{P^<77AMrJH9t19WpH7{&ezvoW*xZWH+n*((qqHX9`TBm1M7<0vo6z| z_L!U+l-jSdWh_a(HO^16ge<-_!feK>uytcCOY%P%mOF{=sGk3bF7sonUW`chrH$`D z&6El8{IWZ+^6tU2nvTCBgY)UB`92N)ajgAPO)~p-(YVeY!Yo%7TwyQSH{NbHKC_^EMsLs1-E}qEb1$9sk(aQiTY61=&C8v2I#gyK8Id^lu6(<;SYm2- zMLmB}dEn+vA9-4gMmD7kOPo9zZEYjz9NlrBaAtx2DXYwir72IIxMs}r3J5H8O!k#o zV#}&qThr@Lxg6cI|MDlU)jv>meIOTIO*`g@VX7rpw0iXN=P%jOSVf9ZU6kL|C*Ri%A(UtY!U zQlGuu;rVcxvX1G?>Y@w5cBh38o#V-TQJ+^UyzkD{1g0{rSv=yG;Yqctd(u2k`A)EI zy7@GQhNi<&Yjm!7`bob$~thm|Mtc#B_zj=M#Y4~&TqNjo#L8_z0K}rXZ z%|{N=Y1|(-@jY*@`AMLikomzE?bTTPvGQEwp=}GjSXRcaEk_zf-;I4^DVA&8__eqW zdz3ZDb2OoQwZf9J&vPTpmToD0+j+R*aRm9g!`1iKWJpp+RmyyvjAYd245sINjP}&c z{egHoQV73!kf=a|5;%@xvK%|&Z=NF=vMS&?vPj^(vAsqH?rwnh$e8pZAvwn><0c4R z&vCOzVE%K;OwL~>ZYn`LEvGy zLo$KGkPJCEPCJJoFpeFtV^nM|q zENu$P{tIsOG&KFBG{V3vY!PszAsI*lxu(Hjnvx*R`x`hH2k(|fjM4I9K4}`Bz=H(v z)cC-hj;1ZvKw)@HFPmE`V;Q2O2rf6|ou{x=NMJHR)+sFZ))<+O*)IT_JU&qrHOV$W zujU9yO>$;JMhy4Yr_kxS(r8nn2sXiw5O5J>XhgC;8Baw|$$)pnQ+~J%2otTiW1=)E zz!Z`K;QX%{ zN0JDdY(-FF&>*$RRH4!!?TKgi!Mz5rnM#LMm`+_YlSQ$V%`p9t<9ssHNG5nT;6eQb ztvGIq?no9vquv_KCW9#tehn4!`2^56Jg-jyiK#UBOT@FQpake#4HNY031A7?Qv!_2 z_5&bePo;v$sCTdit|?5En7vSzN@9Y-{k8GzE;M$UnX~Gx4~;?X_+_SWlbg=LVHH7$ z2F8*=wAkCuMJB*58Kbp1e19>X-1om2r{_u`WXya!VglRFF9UHL8WR?1a@RQmO>Vn9 zI+7xaCWjfI_X-83k&}u)jnqOzPl%)Q4~Sx;48&ks_aV>9;XJAP(|C1|09}6o7+c|* z$1ej93m{bt7Xsvl39x5GDAUZo|WA3E!_i82{qcQUY@gi;_rMIn>_gm#@aL32y_Wyv&%hT)G3-~>?M z9wXD?ERnFhMaX>Ayk5W~9-w&ew&>q_Q&bH8OLzPo4HYhh-@Bu8n-xf$RsL%k@OKVWcyRMO z@VCeZeCx3a1w;m|k{9J=s1S)vRP549E)tC$Wk3rriejZM2tPN4N}dcXxVddsvJ~I- zrOb6l`V5iHbHW^C7V-+lB+d)BcGPxrf2?%3@EypySN?a|O2^ZRNu z6_)zVEfQZTZN6-Gq1^@nr9hT*LK45l;`n8$vYXb+FBL8G*&#Y-mS(N`sslND*2P>G z?TNf-ty9!3X=fCe+EJaRoV)L#uORVdNmI4(Y_TPhL-p-D?IOmTjWq?CJ5Ggbo!WO+ z=%bsm8h|7!_4pU#kr-SzrBd)ycMTm)k5))zrc3 zmTHU{ZaE>CMry%YaR_1wggd-t|wGXs~G@2?bFcjPGFl@8Z{ zM~)AB4BzpK>^;6|Q}E4p*^NB8K1qZ@aU1>`*S%&si>f- z$X7I6fAxH5cuJSs7Naia_1zzx&u?YT`0~2N*>84a&&SS-ROfbSp7_y)2kIx#R`$JzeL5U!02z^H2$8 z%`4dbs={xv^p7PK^j^2-JRkQHj}SExVqkVC zS#3w^vzOXgHbE1~Bkt;yPCYi}!0WkFU@T3pgx=eaLGM3x#JINmB5@c#3z>YHc2 zP)1pYzx5clH~YVs)%j7swd>6m8AlI+6U9G@T-NmKugtRTeY&JLA|ph(_>o-8k7vYF zo_7oQ!R=>+CuuZ-xZN>-?#5HK2NdCk)hb8ufz-)U&(QQf^GZ^dnoy7Dox*Vol#Tbskl zr>hs*QI$Oz#iZ}mOwT5oR;qkgfW@%6;K+ipi>k5JC6~@g_xBgO!FA zE9bg~4!3W>7{t-KsxC0P!wdU3*e0J$jnxjG=e0m&vjxgB2r*vUF2;ac3&t8Ouc+&Ct_!7qxhTWH<|W>Tn!rf zOhuN=VEb0TXAa2>Iy-Z?zBZLb2FsJ}T2UumFZh;l%9Ab?7_FT0r0X@AVI)&Iz8qLZ zlkFT=jtn0yHlCeNa|D}Zk{=lNocc+A;D|w45df3E9Bq;zJ3r*8;(>bKwL;D7z}$zF z9WEw#foxlv3a?LLFftJwAlzvEJ52VW z32J|fA9q&qTqy}mB_bGM6#OMCm2EE*w)3LQ8(;{6*HC_gUzS3GH=y{VSFoEI;4D$d zG`9B(mhBXDefuO7>_s|cUZ^ItwN(K9h0-ge$?S_HT z2noiu@HqFj0rs|xTL*pA>4ZBLc%F?6Z(vEVoDdDcv!1w13ox|qmM?m;YmqEID4t{^ zF~A6iXa??;lEFO#74y1nhSIwMg6}Zy2CPo7fzy3AacQ05?tNCm4m>xAaLIU z5O@j;Zw+w2dm8J7(kn!;WNCz=0NF4SI9zyif&}gi5v~=y8;OZWXs}dK#0b2C-;d68qWkzh6L=1@Tnl;7Z{O!LgAjnKIL*t zp(+oEvP5uanPgaWP!|Gh1`+Nl`0)e$1OSgY@t~UB;@EC)2q@s2Ph`Jj02wDYp9l}` zDVzWeY(6F-I)x)M;4s4iP3|ZWk0vqLOz|DXBEu00Zu~=Lv45^EnH^>P?co44uszh*y1`1dKo4<5+yI~Wc!@{I!PKT1u6{eaNqpI$Q_3i*F54qV$5 z_+7z2d;j5cEB>pPRJhJ5=(|KI)M||V2IJpRa6BQqi8@XL$;u=F&z z5#Xy)A;qGwWBdP0QZQ~H;_)w%;@0N>>I~)%Zod9=nqZ--|IglF1yR_)P0<0H?M6q(jlDkqzlJ>>4o>3LyPf^C z3hLobC1~LJzR3h6c`^Y>21|tloMgzLor`|H6%oXr0^$u6cw=>CEsj?A}7yqchkwNdl67+h{kDh;P4MjX129IFhxu8FwCm7%8{dZ0%vq}^M zA)u$<@}d6kx1!sijGJXjADr+$?2Je02REEu*jpoX!N($W&1Yj&<5LW(@Wlun`V@tB zz~8LTyU?JoM%XVtgdbh~B|LrH2=n4a1W?7Vj_8$fV^sVnKU)6P9^L-U2&)qS(8BR> zROCA>-1siE`THcg=9>e$=Z7(B^*tIjnJ~sJNtFLbB>Hf|2(A6WLJ$0$1jbA_qDy}n zp<+Ly(E<2->nH2bHOThG{#uQ#Mi8SzN=OkliW5H(PwX@o*l`$wtiS@e5o2sV7qSQY zg;Th=*jp|n96QJZ5L{yH3^(G4sq+Fev7Z9iA|AvZtKkLgeICRG+dh*6Tg6V9VqbWX zXzV&4VuVYIU6_ePV5|5M;|zX;58J|r*n{QHUXxW=tN^e8{`^=DKkzpdgl!f7$%jz{ z5C^PN5V*psu&|9n0E-YrJTPrx&Pe>2k`UsA4dcaPA!IieDKa@+fG`XviJPc%M4-bR zoMMkqD*_$%iLqzEkGY5<+p*c=z?WYP*_8oGfHjCAtFbGP9mU+lVV!nJ0tHJUfLTf) zJ1{{hD1McInccvtbCSqPjL3&9#B8LX^`!<3FAZ|AG(ny0Z}DLD(#Q@eu*(1TZG$Wu zZZKoPGKeJP7=e@qFX$f_j3|ppVK-$E1aU7cg4Va+G(Ug8+{K{Pgmnq6horBs(sB^?M&P-Z$n(e!}&rUR<{7N^eZ z0`9av^w^|_?7}t}0Hv!BICTOH^im)6=m`Pp3Jjnwn+QFQEr2r;K!78;iiDV9szgw7 zSu#Mnh`{OrPGKZqpG*O;0~r`tQK3$h0(FmZsu`y++7zoqDq@Ri(h*Zkjs_A`(_!2P zG*D?f27qDa{8%s@ruqagex*ahW+qUH44`-nIS?1@Do&L#;Rdib0?OPFSPkIR8Dn6; zWdvhvGDa3*2aOPGOxFa)m}Ly$D<+5~cEK19pq=RyILrjG!350!%w-BxqZu>+m>)w; z0k_JWBe(!&YX+xH&H{?77sAmLG>40#1TSWo!=(Kd0Oe?bxU#R9rxq~h%7wrQmMX<&HhZsrL)v=EE$Z!=6QmE9STuC|OHjBD@5s2bRzSe*l8dj}JSv7^JAMgQC?E zBnqQ01q!i3BC%1Nx?~00QLqfC(52A2#u}*k%V04SAUuN&ErYrT%YkW@HPj{80OhCr5r4aUXaqX;)B#TT!ze_Y3kvfbq0r*U=H!jj0!~x3 z6n54T?vurwie9`imP0E!!Lj}0ZoxUbIw86l&g}jfKw_pG`XNq7a%f3sT&h1zQM|7` zyWx+!5^qRxhRcSIwK&6NvqljtC;W9bDo#^`_t=V>%49A@Ez~nvQi?`SVH2R_^ zT>6i2YRei>*8opACVXCSD8G2Z#$5A)&GPaD)x5X{8e+U*$8vo^kFC8xabUwB(4S?42H6Vt)Kb)>t0WgIDe^BX&Ksb~K z1K?1SH*f~$$Mgb0sz$tcF%WdqH3;~<-3edv%^TngDizEbmmd=d0^G@9z#R;NgT~kh z4Yt8B?yZebH;7ZKLx9?{5e}MMD99oj0)rQZ!jOkUKvH@b+ykpZp{_X$aKoX9Gv>Al zaFJn9H?j%pcsD^E`+5WE`LLs#U`XjLFp$P(_*l2$)RoOJ(Aup)*=>Op`n(movB9!i zk>%K#ZOCG*2&c@p!*Y_g!MJVPVT_O4V2qR<&<)Nk4;H;0aRP%Au8OU&N^(13ZP>@N zc?WR6xeF1-4OM&@1hBO`5eF3hwFS0%CqTz{f?_ZtK=JXn82I=6kLUuttHM&l;S`j! zLD*fKjR7w63dBK@hN5aXWVqYQ=O-Wq0fBQ1y&4eg+b8r+G1aBUTapQF*QHb_GPBzp( z0}%EN;(fqx-Y#}OuU&{XTDp(@EyufN??QBt$=3|{=@jqBe=#A7NwVN(726BP5`W21 zwTp#B^Pu?;Br)+=L_(VFIQ;FDlBxJ9<(vF&V`h61W$-9qS*0L;`1eVG|J!;9ZodxT zgwU`Tv2aBs>}At)_kyW$V=t^84Fg&V3)_pxVO(+Simbgb8}m3e&;ow$g^lb**1O1po4?G42@$rZ(CZE7=EXNyHaOgKUeUL+I zC&2Fisc*0{{!ovJ?`QWdz-e0!J)8i26Zf+PQQZ%8Gl%xt4;a2gHa-WZEje@#j@iSZ zC6Zvux`~K_Bz{N!u1_!^yD<Ms}F$UX=O~RI5!1;I*I=u z!>VfskVr1po*(@_yA=1FYqJ!*@u5OP`2Hux`<+?MiIIG37$2T_59RGbp67geeaKa8 zYf#mAlbuKo055)96h_gWQ%F>@nb>@ZK5BZ%FQJ-1$b5#rnEm!X4w;c9hQl|JK277`w^cX z!4rFr-~V!2)Xh?npcWVN+Wwj90Z~Dh@|L(?%S(l23@FJWvwRNFkBTo?T&d#TVBsYd zG@#M%dhK;$!Xd-f=ZnH~+D6s3tbX`$(P+FP`c_lAA?L+Hxdx(*V|eJ7wDta4#}wZ2 znOEQAS^Hig?&8^l^H{enqK(xJ?%UhGwC4Bb3sYkqxlZob;G^BiQ{umVR(ku_gD(_I zqm^$t(Z79C^S>SAuCYggp{jWE>#THBWB(E|PZUq>!kjoS73oyQu2@gf?9RR%@@I*5 zRmx%;)=1IuoN_f)(WF^e-O*#Li1@^hGdpghMeaGej#fWQtn$@anM$<9TsrG+u3Gc3 zMX8kOmO0`PzvF0eRjpK~Jhf6g|8gwLTjt@`r=Hh$c+FV1^+hOVyi4f;_l+~xUyFz< z?U0UgxVu8Ng?6n;*2KKW(4eiwIH5`4_M%+@lJZMj&IfA{liWXE(vYNydYL$1;FlZO zS;@ zfMC^{>>c;#cwO|iHd>Uup=Zy5HOn$Tzxe6*=?3M;(|aF2G!<+4hWzroOCH{3raXiE ze4n<525*d;ZN~@CT@$Fj*RqcDV-JU3ALt6H&B?uYSKpRJ*RZgY3i-Z~_2`k>{vo&1 zH#N@HcKJW*HfwyHZQUuixptoE3FD7Owi3b8{Wblq#0h*?sFj!gcoPx8ga&qNFJ9a@T~y2j z@afE{zAN$KtI47?b|@1@(af4^T~G=|-z-ED^F9syM6(bDi9f%g3{IOhv|)XCPc}3j zFDf0KD&D}0u9HP+jQc3abnxgDU$djI2!AFUXp@X1k3v_mZ1zeN9)*c7=g`AAoxq{z zW&_>Gp^b0wI;^c64X&+@3D7mh`phR#tMQhHtY>6`hWMmMRsRA z=lA4<+54v4xpU{XX^tFi3GmDbF#jKnLizPMbzC7pzi)tY?4NIGU)FRzK0a^)%qBpo z4RZ098-PL*0lGN>@@#-nz&V>1y^+be>*6E3>6Clw2H;m@ql~be;{*ZPegl+a3pVC7 z1~v|4SDXOj3E;a)&aq)5*r2hJen{yVO1ji0q|Yenu9SA)EazWJ=~_xU`7_@3XQ^3NqNAt)Snb&m>XkC&=ESdik3pJuS_r+pl&537T+j0ipqe`#sQ#@04DtAQO-T=o2L^rzWo$Mf?Mo{l z&gL!EmO%w(9+Yb3CMF$$nkLU|7XA%1fOAyoGe3OrW|$ZWRo5Qd5K11aM%WaJ${fIus{tSVtYG3jbduIh8T-uskiMz8SB;mb6>#g@JF z>tK6PXHT(GldY`JsK=wumQFg`<6vyhXAfR}x*9WfUxVNRXIpsO7?QEno^W92{`F0* z$Mvi3ZT=^zec_6uT2_kveRr+)AyejdznDC7j=sJ+S7d18b{Ah(>bSR9=`(@l?R$+e z%Xdt_61%rUd;1Un-TAcfSmNb^&FYSQ@+m`?KCO4yHm|Jmd)(Gf*n4Di=^Bs5=w}bn zHR)QtH~W~>X~cq#o9-C5-Mrsq!o9YSyQY@xkRG*QNy^({DL?!d5IG&h2fTGAz2$kQ2jloo)N!X@zgK^dwLj*r)^k<6*6+&eUWCQ9 zY`t~aoRREsog4dtY^8b^nRvHbsawBId04P=+mAmyT*UnMY&!jGo1P^$mv}U=()%IR zayM&g?btBlujXA(*EF`tx4DY1amuXc6RK5P^I=|0hlNjDN6akP+xULhi6hMRn>J78 zpj%P1tKL~=&G$oRdoQ0fzw@z!p87>SyK=E)rRejoejB%TTgFeB+wZRriz^hV{^@On z`?FgNcgtPM%eTdl78feCU!VT>qqnTwKT@B9eLc(SvuZxNH9FB6TmIFw5r3w)9GrN& ze(~~yl1s!s*>?6ylhj_DI!{*DQ}69mZ9tQ#e}W(Nn6vTj@8=SCPcx5iwZ_Yy`0Jw7 z{8@in{Fgo5QGQ?P}$*bUE zo&P@Bq|@oB_(B(t)=0_>n&0h2_nPH@am#(OS>7eaKZXr2lKcFU7QeJP-LO&1al2+- z8Rh9VvO?O}DbmzE6SJmPNsG@Dlv%0&`)0FhxXri!zBRN@aOI`{1r{~8DmbZO$K)SQ zuC)3b(SO?3cTvmw`=3@=Q)XwWomV;+i^^ybzu-yj4vqdiIcem$ab@b<>wP7y&@bl` z&X4%}e;j;s`|HN;58S5@`g&>ptTlgMf0Nq2^sp9Xk8Yk=VeF8xFIGHUacHIG zi+O0`khIoWU3wPwZxr9!{;2B|(?ZpH&rN}I{`ykaEBLqil^dMyvU*UFi&ysa`8vHv z`kr&GKi@pn`oOj>eS<9NQC0U{Pw(9AhgnxL^7m*EU>JVabKSn*e~J4lBq>F5A`A}Q_~N9j8>gLw2T=Z$oQ5Y6!TKs`coGq8jgp2ZQI_31B@1Zi&u|ue zTFwtoB7(J7((ok0*?c7pPa=X{R?-7cL!kSfk;}^dK*DL5(2dT>68_O?Wc))(mpX$+ zPAeH@WjO2%GP)(oC7000no2sA(&LqMp+uzPm2?YAe^kz<)rtmTJ6I6-;rLQtb0p zhpLL3cV0C?V_*GFHUD1nLG$HtCHkZkpPv>zFS$*<4q@o1^#!G#w4cB`g3{l{}RuOWv*vy!?!k7&HFd`$4c zp#$#3l{oa*%)iHN-LRJRZ#AZJ-DM-*7PxTT_u$jB+at%#FIwe?2+0Ri3ebYwy3+z1jU}iFfpmUy{fBbuS}7K>V@9PNrfsbSSWZ9lO1S(kkM zG9SAwn)ztt@VvTwnb&r=u^JCwztZ#HZjCaMZgzaJcJ0e9?*}egmGvRx&ufCUoTlEeoTtdOM!iM4AA!Y8dU#!72T%0m(s%$f|uk=>O3fL zQ(9v2xe1ql_E{R9FJGw%-EL+rY-!JY{^Wd>&tFutmMm(&`t!#ZeSR5foz?Y=KHNfDs8_#K@Q}P+> zjq1AiuU{6vl-f@`Fv@dc%iI^@o2bw4`8nUH-lhb)E0+Jtk_e?d7d~TD@Rwd-GmC)AQ5pb6)hs3zKZE#+GdD}eX(aj}w?W#G>#_?V&q2B+X-K&o64LH4q&xspbF-Jhva zRR#HIF5wuF3N+58$|&`uwAT$ey)qRQ{B%RE3<3ADY_gI@tlgjKZ{UB26hNCB_?V@n z=iNXBwlulWMS>4k(%xx+?@-e9(g1&>>`MIcji-EW}~w>N{}h_94I%nYYiOHlN?aE=FCj-7poMKX$!G`g+2<`&!KV5mRc zPRR41MUH-Cv*7!OU_m9~QRxxb&dAaqBA!0t5pXxMfJaDgRnm7fYP*A%94O5dHb{?U~hXf zCe`dS?tG_EO;BfVUE)o@*nA#sjZyn6=V_Ool6PR&>jm%E{k7yu-L$7Mkr7R2{ # z_=biPGedO^{v7eH=<{c>Lw`*_J1ITYw|CV}9hM&0vm&{s$ImCWj;Q=rlc|~bLxI~J z8XfSKhW+mSlSd8f9%*j=g~k?(LYHKEIJ>L_Gsr)1^q>uLs9{y)&(GBlT(BRdbD)$zu+U z?RI6iCu(~Z-oba?+u zvGk;K_gfTR)pKx(FuUikQ}g!x@OA%c|M+Rqh8~Yc=I_~We-(3q!G{;<)|6a*=fIs5 zYw8cDPIQ^`X^waF^ds7LwPseXT3$N%BHE|H*;_pa6b-AFZ>3L2$;;_u&Kqa;TQp5G zd$M1@By-vD*;R^zn=yv|tam2QuBZ<#aXZJEidru&c9Fmk`Ju0# z*_Ou}&#vw|DkyVpT0NhrLu-Q;JkRKtJTI`mI<(fd2RE+07&5A_`~AC{E8Lzv@zm!5 z>(*6x;1m7e!L&vd%G(WVpM9yaYE&ygV*d_892M`(0yNPi~S9vPwDZASkba4lnjF}}_INo#MGZqYS!QW@_Rbu;SE z9V$IsyJYXhrXKfC{u8j`S(;Dgtdq-HUujeAmZ4kY(fu`*8@ZYM-+8_+efX!-?ls!K ze?8;X!oV^&cim1l7fenW^Kj_nF}`R0_K)b?^hkms%wGOttIwUAx`$=0UE4Rg+Uy$D zf9hJcM%LX+(l3?5R&A~DI%3q4^MCnOZ4_3n@BL=~)o8am+*bEVvy3BCwhT_NZR?Wd zdoO--{xF|vXXdmiqV2kWcek{yC8z&AFT6|t{Z%(?i8r^JSEo|F6HAjWS%SUq^zL`J z`23!k3kRfSB*s=7(W*q6J)u-oQ0wyn@hLk`ly6<5#Y*fa>9hKjRPL8;w|XvmQea}c z+)d_PN^Ig?w911DC!Y8n*MtQ1ym<0;<116wKPW%5x9Q0An)rJdVuw@`yq3nC5DoWWY_SyWEDt~rb{aRH3X}0JUG#eMIwE}(}a5nBWg0uKh z@HKwycl>BZKi)fjzz_6gD_=vsn%*dR&%K7PH1Lg5yBu0A`UXm8lLPY88AS(Jn9z>;zJMV%2aA!!!2Nc-#!Ku=Y zfbfyfZ#XQXk7O7-tsv6J2_J!A3e^?!QK?IY6#59rCTB=Xf;`TFV8g*DrvlBcV=Q`n zQn*2`!sioEUiC@ogbZm2h~VvhLt^?TV91+Zz;MuKV0Z=}S*OoRgEGY9Ga!qdA+-sT zngc1v0<)Y79HGyxoFMbE0GQ(hU{wIg&+Ut_;&S90#6elaL0@DJk^y@NP}d3Ymg<}O zMP?~gIyS)=z97eO0BCA;`0^bC7x0Ay7q|+X^OZQ~3#zn#RceqS;a>rXcZT#N$fq1g zxw$sA+@hTS&R12Txx>{Y4&*B5hNuh8-RbnZqx!p4r^0g=;TsoPmxoKG_MMxe2Fs|F zmL>qe3aJ3uPnWQb zYIS*g;&51)X`jmOS(V~-eA4;MRSi<_8vDehl>)39jA?oEB1C=!ivlx;dSd%PC$HHYYu~H#$(s+(Wu`}#=v(*wTy^}%R}*Ue{8#wIyrF}9Iu}jY8?rv& zFQdKTfeGyGsl=UmC(iNcd1Rq);oCt)ZiX~Tj{3Rgo#;AMTEF)C@ae#H zB=4c3wiC)M7;q&(GikkjS!n!|bBWUSI%{V>_YHUJTW7iLr{vcKn`}IqI(pK!AC{=z z=Jjj(tnB!H^9t|Tki70~!xg!vtj{~LaFEZxRnEUXQNO{S&o{%Q3KCN=x3+Yu4_svi1 zRLpnbn?pO7c*bPvhx=AMp;=yFO0A*gY}HPVn74k|u0eU8U;El}-u5$#TDMMIbM=RP z12Q+Y2v}oVTV!dkdsXj_G`47C+4^+H^%ud3ZWVvs-08-Ho~3dpdOa)QHLRNZoV;V^_PqS-x|ABmLO*tR8n-_E_96GW zzjRrixwS>UI*&I+|1m>)vi)@P4@a9VZPHb<{(L3((9utdw71`A^h@Dj-dcN^R%;%6q`)2#122FjEN;mea)MosH z&6X!V3ud~nwEZ6Xb81^Xy6Q>qj6BU+an78FtY`J;r1My9IwESUU)bf~J%eKEtj(*m-VN(AH zpMhTYo27hx`LwR@5l!%bR*^5?>0?T+KXtHPmo^d0XKTikJ9d9|i7Ta6*15W2L!*;y z${K%hFNDpkl}$IuDLxcn!$Co3(`~tjx~Ll2$#iq~fNXZ8e^k<}p$E2RJn(?5HEY># z^drPm`EiJTv~m3SfFHaK0xX!`6PeC9GWGLRhw%cJGOeUcmAsT{Zy*yJ>Lp{s{JrpF zljBE2FJyb*$o3ok2+8e01wVKLgDU<&a8AF;Smj3H`G`1Bgj?QH=oC~bQykYiD8`Cc zJI8^%$l85|b|5;#g7LyN8|-v$^?j8!ZfhR(P8HkWt@iT432l8&7OOUHTt0O$)t36q<0&1(u5Z9`J`ad;7D&>o)1LIows}oe74lKRe#f1i_hpO10h1A_y zxgu(>xUYrO7gQ=s+=asGb}F=qLV7iOAFlR`8&XU?+mpF#)#aHsT)mrJ(5l1Y@UqZ9m#4oRc~X)QR;}eBF)r+Va)Rsa(4MeeSr-> zqb?iQew2Ds17^RiE*EDyrLLuBtL~`7Tf~0b6!)^5k)~l!#5qIv6I@mU^ zn^Z2YP!Xw-ik;{V;OwGOOcX1zKq?gF)ajZxo5dXW+d`?JI@b4$FJ-UF#w|uc)nX}#Ra_$Z#BNyX z$Eqy`+%ZW2ei!!Ktq;DdD*Gu zQoiq&ezaT~$lO;-#n|cP$oJn$xiniL#jrgqrC{8i;}zMePxqm{hlJRav*}#(Q7fgP z=-R%OKvb`kez#JpjKH#Kl~l4s_T@&7dj}mStexKtF~uIfN~?p|+`n4#WQ%b2td3*H zVZA=xajF)l&8XYB(Nyj}-GHk6#x)8u+%e^_mxq2k*KJ`J4DuE)r^+k4RE|v+awT-f z4poNmsq$BT{{g?{Z5>TRAOz&f+31Z@;n<`@ZrK$JE!aNlZar^*-? zvqtJn6F7ODG!}mv{v)-T}YS*nkFjbz$k8*KEDp_E^)IJV(Yon+M6*vu``EMQ-3t8|(5-y!*VbsPH2 zz#b8}kj2XKZxqt}L27=)ogQhIc9w5D8msEjy?*isnAfhbZyCsXi z!p$M!eYz7N6z;@3xs6KW<=t`;Zunu_c1s=EQ`C^BPjt8b!@7f%2A!2f#z~FTMjaa; zC)HN=?uLZ-?-Jc>SeITzY-qWZI7!cv_DUg5bOdmq-har@{(XiFg-tz#=WR@_I^mtXL}_#kdpGa z0cR^VkWxAq(1erxVjpTVM183An2owmo&8I zvHYy$>s|p^>2X8PW^@vSt$qmDRRHzzy-5PTshYHXSi%!pO9gzHTVN5NEn_xiL ztYc6Bg%3(4S)oHxDC=}ka>rq&2?r%VNSLh$r9c`oiw@NQ#I_uia>=MlxSgCeNRR?^ zQ5(4X;$NvK70$)H63|o6!%~O`E`z0SaO6=`Lv6Bc*MaER1R#q37IY(y$Mprv6EFw_ zAWpI1O4pm{4Sgd`BFb_^sV@_3*U!Vs5EoRIvLQLxC|UWCm*h9O&WLMra2Bm6M1#ONqM z2(sIl+n%_%N=KZ4;xruE;|`uhwbUHm5khl*ZhGPjtHM<`j{(!!$HAO4PJ*kDk$Pce z1A$jAVhl_eASU7VBv$zZ7?ucy2}l)TVjU(BA%M9i({$ts&~(Hp)OYZNld2;M;l2!_LgXowl9|5gDX>ia-v0tDFYD)e}KXT*X6h6Z_*dvdW?cm&XtYW*p=O zb=sT1#~itvVmtnmr&rz0?q+hTqQ@}aOj0FBgA!b@7!@;yZnO) z&$cAW5{&ZTJ#UIu=3090=DM-z* z#z!Faaf=|SZ@i^Ql-ZmFW|pUFF?Kl#Xx&Jbilb28i&7w2N73go=?MdDf(8bdg@gj` zYPu--t6|4_C&O8yKFcOWFgtl3YAES~RKiV9oi|g@kP%-gBVnP;Ox8Xb_-ihpgL)bY znw$6mGXm6*yR|DBY`^~^s{4|R$xgIT8!)&RP!HjNQQ1rTr&SQn%~ z*c>F%SUN2&Fjvk`!DV9|&)}v%$+&s3x*GbSv^WIb4btr37+j*yBL9^Ff*d}L zGi%`jH_9N7L^U?zvJ?_3D|@Ts<{_87vgWsfd7(L>#fcd)A+!F4c@}v|DhOG<zD1mBqmoUyWd#qMDEe{)% z59#R&m*trx*V*JUMyUN&Vm!>#%V0bmdxAeK`7#uP>N3VeQPVa^j+gY|uPb14w1V(F z#<(b}c?GOn=Njo6v}Z##$mUP9zXEiKPZ8B8`e{&+jg7ww*-5>^vmB_M`CP?dIyz{) zDupxKb#!nHpltOuSy3BU63UQOX|-9Yaz#ei6w=}Hf5Js>)sK1!ykw>+evL#|3MMFY zy$mKKJa929{V=e@*T7H9uE|aUrDd}fCO^`Jsp^6x$?@7JETAH+z;%$RSgKUQT~AFw z@KF)Sq0QG}vJm&<+Ddjf1=V2M+hA8y8nkSjqOdwDl5Gr43b4w511hC{3Oa64^1*hX zd_+|}we8QArbxNyr3tx8Y7)~1>B21ZG|+jM0zzfo0HLa;q87O`e(pwU+JL67Nq*$C zY)N&rZBPahPd|WTY>-cs!`%pq+Hkd#%m-CcA(CIF0LCN{7L- z(OkoT;)*)9_y&yZ@i!#*!a2TAwuyoa)F&gWmL?U1TtG^u!qpof=e2a;Uo;K)Lyo0E zZeYq`(e}LL>xFAGN!!>Uu;`2IU6`O$(`4(_CmrlSJyEQwAa)`RL_K;F)#Xh`H;Boh zXHBdlWu#Gr5k+NX_An7M($Iyb;VX@t$-#cx(}C57TT(D?%c1#iGaKjKg!(kxl>9^F z-=em__0EJSj{h~hDHRHG+)?H-)1h#X!y(ER-$Wa*%z{1ixRO$a6I-&Zn=l){LqJ*o z*kD`+-vTD;<5B?_i6on3vkPg|4VKYpin3pCLG%y5BLz3ZyE!C?a-5#*@c;+lgX7{e zXC!4SR4<GtkoR|`Re~kAr%8n3=6MGv;Iv8<<;Q2cUUjlK}UCBQf^UCN5x;YaKOiDf1DLiet3$+q< zPYNlaFfSe?7P^Wr=&KP@X31TtU}5E2PFHfmzC;e$^9#W%wMaX8#MuOp4Nf#H%ci3L zf!YP`OTliq3!2KpG4w@Q^c`=mdj(R@2KS+gZv6*>%Boy_ z53RhtFNLagIyUYe3|I`O*>OL+GgVL)J)kFV_<_b3^v8_1Jr<*UP>$2>)GRt+#;c+i z?jf{x?E(5E8@-6kLf%NYPLtVzmX)eeE)0|dCpqOIZOpjmS!|i=MI2%=bxIaN7w%)Y z4nD+0#1+Hz(ZY&6z{lc8r2=FG0|e>Q5TL?z&eL^}@c1x&hcAmE{AClTtTmkvB{5Miw%AZ>}2U< zru@hvR|6SFX<$-5Ln=ga(+oRIu7MD>FfBDgw8D`R(n38mK*A1B44F1>YB$}QoU9k%TW`b8rLqX_x2H1P!L zUv5T@Aem{)0pO(haeuPviJ~%)l>1xcDe&9(97ZP9$T~fRuDMG+rOrdOjejc5hhC9e zH$Rj5upTdvcgHhH=jmXfnCRG-`NNpcGs#UdK)V-tE)_53_%;wBMOmQGyGt^|DG-p$ z0^7UWbEy^ccqs*TA)3)^JWhE)E=#tUQ%ZqoR)a&NDiHL^njJ(_AfTc(TOKPA(9#B1 z-S|S%vBj@Ix=}BrGTC>=;88m8U!x6+Qn%HnMYugLm+2K1o|Ny8C~?nSu9?w@LA$KFdNV-HTPz=mf^ zC2?T1>^rGpZl~O_2c~NM5jXGCrEC8lLn1=LhxF(+v``2O^n~60;=N?9?ckjuLt_TZF=~^t za6tJ6BOD!pTU+I!_+EP$7e_YME(_Ed^-+rSgoaSu=-6e6I(o`LPYFC$&_Xi8=2d-? zaOc-2>Br(!cv#o$e&WJjLxk%J4sNZ6^Ui92mh!RApAbCF^$AOU%|A;~80EZKQZWzk zaX77Gut8rTUuJBA6R_;FWXdI*0IYnL6zPkV5QhmdqIZvIVn!P~gb$ur#-pG;{9XJs zVjkj;)*qxdDCj$Nm@WM*8CgwFO&N9fAuNO1ir*)B#NOE$;f5;B;DOFxB%_Z!Go8xC z-riV770s%9YJQwMMpKaG`6`9x3&GNq!rZt#UQ3HYt(iup@ndTpUmZaRdhjvXy11iG>QzZQ1tNF1nsaUC9u0cgrB?TqNdnw4~Fv&(pnlLse7iv1{$l|!KSEq$l zn`5=9G@4*G#SQstYm}-S_Nz_{J(jIsOU!dej?>6N{c^kviiCo-Dwigft)v|La%n;_ zvzQy~;;C;WJL~DD$p=yKs|R}S>#hl8`Lp2bB6{GdY0N4B5PNzjX6nG;#EbxJlZF6gaa(<1?tyuvlH6)KF zR--fEI80m~O?{0H!j-w_)z|_oczHrg|3aceyy&mqsMEo2YDFJy}OGfR!dE zml<~)GK)8=LU2;V0umFK=4voct7s4_!}V4m%T)jhgD-TnP|j6{$1+%HA5>>F(G!H+ zS3NAt5%d*N1B^2FRR`noBz?s~AWTH=s}?3zKz@x?t;0d2{OFbqA+ufp0CTz)+a)_3 z9dtS_KZpPW&6|h-6Ux1S#>N`w*Z4^mgB5#UG;h_-492>6%OqW`uRzte~b; zfPtpE%SVF=y9C%QR0np1Llsw0^Sj+*vkG*nD= zifvf6N*f(>SRF52>d4x1!C8mnh(aS)BgsrIAKtzdU@+ASX?*QA5;?BfZCbjPorB40 zkAu<6vwS`aKTDy`Y-F9el+|l>%AB-2^--_IyTU?7m~sLP6cS*F%J47K&^-U@{+qz}Jkl=A^?ex&iF4as>fpOGH?;$UX-o;jGcG5XH|4O(FY^`JgK zOn7gZwt%=+NEZnf#;96_k%8b5iDuMOgvqrEqx`}H2a~UL8q4)jpk4-P8$!&*7<3|^dw^Ml3r78m+tKsQ{cU^?p3D|e)GYJEPhk)rBL}G$( zrV$(gIhe*ZOpnR&$OtS6^vv{Tg-cl|RAJVc5T$VHNG-X9$!rz)-ext?mMNDC4MwY= zW$=nQyHFhBOGgm^*X$!&!+@VzjCWN0SG8}N1rZ!ugpi&xoOUNZMqp0p9o})|r8k~& z5%fPAd?1%VYCLW#)MqqV^>(4K zMVLB9Jew|52!mLt5bw3Q_72m|CK|PnAKy$tyTkj%z~R9t9vPESWEzu+mUUdIU^0nF zo8)j8mk(ie*RpmrZ23;_1m_p|@MM;2VXzSf)D;F-+$iX6Y|9W_8jH@1cbaJaIZY?* z9v7SxBeot1Qw$q)1S(kNRWX2kL zYlVow@EDrljS4Ub8h%LNqOj$qpwUf&xQAd7Y*IYmarPzFHc-EBqGmZFiH8zhq4wyE5Kp03tAZwez9SMK6tjn5d?bGlKy?8mKpxC2*awH zkk9I%AbVI=lgDloEFZ+i1&Il}M=<~J`iNjj;joF|oWX^pcivpF#q*!?Sk!gy0=#UV z#wP45bsjXT#fUAUe7EpMF4L7JGgY7#*iC33v=You!009hXFTA#xK=$*6VHfj! z2K;!6XiZ==en3oM8E2R>voP*rBlMm!M^3Y-@l9CB=M}jL&Xdq%Ea3Cn1q8(Vra~i# zB#1CU8<;R*oO?p30w&l;P~)Nigz2py<76vi=tO~KfxF2gV=)M74I*BcV1Nk|7IuM) zt0Ma<@VNx$g8MB{#*E`SJb%D@5rr5Y4CjZ=jF>G?X?QsXJ3l6f`Uu_uc6SK9!>|jS zPA-ywpwTJ}9b`f_GC8&~_Na)BKw!gFGyB6mdZ4B7D8q#W+mSU?okuQ6)QjjlK~{c#4r>BA1+!}7D6ziMNUTi zio6N+jqMu&1Du zp)MU$+(`&oFj4ujgANtMGtOBE%Etl{3RJ*K7EeKo#o%hY5d9Iy5;z(0RO`MPh{jFL&sO$nHn6PGx*uCh8 zTXmw6f>;t57^{@RaAIA|rsW-WII4o~$5|7>2*xU*5EZ~FMq!M>3L*s&xzCm<-yC)< zD+o(YR)jYM%D_by$cnftKRrQH!LdhhnvccVL42DyPIy+_b(}CHa3chU!zvKZaPW`? zQEkFeP#!_31t2ZUzZ^w_bATfEW1O+bIW&y@qzIyCA7UC~XaKIOL2_7Aw2L zTCo*z3&<3i{yFm))(JnJ6oKc34~S2jiJay!_ygvhm`^@I&*gI-61%)v1IsIjN%9rK zz!Mrl7({4)J|IT69IwCUyR z23$!9Cs{xcPBK3vHUn>LqQ@{bc^P0c*bRb8g#Z?jL6n|Xy$IEc$ROS)Pz%=-2s4bL z#Kbe`e-8N(nH8oOB&!p-h#J`A07=g=oXu#fh`;Z+I9U|Y991+q|`dPhi8c$7!b zf`FF7GaYisZ^3pdo{_9(tI%VtNDE^OSte>lI$B%_!4|zJT3`n9xMNd-C?qXn#2md5 z6)R%iV!s`MJZBce#%IAov%>xqSd1)bj*vDGNElVD+VI51>ZpsrmRSs>rOlW0FNZ(j zx${&&*!ny9;I9c~EkX?c9JS!E z$Xi$P}j|2c_({~dK3&u6}GHCh5CcuPUi3H0ro|MH7z;Fnxs>Zjni)JBK!zTmJ zPJm%+Cf^_I0@YPR6~ekavYTA#DOZaShfoC$6{8C5z2h_hst{I60JG6fS^AefAqd7t z3c!QdPQvHY3lT@;(YuQE}HHrEEwT{35%eB z!QJP3hf^s6WsC-Kl0X~@WsOEVuav=A2u|{iK(7i+fbCJj&|z-`CwovI+&-Z`$N(AU zJl&13xP^?^M8v~j_6j|Q@)l$Y7O#XJBX;M)it==al`8ZYE4MCkV_7 zJ)!j&9%(34p(BXPyAFvR+>Z#Y%b3uNK#*1F39K4nND%)Nh6Hg69!e_WOHrEV_}^ipKQD<04hO8a$N-Bogenj! z;9;;dcm~!X>dDV09PHo&h;Uc<*#y+#Daok25E7fz#YO}p7=^LIz$1t)TtXjVTL~S( zvZgafD1=0eSm+4?EBq|M4oh*gj9T_*9Wb@9>mIwQ1n&qiy*NHbobp2zc5Eo(yM>Kb z&gja+Zp0FhkPps}0K-bV2;)6U+VrIuBQ9fs9nk`BVW)~fciMm=G=gOY9)=wk-+{U8 z>_hwD3=>xKg~Eugi7>(9!I}^s_CkH4#RF|2SUhOe&TmSA5*GHnVu3=4f53dTeFqu% zvOLn_RzVm9ItLY;j125?7O8->8-WT~I~B$q9+)uhSUVMAoSXsufsN=t0QQ}pi2eiY z7=EQ0^&tu;P{Ae`CR|Jj@0yCc=c_ z)YDE`-pJ5@Png>fm*y(O4hW$U1PKMj0+?Vskb{#wOxep8*!F{cLqa386_2QuqoVbg zCVcMz<5vdh1Qov%0Wd*u*$F5}E}YyF?0vulbA`OJ?4D#>ONjpq_C8>Oy-)jJZQQbj zPETiK_#VSo1l0pva!doqvIQE(s;SVh5S~Ont2mx|VV3}c(ugeZ z^Io!-iV!Ol6&CJ`6%-a=g2Dn{3d@ltC@*ROb5O@aqz^TJz ze}HMA5QH9s(n6210LF`I9ET8;4q$@Pf#IC3biO&ZdMma~2n+&!AdIoNm=C1o>!)3% zqg6PAi0Oq6@|3}nlMHjV|7eq_``kLHOKah0t=m(82BRf>mpv<5fJ;2AueIhJhs@HH7_46aWzBAZ?H51q@)qJjVtF zL6`t0=yd~jHlqK;+D-$5xxz~w(*MHfV{uF9oe`%=g!IRB}xONT>1b~9~fn{z%mLohRtW+2v6;Pi}O z2AQ;?Rck^dk*5N-;t0rK%RKMX*|FaQ>#42`qQhed0;gkRmZ0l#qm>}4uG1Lis z6mH65b2FVsC6S!N{QwH9RxqkeygGvOq2+r5u6AATMZJiIn0O-;Fzn*Z?y$pwz%41R zw;E7k91`Hk4;Y>d$}XIJ!wMp-9DhJr3LCSq?L*KCdOM~zPgXjq!HZ>_XF(L0Z&+N7 zLO$5tLOvmyiY0PKmhn1Qe*v1 zAT@Rx38c0N3rg6=BWyPW4CXIS864{o7zFE1yq$(uJh11SFN|~A-xw*I7qDqc7$zKU z6Jc0uLw!X59P-2P6Ek9$0M{@bWaAVO_M(EYLOyYru*UIC_`v6v#~-dK!VP?3(d0lr zc#c9o+=tA=5QpKZh4n$+CPEYd4jexwbc9WS!D)1u(h9h=DKJkJY zEIkSQ&hG6NhSRn`_rHR5#SX zwM(YzHKUACFc@@E)pgZt8>)o-|12Fss#NhBGPKL!p(6+P=;@_LX_L*}t5m6|Mzy{E E2fYD?g#Z8m delta 60513 zcma%jc_5X~_kWLl-}f!qlEmGwn=Q$bge(pYWB0`%bl(Z5_lzJDH z7Q2+9BtMfI! zF5H}wCl-5ITmHeeSPdU9z1`=}w$DsWvpP_$U#Xz=O+h%0ZaW#c5LFEph_T)w-PiNa zJb9rUJCV}~MqfWAxCoo+2hr_iY~~+DpD4G^d>C(Kzj1v)pvrIykNC;-1wD&4yq5_G zjdNOl(o^HSasH0OjDzZ@=P}2b)B#FqiLEDCcOeOg~{@+zfDle=s2>7+;9LaU6-R3_bEwu*ku!U5JtC#jN;~VlLO0LiK0p89GVgZBL&uuA%rZxx-mg*o=D}lF zaCIVmOY|(wk6aOyD8{#K$?Yol_J{X|ZP2${dYLy`TQ=T<|4Opc3v&_YWQ)w(7yq%m zKEpDFH!)UNO+KN!RsC^zRCR>C1+!LnX|Z!=uwOxwnlEuo@Fk`HOru)Y*Ts)g66Cpx zYHVxg?qnQ0bZqy>H2e1!)k+&mb{D;J6k1J8Stac)pnfQTPf4)O;+s!6#@u){-s>=* zoE`Bk^&$P^Ztp`^<~(q9^X_P87~c|5f2gZaUOphmy;^10*2_m^EB19MYQ^)LGeff0 zXF9c4Y>mj$^}6=9oGU)yqaCMbFJ%VL2}J2QkBI8pPlrpN8?IHh>f6F0&|&&!wDUnH z)2i`m`3&RZOUlpct~~1Vc5m9MiMoQB{g>vh43#Q=xjOi`;MT<#k7+cm%Ij;nag($% z$1P@|-b(ogvm&!j4fXV_H^%&*l&`;^)XNm#(OSRy;!U6I=kJV0+K+fFxm~a+^y}!7 zuOb55Q+tbDRUTegXQ5!8XR}f-Vnx!I*t9JwyEbpNP@fqwUVOK+c9*W>@_31sQ=YD_ z5@*E)$fKJE6%>wUY;5l})qdc!%rtU*%+l?a^yLk9`*Pmv9r*T6XwmJE7Y%$BH!AL| zOpQ}!YD@1NG`pwe?##GLN)C&5%}aCGWM8~ttSBr(N9LtusoS{|lec($Wi8%Bn`fRY zx;%Gu&G|)JA4oiQ=-gsYN;C4-HB6VEw|c3L*bLuuBE#PUhq$~-HcwDbet+IKvPG?~}vsdhi{q~ywV{R7hXN{v<n61d50x(fT(@MU&7i4U}#I@S@}+$e+CZ4^(K?)6 z!09r%u1K^~%683R<|f&Si(PuA=GxoViLOly{vPrClz2^1v0r-+-}&cHzFy51?0ira zTkx`(i?n6wB0no5Q6;TCw^HoRENBrnzOrdpO~1Hs+;Xd~D~B;jXuD@n=Fv<2GCsaE zpV~7AW}a=>8&gRdS+A-zYNn-i}DYyivX}+g-0ntoDZ}xo(!=HaiNeo~B+qnym@T{WR%JS2lq%Mm<7>A5wPsgerN-{Q zE6e}~-&n8PV<07c z`A%Hvjd?RC-hRC~cu3;hV40@quGw5fI)#K1Q?;1`ZcES>OR?)?E0Ps8yh($xP7IBF zgTv0N7-_BH2@iKabK&3+40z(M_x;Q8MvY<5+T493yN{uJ<;t&CMLwXs_xKV#cuDs1 zt8bs)-1<_I{$75A#^K7QA}fNG&D|_DuEmz&dA@_WReX;;73_NV+-;g!nziD|mKX!4 z1-kB|{msmSUlp8A`ifz0HD||LtrC!V%OZn#gB(>gSDqWjsyZsZ`i{RI46+LJ4bbGf zL0?#LlVj&?;)!OG`DUqTL!Z>gNRKleB~!{d&Y@RUD<}Tp20| zyI^-|zeCJD%gakd-4y2NiF}!^w6g`YkzXP$Ge`lkss^Mczo;?Qqe7)(KY{? zS$LIzvC%RDQ~#`JFMkDR#zNlBYqFmBCdUW{KPY*~an|xw_r04km!jW$UOZ%$cC>ia zbBcn-KKI%#b(6L(>3O2ONx>&(k&TYr3aH~UZ+KJLbEQK)E8(?$#G)B9-@Wq;@4sNB zL23&Xo-bZIuIiC>K00XScxSb}!l?&-U0YX%&eaip-SA2yjkz<`>#W4(VF%w0cR$<| za67s6LZUIB_K8y8^CwzY9zE2&I6&B0I`lhNd zrmwq~r&&|nN5Vxw@Do$pl^R-9Fn{v?)5v8SLTCF%SE=*VHL8XdN9Z&jF&?~VYZ=w` zQrjct{i<)2$Jv7qHuU=#HkVvGvnH#Y*Xe_2@#xw{lUB=TwF!wluat6`dPbH0eA9MM3T)FH%@98pTe|zPdja+6CgMF#eT-(Eqz8ms=8_G3EFB;jRM0{?1 zFyNnc6a#t3H}ZQ=&~BPVy#A*Jqu;l;*uR0XFDJuE&OS}c=!T@ac9zlY$FFKhPHWFz z*WrIZ`wWL6!SQ2&nc)0?@{{ky7%nekI9>dz)f&sRTF;Od+W)5WzWL5@(&sE@Ol#CU zx&`0I!vUn3*b~-c{eTu->+-^&er#Z%d42>_v951CQq|)7s~Jjm!-ESi`#opc z*Q6_dJb$V0p~s$=IyR{4mF=bj4&`TECY2qK?-n=YRZ%A ztLMCJxcvHR0Nv-SY%9e%XqpOc{so!($d+=zZ#0fj? zsBW!c`&0+>!i5u@gJB!Vd(v7OuY1HgS<#sBOFlkdO2eq3BQwcSOUPVWW=~2M9$h~1 z>fY*vOWkHJiW>r7J-Q}M?oU~fZWotov;gag7v)JV@ML~=Z z^YKLV)4Z5dR1dG-^7~!C_I-)&rmYgXGG;Hbytlaui0(4Gc{cd!UE7@lPv+lSl6u)D zb!BR?RgE06<&Cha-K|ZH4{F3C`Yv>7$1jvvTlGz3y+Z8QPxsDtT@@()#4XWGGn^54 zyG|n`%jIhpPvP0ot-~)&J0^(t%TAc+^6--B6g?t|juNzW(PY=evQCQ*EhRctk4UDe zl4&G83WcajCL8F{>2y^bOGbz0Xr-PoL5%}U6bX7XD&r>%;06@xPZ)Z9n-tm@V5~gN zk3!I65J;*d21$>M^QAEK=rlCCSQE7ibohZHQuPRQ3ZUqEWD;4GOrq);P+2IP-%y~j z5|N=tqNtLmfMg0?k3@%de*%MooPKnIK+>bps6W{eDS9-lTOZM6i6;|mtT-hei9yh# z6Mq8nifFg54q6=`j-ClNQY4f07&I~fSU57sM42Y1%`2$cB4c(meLpT~u4=-Ym3A+lqb{^gdY1C)S zPvKa&Y1w|_@F`OdHBuro7Y((nMSQcgSH#1{OHIOj6$U8(HJm&(=bi+{q~j8G=d(LLQ*A?VE8BuRU(}TDvfrp z*TD!}h$x!6!}14&4m~9SbQ&@r)eN(grWoi^4d|@iP#M603ggE>oAzs^H1eWR2oG8o zmMKhy1w#N;rBQ(eI+Q4h28OHr$fbhb(9x8gl4#K{xgaNjhNdJ-qW$42{L>tWSmOX9 zgU;SLQ)oJiK+_{);?9U9>h&|1WI)m*VJR;lH}98RssXIf8)Qked*@7%DF!4mMUO%v zqP7ub90p_**(J$ICllF+TZQLIJ#|C7sumuU@-H8IQ63^R+m3ddUp?zm`MKj~vc#45 z9}3$++W%=VzhB4k#N#bH=sZf*`gz{xuD&nMV{G1fDYekFB6WPMHDg6~#ktKViwLx) z!i-jzf))9x3y+3wEpx9ta4$UX#G$4&9&3uWD($LTPSR;9c&4)IQpcN>Ov_7rL2lu1 z8ZOQsY5$gyVY=&M-7^=xkBeqoyB5>j1dnMfO5?Lp<-6v?^~m7rNUfux_@_p&t4)t% zdBdx=a^?3|ZYt~;*uiX7;?D_6xXQV?KDR`nqeG0C)@(WuuA}+UK+Cu);?0*Vs@&;LS>v-Y_nX#zagePq zc=<(iw&y3JvC>SUnA`ZnmPG|Qombatxp=6=9Lv~vP}d_&+bu}Elrzrg*3D7Dth?S> z+--+rbGgTMjqdE zWJl(GqbmLn_ZIo}lr=nEWw86@;d4!4drR)=h=&QZI_RjUt~}dS^5XKCn~fytqEtv` zF^zohf$I$F_BKnO^km=jLcKxeQqhN)7i1?3`wL3q%}4ZQKdwC*@7!xY7JP&AnA~ew z9`}aAL}`KZPsi@;bZ)HhpoH^&pw_26K_ z!_^vQ0%pf%@2^Zf-m-7QxS*ztVM}BD6 z)+m=|;$(7MILyjkP*BZJ!7&rvp2>Ed8=Dj>>W`s83j-&T0`$;zo4VqEzv%S`5sk&OvgN-c>O;*uz zX3U>?O&PhExFk$eM!3k$&92vxKmG0!KLUrM#;$|!h2@SHylywVc&_bbVEsiI!}0aa zU)F2A=r!%_dB<#DGyE#6hgZU>HBrO>%?QRKPd&PKasxv<`gk2*o}3pf;Mn z=akx!iRU444|f!Bswc$c*B+L(S$;q2IOpE^JEBg_T3Y`YmGhk?@7AQ7m#6>cwEs2{ zm9csaJezjmYfWZvwCdsk%6ud!-bZz%c-AE zWS`F;yU6el*3C^cKXW>_bF3}fs%leshy7BqcP-~_>%CV5$b6lXeu}9(z-iJQ^`%fv z>Pwd%W8cA&rl-Bl`{SBla%@zo{<6bPvZCjii=1}Hk^LXTHCIn|lv9mAJm2SXDJX{X zu0=WDMT+KQt0T#&W5&`SmVNWfy}2NpvDlP)h5sM!13ilG9PSGTty?@G9m-SFpO7@9 zQ|Nlfg;!=$waui_+|2Y^!5H(i(v0PsSIk|!R(pNGz^1t7M~d$+X`ZaC=1-EGB}wJh z4;6V}*HL{S_~G+XVe^H4s)oMeicjqKJwVI*{9;CKmW^{IF+Pq<9=~c3ZCbI4Q!{&c zj>xu_8XM{gWar5RUEVbs&vh@mZ`&6%#1T77T1zZk;l9=g14`?>GBlm6R|c5I6+2*m~qeAg9RE66K45Y)Tp zNqG-qzVYjZphF4oR;l(L6HHn)V!JtLE?VDco$vLJLjNrj|i#*=MHpK2fgw%ro;2skF;A<1!D=yvLht zZH^gse?hEnO*Gka$w&sDO0;(k5y*-k+Gd+(uq#))w^7N~SJ3C&c7vYEn}MQvqAhmW z`zFr5t2!NLu%(5tZ{P6z(6mEQ)@j9ZuP5FmDy*L;61Voi$?AtQp7Tt;@gF(ZEdAy| ziC!A>RL!ZopA5^|mb{rb^sMmG$}1Z#1YNxzC{yEcbl>pGXU`t;bo+>?3M%tZcyISf z3}0|DadUfRF&t_0?uv`ut}&H|IfbS>t9IQUZa?_NV%)#N{4(>ie+9W*WBl;T@qPWK zH>5t;+C(iBZdm8DVV!tuw!K}WegnU(%y-S%Mn@&Hm=}i7kkQ>|BF&UmCqL1WR`6C# zBSzi$?la4cr(J)}7oX(K1K%mHBCXFnsIusl`8*>a?rYkfiNW{Ra{Tg#GT-mD&CLzi z^Tmnplll@Xht5&)%l>Y1b`wt}BYOG+H}VJA#V9z*OcuP>zP>I>c4QJKk$RXn~3|tXVtC>^S()(ZSvyQ_ToBX z_0hDTHe}mtzo#E7w-#IN+4xPwfRy9@zO8VLB;V`B73hfr@!#k2u5L8_QeD$|`jtOP zzrXaP`-QC4_paN%+z=C0uwuK<>w|L9gN2{+XA)0$Zyh>l{@N)>-NiUmmM#@5UXyp0 zd8hMk{Bs{nFkPp^#rFG2ik(^eTMJ6b1)D{Q*S>NFwipqNA;Hq$F(F761Kn=F;bxr>ELOQ zexNA^WIYn;U+B;K7oojzhRP%cxX2`6Od;wKsNksME)#(WRl$Qqa~5mif}lJ08>X)2 zLd6oeWN0J?I4Iz8lZbi@aM5Ytqk$KP`;Ybsa;V}lVV*^*?l5|2QnIOi&BGu96 z1hJJM6FyY>D_z}Gi3ISqq3bj%O^*PK0=N46|7(m4r~rnkP&G0V&}Z}fOKlQCk4Q&{ zD3UthivEA#2?pTo+^7I&=Rl%3^H+iBBvlHyv}79nFR~c?AG}FqyeAOU05_EkWBF%K za1HrePvr4|_)#6)I5I>HSk=+e>JMVw72FH&=n_~T| z9y0I=`L|?f(*eo34A4WuUwXp8b@@*`C#WYDvLBI@A~7g`MVNz2OlACKmLczVj*#&~ zMNZIZ~~YqLGvZzqKR7#AX}9ySb=8H@e~lbdi-MCJG4`vD`7^#}~yi=NB)zvlG^ zo=Ais7RwjEbV``{Uu=n>JVY=SzfV7zfE$K?589tyBpQGckqrJ)`?m>JgthgvIvJu8 z6fgu+BQ$hQQU}6f|J~eA{Pa*U$q;V%|ERzkw7>Q4&k6sFc&s7(Tkoho{~wM2_t5@d zYks<~?4f1NpK6LQrrQISJF`p(?T{13GFKq-=>BeDEJ_IxL|alMI1K1mN;IN_THh5x zg?90A5*Q42fWyswOKY8UGhf? zQb^FA%NoK= zcY;G*S0TTInZ^9_EwQI>{GYpPjJ9U4v{qd%JY=XFyjR`atz2k8{??;wtre%pyY2|g zsZ*%=lorS(-*o<4@Ooz1uEW}9X(?GY8oj~`84p+1?DP40rS05>gb}Z0fejOvNe9xT zTvl0#J+1at71zxeIb(9Jhs$DR=`>UphwenC%{XO5Dd^JwyJ)uGdk_**fmTql*(y zGvmAES6DwX8F;m>b)}3}x<;JSvQ2YtDv|RTPxc?QnQi?^#^Ymq%j%Z$_ThN_$7X!B zSCU?TMU+49Gq>|=uj`*#!Wxc~eC61~t zJ*bmBq%vtW#@8A<{$0_WC)i&|Vsr8bqJQ|h7Xjp*&&%(cSy!C4_kUw$_`$+fYtMY2 z*?Tqx-t|x!+R8T&w0<<|B>| z*!N;ttgA}<>Q3=GE1S8xaW}sfCO4`%7Hes*unb-EIf!^e;E2Mu3eSzjD+gu0qB2xh zSX|5}K06e>{e@F*t@Y6x_l*2o?K3N*+UxITU0*$O&&+o>?u1VajXuA2L0i!3;-%a{ z(FzHhBMZblzjHsgx`d+MrJJgTf@q7Gkymu@Kk#<;G&R&s*fq)XFxt|MQ*=pu$Q2C9 z37CxfpGxD$HzzahUyXZa+H;6G zi=$>$^t#gXYP$}5UyRbpU3Ycy`-xkJw`NNu>$M(P?2Ao)j=fMZv|@3usRwVVYhRWB zipjEy{5AUiLeI2gmgbjjlnzm}I_18`hbsC|RI_%8u=gH>*Ur5pl2~IlvzMTryzZXU zgyy=$6(_7hl|w2Pb{*Mfa*tDgzi*27(@pNoi?cDaPwNSq<&DE%Ryuwe2;O)*crJ(K zvYByOB%14EWN+i~I3sTI`9{$@k30qYPSv)y$t2I%%AvVc%m1Q9AKlnnBUmZ)n2mmn zrpBs1sdXz|bgsG|c5l12HJm4Nvd6FGY-Um~ZO)PmAMKV4d}@hbcMPenj{a7 zt$7v93m)C6ZTzl`!7J|j+BFEz=Y<#4(WR2CvBWv&?YyMkk{z~ss4OUw6RKbA>DI&f z+Iss|baiJ@cZsf%>)T^4S*wC7dfJ~BJIpO{np1dy(pKUzVyP;iZgbD9{;SbjahGG5 zT}j*Cs<{)`tBboO%uXFos@l3~%XZ4(Acucc(0k?t`p>p>j>`}CnO-d6D_FG8=ej|c z<*UyE%&uZXr8w^FnyzKX@{Rm=Tdw+aoj;)=pj`Pt^>DGx6}Ojhk0>8fIiuol`|;L! z>3V5Cj1eKk4-pTUi}^bEN3Q?m)?B-$(f3^Y%9%Svp7k@s-*BtQNTrd`$JiX(B^|Ao zhe+F=uVI?HmfIh7-|A-;7ytT(oWX*H+MG_@NMMt2^SP@On8lL~-U%ZYH=a0oZrdr(xIoEo zK||;JV$z1rFAEshwbgb>#G>T4%T70Zmnn;Qm*bJwD<{e0t#fmN>_dg}hP&-8JalaG_)+4+=PyOwKh@8dYqI$tIsAgk44>4^8IPla|H_Z{Bx z?dsg;V@RWN-um|nLFhjYR(B*04BV(ta77|lA^mcF$3FKB!Cz zea|Fa4i7m|Io_95n2~ZORW|nBt685b=Zz*8=tQPHT>CcGXx_l#9=?G-qq=64ch$%& zVWy#@@fPb!CDOPb^WN%>B{8ugn&*0=`*p&*9@JRQVempCiw2 ze;ex~dMA@AGu%Hcm*o;@(qCTJKwJ=abV-kTqHk$)7o@1KJo2B@!qOU`CC_PW`<_b>T&GltaOHEFoWyR|I*%Km_ zOJZoh_?YOt21WFGtf&l`%5oNebuQs5^M`ZEBvJ9x74BT($7K8$Kk(qc^r>I`0E?%m zoKV`76AFiYRz8h=RwTh?BRf6C53VuU=_!8T^sv)Y{AetG&TySK#Sk15767~?_U{x! zxL#$arx?oi!of^ zYT-?yJ_*98aT7sty3uJYl@5OJPb^ksfEaO*XqXunVu(J-=KsMIE?z0Pa}Lt7n6erN zoGoIQTEHhmqr-I^jMh|NRcWjSSXY|RJa!_RQxdCQh|E)9b$J>LcZ&v~Bfo&>=g49y zLeQZDIsDSoFaz-F;STc`7`t_}DZmh|uHaHI0EMB!WjYmR0+dsa2J;Cw^Kd;4H=UZ8 z*fL}e8lNkL(9ouMBPBcv0d6`C2AoEiy1vKLaE(qw3GP~`a-KIpmsP>A=J86?NN|0K zM?0u6<#eb9UMVZufnO=7JTX!sLwJKi1qr5s;D=H`!+s*s3V@Cu5Jo4Q_2GJ#0{7yo zG$KilfyXYWI2z;ySA|SPiH@4A*+&^kBKV9c!aP801zaP+PRhWjdbOC{g$bd0g zdYVsan&q@6Oyf|P41kHd8l@KSOVHsKnhb-*)_GOnj?L0Xv{`yj$0tmYJf(xwX((Iq ze?ZyYDLN>E4TM8?0`vKPFlB514qqpAG2vGXd}uVQQ&#D%Pow z%tp-%4AI%iBIv+eeGpO_E~JT|^(2sh4mN}e4-cpmTv?|U9)xC`4N==dK2a(@{9rxs zz!8~lfa*9-FHSlt{>}*PD&&=+5-1RTf=CJ(!eR_y2OT7n*iS4#m9VBc5ZxlT8}~|{|5F#a|?}?i69phRxkx#7LbT=_f90kTtlD-G>3@Ypdwmql};>?K;w$= z2MC}_aC83y4-YzEvHXHZl}k;~fU`!ZY6+k8Gz`~UD!9>qvXw-&iw%{@u!3;YJ&mV; z#uDIt#!o!3HAP(M%t-dd>^k3~z z;k6DHGLA^jCA0Ri|HYX~Gk{r|m4ZlW!leIiQP3Q!Jet-hf`@4SEh;Q=66{D6+)%+* z`A3L`wSE4lIPi>v4v7D(&DwN-sXgmojgv@V9zX?uZ5xev#0u~I3rK{gGh_;TCuHEy zG^9|u$E;}A-(jHJ42;+S(XRZ*B8q?Xd72xIiZv!6(&%`zi2HwnU>y@6fcnS4u+9a) zbnWkwK=7D|zZGGUX}<;3{*K3E$Y7}dZ0)x|>ECOEQ6Q22qOEj-_Wz|L)8j#)LIfD@ zgd|bMfXJV^It3##$a;8}=8#z@p8qujU<9$?gNQVfO#dyK_SZfTVQEtS>_6);^*@^e z`$zdpz?=+QApz|i5`)p;W9jbuzb8y1pmx5yt#H;sb5 z1-^fPz_d4r^jq_PX&p8b%3p3^$Z-1q-<9Dmii&AK5n}y>)H%#%*ClA{BC+d(C1RQW)yKk2Q(u%i z@N?gi(HNTd+)>`W!=>SN!aQEbYUXK8*LcgUb1$FGNliHGcIo>2$y3>78dnpnhi^(h zXEN!P;lsAcaROZn&uzS#NJ*e*F1Va@D&bADb<*rZVx*%<<#LrftuOYp_Sp+Bn3#AY zPfy`4Ok?US;6mp4Q`QQdAWAnHm2_IJZIU=uJ40P5#O6x*JEN4(&etaYjh; zX)~)eVa}w+f}x=6_b-NxZ>yZo^@8V2Kysk5HIHciT4r~k?H%nqsY~Y{Z2jzxxz7{+ z7Ox-QUtXd^Y*6Q3u5J{+IO5^xos(zps7L5OJ+*!zW3#Tn0{+c2gMy3>1v@N?FtYQH zLodAzU3PoXz1_ss^&`Zps?Usoc@7?9w#uiKm#iw`j9ztylC@x4O;XPOCz!;O#r$@P z>C6cEmE1eBiF0@Ck4CArC|y|~BZ0(hPi++5vsSY{hIDSxr~2S9 z+ob-%dsAF&>qdF{E5N7kD*27mbRW`5sy%C#c*o4!u? z_mDl75JpGmWL&RY6ZCO)Yx8X1okw3~&v{$8b=wz4hRHI61I%4fl2!#x>ng|27F%Fv z0`E45A6Zk8^-Qe3HKHtIY&c|tIrUv-U*2}?zUBW^ZLwD9EVtQz^WMrGO6%U} z&wSU|SvhcNGh?;JCzlGFjQfuR&)-r_RIYrJ^>HJ1%XiI-VXE)q$+!H?pHFmWXw6n~ zPta(a=N>!6^j7ciYGn@VEs??0(L!sl2%53+!m1m_Q zUgxWEX_M`8MO6`av*_BLk#--4Eeg=sU0ko=38Y^A^4}&38B+a%}|9Xc2k&tu!h!#9UkYp0saTzi^ zm&W5PWFk8*1K#6QnjMz`mvJi1j?0i?qh;YqY+DT8*;IOpAGjjy@+p4sjDVe<;zwfh zlO=;^%`TW?NM+$OCEwgG+LBjI`2nm3@$$$sN zj_XjjQV9K2Ks;m`0>@|u9vhg3Xri9pQs}la5qyk@N+j0hD;_-|fCq^`YQ|4)?AmPS z-c$rJLdfXaKocc6f5Nl>X)qkR^$ft>`~{58X*NUUQ-#sVKz+3FI-fKRq6GwK{s&`d zh=Q3hz=Op3a=Z+`NEi)HN5A25*5dDs(Fad>WbjZ2?vLW%JrKcx#6ukv8n!k9E-c5Z4dDR@gqw`e z;96c88UX@aaLU6EajYN>R3(vF9|L%LbK__%@2$^QYztD{}(=d$^t z(f(|%Y?B&4_FKi0XnGuEsz+V>Em7*{Ln$`sU!&0P~aho zHtJumiyptlz@#8nhKfBQ!pnPjtb&IgXfPz;cEj^VJy@N2}4-JNR7ArvV0|}E(pt2|1x84-J@dh7a zWdoKgt~!l|g0-p!jecy8a6io^9ZMJqiCf2;2+`{+4HI z&ZSWMDibB>F$D}6Wf}cmoO;!moRWLhch1q-up1n z4>nq;*i$2PN42pM1lUGp0pdr%4Bet{sqOW;=!OF(2A{yEIM+- z81--Blb+@X4{cyJe&txofowo8)L2N9A(qR)-?L0vCsq|S`WxGZpj&Q2qwoz70d#a4 zipMyKWC)4j^0J_;K9g$Mea4L_xSVcR5rFOfjzexBy`A zSo7A`EQOw_UnGrxKSjeofSQ_FGWbdC2rJ8Gd);OWFN@cOh#Va@sp$zLL+F?FnoR7e zp(Lzr*i?S;SRh>72+zvCw2N`DNvw~Fh%4Yqf^R_0FNt)&xLn4%6brN8o_g8mTU zE1G8=YMcN-qdO#d@E|{th{|;S%)(>#R2u61OBMvo$pj*r`ZJ4zNWvNgIiz$cu%G=l zRDT&0)JQ8{6FRHMT|BeMJ~PO!~bat|U^_PP5W57wxK%#wjDe9C^k`J%#Y3I42- zNd?=*Dl-cV3<}+%>JHjJb^KsG7lY#syoF?)Hej1&|4yAg;1MOBrm)^z;lJ$T3?B1k z=d+J96!_YXon{|rDDc>god$k176UdzFg@%7BKv$qfiNixICb8_?G`IdCY0Um+ln9_ z*xFpqnP}8m9n@ox4?X&J8*2Crwz+r$y7ZkZ8V0mS6#*^&z=ytlXOCWjw4N3L-9F%k zFj%p2;rA0T&aj3#3(pkt`Z6iBQ{j{HW>&2lU-@5%hpR&TBcU(;|YJ z;BkquBRt45tP+wS zGe0($7g>rq@jwbkR`4Q@*lQkOgUgI9;{!H3c%ddYKf=UB_<#cbE3pQgIw%P(xeGvz zJ^Y9<`pYzR-u2ta*kiXV#;L>#bU0ajCdn4%D}9a|&_h4+O(<(>($8s)k0TMx(H~!od5o2(;H74tZNdkyY3(ktwW%7+~q5fPe;=*nLqzC?n9T_2S4jY=ami zr6r((syIMk$at|b2_y$=!IL0wH2QGB5L+Sz%{WT}OVw&FOh6h~ib=5n{8)}ONO>1e zI>{i>n1?jLJRfjlQnJVnN!G&o#k5o5)8VGDSy;6!B7v|-^!ihAFdcM^PY%(Qz}Mfu z;g}`lV+Ujrakz)ui_;W27F~nme+$C`pCj@BDP==U1!OkX%g!oNfMfT>Q#O-6NMPy;xbT>kBGBnQ}P~UkCS~dto`T0*RUI!G&ql%#ez;=5O%|1cRcj-wL45>e5Nj;h z5T>3v2bAuS3}TFR8pDK3>mc@+;T%Zj=zxkmgzGnK)m&sZ=A{FZDz6I*MRhLZJ=2BK z4xB>g0hOr>rAzgIS}_kOUVUUYx-iQKyQPmrV)yhQE0O^E5T_4}jfg-kBmnh|h%k>3 zfd{MU3K9~IT_*xIgba+rNI=b{K!Y?gVu}q=kO=Gp8Nes0pn$~`pw`j==Su~gA|3KH zY16Da=!hNGK|@S1KLZdToeqs@GLRLR9$eA0TdQKg>gqRux;FD+O-3-FpkqEjMCVUK zb{GPeTs+BPgt%Z-L!eM2;8%xJATuB4VhoTKM(iXk1Y>9@$OOQ-#)t*RZwjk{Y%&e5 zH3e&N%LG}3xhw!G$`lF!%!lSqN*mSG7`5LR^{fEUWev>waq8$|Boe>K$DD1TaOp0v@Nfl;2`+(@tPOOu z7N;KI)Gk|O7Z$e!Dp8lh_~07`_8zCc!N&>M89OK~TMBue_E5v$4k%d%$kViExBkch zdfNsGEM^&0I^+P9sUrYvmO=GVpd|23{})?8BT#YEAw`2v;D0Z`Dx6^bg*w5yq+;KI zmi+z2Jk-VvoME9SDI%hrcxoG-DsX}&OT{kW^cyz)5on3u!u&X%-~yN~XBIxt1)5WF zVbO(n{wg-zhtuh7diHXlpR#GM<+yoR&Jr&VrybdJ_i`{dR7_XyC+w7Sv}WUH5OeIBC#;v(IAymM-`6}rjRn_%u@GDf zt22Ea%vSwcsIhE4vKMn(2lKYZ3s}i-0EoZet`k|M-G*lufXyt@Z{D1Q*Aa1*c-41lJM{h?Y-04$CN{%nbPu~mTp zi4A~)-auF(@_|6*1OcQl5FnIbpuB@%TZ>x8g*61j?l&4VUDY!LM2QcE7T<<|uu37& z+2YM0Pe}+s=vxqH%x^PD@n8$&jcta!m7$QAum$oyghE}VP{<44inwD%p?HV3L1QLc zfy&(m!_$mYtO@enj@V*e+n^y<^4oUcr?DN(-M$^r?xpR(&ngV^7ViLljbSi{oMDjX z7Y?T3P#ADg+6kQTV>6Pyxwlm#o<33Fx}fjCI~dQAeiix76g7aY0-HfW%+ zo(NbN_^$HnqJ;ceyFk%5M8RTU(UREaU5GrE8SyitbQhuxh0k{(b1;!zunNeSbR?{T zcsA`62@E(RS@@Jl#2AXlAT%QiK);cznFF` z3={=3jD-$Xf<3^$xT29M*tu93n%G!GRuZBC{~jB5sg5MXCH^RQ9}5GX9SegDERF&T zlQ={UYh!0@jDte?I9B0FoLUc?T4vd%%&H# zBhuKL{qSesepVO6;-RpbP20vprAan$KTgk&XECV5>FsPfqyy^8C4e!!z|KIbK@6t^ zL{0)Xfxl`4^mr%{3X>B+<@6F*tXLWM@r+HsWC$ffM*c4uHi^)!-UOC}tSWJMhDPGg zj5@r^`ow9bx_{^*w61>u6QKD&bZL8vTrkX1STAk4~QHr^JVrolnYE ztTTRmuDy4rDRsw-m)=L}VymC;(#rG_slW5$%7U2lQV!=&x*BnF-WL~koyj?wmP<0p zHr{%ZT)wTdan8=o4LSu6zn)0ittUi997`f2Ym`ohHD}FV9zoMcI;lVRqNh#*k%?B(JFZ+16w`@a@bM_28?gEbhC}Zk3gj6Xjhy zb4H(uWbz#!xfczNNdzV@^6^l`0&~Vm{aJgJYg5L(Bp$3R*`Mzzc_#N*i1qRwr`%1Y z9O2sb?Qfo<$BBY|=|YxWaT`^8wpf4ra6JFM*s%DxNSMOzXom$aM#aPLgnI7WdHeJZQg}^joB?6;Dvm9?CkJNfJycvtw$JqoJ8wPfYoXfyBO954&*b=v(q;wi zTBaXV+PlHGc>AmuA*VVf?L5~%eq0duQDSnRi^J2yJH>mVk+kNVn;suW1FS`*u1S>9 z7x;HA8@6D$@7HY=n(00~Bjjy`t^OwsmDvQzuO}CKD!DXWOs^&QHN8G+{mdY0#NoNx zs-oA;GHssM3*OpPC(DkyYn^9$5>n+__pMYVa>9SK47K~9?U$Qn^-x4F&-q3P3)L) zFLP!=Xu1@iH^cS8&aWf(SEJ^*KDzF7u*}rEY9c(+#PFKIM0*;S@zRQcYaYxssCJT1 zxmw1(N$)(5P2c6pw(G53b8jMPH2GuWpn=7OWf6msR`tWzHZIHW9JDGo%vP0&x!T@T zG7$J$f1kbI_Kv69wwG?B`*r)9d%X<5>T}I7N<{R+wVR8tJ$-MvI5VuopTVko5~r85=@%KWZ=__f8lRa7^nEtHDibimnJj!d zPTR2QCpaC;rX`O7UCX9f+sD9t*iXJ^vX~vf3r&u(7&PGYPBzV(1@vV$y(kNYV)z(q zD58OuWW@-7-Fu)%#2YXSO<6DuL0K$rV>pK*Hf@j%bRV1Eiql%zEX;YFUeBfnar!u$ z);$h%JDc{!X@%n~{Hfz0$@1eYNqTS^Wz(uTFwDONOh7R(j~u{!Nroc|d<03vPYJ}S z``>@Pi{Ye`$d|Zt5qB;QVf{<%P9eKEf)rx)*WU2WTuR3z5QjN}=Hs>>@%bXi8TJB7vQQ2VNKxFH$a@ zPF9qH0PdwwkyZK?FHQTAq@IJ)<{!z;=MXvZ-z*TF#I9M4Lq*`Mz*0zz>-=;KOq%DH zcUqiuD(#Zrc|?~B>9~YlM4oes+VM=T{Y4$I=yPC=+O!a98NmLbi4f|7i-pXSn~oX)W|>vM%%F2#i$jh6WKHZ|MCu-dlN?g4m-o;CKTG818s!2gPPnw9}05P;kiK1O=Jn;iRsrO z3P=%VQ;VoGwe~y>;x;?9?p2u3(%#!Xw@-6PzR$ZO+&d$uv&h8d^JH7d{2`dlTvXi$Yx~oU{<@@mG z=f@c}YP{IK*|+u10s{~Hw6XmRw?=hptbEgiHh;Ruza!Ap7t%W ztqk)qmfkVxfFbHwv|s01+!~Y(}Jo64pJvnari0*%ACQt3&L_5I$ z+9tz4zu${K(6;;0VQp5{3R|riV%iikGi}eY>2>|Tou2+SXjpg8LKBAu#BGT_&~l^A zd*0+|m+*1PLFaXUEt$1+qIc^%sUb#fzaEpun{QUCyR2Aao5?MyW1-{CY%XVKkIer( zKG-e&L9$o=N37_pc9!3}4XCh5Jx7Y3uvPu_?|f-%oBj}xFYR?d*P%b{YP;BQrI_|9eRX9mUm_;0>eou_WOtiE*T{`f%e`GevgcI(`~R;QWkf=d>jv~B0> zz6s?#zD_JXrpSYNmXNs<^WC(SXly?9wr}@ZVG9oKHF(ZT+5L4*#-OcV798GsVDq_Z zr)M2)n>Nd}Z_J8g4Szr0_ls1gHqh4mO# zV_`~*q1Hc}uMd7dzVE_1i*MB&{AH`(?E1Z$2Y$#OTWxblR-eOO_p2_ueQ3y*fzp_M zoBy^AIeVZ?(vh+4U2fM+=^Z-!=V_H)lA6wbo6PDK_&2`qjK0}zk_WeKJN3wyA6jXj zMr8N|e@}ARH@0+EO!sTEiqxt4V91dv*8VL`*A@==JKAvdPV=|THl5k|`fHaM7L)m| z@538imOS+YyvUqA8PgoOh}-t6Ax zU9GVVq|&T+Pmc?kXEqP(s(rEV;F8UWixay}9qap7=dAv_N{y-$R<`iHPoMq@idom? z=RObWe6O1k`Ru1(8of9>@j^nQGJghWPG`68Q+L_W{#T>&m$}h#TY-aK|Gc}Db!^t! zS*m&IA5+eTULMsaYsS(+-D_tJ-)5WTmpsrdw&I@tZCZS;5?Z^oCd&}qH0JcM#@+63 z%+@a+d*9UOjjckTH>aon6`8ufSoV`gC69%z$A--Qp1!5$ z-7OunKQ_po8Bw8_%Ri`2uN%qxMm}oyx9#thqlQlXexzOM zx$K*rXV#ioxk8&#G1{f`muPGU3*JneU2&={-@zE4!?N!4cDk|1Y?XJ20{tPZ1Py3a zG+o5ed-6-U)K6D-zI1E9E<9K~bE|N|0;Bf+CciPLR8U z1w|;6F3aBwF8_zUfbJv!&TN-n(jiNI!fqKwV= zL}0T+`Ia?Yc#=zTc=oW{SU$(7is%e;ug!hL$L~nO{(>&smj|&Pn)#uRpgn?$wONFUbw=a?Ow4W zqo@DSu%4!7rPGsD3yWnG^nEnB(dQLs(%Y{d*)6^9gr~PpMm3!rT*jQ;t8;jbTiZX5 z`=kD=XTfWCSDKKrv|rDBGfsY3-s9`o!nS-rm<~4bIGom{RJXJ`5&OT-T=!_$rbo6z z#R|-Oy1n>kQ^dvReV#;KtrL(s`s*5(a>d8RJvslW_krZ21rmK$U+8E#U1ddh2i*@V z=RFK~Q*!2v+v9#`YgotT%{->$-}b%Sn*lY~FZm<#!<_ZWllwQ@Wc;!(v{KE}PuEn8 zth{87=OhokZT#$8MFz%A?7e%wy1~_eYqLIf-8%h4yLv+-wq)$>xIT5jO7{&{3VoT< z?B|foeXV|Z-*0TKw1dNX9PASLbt+poplJG+OC7=|Ke$z;`?p#HEry6OZC}+&&OR{x zM4L0ivWlk%hfF;c7d6LPs@vV{?o}Gsu+1}fO8I_ZaKMLa{-w5*neAtr+T&L8osp@x zL(dMms`8zCP94AF^pdAT1|+*}NV?rd-^9IM?C5&?o)+#BSuuai<{Hz3o-CSJWJu4n z-{vF_yOw2ad3kSKk0Iw%ZY^K@a^U66N~P1Ty-82+@a~MI%+)uUC3~07+!?t$df+d+ zw_VzJX63aNM-JZ!55Irn^<7KzFK@5U`(pFbPu|!n?r7w@|NY$I^15{a*|)ZQ`zuPF zwIZXho9;^glwRk*nV0OE*t_eQzYe#WRIhfKKabthbv?+!D%-X!2&~(-bmqfz&Op|8qCXSkRAQhlJM=)jPHg}tUvQcbz|qDu1ZQ(b5O zSZrOwoRgdO{j;b*_VdqC4I9*t{kr;2&66AVe6P7~Ug^tav)%u7`PMAIc z&YE&dTZ>-9FDRmKDGLeTKO|HvE z*?62;Qp)y7#jn})>&{PrEvID7)STo^O8%Ui^h-l>Pj0dul0~@9SYV8beA)aoG*c~& zmW)*I#WbKeI5+8;j*4Q_a++yE$%nbgsp)X&a~rK7ER&_{QT)hyrbGH^*|T&AyXDGv z#SBQro62{e48VOe$GPrJh*sBa+IXi>KN^#j#y#v5G1<>gZYIMKjQY2=l z%9m}tgLWG$DeOSqLDvNokNb24_P)R&ypQc79w%2oQXWJ-<7N%`FSFKWtF zwz-G4U*46`9Dfget8!2N-hU4m4!S4zGmE}oBr0oZo#X1oV%EnY{O-9Mc2eaXV}C#d zo;J(wno5F+VBt?CTFi>GX3l+O&5ShDJ%`i(`7R1}S zefSk4752|WfeR?W?!t}7A~Hc0b!JX-B_-?RCQ~RmE;m{H1(I>O$&QqKmz!LOB)>69 zEgpUWS`B?6qX?$*V})P3_=5$okynFtdJU-5jcs%ZrN2Z6`CFuBpl{EvpkNth#X^)0adQ7`ewb}83bxZbfON%bqxXZ^P z4NC_-UAl6)Tik`_x`r#OJbu^V&m|9szY3Z)>*?i)eTfwgPl)eS>h14$hHiL##V~uF zEh*#1tDfD9Jo|X`@scW~*65p*y|Z%P>$H}U>t0su@%&h1=?z!*cP}|&ci8Gp1KtcT zF;BB-vr+x*Th`Ng8ClJa{kUw}s$zFvG>q!8slnz-alIGz`gKXI%ilA$&3-a!RGq?`*j#uZ;x%#hnSMpGo{OK_bu#p@_cZy@ojxvJa(+DD6L5@V$P43 zqkdhX4=jF|*+RxN$amWKZcq4_E=~P^I=gi6+1aN{Z(g{mUcH8H4+E}b#OKTR?Wgn1 zt<|B0Co9fq95DZBWYO(4)v05@EWBQ^+sOrcZyYMyKO?J9-N%hyX0jTEW9AoIHF}e6 z^7~-v*RPFsd_K|i(Cx6zUA>2Rj6IxiwtMr9<_O#EBkH#5+W*9S+J3<8`o&&#y&L+D zPuN?q-lk3cSJ!*FtZ1R;zg^tYD6ExrMzpzJ=Ly3HEwS$X@WG|uq29;aSF8~_cTLHm zHN9U(wd(n3uS4UUFyyngLo7w8$4uou< z8a-mu>mz@Usy4mp?-OSax%p|--MI2)-nZ?4uH2kQy&Ajxa_!h3=VsLIn^|sRuL}dN zyzAem@XAT6I{bdC@aEdTRsPG^(RQWU>Q!!!S~M!RBw$mI-!}f-=w_|5Q+ppdr&6sd zF?Cs=3QxxBVz=)PUsBJrZi~9!y-%!)T7TnRo6p*}z2{i9 zn=^JbSyOk;l@<%!Z$3Wt%kt*Ce(-o%wQ<)gRh!lwIp)ul;=9}X`q(B9S=zkJP;CSTb_ZiK*4J_~elkUyy)$Lv$ieTnVKc?-_d(A)kuo@0BWVy+gmQbRZJ&{a_>Gp(gHWDZ8 ziFVltl8}!SIQTNC&H4C&)yr0}OrRo@vXz<(d_&@pJ<);^pY4g?C}H`gWIIiX(e{M; zI}&^BiH1lB#s!+3Oqn#_mE!T=F-no&?W07AE%pT2pD{nEinFKotk`q$iQ#styZB(8G{ z*YE4jLEk1eEqm^#TCGh5_e9^ERcFD&rAY(d#qVgeV*HGnM>5)u_&#dvhwM_TYOW05 zAD|m>U|9J_jmrlA(KKQBi$g!xF)bheN4uY`Z+mxsx#iZMuGd=4GM2p1<-x%X7t3zG z)$@X_UgGkm3j+rpZaW}h!tq~D)~v8{*oRJ+YCkKR*nHdT9?y#RzEOAFwPI85w+bHK zc4^`l-%Wm5ojR=jT;l%ljONXX?n?YMt9Q}U#k11fde+|THfQSS75-Tv`)fe-E#G+7Hux{EuQ40OeoG69 z``@_C(vz%JmbKnr9CC-@LJnC)~VwpxA<6 z^}CCWD?3sZJWRz-&d5J&h5O^aPr?TlUHR_(tn`r2OH0+;w|o1W4`X+)`0#fAv!atW z)ZY<5A+YRxOM!?+%^rOD@l4dv-=3+1Y`^#3^thk#wQi_XuUzWYh%C>7ZwgM2nx7a| zA;_is9q&em-XuP(`*HM=?;XF@je0*aV8Q`Z)M<6Q_0O*tJhu8-z`*)ZtADoL@|TCaAUw%IUda4GMr zwJ%@0ZL57bMpd?9`?`Ts0!zM6N&dldcS=;LpIs;XyC-9eVd~X&W5*?rd|_^JYvyeK zgrY^y>@3(jIr;dZ)~^EJmaevDX@^pm((7)H^XYP?+@Je;m4CX)|B7eU!kUY2{yC$Z zXKYlj!1^-=8GDynV}8`>wxyd3jr4uKFW-c2 zO;T^PvffLmzF|e|)e^f)cRN2aCj4cMSsrt0_3GN{*Bj$Y-14l}=a)8~((!JKGuPa& z)#&=>?%k%xW!h?ZwcXgM>ej|-gYsR!_T_YJ{m+gujeDi(t;{#@Y ztajyy=G*t>Z#G3d^sg4JdU_*%wCZUM+pfD|rmtsqO)0eId9g1Cy39=d`$fo^BoUW!u)#me*6-EiM&XXUK-ID}%Qzn-J-8Ft&Y{udh=F_y$aV z7V|i8_2YzN_wL94TDWC)+lC-F*t=m`2(x6JS=d3t!o?-_%%6PNf$PQCx>yXUJ} z=OzVYjV;j0k{O%PVez?!4$ID`sQ*izAJi{yDjFF>~j7E!+P4%WseV32TzA|6|9UMHe5H zK6H3N*fJ@4+LWL6tTz0cIAmzg)~$zxdPl1sjkx{&>*!$Z8%wDnoh!ZhP=1T+=Cj*> zi0I*yMFlX$3a;wpzJO^M^!lxZ=8mrMP+cXZ_ z%YS>S}vhK`Ih_AS1Qn zSCCM#XKIZEZ$ZeY0FI+A@G{r2yB zVqCjAstxX}T5SL;gsC>Ms&xQ-9j2=3&OS5-uv07KJRb&NcxzQnHx|-LRh{kcpxVho zTLU=1qpDOzHoF6I-Wab+Vgov=s>EHJpxWAsZ5gks8n^YlsS<_Wg0Fh_lDya(Fvrh6} zbYrD2o4i&EWH;~=8?XxH+*eDbLC~PpQg8O20Bp5XLS?qFU8|)CHhr~Jlm)MmN?_pX zt&#dLpEby`8vqO`OIRcIVyo9kKCIzdsidoXesWQd>jBh83zWF9R;uD-kB$x-+9#^- zprHc-adQ;&Tqi}c^J`JnjCE2eAG^oODa&5UGJ2hYP(fCIy;O*;T_;g=bi{fo8t17d zZ;;BcSL>yMK6WpzQ~AOhq$rlS9^G8AK`O|)Z86i0z0_?D%+bC9AhaIBFu~ILZiOsf16Y=Nt7U@U)3D_$C8KeA3 zQvOulCIhD`e^Qk{#_dvP6qvJJ!lkl=idT)+{l<($0Ggc03w{S$Y{7BKm-+3G8iDLx zc1Y!e6sm=^4r|{b6c={dli_VTG!F03KCEph?*6o}2Km(u5VItefE!Qptq|UhvdV1* zhO}wWu0bm~r@=l1ArV8zvSWLsO2vi`>NApRu-6(fd;kjK#PZO;B{O6ha9xz4tXqe3M++vRzUV z`$Q#eyCqLolU(JS69(KrrHoEUpOIsu`;7?25q=p7*2Bf6hPQI08+G^X*Jns*pn<*E zgZUb$cX7wm*0A<_q)x2zPSkpMkEBsqwd~a%$%KY0?v=VyxYAxs*1@|aKlX92)XvX- zP&uUEnCRi?t+F&G3uZs}5;h3}ViZbNBAEbMR`DEVM7Ft4y* zs_rUROS!7JMN_3lHeGT6im~qlR^&hEtNjtHee%Ir7gN_wCC>0~+9dQiOF8h$=$r>G$ z%Ci{<>@8chMr5?lapx9H_(66-@J*XT11%a8i$92_?ab`dv=zT2SU>5IY;5u&$rb!dMcj0NW3=UO^unrDs&X^nTW=UX({b6 zbWxK-XbBDBc41aMUMg0CcF{QMpgogG$9mvrHtZa*sV4#s(_$8skn@QgtvZJ(w%CAljhAu;5_uGd^-;+KcXZ^C zEEg->zDw2Qak0ZMgbVIJJc8o&j!EvU=rPHUhQN$Ti>4Z|i$|ouK-`8(AiL;t>@hAC z!7ngYBwu%2ID&7TQk(a2$%A>HL~UAv>J?~Dwc1sUl$k0o%Oa1XA8|*eKsCzhS&idT zNtrsB+C@%EzHaj5!KohfpK_R3;&I6OfD>S5^qF!{&mg#Es&qRcRb*?ANr4hw)D(C^ zD&b0#PcN4TcGNAs!T_&Mps&YINPez_K9D0$!tIqx_G>U8nx2$`Nh<}q;Q~j1+1)3g z(b1EV+Kps}5l6sI5r*`eQ7-R+C%2F=;Or)T!4#Tz(mvR9UlTEe;S}nGrV3;MrzKa( zY%o*S;w&&x@|AEY3Y%~WI1@%j8E3$74B(Vh%pEtv$j~BJff@=2vmqx@jrSSJ4V2h< z6+CY{4gSD&8fS>)gos(L!-Fo9kyCBYN`5L#_LZkWWg-mvEu)26DzPr7q(D#PB_hER z+j#~9s-;l}E|g&N(3U)il#2+32Jk}(xfPan1_Zr(57@b!l|oqK(^7dAqQSQ!gDW*} zV$?jFd=^88NMKYbkBv#DoJ6l`PdN)}QG>XuQAX?aS#;BMMyeoF1UZRG+nhr$!9C|u z0g(hY04B5tJ)w*gT*EX~R-FUy<-my)xHMO-M*K@6cKS$$m0km0kUh;P%!jMDo0`Ug5 ztbDUx7f=Tw=Z*_qNWL@e1#lmxAARN`hl*U;!3(I;^*qT!l1CQik|Ozd(i7E`+aOmC z8hpDT74yK2Jp{zc=b}_nAX0T$KD_ zaJ@iT8V-HlAeBWCO!X6hk#7PRlT?@1$d0+HtFr|O7^-s@FbOf}Ht2_%i5!;1aOeaT)a2p_m7*c0vvq6iJt*lIR-#U^)Na-kLemHO4)}KmAJAViBdVXJ^^*EN(4t^W)`Elg6F@L;?%w}Ioaz(^y+vb1|2ij z0)Zg6MLmRtQtk@GTdO1>IPWr)F|KC?+%5#SCZV8DlH}*EBg_!5jFP@8gz*2JB$Zrz z1!yD!Rd*e62W$(})qqV(gfh`wmDEhSA{BQfJWMh}q06L@k)pBlq>ErFC8L8%t?cj> z(2Y6@sf(%tnD#0ZMZdZsJ!l)B8V|C zc~ha#b?{mTpsFU4%Hp@2tYPTQd0xli;v`bmW;XY_RIHSPRh6Uapb;p8l^wk<`Kw@= z1QI1aTnElgui+~_S#pys5K|43G4XN9f3hqRY9mD&$pR75>xMF?@#cg4Ewhp(7h?~q zqarh0mjXQL!g~}#->DF*e*;p_pcEoHSlEKQl8=P97FdHDXn=+fL~C#hWWXnueG6_u zU7WuGvX)2&FBZNDj;VhOlU2*U-Ij`Zf)MDi6~cfDL3UNYsi;mX3`YVHy{!-ns3?HN z--Mb~-%!-7iP?~s1>V9)X}UCU&MPYSzli-NLksz9nOg48Cq;Od?0l=yvbDtFyMHRk`+m(mO)6gOax<^6x8pXPP3T0$BMw{_QHLLvT+K71)VL+ z=A>YvT)icgQ{x9S3r|63U!`D9QTIFnquQaGsCHt6*D2_0y;KO0hL@zGp7fFgkygjv zTmx>2Dd5kksThN!w;>s#(~z%GDkdP90(l4-cReA4rl>}DJvwQHgi@-9lupIK5Pi{9 zL@Mwbo`zA~nIe^U*ApfPOF~vZH4&H{JAqzirb(U{QG$}KZpDPdcS)9&Ci%4T#Ys|3p&&amF$?)78*5GC(8LQjyI} zht|ObYxKKWsfMUzuqfX|B#2a0UqT)i_Tmoc3}IT-0~g5=U5pOQR{1V!9F+kKqwh-Y z_KUq7EoHjp5oPR8-Z=dNUB~9!MKee5f}Kt5&RtAwJOlxdjJ+(vO0%fD=z6JpXrkX8 z{O|ics5h|fP7uojR}i9dn8|WkBkOSwJW4%)0k!j<ByOS}4i~H<9&@T|F#EuW{W6W#a z!|1utK4T`*Lf9Ipi(utx_!J5jy|!0Vs;Q1__Q! z{T~teA!p^f31za~s2xHXn)>cz$QoKvLWAIwYqtrLIDER!3LR9 zaWx?=^EBosl!?h?m47B(hIZiwD9zF{K}6GYER%_PVCMNR6m9^M(5K7|(6;o=qF>1B zj=t4|4U51mfH_4Biwa6$VhpKE9Hc02Aby&aR^ntMUfkOB4Iw8_B3bcmH@J zl@GStP|@(1;a*{C!0w?@AfNz_?6QHd{UR3hr&Qs%rO#0@zf(CCQa5s~DBG{hZ!D|K{XY5z)o zah0>A>MpKwyNg`HI@BB9ZvecgupkYxvlCq%I(*a+@-^nTf#3}tAlIZ-9QlDEd1WkY z!bfSIn*w0bZ>69`<+uJQ;Yl2}`;)ZWO@7C^9h>|a&R&l%Qc(W?dDUn+C~^>8gt@5P z)-GNlBl`6jIVfr6Hm{D-SvRO%X@*tr4==&^vK zq#L}}Citk7?-BUH#9Um|8pQ{0CAh&)o_3B+{yebXPQSNyvLF4pd8$)MZ(wi@E^&BB?zK zD=t7}RAxVOQ6po&V^U!T|7#J}Nv$r!QdDYRZ@ZgctFezPn`X~hoWaZH!~D+Tf1@O| zpEoWlriq1|ihG^qcSW5hwYsq4Zh;rahyCQLF2Y_&YJYFMaH3?lJ1W_H%3cXJC!0k6 zfLD}rn3{6t^veEz74vmN&iB_~2=sMR2O(?-c-r^EwDgcY)ytMqrkGoBCVzH=$7hl& zGT9#j(Q52YXcp*>OdZ`pOBFJC+uhgr-QI=u^!u4i-~42J=BZXLdqmRbx&kd=6)bs?ukr^p6aF0 zZ>}Eb-!V^hslv{T4WrvjU7IlvHO{8;g}at&ls0rh+~)=TYM05nsE0{xcd6FcdpZsms#=71Gypbo4OX`}67L3K^o2Z4Be z!dITj4)4lqwb(3aR!ChTNZH-15k3mLEJOQ^Ko^xAIqd#LL{b|6*t|ku_z4BUm&t|H zR%|48+{@FK}p}7yX6IHsYzrj`X7m4+Rm-@kayZ=?3~y-iqUX z)WcZJq8~Lnbd38Ew_&reqH2p8k2}G>_Eq~}10tp<<)(MkxZE0e)E?50IvxL`-fD&V zHu|V7#m%@Ynk$N5vA~$-qc)Yq)8q!)-*u{5Z#BcZx^Dj++tA|gC?D*L+Of?C;mwsc z!6P?{ezkyz!mo6b^C|k(WTb0Exv~aqdi(j|R}F9wekDoSkA8*GAhxRmLH7EAAX?g> z4fc$!e4G(4#~wxWbOsJL0) z;dibDj}BMjoCdX`e2SPS3IG6<%T-%cB;9~OqD^5RxN>~NW zL3L`41*@sOCDp&%j6A})b{+q?wzMV-&uJR1SwqsrsR^xFM*@t4VNY3rnMfdMG`74c zf(mi^O~`1a$H$y2v|y47Fdd0kE+3}40F!U2%*}`PG3jA7^3=rz^*lr1=`hfNuh43s z3;1#?l58pW*^`FlOF+@A)P8GuXBWsw0$)O$`OpdZ}hC%KM^=WnX*>B60 zP!K$r;Cv%s25zb%9~{qoJ{@WlU^;=1Ad;N z59|uVq{GWxLgyf*Y(nqwu8PnT#4!lS;5AvHLcA{~AZUQEn@8HHrG*Rqv*lkZHe2qYUyb>dfrwPkgr;L=($`u9-u?u=O zHbC7=jkT$Tr3I*W+O%Y%IkbT%LCo-%a4;Rh8ic-?5yTK^>3LjTFwU14ptyM!7p>q{hOlJWGN0k7h2aWl%^4&sQ zebB~AzC0$;Ycyo9I%R}cP#`$Gg95?z8hQQ1m6b1rbB1a0+KW>g?huhiGlq9qd4zCl zbJLZCeU!<$3&vH=g{^|MBgSMi*i(-4d{U%0a1a==Jpg{V8Ud8 zu2l4mLs=s(L*<#sXu{qN*D&;eBcsY1LxUGwgxLxkj@C2ISQ{*KQ@S(Es1YU?SW=K< zc#47>2vEjq6Gc1>H@w>E+z8&OpuiKShVfPf-O|dzW)zTySfq$TXN`^bY6R_U zz@k7vMhnA$Z&-_GvIUrtw>mWjEg}FM^2zi^c$=VGu!N@-fOAiDqU1*Kn;<+$zzdXt zgyNYHkKot@L1BQ;UFb31SQ3!Y!wbzLh=CW&;`uNkA9ku_n1jZ~o4A6;*27YEBo~oG zuN6%Ny%COot`T?`1WOIhqZ~1$%(@|v`e<0>OqkyMcE{p;CK*RQ2H2X!CW>NFxF0mp)d?aT7o-K!2r90Z`fe4kSD=8AL0s) zHUS7G6JQ3B-!XtYEPa2UQqcObXzv}He6RTs25^C0?RFbE4Gn5QBQ42UJ+ku_=r zQHp2z$m!?YDZ*BPL8WD}cSBSR?dCEac3k`!H+&YIQ9TvEJ!2pJ8+vd}=J5%T?qbH#*RA~Bz+y0Ns#nM=8o z4l7SyHR`Y*EKEcgM1nbGFj^I(!NKeTOmG_*@X}09!}iJE9~=XZAdfX7^aWDmsDnTS z*m1(pncx87>tjU%Xu@HymgiXmHeAK#!B2b@@Ro=u$;T|5M;{Mx3LK&6QB>+kAZ)w| zY=WIZUh)~(n_$8nTq@vh)(X1DfJL@|JKQxq?hx97BuDI)z~N?iaM7O@PPikSS7^it zGnOYLctBW7A_~$E{V`!rf*&TBAOg>TWpWnLxyu0)Tu>^f~L{Jb8#WSp=tm z5n+s3{KA0$heN?=f+XfB1DHTT zBb<*WULG1@!0>Djn4qE%k1h;9W`|&~o8aEyJA$J+xvR!9IYtOHp5Rx(CF^B~bzv6? ztgAN))Wx|2ktOs9(c*|TMOgXp%njZa#4Y?UqA0>yJ3)+D zpd@(&NiOHXsC~!`go6r9h;T@OGFB|W^9n0vt$Gn@t5KNEq>Th*thEqa%2fzT3nVnd zlgN`0$ANq>fpDZnnEhtFS<4gBY&3}ZAfEWq!gi3L%go0A5E3M~`3Yo(y}+{sT#wdI$6b zUm;2g>d*q0D9`V389OeHlnDfLLC`D~?4R?Lfu$pirv(c&o~#zwGdu+?T2Yl+wBe%P z$D$R-7(Q)*gcit6e)1s#x+W$SjyDLJ#R9vJ=TE2xVcP^7a{N{;+`shvwev{BB`gjM zTudOiOw?SKu;@k07>21J?%)R$Z}^kHGoqWykN6w;3pNw9aBE1Z3`H zh6OH|j_@oA-WnW(5UGHrjnJ^p(VSFd0C1*H(}0# zSp_$^)u^TDQAeSI^)F~Gz~E9AU~uc?!t4eL7SDp@!tFI8)>x18B(!3M&Pzv3CV_%* z6AR8`vkhxno@q!a@GuJ&X?%|X6UG?!v#17P+KTmI`3fo!|L1bQ1=^bL31FPagv7)W zM6exTABqTKmok^sb|HmJ19G`P&`X(r&%X6ijolY z7d&WCzk-|03NHxXJIFy%RzTf3^iJkbt63-L5`+&Zi>?9=ZVQnWgV&Ux-!q=m>}{D_JX)+k9<&YLVY^ky3-ph=0!=$U-VTJ;@v;T6!t&V;XU0Sj7^f;I)LY~u#Ha}!vEdm|VeDYMa?%u9 zQ1G`Oq4wS$Y|k1k_jequt5mcf#+LTQWA_elmG*#^BpnTgdI*~#Hv%ssOOa)@(DgR zzyuLYFmaY(`%4}s^goaMM!2(uhJ}r2REWr1A)nxKKt31_LO!dLE+P6Oqp+_))!7HAz+zc{Bj(y9M@`I zND6>hQSjtKl!`DtvEmV?9YQ{Zp+m^6fHZ>3o!S8Xu~jITfq)?-i$?}3LTtpqug+0c zzLm;(m|zEp9WfbgVk3ebfC>dW05HK008Fq02qrKg={5Th=eh;JAVN$wU|N9*Nr3Z6 z1I90=QC82pTnNT(I70tHi3tXS7F#O3Iwtn#$5RVSpI6a<@#|73XfOjeoPe4602OE< z1kCUm5iTM07)wxo+L8N*=MTVm6Ao?YbLB^lTL3_W*a-~_F+<2FgftM0U&jE3T^yl4 zSklfg8!{rm(HRJsgqqhO}PgD4^ctD0{Fz8l^(2!D=zEJW7-dE_zy%3+98F1)h~h0S8a2uKjd z9kcj9U=9K)zhXAQ$%A0Nwa4Pc_U!IfC{iQym+ z#dA*ZzKQD-oGjpdXvin5l>x&BpwJPx_?=)R5OIBz*ki#BiF}alPK9aJ0qaD70W8A! z{cdE!IW*2s3LyOWLSgx`JSPRG#ppZtgpe@^yr|P_`0ZRcQ}ZNyo;=3WB?OP8N{OUo((jG4R2@M36?|LJU+%Eh4=d+qqwL8Oqf6vfXGiYz=R2;gTKJJ z!{B2bQIf|HD2gy)a|UH~;s|0dk~a!)Du^FJltsW2&&P=7=C@jrQ3$XAOxaMxsOOC| zw!EBsN1bzyEtk1OXUQGTTt23b@G=$Vxj3FUj3JDt5wh@*YZ>DuQwbEKfNrE_>t?wUSN@8Am<` zt;EiCQ0M1Q-(UqQUv5luI&XB%uugb7A+Ams3^4!-r$P}@#g~OWWgj4iNhofnp|IeD zCzxQ3VaGzS#sCwnF*?TNj5JL`>?`wH2Qa}L(_yEdV!vDyLz4un{I9oMHl5t$M-dq{D?+Vj~E66&e=ZLAYL*5Bfm6w1+BNcMhCRo^+u? zm?{EHzOmbRmcWxIcEl>Iv~bKU&ncE;T>~gs8x$VEkqfd(C&)X%1bK%=n&4}sb8CD@ zY;?SaXAo?c^5cYtouWCY=YZjC2S*ve1f7qdzW<;CrWo&Ch2`@fRIrLvz*1aj7^`1? ziotO#QUOL+9u@4~RcvK)f`Pow_>b=$Ocb#ZaRmimoS@RM9u~YUdK;Kps1U5lPeq*0 zMidE$$tegLzy$S$^ROa+ z=$-r)^87<1=A6}q12Uok1~0KlLcOpziX&9QW;}Th1fxuEuz|4r7(*=c8Vjy2kukB3 z6s9K@KY7e$rxpk!)Mv6E8*1iAegw(#wk`-GNH{$XDGC*`BAsATV_ht)f#F3E+?CKq zg8G0Do)3ek9hDqSojWi%iy#aZjuX%l*mA$5u_rlHxZ;FtkURA3r|P{t_aA` zIhQZgzE|bLxcv83=U#)lMnVdq$xL^01Ashz%2ZF4_7A$ z4miM|kobmijFTT?#J4DmO7uTxn&2G4e~=oNia3yqBscP5%ZP78jDDbV2|NSSD$Z$Y z6a4{1j0;~OOc+kfBcHHx)!`%xzw83+Kd6d*8-X$wi;cJBu$?PT6S&&)qK5}bP&>uiy6BV^Nj}r|OoYVp@;MNOp5V1ubAK@B2f#DEy$_p+`M1$7Gj|mnNA{C${ zgnR}eUJvV0!I=OUg1&hKNzN;<+|?WwsW?r~XEf^gl^gOQqmWNH{7H*mky^OV!g)5? zKvo>g5J-qq4$c`VpI~ZYZo&i2BLlmOXG|z`-k?HRajyh-DhRtnfC*QAzf`q@qHiyktd7i-x4^CYq>7k`ZMj zMQNz~p09hUKJRz$-}f)ibI#*D&-2XJb6tCmiw~EJUnmn3%AAl*!KL0h(p_6B(S1fX zadp`(u`V5il<6s|$t-cO+}}wRtQkAsyauP3bG$ZqRc1slc^zlTXB)C%v+!1tLXG7a zWnJID@l%eswN}o>^=}YJBK7AUrY&#j5p3@HnN~UNaV7k0XwEzX6;tO6>#GFj%k}f9 zSY*uWRQ`VmDlGA*Xzg`YR}_~@RC^V;Mf8HTTeGkqa-(>k1MYzl?`B$U(z20VU7O?L zTPHa3w%&1hmK!v8i+UyM3Qvex9>dA|N7vGfZEC{%y~uE zK4=~k*FUjUV*0b7b^uxCQ@+VMwU)D1xOIv9FSV5T;w{7K47&<7787qc4_ynF**($u z^i14Wo#x@Z%-D)b|H!B*tJSs zJ9(XoLbCFfZP&h!4YjOTp=4$tzNKs=PuZ-bAkI4cEKd}zrtouTX5p)E6N61n-!72*#S(&QjhLiACHy;tWzV3<_?q@$dFugA-l9u14INB=5h+q+T;yUYj#u*#d&f z3L!q4q~AmB{%#{T(ZD@Xb+VUv(v*wE26dS=QJ*$^e=~O8T-=_rD1qmSXP;#~hk)MR zgD>zGU2Z-8Fh#GEE#}aiYKfowBNt)v_oQ+D5I8$(sBD_>I@Rz(l76bFn*LnV1`;VWJ>@YO2hG9(#TH_VCc;_NkW5+TkBug(H|j zgFOoLUHiT1b*`pzN4X`lZPi5PQY8mh^7Pr{Tr#+SY;MGGgXQd5Wi>Zq(-_=nh8sZWz}4ro7y# zkCbd0Pfz31BXIt}d$?bU-L~R;cdf3=YNkhP?Yh&atcu<)(L^%?-!T^FoAi{-TQzbn z#pqn2@7+G{KB0IMVzYL}i|S(*t;embWHJ;^DR{tN5cX8r_zBY*GfgjnzuSg_NCV) zFp~+){?}aBRKx{tKG)=!7<9T~ua&F$^SWcK&@IY#`|masNzN558y^?!_8Qq6o~!a8 zVOva8ABWh1K68oF+Mm$WoMk^kioZQ23`_XfPhWIK7>0}I%-fW4MD_XkRw2@k!x1XS zmNI-+C~25}{Ni5JPP*%E(AyV)FHFz9l+! z|3)Qv+1XaTeG@TVKhjxAG zj#v|$y`^v0+xYq0A4E2f1Wj2;q z$Bv}-hv08j*Avawvw^aKt12<pFUyPkB(uX)sPVA#ud8#<L9=bEgms{s8}r?~Y32O^)e~BA4wa<- zeR@{mJ0-`c*-ATx9`-0Qgr%5v*H5_G_mg&tHN@{0-D`2bTzmH!@y?M?q2fQP(lTP= zXoA(#A$aAS&)w#MYmXi=Bays(0wzw>>>diuEB1`?Vdn6JXX?~S3-Ukedmkm|t>SfM zd)6izx01Re6_>zlmp&ZY<$`xETGZ!}3h|8@K)C3_lHWlXf3> zG@a9CdqC6PUYH`a9>2>{qFL-L!=QZa+S`d2OYdjcXG^>ne162J>`eB8VBU$BPc%I@ zq4yX!PRCw;*w=q2dXVuW*r-*xn(hV>F3Vdp%pT)cTRw0Of;lUD%H+TY$Dt9As zgNRp^{{orwYmHN?xtQKNPsAKE*U7*9)lzqLjF@J>u&t1XNVBQR^&PbJO~U*aLxj|N zU%clHU6kDRqUY`=&!KM*OWkxQT&p&W3S>j~p~MFPTNML3oB++}{cak!^){$BBEjLYY z!H#;&x!KRoo|S&?x8t=%QLgajYxdS%dc#MTQR{r{_XN|A=&H$`xc16teTqH4%)F0` zAB{MDOVIr8$76HmeWDb_$r^qYXvram&G!!Q3JwYK_S}k5+cx;mr<2gV>WDi+uNYEC zs^-ok5%ax1rnL2L!wX>NHhles0Z;z8y%1((hMCUiT)cyBj}KcWDKK2$}Cb)MFl(%QPkBD zF_fNVN2ch|slX18*I^J9NEEUTE%TzP3i{j;v5}bt5%D^B5{!)pr3Oz>Ad&DobX3R) zQDHNTcR~zhh%_BKfuTT}#ZrJV1;+l3opwU(WM^68X*yIQ?KevTLx=L4rx<$588Mh0 zpU9x-P-!6D?D$w`bh`nfi3U0$f+)iU#wQbXC}g6-EEZc?0v($ehFzo&E2?0E7@{9t z5TjWkh_F61D$HkwFOel2`oWVuF)=jR6)}*72~g-Xg?qQMsVvm0V4J1g=GcvfWgNSWK^RoEh5T!$FSk@0jLJe8s_ z%b5)OPp3hd#hC>LDGGiq8SE!^N@m9=5Of%H^r9_$W@}_-Cp7~DW;ED-;vX&K&0x>$qWSooL34SU84mPslN?}S#twoHUoi;VGxP`gv>?H zZ$KP`h(sMK8I}uXN}($dNTke*8tR!nJc6jzMkJ4yOx2+fVQ#=L@h7dYJVLgap7VPOdbGWs5{vvou| zO^1jlp*r4w)KLgJBoZCn0(FWrJc)3#$V9qAK*gC7Da^hlWEz^j5s{f48+hqZ z2iAeJQ@HjxV#-KYZ)!7$VhUXSo0E9S!*yp7x}|*R7F(PyUE*6%^I5Y&hKwH_q^p^ z(Yfy-^B=#tS;{OvReA1QY24MHkMGfRa`0=-_B^9MYn^xz6I;IBwzTYK(L;~vkdM|b z)J&D~8>W>WDy3A_@{y6)mJ2IJ<6cys(U;odd|~q7z-pB8=^85YiHFU%B2mQ-psMA@u}J7qI{*cTQ<1mPKKV6 zou5*D#LYQKOLBe0_?W}Pf!5tkKgHAJWKO)@D|>$1u#!-Sr9*lByX;W!2lsMGTXvdR z9{nUAnPw;-W^kxJ`SZ0RHH$S46(&KAXF7w!I(a(_CJa-F=PARC@=q0?yIyYNOL{z7 zmS*FA{EQ$?#p0+O zU2fgv>BWjiEH`tzepr>P3@;umu{TTh<~)3#XSh#+}l z7gJR~qR|`Ht8j4r6nsV!Vs7^`&({t2l+Tc8NPVpoZ31uPX- zpH;qIdjGPW#Oylq7QMV-pCh}j-cqETR7373KH(kYOLng29Zv~#tymF4$|`&E^Mc#W zlXbi@^=8sM*Ebm|N*$dVenB>UYP=~ZER|dCcHY|c^$U5;9=i!&TZDf6Xk=L5*e<#v z&M1F)x3F~j=f?-_@JUUg`;?igI(mu|dw5kLh{}?>j1e|FEZ_g{uSknRvQoWUKW3&ZZ6ZLd~K`5VB=lXXGNJe|H84kp?-Cn*WM3bOgxt#7@{dPPHoek zW6^)X!7}mA(S_&UPQJ;i9at{;joJQku?1J&2jZ9Oe6hrB)w(X0oE3vVf~2@I|zKt=3taY^j?8=1dXS zlPWI~jror4-hFeshIzw)3Z+)pq%GX{Wj%86>E)OPy{xk@wtBR0*u&JSDm7Ou{i&T) zMq{=OL{G}kIeGFOAO4cG@0+lbzWiaUgE}-#UudrLFh+Z%1^iQ-z9s1^2GsF1Zj>E# zA(K^2-H&eh>Lq-6j?X-4o8`wfYz+4mFeNS(36+zgeux>4M>!Vq^<}ph=vK#m?@KX% zHuYI%a}>4NSMf(r3m&EXD8$u0x+?To0Fjd^Opl5mvsAx5N#^ybKiIJ6>58EDcW(0D zfBmU9=G;=XV=A|`A6}ZjB2}};{>rOuocXPm19!g8>u-C$S6w##bEeM=8IwJ3%%&<` z=DEGn>zu@Rcr4abFL!+`dSzdN_@adB;X78x`6s*X8eh{txcO(qlW)<lI_Qkbe*i(h8SMff~@lEgAeWRY4-l)X7J}BO3U}%$*y@uDfk~)m!#);Df)~IjPli1~{I{ zy?WA1X(%-@|KKxpu>D@-*Q%qZ2X}3hFuR$$FhxW9dWK%of+k_%>h2G+xw(0VN03{7 zH>_H%`Iwt-yxP(Ffv-({W7CMDZS>sogyfG$d#aX}uLydXkRY%#H#(|m@Z#c5dGmS6 z%I)PDV!KTozG?{%_3}Et$XKr{c)g8>F{$FDZ_p8SGhj7o=t_}Az5cCK@wPzAb2mPS zCWNZlFIjT!NIlg&ZU3BhXU?DBWB3lnxb5nR)ycL!bDBBdNqg5jtzFxjZe5e6?$RB{ zT^HmPnWwcKDHa)=ADEEbx-T=r=}aY0XQRrHNxIshW7O5-sk(FI?f1KAyC~l^vtPa< z>SIM%@yW)0MZr7HXef)4J2o9$d3f;jt0ITZnLAGOnZEpZXcr+Uw$rOYsYks({$LTV zcx-+Sa@}QEXaUoMC@g!vwsAc^$tS@?&NEQ)UKL49xvab_KlaDAZ*jb;F<(cDFK7)d ziTcp9Sj9x?rnbgNMEiQaXP*^5KRLKybitDtcU(LlUZ&8D)3@&S-Ea3FSTt$#pUhC~ z)Nb3~XI)v`yE$5YV#C)GnW&Rzv|X2N{Z8CkuEQrFy6m3$=3`8I<&8VC9dw?BtQBec z;e7bXvPI=ref1p6LMxX{-U?i@_T%HV4K+rwD!rlSD;LHdebYapoubHWe5fB=r#PpP zf4;x0p@Z!SMXQX$O1q2BANF_|%U;}esOcNuuzm2o)2~*jmvbL(>Nap9I{$RMk<*&N=Hhuk9;p^Nkgmlb^Xy6{n^isa$X*xtjmk<>KWXAM6K4?A@A4Bk$hprTZjV z-FGyO`%n*Lh?_MQIk7ew{Pa z{NxDpncjzO}^j_|vdEeFE*eKRF_oZT0)7Da;ABFg3HteUUhwrKZ}>*R}Ny z-WD3P(K}dyPGO+e)e$uY9TZq-F%AgW780!B3Jqke2L4iJ{!(ZD(q{g$dMKn_AV3anQ==q3xuA{06SY)7!-iD0vlY0!^|ZqGzmI7zfJ8R6qHQE;VG z!S=FKM6E&*A#p06HGN$tXBP#qlc~S~r(&04ty45(qGuou=V{5ySZeN4p?E>N{G<@w6=avKmwohB7slVV zACCM#`9g)Q0_$KA;0Cdz0Be|(*_$nbCS@S}D*rhMn6G3qVP@y}Gm(XI{|N;XpG-%K z!r(xaWd3CVNN|wI;Ch%@fW>tBzc=K!puf;?t7n$u>p_I?Uy}a9VIG~?y zDd{ih?A*2K@B;kzTK&Sa7Xkedg~41xwr+W80)cDHVtDh3hl>;N*(R%1^TO@k> zrhGgnDAm-{Y@-DItZ1`Q@&gOn+e6 zand>0$FF7Mx7a4Hbn&lTi`@JC9k%MN_Pci2uF2Ky+L^OY$6tM0qVRpMZN`c{wgHn4 zxUALOI)3rw2g5s0M#lQZrK>uZa-!FtH+r^RseBUpe3<`|T{5%7Z*!N3#Yo(!Eqe9x z<4+lP-hbr^*Eu6aoBU$PJ0A4q9v1^s`axSe~u6PbW4as z9%Z!Dki2+5k7MiewT!UPgIuD7Md*<7`zhm-lkhyPNx_MAjq#4(c9QRM>fdGA#klhfl?@0i4|Uc_g! zbPR9c-y?FZJlR2WK_c_Z_~GOg_XkD4+;6knpR3VWd``f6AmZ?IurQxp6vzt|Z~t^5Txg zg6`XQ8+e*iRtM;(r0zlEHt;czep_UHMt*#oM)j4r_iE?mt=p3Bk8jTqJbgTOFy{1- zi0paIPaRIWKB~r+-H#R37QbI5Z)wHcdZ5-PyS=ijU2a{~;U6`+KQdOB#&X$9d)3H01=uh82=2^a#Z=(R~mX9$=+LcDsRh&``ZGvA5tF#SFgTM zbMqwQ){%I98*97QSLgWd+z&xJ+{Lqofxdd1-*k5$y28DvAZmbosv*etZOE8W2VLge zQ-#ik{Xe%X(wI2=@EG?6Gv%WqmrP?S;#-a}c?U-b2_BJ^5sT74g$~AK9qjY7{U*5k zg#9@J-NY+hyIdi-J}wkC{lwmGflWO6)Av zlL_%>uDsA*&B*o?+|oS!#vFeu+!Oy`?o~kkG*Saw0h2O72IO;$TUA7{8Z$Gp4pkT`gV5< zEV@LlFnK(z)8_LW}Arv?KWOt1;J@4tpxPLTZlw)sPdLgAMneO{XoT z(XN)Ar82x6v-mdRo?8k#E!irm;l*N&u%`adv66OwFABN0(wpHBU?Xi$!)=-){ZZuENJL zO3_Tr)UIOQJGId|FxSlSr2R^L1A^Wmf#xA*XySnMmzOdv=Z`<84jX+v+pyQV^8Vg4 zL#GF7qr{CR4Cx;oe_mKvmHo<7gzw_#2O5+Qh}pX+*^%kx50`Z=uTlMBs2XyA^|i^! zR8xm>i*RLA31=CN59>2&b#L#TdlaMiY&2KA0xuGpeq%K=cu`WH@WEtRBQeG|g&WV} z?%R;hx#u2zF{kfMm+CvpNh8U)0_!><wjT_55x5RN_;R_czL>Ini;Ce%nN#f}K1|%Xc#7j6Mi?qrf=Fkk zuMiMtK+uk5W&O6l7z7&2{$l>i{-V#=UGy2d3*urddkj=+_Fon+1v-OmkkG;4V%0-z ziTxK-n!tWz%-C^^8Geizeqe*K+gbeV0mx>^z_S@*(MJq`*-z}hY=#Uxn;`?wX2^ip z8@rv&kOB4-yUak*U5K_E145~+3IZGWKY96$sCe^D6G zM?I1e9uX{-2BFwlL7+PgU6cYLP?jJgiJT&6Pd2g`?M_FyM5!}q3Ir4}v-USy;Q(TY zFwg^Lh`tPo20A*0p)iYPKv3#Wv?f~$28smDES)HU1hK3?)&m;{-L8UDVTl2%>qQ;? znYEaOlELoA?9<;+xqXNP$dGUi!oi??VzPBnu`u3nc?jGD!U|=)-Jq zcM(873Yg|3DtNAFBnbP18v|Zc5)E!BkC2A1scr!4;*LWKAaj{$=K*(SLN$pc2fJ_KwR2NkXZ+(jygOr3QT z{Sk6!5dY!i0WN>(&3bldGoFvy^K2&*K(q1?aUKR?#_xv4UO*ONPKm!Vp@5f=K%&kt zF}V2ugMwoQb3n3vWK#geTn&HaN``wvW}t*Z@SQ=A|8ZdaZwE+NAi`Tif>)46nCXCh zOaJgX{ci^>4+Xvte{|4pNR(U z$BCiTyYLOw-U2R>6~_@tbh-^r|0W+CKe}ZR!p%XZ(pe6W0q4$uPBX#S&yE*jGoJfj zqPdQWB$lZO{-&P7YNO%9WN4p&41?I_?)99ZLK+{I zZeng<9Q`E8LGs%A%g2?n_BZ*aY~ead+SD#zW7JXp`qcdEnr%ke42Jwi7qJs-SB>^& z-8y!^Le@0n-qKR3tJ+^u1QqOi0{X6uyq{KNjPJ3q`qI53E%DIP5bJX{cbQ$`P31T^ zvfjg)UVG=QR%QP1+s8|pVOkwg@sn@Q+DFP71Vo-|9X{*7o6G)lhWSDp#BGJcDX!u| zn{2bZIeeBDcHBuyEAdLNii9~ti$i&H`m#iJ#4r17o?@Kre`xuG*5OeD@;+A+4yB_( zU%yVA=T(|_K&nwjdu#2Fq3_?fjKBK4?ar>#SF}`2Z$Gun5A30*9qBA!8l5$1pL=7q zuvxBH|D06G*Xd8c1R#@p?JKyVdYv_7b8}>ZJOkDyPwlPSsqQ{?6u&%cC4TS7{RJvZ{k}IXma0)X-mh8S8+h=h zOwu*qodX&@`D!XM$_J)hR_1Xt^AA>g+=<+Hsq z#e?Ef5_?puoEw^#ztZ6LVeo%hPsqL z5I-zPcok@+rs_s z=|+u&3vJ%hllZ3vq?pY9%Y$;X$Da|X}6w%YnNP+DbIf86U;xi+Vm z6_+VnCvV^c_T;o{HlBXAjN=kfYx(!VHNpmm%Pu+H?9yK08oXIbE!VftraG%TYfW`wXN>TpWB#{-zAV&K2&!C;@@sCsTgPpz-LdIJHSdYb<(rxB*33;`MisbMo)|e< z^yCtw-0JDW+A=|b`v+xXcXv(bortCf(OM3teG7W^B$}_DJJ4>5Jg6Y&a&#@{r`nD0 z$^u&mOvBLE`cg#Vmx+LZ4*IT8^)OjUnZkQ*xs0>S7yEaW_nKQAuLv4D?UqU>AFk1r zDYy2L@;q%Mk(PsdRA==zbn11@yqIkLa;;VTi_U+2B~-B7F7}1B-|<2;L@fRR>K(f?TZbMx2RX1dRmf5)$f*2*64HD9bVRfLR(*k>CB*K(m=>xa8`Ggc?iPJ zz(eY1;38zO9%--zzu*KSdi^DYXMcm8t|Mlmpf_Pz!m~24di{f`=#5z!NT89^S=q~M zks(G2-7`IDs_4oK$P)A+hK#$6sk~%}se)og21A6#vNnlepRkj$>n|g|sK-s%g?Kny zB4D{d_A}TQR2|IBfDR;d{U$JYuU&y`^YvGejp+DISX@j-EdE8LgGLWwMiQJk5@ROE z_A=N`f!83(`r<7NiXAC%*33e&{UDQ2&rRU90Imk;^4l=_`wBP%vruem5VrpZa%TLe zx1rDURhSnMRBr-H`v+AXE(+Ei559*hh!^_o80dw3K?r7ALS8j?uGnBQfN0pVvB0e5 z`gsjGh_2lUwqLv?qKy_-Bb?$y%wYOcYV274DfL}YHPKN5j)10BfmJ+yfe3sQhvL6`NMh!HVc5_~R1u$c(h6@dQ4 z%s_cnRQn~MHS)les}TnDdo6@h0z33G9Y|o@!)f}BXL0w<1Mc}r2tf)`82$i*L5~Ml z;BWN05zJXYWm}>b>cM3-%a{xfGdkFszpwkJP(5W_r7t3e)yO7|3gC7uNey|fk)7lX}mYMz65#U%88E9_- zrW=maK;pr|BEvPz5b687UnmGSU7`fo|tc=UQOP8>~o zf$;xpd1o17KOG@cSlb}m#ZDLbpZ%J_QQ=Bv8t00j=eiI9nSXBTEC|#M0_(ROzAyhj zD7dqPOrb*}=r=(9mta&#Qy~(`tlb2E?f*4X@Z-}VH;uuX$d{(SoTphCL4hF=SbQ~D zaf|z)kW^VU`g=s{D|1K2?&N$=(u~ztN<9|s-gcA;-CYDr;CgeY6NQ7fa zrL%cOH2o(pIAk;$`*FJpy#78z?DtvV!DNj%j|2A~DC|dF3<{f96Yf7z5HP`$sc2CV zd;~p?Aq!@Gf68cE0#4xHsZUN=E}iEhM5LnWF4DtwXb8ubS>i4xNgzP@1x&C%Z9>>y zwo&-6ASQ#A%?I`wD`OA)J7dp*;=!`xSlM-0{fs@w%8J9vGxi~bkl45x`;e842JP_H zvFhnF{8$-cw#v{jV<65%PZ=}OQ^rj6ltHIgJZMFZAqtRT$>t5jjIH?R_lbsudGyh1 zPY@( zBn|=*+owTCN_vLG0$sEmF+xo`5Jwz?#tvq5Kmna91a+r02gik8*o0e*20llePzFOK7@Se;#zA3kgL}VhEO=Rs0gM!`K~g2NsNO#2G8FqM|L`$Z2+@@k$Sp zfS&DxWeMtqW$}LnlvW?Y%q*hmqx=&f)Vn?;20hph_0#WRjM7(#9cnuO91Z(nnhRb- z!=rvA5k2-A>e2>~Sk&VUP%N;`YmiZP5Q;XRfz|8RNEF&J2tD||VAFkrM5BR2P;?$d z;!(}v*)e2?U<{-mS%zL3LL$)c5oqup1~J^;0@d7&aH0w$F!&@Cv%UkT$`Rx!x_1;B z(YJ^@YVi(6B#gp}bB_UadlcD)7LGwHOo#_fdk4dk-b0ZkqvaS3b_*+ZjzJIC5748z zADD)}M=VjvaW>8keT-48X%u{bY4}V)ku?q1agcF(0=fxIfKZ1%0>xUnGZTnCs{RRz zFc3Go>?0KWv102-z{O1h16Vn3bjv4TAodv=6edCX*3axAxzX#B&?EH=d)ytU+E@0F z@n|hZHGV-n(1>rdVE?Z$51lFC^7Shchu*@dvTv|xXTAeucF{P|peexl{9vuz8C3Zv zG_s@}{SLFbf)$VcKz5)((?EIrL>v$4;${$EeeibLJW)W{sRDh8b1WCh9C|ngo8pcRADAz=0yyK2T6w+>Yh#jQk_h~Qk%AyIe$ftrVQiQv|tr^R4{{X}sI zsINF|u&Nj?5mlA|Y5=2pB%t+}IJD+T0_7nAlGH|w5#6_a- zm7p(&63!XjsSG_>^F5*j^OaPABH*0RGZHOq|fL8bx0dHd+S0sbsbp0DU4!GdQ=Cx zrQ-ooqzm1Y3D7{t!(?ptaSF3PIQOw)9ubEPrU-PXkJk0ZfNzuu3m5 z>KGlUEIpvsF@Uns2TDQ@C>{f#S}^J+MzP+g{rWIujRh1<41kr@N?`ia03aU?al#0V z^`ni8MmSM~hBg?&tr|DNi2yy%2<{>6%FJ~q;%TUv5lo=NA8s`ic4Gz75{v_S2cv`8 zG}jWK%hD@~~6z)wp_G^O;e+R3{|Fee6 z7-s~-n;PTP!Oa3`>SE~FF+>W@H-_1r@`3bpEEHRTUxwQ>H#6bgA_)Q(mHyY=C!+XZ zoQ42Px%%y^uaI1U+l?sA>37x3~bSouUt*n@a`91j|{8XA^c!A9UL;mEaHK|`%2ZWo$q4c(HgpjFKV zx`|uE;pwvh9IIQqHE;$!%Lw(dff;VFg>G_d;BEM13y_x>bu=A5GA!^(TL7EdLj%DM z#&~8A;88m`uKsIbj6L?ys_Fo(?>*t2l3okNs}3N2$y&HwD;?p+ZE%3=$?3!%oEx2T z0I9OEVv-|FX0bEyTj~V--e43A$&Ge80VK)=AhqkDxXl?@@w-B+q6^?yO4AjLBD(=( zr7O-6eeVXc47kF*g>Z@?8t4Yo5_X4+PhJOgC*0Yr)}mAoz&W}@U6TjY^}2&-@Se?# z8|eY#eq0Yl&h@x;=w(l!^47yZW*dOg^@N4(*Z|#Ns`hB+Mw}VCcLUB6Rq=wA6x#?l z^{N-J@7M_JL%pHL1}~fgy44uY4@)m(tgxo zEOU124piM2C!E;>KZa5(NBCKvOCphiM*G0=J_b$Td#%FgMlx=}uhuE7<`uhD-xp^9 zpa@_1;wt*Vb)=wIeBtyLvFS-)fXeu@7*YM;4p7igKd914<^0XBoZaxz4?N+F&_4#! z^=I`6@W;NhcMu^COtun#V9)=jJa7GhQI?t|JjnTtwIw>C5DJQT5xPj5`Z2AXa z{-u1u98h|~-&PnJf)ake#1}9ol+3`rqM24EeDfgMK_F5HnV$CYnPYcUP_q=AK*f?B zxG`=_J!c&cVbQ-l&Q#XpJaah0Qg8}zuawaCeV_$n1YZg^3gnW)bm~%Aht&#2sFs=2PT5ih|=tmq1*T4JWVBS%{L(Nbe?R8PO4EW9@wdjF$&M7znBHZUdSbRi7ltODI(!=X8YfXq)ZA_( zlvnn&`O|`u$}shjD*^I;UzHM=S+=w`p)G^l5u;Ui_0-;lpKfXSoYL!S{dsTc5s2%d$pq9!zY=cjlC@Jt!t9j2?ui%e``<8oTN#1}(j@NeTrwhVZt12}_;w5# zcs1I$Yj66=Fpd>QS*lU*ql|m57u<{1KISo8>a)5UcdJX<>8hiJS7%Pk;Gihgp++mIG{n+t4-|m0;alUl=#*(VA-R9<}8g}1Wga$b|31`=EDGD^+ zc;JzB-J5Bd#PzA4@Wxnqp=8o1&(6s`g6?;HynJ2?eOK+zdp0)p&DYVqUgZau6Qi|t znF`~J)bogjSF6h1d3kOn2c3GzSyFj2;buUn1vi&;(0eIs<*{8&-=n@*l=h?& zD5Q<|NuKw8Q;I7M1Ll#G8Z5n|`xomiSWV|h^9>r_!Mr+D5nU@&d9rlS(XPVdMONpW z#TOg-p3&V7DcqlWB+=^CCG$CSdC>gonwEi;y&{? zB^3q|g4gfW>&sQ2y8cppyScPj>HB>$?Xo3vq}MSuV!6lf4HQje&3{}RJo;%{jAR(+ z$19AZUWNMM70lO-cLMyDC(C8^zEqeKryU)LbZ*&eNIR;&<4GpL|Jr!-GsCL>z?T9) zNKTLBmc7Zc3DMeMc;|uqfx43me-QT6h^R?-X;0nR84bnH2ZjK;mkzNl#Sa zc2&zS1C_i=-*#Mf`B?9xI@K6We_NljJU84^FZ9Bd6XnNb>zPWPk>&&%zWn{gRb5e) zA;xPEGu_yH^A$n*PXs#*vX3gh1C3t9M^|ObDc|V8PYX}p;~d{oBw&1S{df1=;2337 zdA&ZtdgT83+$A@oLVEjS9-a6}kzBNN<@h(k$qUnbv9dBT3l@`%gc;+=<1`MNJsNYZ zo^7ajYgMWha3SCsGjN5r>86iI#-7P%KP5>rL#35mtuueN*=FrtVidM^u0snsOk-EY zz^<=P^7>5e+f;YUcz)Da(@T*KY1q^F*h_TIYwzPb1&^BR89h8S&L`?c*H*<{*=cr? zSQSIMBgq%Jw#cDKc5T|pOV>q?_g*|aqImChWn)m=+<3Khb3%%EnNA-o=g^&%=bV(x zxoD1DIDTZ`xzOc{EVNSO1`?iBX+QsDFda-g|5l6FSbbv1{L#ll*liE6*9DS%wh7%uIK6p8rKvZt$6o9bYp_S zPGjmDR6;r3=HB=4b$F&ZbCY|YNBZ>jU?ZnZ-08-K<@sfzF3OQtgzimtp?1!+$wnE$ z=Hi~o16*$uzNJlFIi5eD_|QCdI@8W9gNv^IqNVk zlpHbL6Xxn1y+Bd&(5eBI)+%j*lMzFMYs0VEenJ+`?XQoP?ynMCQ|QlZJ9aweqj_wc zh`Ui{nHl$r4k3f}?VBf7=jEhD)RHEbM}ut~GG)aZ76XK}f) zJg(E`Rm|}d6^_q#Uz@w#adl|X0UL?CFic&;j`l}^&G%ofmEHXIDNSs6x5?Qh(_8s1 zh&dWIejY}f-6=e(FRw@8ciS*O9cn~(*+%TS@yh7ZvJFq&j(9B<K5cN6V6sDwQ~ zCL-NaN-`79=syo7pJEuvylrgE&e*4|s_;deE8j@OuON;jQYhu~*=FUj{7~kPpM7$) zt4($hcU!jxlm>fp94!q$?;BCH$5Qnm=eot8_}q>w>Y9~x|L98$U=GHkOCNDbNTt8g zy_RfexIJMBPJ(W(6WGs{cXD@OLBXA?bE028u+EZ-%voeZ?>g)2zF9G4vt`{@$+rV~ z@3;F;BA0Q+Lumu`j^8-%H00#<-C`1-MEGCiL>2||?C7g=E9yC)^qS#S-}~V3L96)^ z9-(_H{vTg&0an%4{Ey2al$P$0?(RlX8j@?yBle#-$w6! zzwh zCt~9G9I;lKVDg8mGo@;`RD{TQey;FS1XRQ4^Wl3RgjQ|r2EkX^eO{eOsDd)}tjD|b zlwr6}G*OA^JIR>?Pab>~o_MjK3u7lYnHO5 z-Vt{(xF;;bY-<^1>nBt7KSyh*?S-E|xku$l3=JyTnv!I=%L9i7UdwfJQux#8$>}?Ca%Nx8UAy?5Z+4w5GZl7&(udzo=<6j>|9cLquD6wySxb^8LE6#Ng)Ch{-rR!U#8 z@K3j3grnR{2w6kf)AIRo5|fs>dr4`kyV#`a-kWF9gR2v2Cjx&3!mt z+fw|R5#s$C1ii|aa2NCbjsfGEmDxb)Ev1733LJfLaUF=E)&^niHmkiM33&y-iI`^( z7d8k%cNvIh)GLm%4+=JtRkapyu`%AMqOJ_uvkG5+#ZCE#NWOD14CheOM-X}0N zMw!xBjeA{yiF_$O1)*|Vu*QZ@MdQaR@j0s*Xt5_$TX|!=Kzx&ToiZ~sM9Y({!wfoZ zk&?le{LqN6LzsqU5>T*!adtyxtflVEiox}SAb2Tz2Ap-iOpkRAvMy;fHU97+ol z;KH;@fB`?<&hbLQIK1+Np@cGTnvzp4J@jX#Am|n8bR@ys7|iIEr&tdT zoa6HeDz_i$v!YlJV&c4Me2rqdJg!NvJP*Rn`c?GxG&Q|l5hJn8E)Ecg{ARwyK6xs~%^BUbIAT_H=I2|M=_2-BkqWyWY*H_sVQzj~1Dm~9 zrepvY-7MuB-m|9wr&9ni`bgORMIfdC7Ind2gybW! z{ukk!0*Gm(0&XTSrty)8`-`|t0r5QklQk6(A5Q(P)%uY@Nc&CXJrWXs5vz}c&tC*l z8bCAv1m<4>xL>Ivk2QNh3Kn~u!vqE-p#+5b+w%wJh zDvE#%DhL|jPl0%VN}zraJ_vwS9Q6fmfW0ho97_r^@UY~%|H#O`6Epxj+cgn6|BdWGujxkHa#Dejq6L(fQYP;s~9 z8YK35tYn{ux3WoN9*sAJdFVEXZArl9YLhv=7W^Lkurrrl?xj*j2f5z7cTnk(f5Ee6 zQC4Ti^&sOC={_x!rjvGYetkRWLXDM<5w+QQHYWq7swo|qj;NV9Ik(0?t-ZUv(>L5R zs;(Nq#IS(%t4n>T!+J?kU$bCJ%Cz8Ksk;Xja1lf%+oPTnLbDLS#lIDasyKWa{kkCF z+Ix%csI7}XiJkJJ`Yrp`51!=rVEi;c{Fo_R!fG=BFN(e|TYH*Rfq&1C1sT_Z{>=|( zdN(8R2dm_MKP^FBKTs^*k_}7Um3JJKO2)*JcJq)Ak!cmv-qQ zvc+3Cjv0HC!pkOkC9vgGxpQfM!R#Najc2XyYBo@%YbP{_w{gW|#@OQ?t86z=s3)?K z?_fVv5Hsg?6C#n5RcVd?=|)jVw9T6$Z!_u-&J_i#rCjB{0`uaRj+)|z`i>(@EbNPa zta$Ci7-;bEhw^%DUXsji3DM1ANJfl{c0sIproUUTZ%}*w&FBp6VEKC4k%IX5v$qXh zBX8Mg?j4!BTm8e?LISzI?GcA+rug%HJy1}ks}t5}c5u7c%-4?&9v2wwUl+;5zrC4k z0`Jt|DbCM@fzWVXnzTGGZh`EQyqhEJJ;$2;+&cI|JXXK{9;VuTVYAO+t9S$#38Z=sZyk%OP7>^}HdeP#jkBiD3x=f(KqoFr$XF$-^Q2haCIl%TMDZ(!!Wmjf z4tInjaFhmSkGL{yt8!UDy@^hZ2;HBZ@f$!apSLj7HJKe9*Tk9f>X=JT2==8980sX!pLba*gCK zQ~rumq|SCmAXKrv)27^Rw&aCE+eEc0jVYqH1ulr&ExMSa5FTN^Op-2XrEQMo=;X_ zhtsubV&f31Y2+3$7^Qm0MMf7TB1G!aOSC*AjZHsULxf@3iFoOfA;2GDV4mZ7R!Z!* zbcXX3VRku}MfAI~t3@|1@xhy+rK0ofp_VB*lq%X`S$o^w+S_*QC5*+dQaxac_OOLM zzZ{v{%Yz5O&@=D>R7|ei#$+2TSkFmx=rwCyix5a-F=}B^$jI;7?E9*HW^o1!l;nr0 z2G^YQ?o7u9V>K40!bu{#x_0>v&J2}XhbAGE{Si7$H;Q?W*(!^AC;FQgg zV!aKD$QknOqVPGHJwZ^U#Tb}OifjRAPZzm9c$7F`Vy)aELfCFm{Y(Zfo+$|8yjr@k|2i887m{kVSzPT2N$!dwMQa zL^Wq~3}iZbLPyZoi^<#qDkr&0OrX$=qTy2XVjNYC(q~Z&P>tTS*t))d&0@p3Qa*#< zVrrOtQtGACIT&*)Qc7jL;So-EJz0aU>R1^cO2%F8)T*ha3tO`Fg(^qKrVHl8LnVEu zrAd8X6-i`)BSSO~?&}_Siu4VvR8>(f5=L~N!N3mPuwO1@Rwt)F<8bJG2vHwWQotNk z`nSC-I1_0u*VH4*C(+Rdr7FkT<~CcVdI5{N+9b@a@j~v+h#E3*5@!dyNfkwM#uG1} zA2I@k`%!Ufy@%72KNG^Jm*S?-Jt*;7<~3hRO+#c@brF|Q(>u1o-KVW&2pt*7GOJOa zDQvDmOd2PG2uQJ4^C!{pp<)KiIjdApYlh%@>1mabcq6J=S8qCuARn@O2IjyY<@ z)oNhOFCA|v@U_LZSVpM6X}2Hfs2ow)r{Mp@s_G^g=90_ok_5#%A7f#(ggHUIG!@uv zr&s(IQ=IqmJ~zJv9Gry@i>>;#y)82i1S*$!^8{Q=-g1W~^3r?9(?1#(%u&sKK7C$# zHg44qe@(ifYm>818m=*s>zW#?=qs#(b@@WoVZw!?m7gyrk;hSCrk%+ z8hkry#44goEGm!c66^a>m=XZG>Wn)QxKZK0LR(KYMZ=}7T9|j6s@KiDm?2u=8|q<) z^Yt4A#UwSSgUe5Q=UuG^pJ6VquE|sCZ5KNf_{g4|By=qeg~Gqfb}Xp@zgmH{GwUYW znPPtC{3Ops+>udPtg_mQwxg|3gU)PlKmqFc@egUCUTDN1F;`wLaj7LzQ-)rM}WPH;A7Z)UdbogG5e$>VG6zcq_>?}59v7C(GG#zZ~AUQurHgTTBl#puK|Qa5M0LW*p5 zDInea4q5?6GY(eMkVdKV4;Q+@SoZUmR}+8<$hv;kPEe(T3DNM*H0sVY#aYr`7K!Yo z^+yEwzl#(bQU__KDn`Se&lcZu!3mVm28v5;4dBb9Sg ze*aQA!h-nSU1xg1Nm#>!7gW~97EO6qPIJ@b2v{0ib2&t4{<6{YCOh}bJP`#B=85}* z!2;}sRu1jgtVrL}OR@dMoCg*%%Eg5>sqoV3quDsSF$ZjKr0A;!Xk+*6-T)2No)n%l z3wS*b0+|iweyo|0W7ES@sk~xUbP4K3;`2Jjg2lFJ@0|?2QWLrcz6ccsLMB5Fr-5Ln z`NCFkS^gJof9_4|&t=wD4O)v(@UnV~_=0P+7AQ1u&1R8T*XW_?b*qPkgvf!+tg0*F zvU|NOV$b1?k@DOm&t`0n`?bj2mzI^rKT-30XIkbtpT$n#P1)Nbh`i{}OJiKlLqej4 zeB8^LqQ&aZ-Q(~~_C~j-Hq-G}M;NnLzAqUO9DZ?Dk*HcqXCaVrPq%9n#Qov;CBZ71 zkcdv|r-gu+RN6H#n)PR9wHzM-_(;p1xB{(#>y!I&@RPuZM9N2N9YBv`c|=LX1=22l z*{T1u)_H-v+W(8?EEa-@p#dO&NK7G!0z&l#$kzCq`qv@*BjceEu)tFQF)V<3jI{hN zf(9&Spe_eMjPU&c;^Zw4;d|veb&zJq5e4s1=$j-9@^alZa>_6w{ z1aKIEny$y}M{1xh=#RM0pVAzUcK)w)SIA8f2;*PcH~<_B9ySQt7hpP`Vh|d}p9Cn zX@-Rb8yg7^KY+(KVuRo0oACOV<|q4^lt0>w+Bx@((m62V>HQu&If4 zXEzI~%wMP zpRlFfUE{1iB_*I!krBv&_zu(V?Tb-PR4#2)7Q9i!*ms|9+uuOO z!Ja&di67J>$BS8}`@2$|UgGgpc2Zt$zVx`cmyx#x#hI_A#^Tn{&2dhWhx>6iI^;PJ z(`-PzQP!Scl6{mYLs@0frYkP$|5k}56L(XwSh%oT%S!?Yme=)$?m}1+NlPej%-;VQ z^Cs7SV*63)BA(#j^?U~sgG{!-hxk^tXCA6{t##V+Dwi=Q= z0Y-k+)Nw$*pM0q*)rckxeH`gjuN|t^Rylo%u5~?8d3~1@oz8w?-&6@6McaUYyUHSm z-*$$C9`7%7J`;CzbD44k>h zU;?rlJfd9h*$PI+UOuPutf1)5V4||qW()I|&a=|ogoAZSPD1u)lWfF$sx1`s?t~R1 zFe~asl2-)WzA>WSszwTJ^b_AiZ-xO-k68cPZ#_w^K~!xy;qtD?Amy$sx1HnNb9GlY z!2ud9*wMt7Bnt8MnI>E5y6#N$;b3LxAL>iiA#v-X0*KRg;kL^7;u*=BjO9zlX<0hq z1pQ6#ZU@=U$LbL%3Tqe7;pw@vDCItXN;&Iy{Y=aDHp`Eu z-!K}MHIWh?UV{PQ>>w4P-To3DkJoj2ZZ&*4>3v|Pkic!^(`7c&HTJ?bRXH#p6603K zwO?S;!030LEGKjAOVbxh0~eh;lOlvhGG11MW>9n9<8@N%!XK;VBo&mg?VcLbk5yOO ztE1RU#&pNs3|HF?-775%ZrQ@q2p?xX`C5+G?Npm!0*_r9;E?lUa1Gnr`L5@Q^pAJ+ z4<@Wcyy0Es=6+?-@6bV?pp?wO=1j~VnsK(6Rh+L|oNiLON`b7nG1rDgnVs*W=+3f8yn1+-D5*Q^;_ zRcjE4N_)C84F#z&KB2NZHkp`(>5A-3x*Ho2?yG0CC)ewi-?e5!p(&Mk!F;PvGTv=u zk;{oAE^dgrb#v#iF4Jbu}TtCEOZ)gBjlCl0^7LAS>^qphd!M z;gMQ`2hpGeZ^wS5Td?FrL+PE`WDaRVWNwW`hnAFRVm^101DE?Ukpyc9{vla z>8sx5nbsc_pbvqtZ&TmCtZa8DZFWht@^qh);@dCgk)DvDCb>*NY zqjrx5vpG7PKn`BY6~z3*g}Lz!RX9d z@E^R;ujU$RB z6+(@5}$w3}}$OoBa=KV_O` zsoDEw+9I-no>x@geDn({eEplu1@;?=H7goc#!6Ocq({;<=8}!o5jx2O?gO>IYb2=2 zil2E%-0dYKo6kuf7KV)*6#6y>ITuRvUwQHJ;+0`#dl0Mn%9W8}DfvL}Y@ZG0O zTF%fs+iGrtab;?4w9Llja@F2=JR?n{V^jh@fcb=e{b_*(iaTP0F0n+0 zvIj0^h9*7&Q$~2K%C*^Z=G0>WV~2L}JxujynWE}~lcs`TrO1QG^x$OmuU;(C(|%%K z>q-Q8c&X$w+w6tz>R@g~@0sU*Y*$QmAwsQ%6qxuQ?~8~MB_ngjmFZrV&cTSZgndj$ zwkYH~c4NK;qn7x*Tr@7E2%@M3sWMpXQp(%YG6dA;C!A(`@%BN!izMozG)5Lie<)w= zBhm}s^s0UjuR$y(=2a}yM!~W*{RUmS`%Y5xo05{4`?sd$uNJ0t`RvOso5B>?En&(e z1#T=zD2J=nWoi`)@3S44-i0MOR0}yxjaMF-%TvwQfeSv7+b$EVo-R~>sDb@f-Xhl| zEre_@-!k51X=+%HZ@E@LP%X4Jf-HnKTH;ceJ+)|Rl<%*4mP=w93r`a3iPwIB`sBt% zzfSmvET?q>J*(ecU@2bjFO%sU}q^+CzP_t%gp#z>#w8``Z!|T%pieQL$gulPm=KVDxro8g~?l4+u&1IHX zTQ0WPbF4E{dF-ikd+sO$*F4(_a5D6hi!TofJ+?*kWwH?x)l(DSW6?BeKRh!e>wHL* z?qqxJb=AdszZ*c_nl4fXn@~ZC2lI_&PErFg?Z=IC1@fyHgb|O}q7j-qvydh%eW!6m ze0cDMW*65Wk^+6FZHN-@r3ie%H-SzE#7lB-#TMFBduRjlih{V2*3tfYYDu%pvK1HT zYFGR>=?Yy_<4Ud<+aZaE*-y8qvGeF0f$Hvh zW#IuztJ`1em+J)0&I-5?UZ58^Ku@xNC6ciN_)mcEMD-LXzkFmuC>wxGIH2IX5JV2K zX#i4~{<_ZpeGNEER1l&@5C+!oO!U9w1zbP{Co6z){>v`c0Ql&C@PT6bIOS;!NK7LL z>sJQS|G8P5fVKWt<=HAQ%O9FKf#O~OBe@LkDf-wa4Df9pZwLr@)PIC=WFYiCAk_c(HJm)Z;j?oz=RVAHp#$hq1LGz5 z(&MrDduv^LxD7pUPy(XFQ{h3mooQ-C2{5lxPj2thjAABC*BuDl6VW72UaJ=IIforA z2`*l{k}O_rUa#GKsuAAk)n)oYA$NGF=;}Zz5j${-LE<31I)nzIyS_Yl7JGba$;T7UY zWi`c;RQm6H_lya74?-)=)=9jv_O(bp?_Pa5<>p>Lh8mE5JGqtfitv59Bkt-@i8Qk>HfNe|?Y??`)8Rb{MB1>THz$*s@9X?pCMkkuE#-AR zg|4WoTOlpa@3Ss9#5Kw8z`va+Gv}oJ8fYbh=orA_*$uz)xRSB z*%&64Y%HeqbN>$Q&;uh3sA*-iwiJt&{- zSrZZE;yZKZFOz2x;g5jwI}iHKux_v7&feUyH-iP=P)D{J~aai&dVM`Rw4@YeoRlUI=mBhDOixp(R|B>*DX z_cN_>3erT`s!ZZs5!@azN%0)mMkIT;1WyP3OuJbMycUAn?;XIajZFsVm z_l^;7LKqQnvYpt10y7tc6k0u_H3;-lBSQ}0oJB`erQYv7gYJ#OkiBM6gMQ|1!#{~b z4%QK~gVz&SiXH0fJ&z&+ozyUnqCY>{h%qu0k+G;0#=ABn^!YiMbkg73Leb0`uM)2C zIz2srI=43rTj>lFpY4TqD=HtAKZAsd?RKCXb1U9Jx=z8qjKy$$l=s=(RH^9qu?+t9Oj^1{B>)6nTCxu9~AiQXnOUhywzAr zESD23sr{~t8cJad&OF+zBE{IPP*fTIZI-gaMP%O%;H$OOA(j&d)3t1TpY}FH#i;n4 zE&PQN^to4-;weON8)H3*)2=PlLgZOKOL0c28uM|=C}e##%lj}%y@Xn&ZyYeglM7C^ zBFWj2Q+le5tA@Pa!rCSdC;QOE)sY-gfg;OY|0Zh7VUq=s`lz%@D~)5#%+yWaUDx}t zRK9&ZIOW6=+ct6!-*d+o)|@mh=2L0WR!B~Qup6Q3p z5YaZ}X-Rd>a<@`O*Sic+awHp5+mfyHs{-ddG!o|K`vG0&Q31X1Zuy^RR7uakKSFDg z!eJ-|0$8k+O@}#`Mi@hVlZFCy%rq)G804wToxUuv)lb`h%`bK+;=mhi&FPA4T9r2W zrn6twNgxK*x1R5-O&t;t5gYwNAgl^6npxr*Rc3IeK}3v|_tK?Me%I9|+jc5Ra#*Bg zGz479y~b2|s@E znk{zEN!76Z&c)kE*AwY7NEbVg6=%Q6n}7#KT(CX5 zC3;iTG7ayQ}B-_Q3zA4}kE z);wuzL(%qm9%7K`d#J`7n@yunAintx#XB#7DRiY)F;}18I~$RQ&ihK5;1krbXfU4S zy_};`zBn48PmtgtO=~=-J_5KtV~h!3AvafV&~8gx0WO={N@RxsE>qs9Qd=Y73!`l6 zh=!{6$l>DqpS$odA_*g|?;f<%0^>s4tZhtZTeUQ0Cw@5DZUkn>9j%zYj~TUBpDd!5 zQwZW#hc?YP*ZDU2YK6zqCO3B-x$uV;t`MyG>vsJHUkxLrhE4-7rITB*8NN9DckG#d z=a(#l$DWDN9`JLGKXd!uMWLdS8pvesn|=I}`vodY`+Hx$=u7TnVMfP}Q@R?1AB?dZ zWO}*&+8;n#VEM0vc$1O0A$&6-PQDQo-3~+7YJvG9>g2(TdZ^80+%Xshuz9kR-)+lo z?cH}gxSDlZP4bXoUz6PSf_>-t+{y8!r#RBgH!!hc@zXH_vAtKxMeOF(X`~(PTc@RgaQ-6-Ko4UWV#E+f*B>8S&Oz^;HOwfokX+;x1Oh8Ljk%04jH*-{# zcF&{Mn&8|<25n(qtl8#a7hB%_I*ToH+QV6)Ga);~mh;Nb^A`JO4;Y4nvH{sUcS-s} z%;6u+tj$5oePhs}vTl7f^H~$8-odWN zo2v6KiqV-KpRT5~dn!$pUJ!3hziM0l zFX93i*qlJx(JupDxfcX!sWzpUtpf3rCOOlAN==NG#hVE?Lt_`lJd zj~#~MSUWKi`aoEJ%=`#L%<;GBE!g+3m2m)|HvmEb1f~~6`G?v^3^Jg76M*pH0_gpN z$^M9x{;N$;8Nhu0&+V|YLr8rZp5F$02b44>>3E|00`xG z%;irR05OT{5gP^u@Jj%9?T>`9M;u!M2-9QL(^Wr+9l|>fT>ZkV7%sy{~FNHMs%#?)HZt*6}Hd^myC@M78#OJgw;ARhKg zyM}AzKRP}e9OT^l zS+FM3y7)c~T z_j^55b>gkrqm(uQrNE}1YhOVwfT-CkN-$hDlfHC_is1o1$jk9O0W)QTfShB5(wS&| zf%^!f01TtM>$pZ2wqdw0O-*$A13%%#&@kRGA`SMjghhXrD-HGu^Ok1mYUTf0r){}o z&KQT0&l&fkZ`@swOtL*#Pyhrko!Hizhf8Ny$D@ESzELKI{vw&hjY^tAYbUi^Fd&O( z^J03%e7f(j@*K@L1l%!zKw`~cfTo{hZhVE#niGxYyD6+q{`I`~EY?}lR819s zq+I0NxC3qlrWbbmPDgl@x`?=U8FdJIIq!FhCcbEYeIb`r>mWO~drqCU5Ya9lPjQTn zSLIKTIX_>ks(sJ17iA?2*bXE~yPV(Px6zo^pG7IE=~I7?$qLrtC_6D;xad+bW>z#d zWwzEemml?9`y@`&W)jA{rEf?%ZHja!UZBw!q&k;E!urV|sKfdab?6&?HnCGs;rK`r$+sKBIIRqajE~w-5hZ7I)J5tWx|0TWdy4Gpg!DPE+<1 z$$16D9r6ADq zL&&u0%0CBFxj$|Ne45YdY8wHa8v17JWHCL=8=%4sYLMiCk*cpWxbC7kmuJq;v>;;)1O|B{2^CzV43o^;mgk?=g zo~GouY4o)DwE^QmSV%nDnIR%AsrZV*GC1> zQh>=aozFeNF#dASmtK9Rky9R6-BRk&_j!3zMH3;t+m_pf61Zy`n)2#6JMEP{nAW$A zF&Bwh)gO;XEdzSvY<8)SIdD!A%Tl3ZsviEm9~qr(&mM+|KZ}DRoJJN>zSQlzT8S`R zPt8j5uFbpI)e@h=$&XU{1)DTv3Ri0qg-@1w^1Cf*z@>5BD>gfVZmEsP!>R_$-kFSO z3TJndi02qTacW7+{pbjl(K*7(6mTTHCq#XG`>In{pY;n?NydFChAoMD4j;DqNzP#M zt$l2c6}mY3Q$dm{*aQYb59f;`Ea#AR2~A_uO#ZxPBdD4dMS1uI7CtE`b55t zcMJLtz5qAL%^~w$!Xu8qn$NXJkD#fGpxs_a2tzEASk*=z8gzfpm|Y+y3}U zM)c2mQS{3$!7ybCE@5$mIda|lQ8E|RIjGIv0rE7;XCJ1E;Qcan&k{%l`kag9QBhG# z0?937Za%umGV@5i^yOQjkslbYq|s!&zCPZC6-Eg|-22O*fQ$wLU`Rmm?sFV=&R<_# z|H$}Y2l@p5iSL0+|3|V*Q~K0GZ?Y``B7&QR?*o$fm zi0>rOe(|5Gfesu%7mnYUSWSTLKW+$s8VQL`0RRqIrvSs|pF`OJ;76da*cbz14KV-M z@gtHh0Au>gj-&arZ6qr@fLZw8R^2cBE}+@Yqt!?CX9LN9O9MEhKtGu|3>sD-W93iF z^R0#ak1%0a^z^1WrH*HNM**6(|rdTg}uCh!MD8uYuhI9Rn8}HJAIKIVgm`&glVl z5T88|NzKh6=p_h>t48PqBnAb={rHy~3PN%QeD;u@0k4q1e<49YXCOl;o*I)g5IYE% zH1Pt!9D)YGmm$hX(3mxQS0HZ$2oE+i%Hu166p{c9U4sp9e?6%Gx<^1;lg9xVH7+pF zH*k;{;=c!^BSNPD1Ac*v{P!K;VBx3%224Ezs>w&Fq3IziSkPmD;Ny$`^*;pxC*)DH z0ycE+Q{XfBmozCcbpBs;_5WA}aPuBzkBFg{p8>mhl!f~3`20gB>#yx$)R56a3&4R` zSs@0@(DPWoGT{C>IV)R@G7GdR01w>?{p-y@3RzQwp2Y&1i~PAxR>0R`fyS!YQim>* z|7%w@%{kCwAS?j!_g~V$u2_H@OrH7n6mut#Kx4uHAA>BAR#_NYaE)<1#e6koa<$EznyK1swGEJqVl(&nb1+cYr@q9y z;O&|6{YbI-hP*4JiRHVFRY{XE3~!kqThr&zrkH}nCL*7-B;U|r>7lWyo=(l)MYW+c z?I69WiH_Lq(o~|L6rJhbiRT6ucGO1CST9Jm*HOuBAfh+3y7APJ06@f%L{1H zTH4}!2FAMLr8V?KRbDHkgvjV9e3YJ_7@FuE36gH@?CBaylCliEkk_-)@3^zCs}^nF0hNl*w8>)NYc)d3kFW`!;TZD^Uv=-`S&w; zyUi3x^7{wY0wHp8;6Vf2jeRJvEV}aDQo+FS67>(Tf5!tO=%J?P=0S1(VPYHH(D491 zIt9NBubZCk!JEC;^#M1tii1h;#P~CtkC0-JMukx$!w(+lJ4dF*y4D`(cZ9PhY07{JL<7}zr78EoTunu$;Hl0Knd^syZ5)m|8+^!6{Fc4*JXWSaf;VrHoH>p-K5Bt{(emR!kEg=@ot+XIF+RIVW_+ z1dgtrGDT{0(`yvPh{z9TfN@=KU@boH@?3v{t?!RWLzLBGU-Y# z+I(iy0Dgz1^YSV0whX7h7h%_erYF!ZBeM$P5Ri#(G-(~#W~>k4+JhZej#N{pXs~Vq zMJ#NOZ(p(mwb9Spkg!8~X)Hc2W40_=U-2W2CH87f5WcKyBRavWkF+U~gENIA!j6}x zp?slbE4b7DjEYxGgzqhqWY>$beLF*52CIjiLbO zr14f(n25|m%4;?vu&T~6HZTW8$cdNpJQAAR3Wd#@S7u85t9?rVPOJif)I#))U*}E5 zL_Dnkk9%VonG{lt+>TAzb(7bMzw=;LwBS)C4;6X{|CS?BZ>=}-!Lg^G&II(i;oXlG1_dgy)cRD_mRCQFJa z;T|`&HSM@Iv~`FeL1unwjXMYV3Hd|l>#HKtwiiF%_kF8~F}sa{-oNokw@Q&sDZvGs z)u75WBIsj6{V;|Nw^Vj*m{{9B6^|(HIsKeHkSZn>&J;TaBV#p?ga6U?gCn|_WXjcK zzgwU$Jpx7`+MP)h0W`}3pMw)jT|z&yNlZ|!z64TV0X~_dP{GWceNrrT1p(KJ1fgEy zS%9>E_5gr=D4(zF|~yzQRMgjbS!Ns2D-s zvFm1m9!3Y6#Ss>R#^hqd(s1BI#220$pFDvu+C70)xDpkTIT^k!xn}e<9a%o4y|v<# z$P&sPOZNgS|pAn+??u_E+k<`P?BIYS*v6qO+TC&|tzm zV?K1h+`5@mf4!Jp9oXQDHzX7#25-jgHH`1mu2a%%`r&ibm-^P2!##yb-;^2tt)kdE zJde$1yd)ZzwDVfRAFfu-1o%^q-;9p$PRU6P?DlkoB54kq;0+3D;O?Osf^k;9E#AJN zKx&ti!4|48NesCU%Y~G3YLI(-F_0bL=qj~9*;!Gko~g6EfoY4UA}b$eeZo=jDbI(p z>DA^=YG#5A{f5yNgtPoKQ=sS#>0bU2?A>Qg$A%@=2?XS$tinMCAz`d*`tMGs2v|(C z-EH#B4McjQ5Se}Lyr*?FufV&qFEzDKG=m8GnRAaz;LYw|F=iCJ;qpfDB1R{ASJb1K zr2i@jcFJ-l4N76xZG1giuoLSA4^hdh7j+A7;rctNCL$S|l6hWZw`d826+>NIv0i~+ zCZ`X^hg3(5`N?69L@>5LONg%&VsIAg;2q5bd&`YfJo{MJL1l1BMZXLVHOfo3@Eu2Q z+yYYT67NA387Nl{-XRE-Yv-qlii#0UIy>d-++5v)hV10)Bpy{dJ7OWTK2fKHm<78I z1jOa>xmfptD~WGE#kO2wo!7sHdU*2@P0dU!PXl+J{o}d-`RfQR#=8pRZx)P%3s>u? zO77MGRVQ>Wf9W zZiht?5kkFePVQjfNZ{pK(5LYs<0Qm`yKdd#?61_wB?-b4#U(;_EnXhNtR_)Xzs7s= zR>M4YgLe?$GC!o-12WVU%mxcBeom@P+VM0hz!4YIrcMq|RCUQ7-1q|FxR*7i#rasG zbZtvdUaBs9K$PD7vwHs_b??RU;yRVs{L}U79d0&0mUzkiL)vWJT22fz-&a0suO=;| z8unHq-`rKDkcMjNwb2+eo#;XzYhb{7E0Zb}u&LJ^QmB$rn|2|HLgnoG5-A(^j9$w% z-A)jq_oN;4ZPsP1gQFNM%HOOn&O(E+-V#r-_ZW~|bH3ayMKn`SmyN~1!_pCA>3xTN z6g#mtW*92YqA138tyFArB)@Y~3$-#wRGTrq)X(KYVtGiP?>!>9F6`^lsnn~bbzxVQ zh8uVy$`{by;v}kAh^b7i8|Tdu?5M{giIR$2=}WW`BJAPZ1%@vUYpKXWVUXG+2tneg z{rQx9HIU<-uPhsVsQt!^t|5P#M)s!lWZJ+FCTB*kt0vle7b3{=^2n&)A6j#hNqw#% z8D2|$7u=Qz6~7I0E{XpfdH-{%zS~dCI)5fUn4e8#!tO^0&TBD-GEEbuhrGvbG}}8J zYx7gJ#PqxyI7MJ7mUv-A#)+Ffi?4(qbEm@?IzPVLX_iGHcZ+UOp2%Qk#g~=cZ1C2q z3BxgrVgAe|S>`%_)_@sR;q>AzmHBytO1t%wfoIP0G&@0U3YzJ?u?v|&TW~_ahhCdw*My+f`8`ZXBWHI6_t2)ot zPx1f8^6sS8t7896C87h#w_dUI%B5HAqMS?4)CODy+-vpGx|42x&&$YCP#dVf z%3nkRdvAi;4n`NHbo*5NK4`fcnMfON2nA00sJi3jMH7CzX;Ue8Q?g5!Rbve*E7rW1 zLPuj~zgyTUiNw27m0H1fnM~VO&HBbV+8{&KZ0|mG3woyfOo0%x>a2nWK+0`9^4Byqp+ys7b9m&mn5>A+Q zla^&XsCjlWuqUQ^!1%J7aftif`U2C~It(-aHh!wzIE#D?$jK_JtVdR3YX1{7DE3Iv zCnGP7PX?@Jcevkb?0rlW0UAN%p0$(S=(f;xuCmDKoll)`u#l1`x{@xzUk*Z3jk>M* zvP5}=dX1{bc&8H~?T72zC-`zt0qR-5pDLBY@i5VNyv9IE1EGzERh4n)ZT2CAba4m- z@$rxqbsUpa9yP?dCAoQ8UhT5Z&Q!8$|EiWEgA=Uzxx>XN?6^~QdpAU$(E~;PL$Rso z4ebQB$lY_d(vC`;@$`}5VpEQdA;T;ixEa_QhpG1F zb|L)xJhau0UX_>I=?s!@)Ms7=aFQc4is}s4kHzT93D^Q?8!auPj__|1QGT3}^t8#0 zZ@*qHmJ-J?l|HecN@SyGr|cGNC1XGidz;Y#&bY~mh<*Jej~TR3hk(JGB;c{cU3Icm zy*Mh3f#E+(AxKa)C4MHO^IQJt^e)B^7FB1G0Q?d65cX%%TyMip{H!8}}y~ zSWHBLiPc|%d(Be3DBy{kWz*;bMP!Z;lI^O#?D7V2A}x%5DuR(ewh$Bv>f|()B5N94 z4b%5=;s4q`QhjR(a~a|r?u-iWUhKsZ%mDsye|;}yD0;FO;qTMxw2*2v_y5>B&Oj== zaCom3*;|n^3wI9{l}bWZDJimAqDWJ^$!I7mc|{2!vq&XUh>DDoP$@-JN=bx7eb0OG zrTf;8?|bi=&w2LqoZ}ouyX!%xXkEs8uehcFt?AIoUHZf>()`>XTSd@)!8d4`X&3E?bUb0@CE(DuU>hu zjRHT;{@@$-HjU>_T?87`eS9Es&zh;fjjMirZP{@^C1kbv&7~|8@2m?K?lTq6l(hEy z&r`p1EUx#+$Wrzxl^jG?W@}nW{PR)0mXp*hUT?W|j6*Z2ZSOxXUvsxV<6wHKj_0a- zfzlC`UM}ei_iRvj6230GQ@FxpiQNF{+}Wtx?6C9ZeXA^2{4mWtpQydD@N?D~)wRYZ zOU&K|^5~yDz$03c(Rpg1TRn7s?3op=!J@x z#e(k#>%Z#uL}ilquXr=vwE3*K-sQ-r630J3bkRCw{rt@uou6`-hCdvr8QJyF>i*Os zjfaaqDD-|{^R72e+?%PNZ)_tz?=;=bsO$Lk-&rwgGtjo4OA9*9D?O?QygzkVHV=eH z3)bb#?@Qf8|k+Uf4Ywg|n7P^`<>8;8emM7oH*eO)>`{+B(Q_@Xw)EKk1jh8id1f?j% zzYO~zxPrbwX~S9Ju+T!sx5lO_h4Lp_%(FxIv=^`3x~ZVVPx)d)cU5Sb*6fRUvjZ#D z7>mLc_J6jRb@nm4e>HJcG|S>#4ZpPEuGDph+^M7#pHSYxDQ=eP89Bb6`WFo!&U!|! zw46m)=yFct&@~Uz#|sKY+deYddovrWXU2qWaGXsCGqlb}`;*-!GXFNU?93E#!G^Rzcw7LXv`yXM2u zV;$3-U#@IFUN5!AGT(wH+CeW?^>v=1-=4(6h>>=xqp8;=#TYk#UN^h7ok|}qWO`nY zrmUKOVmPFd!WdjqurX$659RAN-o0(xX6RPjEPZoGvsQ@FmUu^1n4D@8TUsbstbO;B zGd(_X>9!#Mh1m;qZaT9ixAm4#57s`6H}Ftj-XFa=A&1VqxW~FGbZ##q*|cU_2y=eI z>_sl|tPRFm_G+H{tb*R0HoiLug| zN-ZU${x^T_H2UqaNvqaAtk`v)hrU&a!1*LM>xj>qW%cQvTdL1#2;F8}kvEIIoZipq z+rI0%&2q9u(w;o3(5k1J-BU@dhW(AhO@=bf&yW5-ZrUha{Y5G}XjNglxz58ai&D`` zO9#kg#IxKtZT{!11zQt$MzXKYX(+hgeVs0$fBld}rftBvyW5;Eg$MpLyysXEb#

XyiDV8BsF+)Q)Zk^gC7tG$jWhn5P zZCKTg{f#MBue8f;5{-*!Z>zOB(*l1Eu3Mik)n~Om<1SAb-)OJwtc9xTLyJ@0{mZE} zfwd18T3yz0c)!Mqv^?E*zw5wkg%=x*lSUuMmVDj2EB@{WWbVGl9rT;<$I{D{l2@#| zoar`u_MQ3L*5!vp8vK++T5SRplSaOL5WHBQ0fWn;w(q?P7GF zQu}dN>V(m#`0jZZl1>$xo9ehUY}(g&P1~V=imFjrpw+9L{2!Hme!O1%zUpP%Rl^>E z%>^57JUL^sv`&_YZbH(7msIM?dfNKOlWCLP|cK zEhJiVC37!ojZ;VaE^ z^i+%Q_`p1Pj$buLv0w2}y+g2?##@7uzD;aV-l7Pe2Z8xS0Aig!pwUJAGz!zcsym zLQQ!kyZp)Rm<~&)^i$7Yu8b6V{cztL>6yQ-9Xl{X%a1=oc3^AXjkY%@cPVXnvAOD@ z;4G8In|v3VR$trXTs)$9EQ@Ax#B=ldJvxeB7xoQZ>K~p*E7mx$?cK!&)yM?l@}hjd zyBYJ&tNDf5z72PJHeK90anpP)yHDTBHrQ@cdYe9VBiu1BDEQ_6u}nklYoc9N$0Mk> zbNB0|hg{C)pyX$&N8qujxOn zC6>kUIA=$C91XaAz&q@;p?KP}=OqpY&h|>Oqy@D}yG`z`wXJL%IeccD+0b*VuNfN> z8vCyo3R5doio^&Za0$nQ~=G%dCt8+gDzGHLp8)S03*TUJ0G5NYm3dKJ#~uu+Vqc zB%j4iOn?+TwIf^SIkK|-?{CnzsmXEOA(!${L1!wJZut*Y9VJ>tRWoj682$t>=2Oe0}+H!@s}#pmU^i!*jFn*Vaqa*RmJiinesqNo09%jdf@iJDM8Bf-6## z+>UOWI(%_xr`hYN^n#z$Y5w+`Su4t(?Pz5DS{~!)ZndU@Z|kVMbDif-OZL~p0~b{f zEAJB#Lob)iefnPJOf{oHJm!k9lg-*|*Jm4*|5&zK=M(?;NB(lpO*cPb)u%2SXu41w z9MO5QS)rmuV}>}vg!Jg#rl)fI-ub=1Sf%*sql0Su`WHd-eYx({WGa)8S8#sloNuji zg3qk4(y23Kh*l^4()A4re8mUvJv*-a>QefYlR9!98%|k=2x^U^>8D7 z3_bDH$0o6`f0dZ&hP8WM^`+@+ybO4@m(+Er-?{kF#!g}9c^A{k#E+C1^myWh$M4`O zo$kBpgJ~D5mqkV+uL`Pae^$nQh%-O8V%4V$k!L#x8C&>--L_b%d^yD;53alF`=c!; zEdMYi$kD-4*YoKQ@{JSgqAS*uD|J^;FDx4VdOeUd_2at_IdhD+D3>0Zsm9YqN8TBr zwBP<~Jyxn3PGJjQJa_S6R{O4J{Gsy<{ChRoi*@z%qRzMrl~*x-pFh|VA|#-(_H?|B z#dqy+`PfJI=Vjc}tBw8qKyBuX_q^3JkEeAvw`Y8Ma5?3-j*?S{3Gb_$^_xpot|x|& zv>MO5$w^(yYk0gWJ?O?rPV9*iBjGNoM%}8zw{1^)JmFUm5Z*5}HEwR*+iLAL)5}ek zP5FdI(nPS++(|HB_w#A})+3UYPIm0l&P=Jsj_9j*3iOlT z>N5(cHesK8UzZ4n>l9WqGEXIJb0 zVO8n7W>G%2$dfmI4Ggqm-s$$)m^)wIp+Ga?k;>sa`|2WE+okj_pk0pDj9G6bv@B{~B>*FFs1j4_@#7W^+@h?WRBptBlRZP8ZHy@OqJVs%X+VgZB18|KZz3&rVCG zJc=VpeRqhB;HOaP5z?B3ldMzXPo_*eqAHTxwMu=RI;pv$s`kyx?+fWH z_L^HkD#~Tk4W=5lEgG~lU()DfbuWy%%ks^U)=HyULq0ou*@xR^E{sWBV|nKIrUuu? zjDj92^VI5@<`yeM1stZ{rWlGw4s;vbpDQHHa%LMUIDQ-~`gzcF_r4p-?w2fo>`YiY zYQL-0XXyzE+ig9Wc^WxUHTnBHI@$``&BV0NZS*Y*j$7&5Gkbn_v&^c_`g_YX5BzY@ zDf@ac*^23Bd0Xv7C_C>R|54GkPFE3?w$E=hE{4t56%|4eUtag4Yui&Og^zx(>9#xN zR8qX9LjH0Z2Mq+6x2n0>z0fsU$>wO#kTJ@ahbr>k zSGE7Nrt7Cq&-G_KzWCeOe0T+crm$MTWaHP`8hejq|HAV@Tc2-Vo$Zm=y>hhrPQtxG zzY|2}ob>4gMS53$$U&82EywSIimz5caJoG*S0_JV{wV9AvPfsXvgQ7oyhG>8b!t3q zkc#DH=eA8NR}8%MI_L(4t!~{d-+E~_YB1Hq{qu{CU3r&KKl{aeF>Z^f?_ zF(~;K{W;_N)jsrz2>1yi6~1t!!uDuVxvaP{ptfK_}uY0xHP< z^)p?G4I=)<;zW-Fix2c32+0%cKT3?tyqGJ`YL^&&yLiPxyB1xhmlr>Kz*aOX|MdMM z3AfTE<@7G>{}w24p_0cdH(51&Xzuqdj$6))lNM_|+u@byJnX*T(Ce4=u;udQh0=lF zZsw}lT>Bt+yZ+njO{{mS=wiaFcwWciI{B0*KQw%_c}P~v2jbpbY5j1^cEP@$p|p=4 z0Y`3Z%4keV7C1KV*PM#SwS61o*zw*vFX7cD8(pK(>y)aN!a!fhk#q{q* z-Z$6fuuQw2&gxIhjaCY~{NDfOIR~}k&hI0?LK+(9M^X1xTMKpWm1s80maACvg&p&n zr?z0J+(p^C>tWls+YTSd;3@FSPQP*I;Nqd5j7{W)hQHGu<%nc19l5sh-qv#6YrHWx z4Pw7M+9T7Gg?1g7Dt5_&aacTbAp13+FeNAXb^XsA{ZAXxd%hP&t)07WR-3)AfJf|F z9<48a^DeEo%og;!F(>@;+$pRuO1~mc zHB~t`*wrM=I6Cv4$!pU&DbMu?mDUf!L-lL3I)ZxoLYn#&a+I$gRDWjQ)UOh_ zZoz=+I_arCJcmdvbIU9XO?2#+@tNH^G;%*(ycZLnYnk}W#7fYk_2i+ui)@hiS zKg&s!tc|xjGxw(C2a>KxRBKm~3*WniCvW#Rh2#V-W52&Busk%NP|+g1GV`NKd=4om z!Xt0vM%E5VKDWrexo?t5cCpl}5eYS-_xTC$Kc8f8oA-H-$*=5LxAvs_`-mNHL6e^b_rXUsg=r@8WZMLrhMeU%SK z3f_JlsBKv9k-F#Avw;qGQZ~PcM+!M?b8NSqPgVJBn}Nbx>}dLDdby{zSF0H5jzeUI z57Wlp!D-)|qqRYcg&faJ>sW1m)l6wLSD`K~UL^2RR&j=W`Hv2X8R;RxRg@{2%@5Ui zw*RCGEmPW&b871j0nZmXGxo-YA9oqpWRkEXZq{I5^|dwag@-?Q2b4B!S$5iHUww#u z-5xdD*B5GMmM#t0%+C55Of4(zlz5puHT~i*skfOUEy@p7Uo5+PkMC+gU)&vmP|54r zPmJ#$z4@gT)-nM!*H*4AA}h}0(jURgH( zr-(>;(3xTD<0OjBywUoyH#e$jH>@_56vXb!Kbf)p_KF7G-Qm1z{n>sR&Mz+s#J2z3 zzC?xZ?4J4!{P%sTHG8i+C>jg#wQ7B?4cF0m*ZN{kPiB^DI?>!IhE*@OBGgVxsVqx$ z`^%2{eFb_}y+JomP3xR5fa@bB^z>zR*Det7cDs}C(mZn&(W}B++Lp#9UyN%1w*LNb z%)YtG+pZ~7j}(;O_38*6xq@a6bqw{ee+W~J_VXZ;se9-H?E`3H*>LM_rTy6TISqDzvUln_sDHYIjmi| zO<_sg@tjY&onom9+qTxG=tX-{EcG>Jop|y?*I=5jYEO7#VAQPG`K5`W#Y?;H9~PMM zJV2pQo5U`6elm@CZT@NIK8Xh}4xf2={O3x(q{^@dwXCi?JS}Z=-F*2y-On_Hh*